/usr/share/perl5/DEPS/Transform/Consolidate.pm is in libdeps-perl 0.13-2.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 | # This file is part of the DEPS/graph-includes package
#
# (c) 2006 Yann Dirson <ydirson@altern.org>
# Distributed under version 2 of the GNU GPL.
package DEPS::Transform::Consolidate;
use warnings;
use strict;
use Set::Object qw();
use Carp qw(croak);
use graphincludes::graph;
sub apply {
my %args = @_;
my $srcs = $args{graphs};
sub _addnodes {
my ($nodeset,$graph) = @_;
foreach my $node ($graph->get_nodes) {
my $newnode = $node->copy;
$newnode->{ORIGINGGRAPH} = $graph;
$nodeset->insert($node);
}
}
my $nodeset = new Set::Object;
# start with all nodes from lower graph
my $prevgraph = $srcs->[0];
_addnodes($nodeset,$prevgraph);
# successively add each other one, lower-to-higher level
my $newgraph; # exported from the loop
foreach my $graph (@$srcs[1..$#$srcs]) {
_addnodes($nodeset,$graph);
# sanity check: nodes in lower-level graph should not have
# ingredients from the set
foreach my $node ($prevgraph->get_nodes) {
foreach my $ingredient ($node->ingredients) {
# FIXME: error message should pinpoint the problem
croak "graphs must be ordered from lower-level to higher-level in graphincludes::transform::consolidate"
if $nodeset->has($ingredient);
}
}
my %replacements; # track to which node each ingredient node is mapped
# remove all nodes that are ingredients of another
foreach my $node ($graph->get_nodes) {
$nodeset->remove ($node->ingredients);
foreach my $ingredient ($node->ingredients) {
$replacements{$ingredient} = $node;
}
}
$newgraph = new graphincludes::graph;
# add the nodes in the graph
foreach my $node ($nodeset->elements) {
$newgraph->add_node($node);
}
# edges from the top graph
foreach my $src ($graph->get_edge_origins) {
foreach my $edge ($graph->get_edges_from($src)) {
if ($newgraph->has_edge($src, $edge->{DST}{LABEL})) {
# already added, just add ingredient edge reference
$newgraph->get_edge($src, $edge->{DST}{LABEL})->add_ingredients($edge);
} else {
# create new one
$newgraph->add_edge(new DEPS::Edge($graph->get_node_from_name($src),
$edge->{DST})
->add_ingredients($edge));
}
}
}
# add the edges from lower graph, using %replacements
foreach my $src ($prevgraph->get_edge_origins) {
# internal consistency check
croak "edge origin name '$src' is invalid in graph"
unless (defined $prevgraph->get_node_from_name($src));
# look in %replacements to resolve groups,
# then look for a node by that name to catch the ungrouped
my $newsrc = ( $replacements{$prevgraph->get_node_from_name($src)}
or $newgraph->get_node_from_name($src) );
foreach my $edge ($prevgraph->get_edges_from($src)) {
unless (ref $edge->{DST}) {
use Data::Dumper;
print STDERR "From $src:", Dumper ($prevgraph->get_edges_from($src));
die;
}
my $newdst = ( $replacements{$edge->{DST}}
or $newgraph->get_node_from_name($edge->{DST}{LABEL}) );
# do not add an edge if there is no match in upper graph
# FIXME: check - does it cause problems when there would be a match at upper+1 ?
unless (defined $newsrc and defined $newdst) {
next;
}
# ignore intra-node deps
next if $newsrc eq $newdst;
if ($newgraph->has_edge($newsrc->{LABEL}, $newdst->{LABEL})) {
# already added, just add ingredient edge reference
$newgraph->get_edge($newsrc->{LABEL}, $newdst->{LABEL})->add_ingredients($edge);
} else {
# create new one
$newgraph->add_edge(new DEPS::Edge($newsrc, $newdst)
->add_ingredients($edge));
}
}
}
$prevgraph = $newgraph;
}
return $newgraph;
}
1;
|