OpenPKG CVS Repository
http://cvs.openpkg.org/
____________________________________________________________________________
Server: cvs.openpkg.org Name: Michael van Elst
Root: /e/openpkg/cvs Email: [EMAIL PROTECTED]
Module: openpkg-web Date: 14-Jan-2003 14:40:11
Branch: HEAD Handle: 2003011413401000
Modified files:
openpkg-web/dep vdg.pl
Log:
colorize by package class in dot/vcg mode
also build single-node graphs
Summary:
Revision Changes Path
1.9 +152 -113 openpkg-web/dep/vdg.pl
____________________________________________________________________________
patch -p0 <<'@@ .'
Index: openpkg-web/dep/vdg.pl
============================================================================
$ cvs diff -u -r1.8 -r1.9 vdg.pl
--- openpkg-web/dep/vdg.pl 19 Dec 2002 10:52:45 -0000 1.8
+++ openpkg-web/dep/vdg.pl 14 Jan 2003 13:40:10 -0000 1.9
@@ -1,5 +1,4 @@
-#!/e/openpkg/sw/bin/perl
-#
+#!/e/openpkg/sw/bin/perl #
# Usage: vdg.pl -f <format> [-t <treepoint>]
# format: vcg for use with xvcg
# format: dot for use with dot (graphviz)
@@ -33,7 +32,7 @@
my $colorentry_upnode_text = "39";
my $color_root_node_background = "181 176 160";
my $colorentry_root_node_background = "38";
-my $color_root_node_text = "255 255 255";
+my $color_root_node_text = "0 120 0";
my $colorentry_root_node_text = "39";
my $color_arrow = "255 255 255";
my $colorentry_arrow = "40";
@@ -46,6 +45,35 @@
my $dot_color_entry_font = "black";
my $dot_color_pseudo_back = "black";
my $dot_color_pseudo_font = "white";
+# html indent
+my $html_tabs = 12;
+
+my %pccolor = (
+ 'CORE' => '255 255 240',
+ 'BASE' => '240 240 240',
+ 'PLUS' => '234 224 208',
+ 'EVAL' => '224 224 224',
+ 'JUNK' => '255 240 240',
+ '' => '255 0 255'
+);
+my %pcpen = (
+ 'CORE' => 42,
+ 'BASE' => 43,
+ 'PLUS' => 44,
+ 'EVAL' => 45,
+ 'JUNK' => 46,
+ '' => 47
+);
+my %pkgclass = ();
+sub pkgcolor ($) {
+ my($key) = @_;
+ my($rgb) = $pccolor{$pkgclass{$key}} || $pccolor{''};
+ return sprintf("#%02x%02x%02x",($rgb =~ /(\d+)/g));
+}
+sub pkgpen ($) {
+ my($key) = @_;
+ return $pcpen{$pkgclass{$key}} || $pcpen{''};
+}
my $numberargs=$#ARGV+1;
my $format;
@@ -77,7 +105,7 @@
$requirement=$ARGV[1];
shift(@ARGV); shift(@ARGV);
$numberargs=$numberargs-2;
- }else {
+ } else {
usage();
}
}
@@ -114,7 +142,6 @@
&mk_correct();
}
-
# Generates the outputs
if ( $format eq "vcg" ) {
if ($tree) {
@@ -130,7 +157,7 @@
}
} elsif ($format eq "tabtxt") {
if ($tree) {
- &mk_txt_tree();
+ &mk_txt_tree();
} else {
&mk_txt();
}
@@ -173,18 +200,19 @@
my $version; # version of the actual key
my $release; # release of the actual key
my $verrel; # version and release combination of the actual key
+ my $pclass; # package class
$x =~s|\<Name\>(.*?)\<\/Name\>|{$key=$1}|egs;
$x =~s|\<Version\>(.*?)\<\/Version\>|{$version=$1}|egs;
$x =~s|\<Release\>(.*?)\<\/Release\>|{$release=$1}|egs;
-
+ $x =~s|\<Distribution\>[^<[]*\[(\w+)\].*?\<\/Distribution\>|{$pclass=$1}|egs;
if ( $requirement =~ "BuildPreReq") {
- $x =~ s|\<BuildPreReq\>(.*?)\</BuildPreReq\>|{$requires=$1}|egs;
+ $x =~ s|\<BuildPreReq\>(.*?)\</BuildPreReq\>|{$requires.=$1}|egs;
} else {
- $x =~ s|\<PreReq\>(.*?)\</PreReq\>|{$requires=$1}|egs;
+ $x =~ s|\<PreReq\>(.*?)\</PreReq\>|{$requires.=$1}|egs;
}
- LOOP: while($requires =~ m|\<rdf:li\>(.*?)\</rdf:li>\n|gx) {
+ LOOP: while($requires =~
m#\<(?:rdf:li|resource)[^\>]*\>(.*?)\</(?:rdf:li|resource)>\n#gx) {
$temp = $1;
$temp =~ s|^\s+(.*?)|{$temp=$1}|es; # Remove whitespaces at the
beginning and at the end
$temp =~ s|(.*?)\s+$|{$temp=$1}|es; # Remove whitespaces at the
beginning and at the end
@@ -197,6 +225,7 @@
$verrel="$version-$release";
$requirepack{$key} = $requirelist;
$version{$key}=$verrel;
+ $pkgclass{$key} = $pclass;
}
########################################################################################################
@@ -234,10 +263,11 @@
print "digraph depend {\n";
print " node [shape = box, style = filled, fontsize = 16]\n\n";
foreach $key (keys %requirepack) {
+ my $color = pkgcolor($key);
if ($key !~ m/[A-Z]+/) {
- print " \"$key\" [label = \"$key\", color = $dot_color_entry_back,
fontcolor = $dot_color_entry_font]";
+ print " \"$key\" [label = \"$key\", color = \"$color\", fontcolor =
$dot_color_entry_font]";
} else {
- print " \"$key\" [label = \"$key\", color = $dot_color_pseudo_back,
fontcolor = $dot_color_pseudo_font]";
+ print " \"$key\" [label = \"$key\", color = \"$color\", fontcolor =
$dot_color_pseudo_font]";
}
print ";\n";
}
@@ -260,16 +290,13 @@
########################################################################################################
# Write an tree output for use with dotty
- if($requirepack{$treepoint}) {
- # Just make an graphic output if requires are existing
- print "digraph treedepend {\n";
- print " node [shape = box, style = filled, fontsize = 16]\n\n";
- &mk_dot_tree_tree($treepoint, $treepoint, 0); # Create the
tree
- # print the endmarker
- print "}\n";
- } else {
- print { "STDERR" } "$treepoint do not have any depencies => I do not
print a graphic output\n";
- }
+ # Just make an graphic output if requires are existing
+ print "// $requirement dependency graph of $treepoint for OpenPKG\n";
+ print "digraph treedepend {\n";
+ print " node [shape = box, style = filled, fontsize = 16]\n\n";
+ &mk_dot_tree_tree($treepoint, $treepoint, 0); # Create the tree
+ # print the endmarker
+ print "}\n";
}
########################################################################################################
@@ -284,24 +311,24 @@
my $firstconhit=1;
@reqarray = split (/\s/, $requirepack{$acttreepoint}) ; # Split to array
- foreach (@reqarray) {
+ @reqarray = ( undef ) unless @reqarray;
+
+ foreach (@reqarray) {
$useelement = $_ ;
- foreach (@foundarray) {
- if ($_ eq $acttreepoint) {
- $firsthit = 0;
- }
- }
+ $firsthit = 0 if grep($_ eq $actreepoint, @foundarray);
+
if ($firsthit) {
+ my $color = pkgcolor($acttreepoint);
if ($acttreepoint eq $roottreepoint) {
- print " \"$acttreepoint\" [label = \"$acttreepoint\", color =
$dot_color_root_back, \
+ print " \"$acttreepoint\" [label = \"$acttreepoint\", color =
\"$color\", \
fontcolor = $dot_color_root_font]";
$level = $level + 1 ;
} else {
if ($acttreepoint !~ m/[A-Z]+/) {
- print " \"$acttreepoint\" [label = \"$acttreepoint\", color =
$dot_color_entry_back, \
+ print " \"$acttreepoint\" [label = \"$acttreepoint\", color =
\"$color\", \
fontcolor = $dot_color_entry_font]";
} else {
- print " \"$acttreepoint\" [label = \"$acttreepoint\", color =
$dot_color_pseudo_back, \
+ print " \"$acttreepoint\" [label = \"$acttreepoint\", color =
\"$color\", \
fontcolor = $dot_color_pseudo_font]";
}
print ";\n";
@@ -309,30 +336,34 @@
push (@foundarray, $acttreepoint);
}
+ next unless defined $useelement;
+
$firsthit = 1;
foreach (@foundarray) {
if ($_ eq $useelement) {
- $firsthit = 0;
+ $firsthit = 0;
}
}
if ($firsthit) {
+ my $color = pkgcolor($useelement);
if ($useelement eq $roottreepoint) {
- print " \"$useelement\" [label = \"$useelement\", color =
$dot_color_root_back, \
+ print " \"$useelement\" [label = \"$useelement\", color =
\"$color\", \
fontcolor = $dot_color_root_font]";
$level = $level + 1;
} else {
if ($useelement !~ m/[A-Z]+/) {
- print " \"$useelement\" [label = \"$useelement\", color =
$dot_color_entry_back, \
+ print " \"$useelement\" [label = \"$useelement\", color =
\"$color\", \
fontcolor = $dot_color_entry_font]";
} else {
- print " \"$useelement\" [label = \"$useelement\", color =
$dot_color_pseudo_back, \
+ print " \"$useelement\" [label = \"$useelement\", color =
\"$color\", \
fontcolor = $dot_color_pseudo_font]";
}
print ";\n";
}
push (@foundarray, $_);
}
+
$useelement = $_ ;
$firstconhit=1;
$actparam = "";
@@ -341,7 +372,7 @@
$actparam .= $useelement;
foreach (@foundconarray) {
if ($_ eq $actparam) {
- $firstconhit = 0;
+ $firstconhit = 0;
}
}
if ($firstconhit) {
@@ -382,16 +413,20 @@
print "colorentry $colorentry_root_node_text : $color_root_node_text\n";
print "colorentry $colorentry_arrow : $color_arrow\n";
print "colorentry $colorentry_background: $color_background\n";
+ foreach (sort { $pcpen{$a} <=> $pcpen{$b} } keys %pcpen) {
+ print "colorentry $pcpen{$_} : $pccolor{$_}\n";
+ }
print "color: $colorentry_background\n";
print "\n";
# make nodes
foreach $key (keys %requirepack) {
+ my $pen = pkgpen($key);
if ($key !~ m/[A-Z]+/) {
print " node: { title:\"$key\" label:\"$key\\n$version{$key}\"
textmode: center color: \
- $colorentry_node_background textcolor:
$colorentry_node_text}\n";
+ $pen textcolor: $colorentry_node_text}\n";
} else {
print " node: { title:\"$key\" label:\"$key\\n$version{$key}\"
textmode: center color: \
- $colorentry_upnode_background textcolor:
$colorentry_upnode_text}\n";
+ $pen textcolor: $colorentry_upnode_text}\n";
}
}
print "\n";
@@ -414,38 +449,37 @@
########################################################################################################
# Write an tree ouput for use with xvcg
- if($requirepack{$treepoint}) {
- # Writing a comment
- print "// $requirement dependency graph of $treepoint for OpenPKG\n";
- ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
- $month = (Jan,Feb,Mar,Apr,May,Jun,Jul,Aug,Sep,Oct,Nov,Dec) [($mon)];
- $Year = $year + 1900;
- print "// Created by: vdg.pl / Peter Smej $mday. $month $Year $hour:$min
\n\n";
- # writing the "header"
- print "graph: {\n";
- print "title: \"Dependencies of $treepoint in OpenPKG\"\n";
- print "x: 30\n";
- print "y: 30\n";
- print "width: 700\n";
- print "height: 700\n";
- print "layoutalgorithm: minbackward\n";
- print "layout_nearfactor: 5\n";
- print "layout_downfactor: 10\n";
- print "layout_upfactor: 1\n";
- print "colorentry $colorentry_node_background : $color_node_background\n";
- print "colorentry $colorentry_node_text : $color_node_text\n";
- print "colorentry $colorentry_root_node_background :
$color_root_node_background\n";
- print "colorentry $colorentry_root_node_text : $color_root_node_text\n";
- print "colorentry $colorentry_arrow : $color_arrow\n";
- print "colorentry $colorentry_background: $color_background\n";
- print "color: $colorentry_background\n";
- print "\n";
- &mk_vcg_tree_tree($treepoint, $treepoint, 0); # Create the
tree
- # print the endmarker
- print "}\n";
- } else {
- print { "STDERR" } "$treepoint do not have any depencies => I do not
print a graphic output\n";
+ # Writing a comment
+ print "// $requirement dependency graph of $treepoint for OpenPKG\n";
+ ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
+ $month = (Jan,Feb,Mar,Apr,May,Jun,Jul,Aug,Sep,Oct,Nov,Dec) [($mon)];
+ $Year = $year + 1900;
+ print "// Created by: vdg.pl / Peter Smej $mday. $month $Year $hour:$min \n\n";
+ # writing the "header"
+ print "graph: {\n";
+ print "title: \"Dependencies of $treepoint in OpenPKG\"\n";
+ print "x: 30\n";
+ print "y: 30\n";
+ print "width: 700\n";
+ print "height: 700\n";
+ print "layoutalgorithm: minbackward\n";
+ print "layout_nearfactor: 5\n";
+ print "layout_downfactor: 10\n";
+ print "layout_upfactor: 1\n";
+ print "colorentry $colorentry_node_background : $color_node_background\n";
+ print "colorentry $colorentry_node_text : $color_node_text\n";
+ print "colorentry $colorentry_root_node_background :
$color_root_node_background\n";
+ print "colorentry $colorentry_root_node_text : $color_root_node_text\n";
+ print "colorentry $colorentry_arrow : $color_arrow\n";
+ print "colorentry $colorentry_background: $color_background\n";
+ foreach (sort { $pcpen{$a} <=> $pcpen{$b} } keys %pcpen) {
+ print "colorentry $pcpen{$_} : $pccolor{$_}\n";
}
+ print "color: $colorentry_background\n";
+ print "\n";
+ &mk_vcg_tree_tree($treepoint, $treepoint, 0); # Create the tree
+ # print the endmarker
+ print "}\n";
}
########################################################################################################
@@ -460,6 +494,8 @@
my $firstconhit=1;
@reqarray = split (/\s/, $requirepack{$acttreepoint}) ; # Split to array
+ @reqarray = ( undef ) unless @reqarray;
+
foreach (@reqarray) {
$useelement = $_ ;
foreach (@foundarray) {
@@ -468,25 +504,28 @@
}
}
if ($firsthit) {
+ my $pen = pkgpen($acttreepoint);
if ($acttreepoint eq $roottreepoint) {
print " node: { title:\"$acttreepoint\"
label:\"$acttreepoint\\n$version{$acttreepoint}\" \
- textmode: center color:
$colorentry_root_node_background textcolor: \
+ textmode: center color: $pen textcolor: \
$colorentry_root_node_text level: $level}\n";
$level = $level + 1 ;
} else {
if ($acttreepoint !~ m/[A-Z]+/) {
print " node: { title:\"$acttreepoint\"
label:\"$acttreepoint\\n$version{$acttreepoint}\" \
- textmode: center color:
$colorentry_node_background textcolor: \
+ textmode: center color: $pen textcolor: \
$colorentry_node_text level: $level}\n";
} else {
print " node: { title:\"$acttreepoint\"
label:\"$acttreepoint\\n$version{$acttreepoint}\" \
- textmode: center color:
$colorentry_upnode_background textcolor: \
+ textmode: center color: $pen textcolor: \
$colorentry_upnode_text}\n";
}
}
push (@foundarray, $acttreepoint);
}
+ next unless defined $useelement;
+
$firsthit = 1;
foreach (@foundarray) {
if ($_ eq $useelement) {
@@ -495,19 +534,20 @@
}
if ($firsthit) {
+ my $pen = pkgpen($useelement);
if ($useelement eq $roottreepoint) {
print " node: { title:\"$useelement\"
label:\"$useelement\\n$version{$useelement}\" \
- textmode: center color:
$colorentry_root_node_background textcolor: \
+ textmode: center color: $pen textcolor: \
$colorentry_root_node_text level: $level}\n";
$level = $level + 1;
} else {
if ($useelement !~ m/[A-Z]+/) {
print " node: { title:\"$useelement\"
label:\"$useelement\\n$version{$useelement}\" \
- textmode: center color:
$colorentry_node_background textcolor: \
+ textmode: center color: $pen textcolor: \
$colorentry_node_text level: $level}\n";
} else {
print " node: { title:\"$useelement\"
label:\"$useelement\\n$version{$useelement}\" \
- textmode: center color:
$colorentry_upnode_background textcolor: \
+ textmode: center color: $pen textcolor: \
$colorentry_upnode_text}\n";
}
}
@@ -584,30 +624,27 @@
my $tabs;
my @reqarray;
- if ($requirepack{$actkey}) {
- @reqarray = split (/\s/, $requirepack{$actkey}) ; # Split to array
- $tabs = 10 + ($levelx *10);
- foreach (@reqarray) {
- $tabs = 10 + ($levelx *10) + ( 10 -length($_));
- for($i = $tabs ; $i > 0; $i--) {
- print (" ");
- }
- print ("$_\n");
- $j++;
- &mk_txt_tree_tree ($_, $levelx+1);
- $j--;
- $level--;
- }
- }
+ @reqarray = split (/\s/, $requirepack{$actkey}) ; # Split to array
+ $tabs = 10 + ($levelx *10);
+ foreach (@reqarray) {
+ $tabs = 10 + ($levelx *10) + ( 10 -length($_));
+ for($i = $tabs ; $i > 0; $i--) {
+ print (" ");
+ }
+ print ("$_\n");
+ $j++;
+ &mk_txt_tree_tree ($_, $levelx+1);
+ $j--;
+ $level--;
+ }
}
########################################################################################################
-
########################################################################################################
sub mk_html {
########################################################################################################
# Generate an HTML output
- my $tabs = 25;
+ my $tabs = $html_tabs;
print ("<!DOCTYPE html PUBLIC \"-//w3c/dtd html 4.0 transitional//en\">\n");
print ("<html>\n");
@@ -623,16 +660,18 @@
print ("</blockquote>\n");
foreach $key (keys %requirepack) {
- print ("<hr width=\"100%\">\n");
- print ("<font color=\"#00000\"> <a
href=\"http://www.openpkg.org/pkg/$rpm{$key}\";>$key</a><br>");
+ print ("<p><hr width=\"100%\">\n");
+ print ("<a href=\"http://www.openpkg.org/pkg/$rpm{$key}\";>");
+ print ($key);
+ print ("</a><br>\n");
@requirearray = split (/\s/, $requirepack{$key}) ; # Split to array
foreach (@requirearray) {
- for($i = $tabs ; $i > 0; $i--) {
- print (" ");
- }
- print ("<a href=\"http://www.openpkg.org/pkg/$rpm{$_}\";>$_</a> <br>");
+ print "-" x $tabs;
+ print ("<a href=\"http://www.openpkg.org/pkg/$rpm{$_}\";>");
+ print ($_);
+ print ("</a><br>\n");
}
- print ("<p> </p>\n");
+ print ("</p>\n");
}
print ("</body>\n");
print ("</html>\n");
@@ -672,24 +711,24 @@
########################################################################################################
sub mk_html_tree_tree {
########################################################################################################
- my ($actreepoint, $level) = @_;
+ my ($acttreepoint, $level) = @_;
my $levelx = $level;
my $tabs;
my @req1array;
- if ($requirepack{$actreepoint}) {
- @req1array = split (/\s/, $requirepack{$actreepoint}) ; # Split to array
- foreach (@req1array) {
- $tabs = 25 + ($levelx * 25 ) + (25 - length($_));
- for ($i = $tabs; $i > 0; $i--) {
- print (" ");
- }
- print ("<a href=\"http://www.openpkg.org/pkg/$rpm{$_}\";>$_</a><br><br> ");
- $j++;
- &mk_html_tree_tree ($_, $levelx+1);
- $j--;
- $level--;
- }
+ @req1array = split (/\s/, $requirepack{$acttreepoint}) ; # Split to array
+ foreach (@req1array) {
+ $tabs = $html_tabs - length($_);
+ $tabs = 0 if $tabs < 0;
+ $tabs += $html_tabs + ($levelx * $html_tabs);
+ print " " x $tabs;
+ print ("<a href=\"http://www.openpkg.org/pkg/$rpm{$_}\";>");
+ print ($_);
+ print ("</a><br>\n");
+ $j++;
+ &mk_html_tree_tree ($_, $levelx+1);
+ $j--;
+ $level--;
}
}
########################################################################################################
@@ .
______________________________________________________________________
The OpenPKG Project www.openpkg.org
CVS Repository Commit List [EMAIL PROTECTED]
