Graph-Easy-As_svg-0.23/0000755000175000017500000000000011015337113012413 5ustar teteGraph-Easy-As_svg-0.23/t/0000755000175000017500000000000011015337113012656 5ustar teteGraph-Easy-As_svg-0.23/t/svg/0000755000175000017500000000000011015337113013455 5ustar teteGraph-Easy-As_svg-0.23/t/svg/svg.txt0000644000175000017500000000660310332717115015027 0ustar tetegraph { fill: peru; border: 1px dashed blue; } group { fill: peru; } [ Bonn ] - > [ Berlin ] { shape: circle; fill: darkslategrey; background: brown; color: white; } [ Bonn ] ==> [ Frankfurt ] { fill: #deadff; } [ Berlin ] ..> [ Cottbus ] { shape: ellipse; } [ Berlin ] -> { color: green; } [ Bonn ] { fill: #ffdead; } [ Cottbus ] = > [ Frankfurt ] [ Berlin ] -> { arrow-style: closed; } [ Ulm ] [ Ulm ] { shape: house; } .-> { color: #a02020; } [ Koblenz] [ Ulm ] ..-> [ Konstanz ] { shape: diamond; fill: peru; border: none; background: yellow; } [ Konstanz ] --> { arrow-style: filled; fill: red; } [ Mainz ] { shape: triangle; } [ Koblenz ] { shape: invtriangle; } node.point { shape: point; flow: south; } node.doublepoint { border-style: double; shape: point; flow: east; } node.double { border: double white; fill: palevioletred; } node.doubledash { border: double-dash yellow; fill: crimson; } ( Stars [ A ] { point-style: star; color: red; } -> # background ignored [ B ] { point-style: circle; fill: dodgerblue; } -> [ C ] { point-style: circle; fill: white; } -> [ D ] { point-style: square; fill: firebrick; flow: west; } -> [ E ] { point-style: diamond; fill: lime; } -> [ F ] { shape: invisible; background: coral; } -> [ G ] { point-style: dot; color: slategrey; } -> # background ignored [ H ] { point-style: circle; fill: black; } -> [ I ] { point-style: cross; color: darkblue; } # fill ignored ) { nodeclass: point; } ( [ Rect ] <--> [ Circle ] { shape: circle; } <--> [ Ellipse ] { shape: ellipse; } <.-> [ House ] { shape: house; } <.> [ InvHouse ] { shape: invhouse; } <= > [ Triangle ] { shape: triangle; } <- > [ InvTriangle ] { shape: invtriangle; flow: south; } <..-> [ Octagon ] { shape: octagon; flow: south; } <..-> [ Diamond ] { shape: diamond; flow: east; } [ Triangle ] <==> [ Hexagon ] { shape: hexagon; } <==> [ Pentagon ] { shape: pentagon; } <==> [ Septagon ] { shape: septagon; } [ Pentagon ] <==> [ Parallelogram ] { shape: parallelogram; } [ Hexagon ] -- [ Trapezium ] { shape: trapezium; } [ Hexagon ] .-.- [ Invtrapezium ] { shape: invtrapezium; } ) { nodeclass: double; } [ A ] -> [ AB ] ( Stars2 [ AB ] { point-style: circle; fill: dodgerblue; } -> [ AC ] { point-style: circle; fill: white; } -> [ AD ] { point-style: square; fill: firebrick; flow: west; } -> [ AE ] { point-style: diamond; fill: lime; } -> [ AF ] { shape: invisible; background: coral; } -> [ AG ] { point-style: dot; color: slategrey; } -> # background ignored [ AH ] { point-style: circle; fill: black; } -> [ AI ] { point-style: cross; color: darkblue; } # fill ignored ) { nodeclass: doublepoint; } ( Rect2 [ DRect ] { origin: Frankfurt; offset: 0,4; } <--> [ DCircle ] { shape: circle; } <.-> [ DHouse ] { shape: house; } <.> [ DInvHouse ] { shape: invhouse; } <= > [ DTriangle ] { shape: triangle; } <- > [ DInvTriangle ] { shape: invtriangle; flow: south; } <..-> [ DOctagon ] { shape: octagon; flow: south; } <..-> [ DDiamond ] { shape: diamond; flow: east; } [ DTriangle ] <==> [ DHexagon ] { shape: hexagon; } <==> [ DPentagon ] { shape: pentagon; } <==> [ DSeptagon ] { shape: septagon; } [ DPentagon ] <==> [ DParallelogram ] { shape: parallelogram; } [ DDiamond ] -- [ DTrapezium ] { shape: trapezium; } [ DHexagon ] .-.- [ DInvtrapezium ] { shape: invtrapezium; } ) { nodeclass: doubledash; } Graph-Easy-As_svg-0.23/t/pod.t0000644000175000017500000000050510333416314013630 0ustar tete#!/usr/bin/perl -w use Test::More; use strict; BEGIN { plan tests => 1; chdir 't' if -d 't'; use lib '../lib'; }; SKIP: { skip( 'Test::Pod not installed on this system', 1 ) unless do { eval "use Test::Pod"; $@ ? 0 : 1; }; pod_file_ok( '../lib/Graph/Easy/As_svg.pm' ); } Graph-Easy-As_svg-0.23/t/pod_cov.t0000644000175000017500000000062210332730126014476 0ustar tete#!/usr/bin/perl -w use Test::More; use strict; BEGIN { plan tests => 1; chdir 't' if -d 't'; use lib '../lib'; }; SKIP: { skip("Test::Pod::Coverage 1.00 required for testing POD coverage", 1) unless do { eval "use Test::Pod::Coverage 1.00"; $@ ? 0 : 1; }; for my $m (qw/ Graph::Easy::As_svg /) { pod_coverage_ok( $m, "$m is covered" ); } } Graph-Easy-As_svg-0.23/t/svg.t0000644000175000017500000002572611013326764013666 0ustar tete#!/usr/bin/perl -w use Test::More; use strict; BEGIN { plan tests => 86; chdir 't' if -d 't'; use lib '../lib'; use_ok ("Graph::Easy") or die($@); }; use Graph::Easy::Edge::Cell qw/EDGE_END_E EDGE_END_N EDGE_END_S EDGE_END_W EDGE_HOR/; ############################################################################# my $graph = Graph::Easy->new(); is (ref($graph), 'Graph::Easy'); is ($graph->error(), '', 'no error yet'); is ($graph->nodes(), 0, '0 nodes'); is ($graph->edges(), 0, '0 edges'); is (join (',', $graph->edges()), '', '0 edges'); # this will load As_svg: my $svg = $graph->as_svg(); # after loading As_svg, this should work: can_ok ('Graph::Easy::Node', qw/as_svg/); can_ok ('Graph::Easy', qw/as_svg_file/); can_ok ('Graph::Easy::As_svg', qw/_text_length/); like ($svg, qr/enerated at .* by/, 'contains generator notice'); like ($svg, qr/new( name => 'Bonn' ); my $berlin = Graph::Easy::Node->new( 'Berlin' ); $graph->add_edge ($bonn, $berlin); $svg = $graph->as_svg(); like ($svg, qr/Bonn/, 'contains Bonn'); like ($svg, qr/Berlin/, 'contains Berlin'); like ($svg, qr/<\/text>/, "doesn't contain empty text tags"); #print $graph->as_svg(),"\n"; ############################################################################# # as_svg_file $svg = $graph->as_svg_file(); like ($svg, qr/Bonn/, 'contains Bonn'); like ($svg, qr/standalone="yes"/, 'standalone'); like ($svg, qr/xmlns="/, 'xmlns'); like ($svg, qr/<\?xml/, 'contains as_svg(),"\n"; ############################################################################# ############################################################################# # edge drawing (line_straigh) sub LINE_HOR () { 0; } sub LINE_VER () { 1; } my $edge = Graph::Easy::Edge->new(); my $cell = Graph::Easy::Edge::Cell->new( edge => $edge, type => EDGE_HOR); $cell->{w} = 100; $cell->{h} = 50; $svg = join ('', $cell->_svg_line_straight(0, 0, LINE_HOR(), 0.1, 0.1 )); is ($svg, '', 'line hor'); $svg = join ('', $cell->_svg_line_straight(0, 0, LINE_VER(), 0.1, 0.1 )); is ($svg, '', 'line ver'); $svg = join ('', $cell->_svg_line_straight(0, 0, LINE_VER(), 0.1, 0.1 )); is ($svg, '', 'line ver'); ############################################################################# # arrorw drawing $svg = $cell->_svg_arrow({}, 0, 0, EDGE_END_E, , '' ); is ($svg, ''."\n", 'arrowhead east'); $svg = $cell->_svg_arrow({}, 0, 0, EDGE_END_N, , '' ); is ($svg, ''."\n", 'arrowhead north'); $svg = $cell->_svg_arrow({}, 0, 0, EDGE_END_S, , '' ); is ($svg, ''."\n", 'arrowhead south'); ############################################################################# # with some nodes with attributes $graph = Graph::Easy->new(); $edge = $graph->add_edge ($bonn, $berlin); $bonn->set_attribute( 'shape' => 'circle' ); is ($bonn->predecessors(), 0, 'no pre'); is ($berlin->successors(), 0, 'no pre'); is ($bonn->successors(), 1, 'one pre'); is ($berlin->predecessors(), 1, 'one pre'); is (keys %{$graph->{cells}}, 0, 'no cells'); is ($bonn->{graph}, $graph, 'graph is ok'); is ($berlin->{graph}, $graph, 'graph is ok'); is ($edge->{graph}, $graph, 'graph on edge is ok'); $svg = $graph->as_svg(); like ($svg, qr/Bonn/, 'contains Bonn'); like ($svg, qr/Berlin/, 'contains Bonn'); like ($svg, qr/circle/, 'contains circle shape'); #print $graph->as_svg(),"\n"; $bonn->set_attribute( 'shape' => 'rounded' ); $svg = $graph->as_svg(); like ($svg, qr/Bonn/, 'contains Bonn'); like ($svg, qr/Berlin/, 'contains Bonn'); like ($svg, qr/rect.*rx/, 'contains rect shape with rx/ry'); like ($svg, qr/rx="15" ry="15"/, 'contains rect shape with rx/ry'); like ($svg, qr/line/, 'contains edge'); like ($svg, qr/text/, 'contains text'); like ($svg, qr/#ah/, 'contains arrowhead'); #print $graph->as_svg(),"\n"; $edge->set_attribute('style', 'double-dash'); $graph->layout(); $svg = $graph->as_svg(); like ($svg, qr/stroke-dasharray/, 'double dash contains dash array'); ############################################################################# # unused definitions are not in the output unlike ($svg, qr/(diamond|circle|triangle)/, 'unused defs are not there'); ############################################################################# # color on edge labels $edge->set_attribute('color', 'orange'); $svg = $graph->as_svg(); like ($svg, qr/stroke="#ffa500"/, 'orange stroke on edge'); unlike ($svg, qr/color="#ffa500"/, 'no orange color on edge'); unlike ($svg, qr/fill="#ffa500"/, 'no orange fill on edge'); $edge->set_attribute('label', 'Schmabel'); is ($edge->label(), 'Schmabel', 'edge label'); $svg = $graph->as_svg(); like ($svg, qr/stroke="#ffa500"/, 'orange stroke on edge'); like ($svg, qr/fill="#ffa500"/, 'orange color on edge label'); unlike ($svg, qr/color="#ffa500"/, 'no orange color on edge'); ############################################################################# # text-style support $edge->set_attribute('text-style', 'bold underline'); $svg = $graph->as_svg(); like ($svg, qr/font-weight="bold" text-decoration="underline"/, 'text-style'); $edge->set_attribute('text-style', 'bold underline overline'); $svg = $graph->as_svg(); like ($svg, qr/font-weight="bold" text-decoration="underline overline"/, 'text-style'); ############################################################################# # font-size support $edge->set_attribute('font-size', '2em'); $svg = $graph->as_svg(); my $expect = $graph->EM() * 2; like ($svg, qr/style=".*font-size:${expect}px"/, '2em'); ############################################################################# # $svg = $graph->as_svg(); like ($svg, qr/Untitled graph<\/title>/, 'no title by default'); $graph->set_attribute('graph','label', 'My Graph'); $svg = $graph->as_svg(); like ($svg, qr/<title>My Graph<\/title>/, 'set title'); $graph->set_attribute('graph','title', 'My Graph Title'); $svg = $graph->as_svg(); like ($svg, qr/<title>My Graph Title<\/title>/, 'title overrides label'); ############################################################################# # support for rotate $bonn->set_attribute( 'rotate' => 'right' ); is ($bonn->attribute('rotate'), 'right', 'rotate right is +90 degrees'); is ($bonn->angle(), '180', 'rotate right is 90 (default) +90 == 180 degrees'); $svg = $graph->as_svg(); like ($svg, qr/transform="rotate\(180,/, 'rotate right => 180'); ############################################################################# $bonn->set_attribute( 'label' => 'My\nMultiline' ); $svg = $graph->as_svg(); unlike ($svg, qr/<tspan[^>]+><\/tspan>/, 'no empty tspan'); ############################################################################# $bonn->set_attribute( 'label' => 'dontseeme' ); $bonn->set_attribute( 'shape' => 'point'); $bonn->set_attribute( 'point-style' => 'invisible'); $svg = $graph->as_svg(); like ($svg, qr/<!-- dontseeme/, 'invisible'); unlike ($svg, qr/invisible/, 'no "invisible" in svg'); ############################################################################# $bonn->set_attribute( 'label' => 'quote & < > "' ); $bonn->set_attribute( 'shape' => 'rect'); $bonn->del_attribute( 'point-style'); $svg = $graph->as_svg(); like ($svg, qr/<!-- quote & < > ",/, 'quoted'); like ($svg, qr/>quote & < > "<\/text>/, 'quoted'); ############################################################################# # check that node.cities is converted to "node_cities" $bonn->set_attribute( 'class' => 'cities' ); $svg = $graph->as_svg(); like ($svg, qr/class="node_cities"/, 'node.cities => node_cities'); unlike ($svg, qr/.node,\s*.node_cities/, 'no class style cities yet' ); $graph->set_attribute( 'node.cities', 'color', 'red' ); $svg = $graph->as_svg(); like ($svg, qr/class="node_cities"/, 'node.cities => node_cities'); like ($svg, qr/.node,\s*.node_cities/, 'node.cities => node_cities'); ############################################################################# # edges with no fill but arrowstyle: fill $graph = Graph::Easy->new(); $edge = $graph->add_edge ('A','B'); $edge->set_attribute('arrowstyle','filled'); $edge->set_attribute('color','green'); $svg = $graph->as_svg(); like ($svg, qr/fill="#008000"/, 'edge fill is not inherit'); ############################################################################# # check that we really filter out labelpos etc. $graph = Graph::Easy->new(); $edge = $graph->add_edge ('A','B'); $edge->set_attribute('arrow-shape','triangle'); $edge->set_attribute('arrow-style','open'); $graph->set_attribute('label-pos','bottom'); $graph->set_attribute('text-style','bold'); $graph->node('A')->set_attribute('auto-title','label'); $graph->node('B')->set_attribute('auto-label','10'); $svg = $graph->as_svg(); for my $not (qw/labelpos arrowshape arrowstyle autotitle autolabel textstyle/) { unlike ($svg, qr/$not/, "$not not output"); } ############################################################################# # see that we output the font for the graph itself $graph = Graph::Easy->new(); $edge = $graph->add_edge ('A','B'); $graph->set_attribute('font','Foo'); $graph->set_attribute('label','Labels'); $svg = $graph->as_svg(); like ($svg, qr/font-family: Foo/, "font-family was output"); ############################################################################# # see that we output the font for the nodes $graph = Graph::Easy->new(); $edge = $graph->add_edge ('A','B'); $graph->set_attribute('font','Foo'); $graph->node('A')->set_attribute('font','Fooobar'); $svg = $graph->as_svg(); like ($svg, qr/font-family:Fooobar/, "font-family for node was output"); ############################################################################# # output background for rounded nodes in groups $graph = Graph::Easy->new(); my ($A,$B); ($A,$B,$edge) = $graph->add_edge ('A','B'); my $group = $graph->add_group (''); $group->add_node($A); $graph->node('A')->set_attribute('shape','rounded'); $svg = $graph->as_svg(); # rect x="19" y="19" width="5" height="3" fill="#a0d0ff" like ($svg, qr/rounded(.|\n)+rect.+fill=".a0d0ff"/, "background for rounded node"); ############################################################################# # quote "&" in links as well as add links on edges $graph = Graph::Easy->new(); ($A,$B,$edge) = $graph->add_edge ('A','B','test'); $edge->set_attribute('link','http://bloodgate.com/?foo=a&bar=b'); $svg = $graph->as_svg(); like ($svg, qr/xlink:href="http:\/\/bloodgate.com.*\&/, "link has &"); ������������������������������������������Graph-Easy-As_svg-0.23/t/output.t�������������������������������������������������������������������0000644�0001750�0001750�00000004430�10773762717�014432� 0����������������������������������������������������������������������������������������������������ustar �te������������������������������te���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#!/usr/bin/perl -w # test that the output doesn't contain things it shouldn't use Test::More; use strict; BEGIN { plan tests => 33; chdir 't' if -d 't'; use lib '../lib'; use_ok ("Graph::Easy") or die($@); }; ############################################################################# my $graph = Graph::Easy->new(); is (ref($graph), 'Graph::Easy'); my ($A,$B,$E) = $graph->add_edge('A','B','C'); my ($N) = $graph->add_anon_node(); $graph->add_edge('B',$N); my ($G) = $graph->add_group('G'); # some attributes that should not be output: $A->set_attribute('flow','east'); $A->set_attribute('autolabel','12'); $A->set_attribute('shape','diamond'); $A->set_attribute('group','G'); $A->set_attribute('format','pod'); $B->set_attribute('shape','point'); $B->set_attribute('point-shape','star'); $B->set_attribute('point-style','closed'); $B->set_attribute('border-style','double'); $B->set_attribute('offset','2,2'); $B->set_attribute('origin','A'); $B->set_attribute('textwrap','auto'); $graph->set_attribute('type','undirected'); $graph->set_attribute('node','columns','2'); $graph->set_attribute('labelpos','bottom'); $graph->set_attribute('root','A'); $E->set_attribute('labelcolor','green'); $E->set_attribute('autojoin','always'); $E->set_attribute('autosplit','always'); $E->set_attribute('end','north'); $E->set_attribute('start','east'); $E->set_attribute('minlen','2'); $E->set_attribute('fill','red'); $E->set_attribute('format','pod'); $E->set_attribute('textwrap','auto'); $G->set_attribute('root','A'); # some things that should be in the output $A->set_attribute('id','A1'); # this will load As_svg: my $svg = $graph->as_svg(); for my $w (qw/ flow auto-label arrow-style arrow-shape shape point-shape auto-join auto-split end start minlen offset origin columns label-pos label-color format root rank textwrap format /) { unlike ($svg, qr/$w=/, "attribute $w skipped"); if ($w =~ /-/) { my $w2 = $w; $w2 =~ s/-//g; unlike ($svg, qr/$w2=/, "attribute $w skipped"); } } like ($svg, qr/(id)="/, 'attribute id included'); unlike ($svg, qr/type=.undirected/, "attribute type for graph skipped"); #print $graph->as_txt(); # print STDERR $svg."\n"; ############################################################################# # all tests done ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Graph-Easy-As_svg-0.23/t/group.t��������������������������������������������������������������������0000644�0001750�0001750�00000002632�10523345342�014210� 0����������������������������������������������������������������������������������������������������ustar �te������������������������������te���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#!/usr/bin/perl -w # Test group output use Test::More; use strict; BEGIN { plan tests => 9; chdir 't' if -d 't'; use lib '../lib'; use_ok ("Graph::Easy") or die($@); }; use Graph::Easy::Edge::Cell qw/EDGE_END_E EDGE_END_N EDGE_END_S EDGE_END_W EDGE_HOR/; ############################################################################# my $graph = Graph::Easy->new(); is (ref($graph), 'Graph::Easy'); is ($graph->error(), '', 'no error yet'); # this will load As_svg: my $svg = $graph->as_svg(); ############################################################################# # add a group and three nodes, one invisible my $group = $graph->add_group('Cities'); my $last; for my $name (qw/Bonn Berlin Rostock/) { my $node = $graph->add_node($name); $node->set_attribute('shape','invisible') if $name eq 'Rostock'; $group->add_node($node); $graph->add_edge($last,$node) if defined $last; $last = $node; } $group->add_node( $graph->add_node('Wismut') ); $graph->add_edge('Berlin','Wismut'); $svg = $graph->as_svg(); like ($svg, qr/Bonn/, 'contains Bonn'); like ($svg, qr/Wismut/, 'contains Wismut'); like ($svg, qr/Berlin/, 'contains Berlin'); unlike ($svg, qr/Rostock<\/text/, "doesn't contains invisible Rostock"); like ($svg, qr/<line x1=".*stroke-dasharray="6,\s*2/, 'contains some border'); like ($svg, qr/<rect .*stroke="none"/, 'contains a rect with no stroke for edge backgrounds'); ������������������������������������������������������������������������������������������������������Graph-Easy-As_svg-0.23/t/text.t���������������������������������������������������������������������0000644�0001750�0001750�00000001125�10416763723�014044� 0����������������������������������������������������������������������������������������������������ustar �te������������������������������te���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#!/usr/bin/perl -w # test the text_ength() function use Test::More; use strict; use utf8; BEGIN { plan tests => 7; chdir 't' if -d 't'; use lib '../lib'; use_ok ("Graph::Easy") or die($@); use_ok ("Graph::Easy::As_svg") or die($@); }; ############################################################################# my $l = 'Graph::Easy::As_svg::_text_length'; no strict 'refs'; is ($l->(14, 'ABCDE'), 3.6, 'ABCDE is 3.6 long'); is ($l->(14, 'WW'), 0.9*2, 'WW'); is ($l->(14, 'ii'), 0.33*2, 'ii'); is ($l->(14, '@@'), 1.15*2, '@@'); is ($l->(14, 'ææ'), 1.25*2, 'ææ'); �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Graph-Easy-As_svg-0.23/inc/�������������������������������������������������������������������������0000755�0001750�0001750�00000000000�11015337113�013164� 5����������������������������������������������������������������������������������������������������ustar �te������������������������������te���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Graph-Easy-As_svg-0.23/inc/Module/������������������������������������������������������������������0000755�0001750�0001750�00000000000�11015337113�014411� 5����������������������������������������������������������������������������������������������������ustar �te������������������������������te���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Graph-Easy-As_svg-0.23/inc/Module/Install/����������������������������������������������������������0000755�0001750�0001750�00000000000�11015337113�016017� 5����������������������������������������������������������������������������������������������������ustar �te������������������������������te���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Graph-Easy-As_svg-0.23/inc/Module/Install/Can.pm����������������������������������������������������0000644�0001750�0001750�00000003374�11015337104�017065� 0����������������������������������������������������������������������������������������������������ustar �te������������������������������te���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#line 1 package Module::Install::Can; use strict; use Module::Install::Base; use Config (); ### This adds a 5.005 Perl version dependency. ### This is a bug and will be fixed. use File::Spec (); use ExtUtils::MakeMaker (); use vars qw{$VERSION $ISCORE @ISA}; BEGIN { $VERSION = '0.71'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } # check if we can load some module ### Upgrade this to not have to load the module if possible sub can_use { my ($self, $mod, $ver) = @_; $mod =~ s{::|\\}{/}g; $mod .= '.pm' unless $mod =~ /\.pm$/i; my $pkg = $mod; $pkg =~ s{/}{::}g; $pkg =~ s{\.pm$}{}i; local $@; eval { require $mod; $pkg->VERSION($ver || 0); 1 }; } # check if we can run some command sub can_run { my ($self, $cmd) = @_; my $_cmd = $cmd; return $_cmd if (-x $_cmd or $_cmd = MM->maybe_command($_cmd)); for my $dir ((split /$Config::Config{path_sep}/, $ENV{PATH}), '.') { my $abs = File::Spec->catfile($dir, $_[1]); return $abs if (-x $abs or $abs = MM->maybe_command($abs)); } return; } # can we locate a (the) C compiler sub can_cc { my $self = shift; my @chunks = split(/ /, $Config::Config{cc}) or return; # $Config{cc} may contain args; try to find out the program part while (@chunks) { return $self->can_run("@chunks") || (pop(@chunks), next); } return; } # Fix Cygwin bug on maybe_command(); if ( $^O eq 'cygwin' ) { require ExtUtils::MM_Cygwin; require ExtUtils::MM_Win32; if ( ! defined(&ExtUtils::MM_Cygwin::maybe_command) ) { *ExtUtils::MM_Cygwin::maybe_command = sub { my ($self, $file) = @_; if ($file =~ m{^/cygdrive/}i and ExtUtils::MM_Win32->can('maybe_command')) { ExtUtils::MM_Win32->maybe_command($file); } else { ExtUtils::MM_Unix->maybe_command($file); } } } } 1; __END__ #line 157 ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Graph-Easy-As_svg-0.23/inc/Module/Install/Base.pm���������������������������������������������������0000644�0001750�0001750�00000002035�11015337103�017226� 0����������������������������������������������������������������������������������������������������ustar �te������������������������������te���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#line 1 package Module::Install::Base; $VERSION = '0.71'; # Suspend handler for "redefined" warnings BEGIN { my $w = $SIG{__WARN__}; $SIG{__WARN__} = sub { $w }; } ### This is the ONLY module that shouldn't have strict on # use strict; #line 41 sub new { my ($class, %args) = @_; foreach my $method ( qw(call load) ) { *{"$class\::$method"} = sub { shift()->_top->$method(@_); } unless defined &{"$class\::$method"}; } bless( \%args, $class ); } #line 61 sub AUTOLOAD { my $self = shift; local $@; my $autoload = eval { $self->_top->autoload } or return; goto &$autoload; } #line 76 sub _top { $_[0]->{_top} } #line 89 sub admin { $_[0]->_top->{admin} or Module::Install::Base::FakeAdmin->new; } sub is_admin { $_[0]->admin->VERSION; } sub DESTROY {} package Module::Install::Base::FakeAdmin; my $Fake; sub new { $Fake ||= bless(\@_, $_[0]) } sub AUTOLOAD {} sub DESTROY {} # Restore warning handler BEGIN { $SIG{__WARN__} = $SIG{__WARN__}->(); } 1; #line 138 ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Graph-Easy-As_svg-0.23/inc/Module/Install/Win32.pm��������������������������������������������������0000644�0001750�0001750�00000003402�11015337104�017256� 0����������������������������������������������������������������������������������������������������ustar �te������������������������������te���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#line 1 package Module::Install::Win32; use strict; use Module::Install::Base; use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '0.71'; @ISA = qw{Module::Install::Base}; $ISCORE = 1; } # determine if the user needs nmake, and download it if needed sub check_nmake { my $self = shift; $self->load('can_run'); $self->load('get_file'); require Config; return unless ( $^O eq 'MSWin32' and $Config::Config{make} and $Config::Config{make} =~ /^nmake\b/i and ! $self->can_run('nmake') ); print "The required 'nmake' executable not found, fetching it...\n"; require File::Basename; my $rv = $self->get_file( url => 'http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe', ftp_url => 'ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe', local_dir => File::Basename::dirname($^X), size => 51928, run => 'Nmake15.exe /o > nul', check_for => 'Nmake.exe', remove => 1, ); die <<'END_MESSAGE' unless $rv; ------------------------------------------------------------------------------- Since you are using Microsoft Windows, you will need the 'nmake' utility before installation. It's available at: http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe or ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe Please download the file manually, save it to a directory in %PATH% (e.g. C:\WINDOWS\COMMAND\), then launch the MS-DOS command line shell, "cd" to that directory, and run "Nmake15.exe" from there; that will create the 'nmake.exe' file needed by this module. You may then resume the installation process described in README. ------------------------------------------------------------------------------- END_MESSAGE } 1; ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Graph-Easy-As_svg-0.23/inc/Module/Install/WriteAll.pm�����������������������������������������������0000644�0001750�0001750�00000001321�11015337104�020075� 0����������������������������������������������������������������������������������������������������ustar �te������������������������������te���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#line 1 package Module::Install::WriteAll; use strict; use Module::Install::Base; use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '0.71'; @ISA = qw{Module::Install::Base}; $ISCORE = 1; } sub WriteAll { my $self = shift; my %args = ( meta => 1, sign => 0, inline => 0, check_nmake => 1, @_, ); $self->sign(1) if $args{sign}; $self->Meta->write if $args{meta}; $self->admin->WriteAll(%args) if $self->is_admin; $self->check_nmake if $args{check_nmake}; unless ( $self->makemaker_args->{PL_FILES} ) { $self->makemaker_args( PL_FILES => {} ); } if ( $args{inline} ) { $self->Inline->write; } else { $self->Makefile->write; } } 1; ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Graph-Easy-As_svg-0.23/inc/Module/Install/AutoInstall.pm��������������������������������������������0000644�0001750�0001750�00000002272�11015337103�020616� 0����������������������������������������������������������������������������������������������������ustar �te������������������������������te���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#line 1 package Module::Install::AutoInstall; use strict; use Module::Install::Base; use vars qw{$VERSION $ISCORE @ISA}; BEGIN { $VERSION = '0.71'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } sub AutoInstall { $_[0] } sub run { my $self = shift; $self->auto_install_now(@_); } sub write { my $self = shift; $self->auto_install(@_); } sub auto_install { my $self = shift; return if $self->{done}++; # Flatten array of arrays into a single array my @core = map @$_, map @$_, grep ref, $self->build_requires, $self->requires; my @config = @_; # We'll need Module::AutoInstall $self->include('Module::AutoInstall'); require Module::AutoInstall; Module::AutoInstall->import( (@config ? (-config => \@config) : ()), (@core ? (-core => \@core) : ()), $self->features, ); $self->makemaker_args( Module::AutoInstall::_make_args() ); my $class = ref($self); $self->postamble( "# --- $class section:\n" . Module::AutoInstall::postamble() ); } sub auto_install_now { my $self = shift; $self->auto_install(@_); Module::AutoInstall::do_install(); } 1; ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Graph-Easy-As_svg-0.23/inc/Module/Install/Makefile.pm�����������������������������������������������0000644�0001750�0001750�00000014121�11015337104�020071� 0����������������������������������������������������������������������������������������������������ustar �te������������������������������te���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#line 1 package Module::Install::Makefile; use strict 'vars'; use Module::Install::Base; use ExtUtils::MakeMaker (); use vars qw{$VERSION $ISCORE @ISA}; BEGIN { $VERSION = '0.71'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } sub Makefile { $_[0] } my %seen = (); sub prompt { shift; # Infinite loop protection my @c = caller(); if ( ++$seen{"$c[1]|$c[2]|$_[0]"} > 3 ) { die "Caught an potential prompt infinite loop ($c[1]|$c[2]|$_[0])"; } # In automated testing, always use defaults if ( $ENV{AUTOMATED_TESTING} and ! $ENV{PERL_MM_USE_DEFAULT} ) { local $ENV{PERL_MM_USE_DEFAULT} = 1; goto &ExtUtils::MakeMaker::prompt; } else { goto &ExtUtils::MakeMaker::prompt; } } sub makemaker_args { my $self = shift; my $args = ($self->{makemaker_args} ||= {}); %$args = ( %$args, @_ ) if @_; $args; } # For mm args that take multiple space-seperated args, # append an argument to the current list. sub makemaker_append { my $self = sShift; my $name = shift; my $args = $self->makemaker_args; $args->{name} = defined $args->{$name} ? join( ' ', $args->{name}, @_ ) : join( ' ', @_ ); } sub build_subdirs { my $self = shift; my $subdirs = $self->makemaker_args->{DIR} ||= []; for my $subdir (@_) { push @$subdirs, $subdir; } } sub clean_files { my $self = shift; my $clean = $self->makemaker_args->{clean} ||= {}; %$clean = ( %$clean, FILES => join ' ', grep { length $_ } ($clean->{FILES} || (), @_), ); } sub realclean_files { my $self = shift; my $realclean = $self->makemaker_args->{realclean} ||= {}; %$realclean = ( %$realclean, FILES => join ' ', grep { length $_ } ($realclean->{FILES} || (), @_), ); } sub libs { my $self = shift; my $libs = ref $_[0] ? shift : [ shift ]; $self->makemaker_args( LIBS => $libs ); } sub inc { my $self = shift; $self->makemaker_args( INC => shift ); } my %test_dir = (); sub _wanted_t { /\.t$/ and -f $_ and $test_dir{$File::Find::dir} = 1; } sub tests_recursive { my $self = shift; if ( $self->tests ) { die "tests_recursive will not work if tests are already defined"; } my $dir = shift || 't'; unless ( -d $dir ) { die "tests_recursive dir '$dir' does not exist"; } %test_dir = (); require File::Find; File::Find::find( \&_wanted_t, $dir ); $self->tests( join ' ', map { "$_/*.t" } sort keys %test_dir ); } sub write { my $self = shift; die "&Makefile->write() takes no arguments\n" if @_; # Make sure we have a new enough require ExtUtils::MakeMaker; $self->configure_requires( 'ExtUtils::MakeMaker' => $ExtUtils::MakeMaker::VERSION ); # Generate the my $args = $self->makemaker_args; $args->{DISTNAME} = $self->name; $args->{NAME} = $self->module_name || $self->name; $args->{VERSION} = $self->version; $args->{NAME} =~ s/-/::/g; if ( $self->tests ) { $args->{test} = { TESTS => $self->tests }; } if ($] >= 5.005) { $args->{ABSTRACT} = $self->abstract; $args->{AUTHOR} = $self->author; } if ( eval($ExtUtils::MakeMaker::VERSION) >= 6.10 ) { $args->{NO_META} = 1; } if ( eval($ExtUtils::MakeMaker::VERSION) > 6.17 and $self->sign ) { $args->{SIGN} = 1; } unless ( $self->is_admin ) { delete $args->{SIGN}; } # merge both kinds of requires into prereq_pm my $prereq = ($args->{PREREQ_PM} ||= {}); %$prereq = ( %$prereq, map { @$_ } map { @$_ } grep $_, ($self->configure_requires, $self->build_requires, $self->requires) ); # Remove any reference to perl, PREREQ_PM doesn't support it delete $args->{PREREQ_PM}->{perl}; # merge both kinds of requires into prereq_pm my $subdirs = ($args->{DIR} ||= []); if ($self->bundles) { foreach my $bundle (@{ $self->bundles }) { my ($file, $dir) = @$bundle; push @$subdirs, $dir if -d $dir; delete $prereq->{$file}; } } if ( my $perl_version = $self->perl_version ) { eval "use $perl_version; 1" or die "ERROR: perl: Version $] is installed, " . "but we need version >= $perl_version"; } $args->{INSTALLDIRS} = $self->installdirs; my %args = map { ( $_ => $args->{$_} ) } grep {defined($args->{$_})} keys %$args; my $user_preop = delete $args{dist}->{PREOP}; if (my $preop = $self->admin->preop($user_preop)) { $args{dist} = $preop; } my $mm = ExtUtils::MakeMaker::WriteMakefile(%args); $self->fix_up_makefile($mm->{FIRST_MAKEFILE} || 'Makefile'); } sub fix_up_makefile { my $self = shift; my $makefile_name = shift; my $top_class = ref($self->_top) || ''; my $top_version = $self->_top->VERSION || ''; my $preamble = $self->preamble ? "# Preamble by $top_class $top_version\n" . $self->preamble : ''; my $postamble = "# Postamble by $top_class $top_version\n" . ($self->postamble || ''); local *MAKEFILE; open MAKEFILE, "< $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!"; my $makefile = do { local $/; <MAKEFILE> }; close MAKEFILE or die $!; $makefile =~ s/\b(test_harness\(\$\(TEST_VERBOSE\), )/$1'inc', /; $makefile =~ s/( -I\$\(INST_ARCHLIB\))/ -Iinc$1/g; $makefile =~ s/( "-I\$\(INST_LIB\)")/ "-Iinc"$1/g; $makefile =~ s/^(FULLPERL = .*)/$1 "-Iinc"/m; $makefile =~ s/^(PERL = .*)/$1 "-Iinc"/m; # Module::Install will never be used to build the Core Perl # Sometimes PERL_LIB and PERL_ARCHLIB get written anyway, which breaks # PREFIX/PERL5LIB, and thus, install_share. Blank them if they exist $makefile =~ s/^PERL_LIB = .+/PERL_LIB =/m; #$makefile =~ s/^PERL_ARCHLIB = .+/PERL_ARCHLIB =/m; # Perl 5.005 mentions PERL_LIB explicitly, so we have to remove that as well. $makefile =~ s/(\"?)-I\$\(PERL_LIB\)\1//g; # XXX - This is currently unused; not sure if it breaks other MM-users # $makefile =~ s/^pm_to_blib\s+:\s+/pm_to_blib :: /mg; open MAKEFILE, "> $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!"; print MAKEFILE "$preamble$makefile$postamble" or die $!; close MAKEFILE or die $!; 1; } sub preamble { my ($self, $text) = @_; $self->{preamble} = $text . $self->{preamble} if defined $text; $self->{preamble}; } sub postamble { my ($self, $text) = @_; $self->{postamble} ||= $self->admin->postamble; $self->{postamble} .= $text if defined $text; $self->{postamble} } 1; __END__ #line 371 �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Graph-Easy-As_svg-0.23/inc/Module/Install/Fetch.pm��������������������������������������������������0000644�0001750�0001750�00000004630�11015337104�017411� 0����������������������������������������������������������������������������������������������������ustar �te������������������������������te���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#line 1 package Module::Install::Fetch; use strict; use Module::Install::Base; use vars qw{$VERSION $ISCORE @ISA}; BEGIN { $VERSION = '0.71'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } sub get_file { my ($self, %args) = @_; my ($scheme, $host, $path, $file) = $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return; if ( $scheme eq 'http' and ! eval { require LWP::Simple; 1 } ) { $args{url} = $args{ftp_url} or (warn("LWP support unavailable!\n"), return); ($scheme, $host, $path, $file) = $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return; } $|++; print "Fetching '$file' from $host... "; unless (eval { require Socket; Socket::inet_aton($host) }) { warn "'$host' resolve failed!\n"; return; } return unless $scheme eq 'ftp' or $scheme eq 'http'; require Cwd; my $dir = Cwd::getcwd(); chdir $args{local_dir} or return if exists $args{local_dir}; if (eval { require LWP::Simple; 1 }) { LWP::Simple::mirror($args{url}, $file); } elsif (eval { require Net::FTP; 1 }) { eval { # use Net::FTP to get past firewall my $ftp = Net::FTP->new($host, Passive => 1, Timeout => 600); $ftp->login("anonymous", 'anonymous@example.com'); $ftp->cwd($path); $ftp->binary; $ftp->get($file) or (warn("$!\n"), return); $ftp->quit; } } elsif (my $ftp = $self->can_run('ftp')) { eval { # no Net::FTP, fallback to ftp.exe require FileHandle; my $fh = FileHandle->new; local $SIG{CHLD} = 'IGNORE'; unless ($fh->open("|$ftp -n")) { warn "Couldn't open ftp: $!\n"; chdir $dir; return; } my @dialog = split(/\n/, <<"END_FTP"); open $host user anonymous anonymous\@example.com cd $path binary get $file $file quit END_FTP foreach (@dialog) { $fh->print("$_\n") } $fh->close; } } else { warn "No working 'ftp' program available!\n"; chdir $dir; return; } unless (-f $file) { warn "Fetching failed: $@\n"; chdir $dir; return; } return if exists $args{size} and -s $file != $args{size}; system($args{run}) if exists $args{run}; unlink($file) if $args{remove}; print(((!exists $args{check_for} or -e $args{check_for}) ? "done!" : "failed! ($!)"), "\n"); chdir $dir; return !$?; } 1; ��������������������������������������������������������������������������������������������������������Graph-Easy-As_svg-0.23/inc/Module/Install/Include.pm������������������������������������������������0000644�0001750�0001750�00000001014�11015337103�017733� 0����������������������������������������������������������������������������������������������������ustar �te������������������������������te���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#line 1 package Module::Install::Include; use strict; use Module::Install::Base; use vars qw{$VERSION $ISCORE @ISA}; BEGIN { $VERSION = '0.71'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } sub include { shift()->admin->include(@_); } sub include_deps { shift()->admin->include_deps(@_); } sub auto_include { shift()->admin->auto_include(@_); } sub auto_include_deps { shift()->admin->auto_include_deps(@_); } sub auto_include_dependent_dists { shift()->admin->auto_include_dependent_dists(@_); } 1; ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Graph-Easy-As_svg-0.23/inc/Module/Install/Metadata.pm�����������������������������������������������0000644�0001750�0001750�00000020730�11015337103�020076� 0����������������������������������������������������������������������������������������������������ustar �te������������������������������te���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#line 1 package Module::Install::Metadata; use strict 'vars'; use Module::Install::Base; use vars qw{$VERSION $ISCORE @ISA}; BEGIN { $VERSION = '0.71'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } my @scalar_keys = qw{ name module_name abstract author version license distribution_type perl_version tests installdirs }; my @tuple_keys = qw{ configure_requires build_requires requires recommends bundles }; sub Meta { shift } sub Meta_ScalarKeys { @scalar_keys } sub Meta_TupleKeys { @tuple_keys } foreach my $key (@scalar_keys) { *$key = sub { my $self = shift; return $self->{values}{$key} if defined wantarray and !@_; $self->{values}{$key} = shift; return $self; }; } sub requires { my $self = shift; while ( @_ ) { my $module = shift or last; my $version = shift || 0; push @{ $self->{values}->{requires} }, [ $module, $version ]; } $self->{values}{requires}; } sub build_requires { my $self = shift; while ( @_ ) { my $module = shift or last; my $version = shift || 0; push @{ $self->{values}->{build_requires} }, [ $module, $version ]; } $self->{values}{build_requires}; } sub configure_requires { my $self = shift; while ( @_ ) { my $module = shift or last; my $version = shift || 0; push @{ $self->{values}->{configure_requires} }, [ $module, $version ]; } $self->{values}{configure_requires}; } sub recommends { my $self = shift; while ( @_ ) { my $module = shift or last; my $version = shift || 0; push @{ $self->{values}->{recommends} }, [ $module, $version ]; } $self->{values}{recommends}; } sub bundles { my $self = shift; while ( @_ ) { my $module = shift or last; my $version = shift || 0; push @{ $self->{values}->{bundles} }, [ $module, $version ]; } $self->{values}{bundles}; } # Aliases for build_requires that will have alternative # meanings in some future version of META.yml. sub test_requires { shift->build_requires(@_) } sub install_requires { shift->build_requires(@_) } # Aliases for installdirs options sub install_as_core { $_[0]->installdirs('perl') } sub install_as_cpan { $_[0]->installdirs('site') } sub install_as_site { $_[0]->installdirs('site') } sub install_as_vendor { $_[0]->installdirs('vendor') } sub sign { my $self = shift; return $self->{'values'}{'sign'} if defined wantarray and ! @_; $self->{'values'}{'sign'} = ( @_ ? $_[0] : 1 ); return $self; } sub dynamic_config { my $self = shift; unless ( @_ ) { warn "You MUST provide an explicit true/false value to dynamic_config, skipping\n"; return $self; } $self->{values}{dynamic_config} = $_[0] ? 1 : 0; return $self; } sub all_from { my ( $self, $file ) = @_; unless ( defined($file) ) { my $name = $self->name or die "all_from called with no args without setting name() first"; $file = join('/', 'lib', split(/-/, $name)) . '.pm'; $file =~ s{.*/}{} unless -e $file; die "all_from: cannot find $file from $name" unless -e $file; } # Some methods pull from POD instead of code. # If there is a matching .pod, use that instead my $pod = $file; $pod =~ s/\.pm$/.pod/i; $pod = $file unless -e $pod; # Pull the different values $self->name_from($file) unless $self->name; $self->version_from($file) unless $self->version; $self->perl_version_from($file) unless $self->perl_version; $self->author_from($pod) unless $self->author; $self->license_from($pod) unless $self->license; $self->abstract_from($pod) unless $self->abstract; return 1; } sub provides { my $self = shift; my $provides = ( $self->{values}{provides} ||= {} ); %$provides = (%$provides, @_) if @_; return $provides; } sub auto_provides { my $self = shift; return $self unless $self->is_admin; unless (-e 'MANIFEST') { warn "Cannot deduce auto_provides without a MANIFEST, skipping\n"; return $self; } # Avoid spurious warnings as we are not checking manifest here. local $SIG{__WARN__} = sub {1}; require ExtUtils::Manifest; local *ExtUtils::Manifest::manicheck = sub { return }; require Module::Build; my $build = Module::Build->new( dist_name => $self->name, dist_version => $self->version, license => $self->license, ); $self->provides( %{ $build->find_dist_packages || {} } ); } sub feature { my $self = shift; my $name = shift; my $features = ( $self->{values}{features} ||= [] ); my $mods; if ( @_ == 1 and ref( $_[0] ) ) { # The user used ->feature like ->features by passing in the second # argument as a reference. Accomodate for that. $mods = $_[0]; } else { $mods = \@_; } my $count = 0; push @$features, ( $name => [ map { ref($_) ? ( ref($_) eq 'HASH' ) ? %$_ : @$_ : $_ } @$mods ] ); return @$features; } sub features { my $self = shift; while ( my ( $name, $mods ) = splice( @_, 0, 2 ) ) { $self->feature( $name, @$mods ); } return $self->{values}->{features} ? @{ $self->{values}->{features} } : (); } sub no_index { my $self = shift; my $type = shift; push @{ $self->{values}{no_index}{$type} }, @_ if $type; return $self->{values}{no_index}; } sub read { my $self = shift; $self->include_deps( 'YAML::Tiny', 0 ); require YAML::Tiny; my $data = YAML::Tiny::LoadFile('META.yml'); # Call methods explicitly in case user has already set some values. while ( my ( $key, $value ) = each %$data ) { next unless $self->can($key); if ( ref $value eq 'HASH' ) { while ( my ( $module, $version ) = each %$value ) { $self->can($key)->($self, $module => $version ); } } else { $self->can($key)->($self, $value); } } return $self; } sub write { my $self = shift; return $self unless $self->is_admin; $self->admin->write_meta; return $self; } sub version_from { require ExtUtils::MM_Unix; my ( $self, $file ) = @_; $self->version( ExtUtils::MM_Unix->parse_version($file) ); } sub abstract_from { require ExtUtils::MM_Unix; my ( $self, $file ) = @_; $self->abstract( bless( { DISTNAME => $self->name }, 'ExtUtils::MM_Unix' )->parse_abstract($file) ); } sub name_from { my $self = shift; if ( Module::Install::_read($_[0]) =~ m/ ^ \s package \s* ([\w:]+) \s* ; /ixms ) { my $name = $1; $name =~ s{::}{-}g; $self->name($name); } else { die "Cannot determine name from $_[0]\n"; return; } } sub perl_version_from { my $self = shift; if ( Module::Install::_read($_[0]) =~ m/ ^ use \s* v? ([\d_\.]+) \s* ; /ixms ) { my $perl_version = $1; $perl_version =~ s{_}{}g; $self->perl_version($perl_version); } else { warn "Cannot determine perl version info from $_[0]\n"; return; } } sub author_from { my $self = shift; my $content = Module::Install::_read($_[0]); if ($content =~ m/ =head \d \s+ (?:authors?)\b \s* ([^\n]*) | =head \d \s+ (?:licen[cs]e|licensing|copyright|legal)\b \s* .*? copyright .*? \d\d\d[\d.]+ \s* (?:\bby\b)? \s* ([^\n]*) /ixms) { my $author = $1 || $2; $author =~ s{E<lt>}{<}g; $author =~ s{E<gt>}{>}g; $self->author($author); } else { warn "Cannot determine author info from $_[0]\n"; } } sub license_from { my $self = shift; if ( Module::Install::_read($_[0]) =~ m/ ( =head \d \s+ (?:licen[cs]e|licensing|copyright|legal)\b .*? ) (=head\\d.*|=cut.*|) \z /ixms ) { my $license_text = $1; my @phrases = ( 'under the same (?:terms|license) as perl itself' => 'perl', 1, 'GNU public license' => 'gpl', 1, 'GNU lesser public license' => 'lgpl', 1, 'BSD license' => 'bsd', 1, 'Artistic license' => 'artistic', 1, 'GPL' => 'gpl', 1, 'LGPL' => 'lgpl', 1, 'BSD' => 'bsd', 1, 'Artistic' => 'artistic', 1, 'MIT' => 'mit', 1, 'proprietary' => 'proprietary', 0, ); while ( my ($pattern, $license, $osi) = splice(@phrases, 0, 3) ) { $pattern =~ s{\s+}{\\s+}g; if ( $license_text =~ /\b$pattern\b/i ) { if ( $osi and $license_text =~ /All rights reserved/i ) { warn "LEGAL WARNING: 'All rights reserved' may invalidate Open Source licenses. Consider removing it."; } $self->license($license); return 1; } } } warn "Cannot determine license info from $_[0]\n"; return 'unknown'; } 1; ����������������������������������������Graph-Easy-As_svg-0.23/inc/Module/Install.pm��������������������������������������������������������0000644�0001750�0001750�00000020275�11015337103�016362� 0����������������������������������������������������������������������������������������������������ustar �te������������������������������te���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#line 1 package Module::Install; # For any maintainers: # The load order for Module::Install is a bit magic. # It goes something like this... # # IF ( host has Module::Install installed, creating author mode ) { # 1. Makefile.PL calls "use inc::Module::Install" # 2. $INC{inc/Module/Install.pm} set to installed version of inc::Module::Install # 3. The installed version of inc::Module::Install loads # 4. inc::Module::Install calls "require Module::Install" # 5. The ./inc/ version of Module::Install loads # } ELSE { # 1. Makefile.PL calls "use inc::Module::Install" # 2. $INC{inc/Module/Install.pm} set to ./inc/ version of Module::Install # 3. The ./inc/ version of Module::Install loads # } BEGIN { require 5.004; } use strict 'vars'; use vars qw{$VERSION}; BEGIN { # All Module::Install core packages now require synchronised versions. # This will be used to ensure we don't accidentally load old or # different versions of modules. # This is not enforced yet, but will be some time in the next few # releases once we can make sure it won't clash with custom # Module::Install extensions. $VERSION = '0.71'; } # Whether or not inc::Module::Install is actually loaded, the # $INC{inc/Module/Install.pm} is what will still get set as long as # the caller loaded module this in the documented manner. # If not set, the caller may NOT have loaded the bundled version, and thus # they may not have a MI version that works with the Makefile.PL. This would # result in false errors or unexpected behaviour. And we don't want that. my $file = join( '/', 'inc', split /::/, __PACKAGE__ ) . '.pm'; unless ( $INC{$file} ) { die <<"END_DIE" } Please invoke ${\__PACKAGE__} with: use inc::${\__PACKAGE__}; not: use ${\__PACKAGE__}; END_DIE # If the script that is loading Module::Install is from the future, # then make will detect this and cause it to re-run over and over # again. This is bad. Rather than taking action to touch it (which # is unreliable on some platforms and requires write permissions) # for now we should catch this and refuse to run. if ( -f $0 and (stat($0))[9] > time ) { die <<"END_DIE" } Your installer $0 has a modification time in the future. This is known to create infinite loops in make. Please correct this, then run $0 again. END_DIE # Build.PL was formerly supported, but no longer is due to excessive # difficulty in implementing every single feature twice. if ( $0 =~ /Build.PL$/i or -f 'Build.PL' ) { die <<"END_DIE" } Module::Install no longer supports Build.PL. It was impossible to maintain duel backends, and has been deprecated. Please remove all Build.PL files and only use the Makefile.PL installer. END_DIE use Cwd (); use File::Find (); use File::Path (); use FindBin; *inc::Module::Install::VERSION = *VERSION; @inc::Module::Install::ISA = __PACKAGE__; sub autoload { my $self = shift; my $who = $self->_caller; my $cwd = Cwd::cwd(); my $sym = "${who}::AUTOLOAD"; $sym->{$cwd} = sub { my $pwd = Cwd::cwd(); if ( my $code = $sym->{$pwd} ) { # delegate back to parent dirs goto &$code unless $cwd eq $pwd; } $$sym =~ /([^:]+)$/ or die "Cannot autoload $who - $sym"; unshift @_, ( $self, $1 ); goto &{$self->can('call')} unless uc($1) eq $1; }; } sub import { my $class = shift; my $self = $class->new(@_); my $who = $self->_caller; unless ( -f $self->{file} ) { require "$self->{path}/$self->{dispatch}.pm"; File::Path::mkpath("$self->{prefix}/$self->{author}"); $self->{admin} = "$self->{name}::$self->{dispatch}"->new( _top => $self ); $self->{admin}->init; @_ = ($class, _self => $self); goto &{"$self->{name}::import"}; } *{"${who}::AUTOLOAD"} = $self->autoload; $self->preload; # Unregister loader and worker packages so subdirs can use them again delete $INC{"$self->{file}"}; delete $INC{"$self->{path}.pm"}; return 1; } sub preload { my $self = shift; unless ( $self->{extensions} ) { $self->load_extensions( "$self->{prefix}/$self->{path}", $self ); } my @exts = @{$self->{extensions}}; unless ( @exts ) { my $admin = $self->{admin}; @exts = $admin->load_all_extensions; } my %seen; foreach my $obj ( @exts ) { while (my ($method, $glob) = each %{ref($obj) . '::'}) { next unless $obj->can($method); next if $method =~ /^_/; next if $method eq uc($method); $seen{$method}++; } } my $who = $self->_caller; foreach my $name ( sort keys %seen ) { *{"${who}::$name"} = sub { ${"${who}::AUTOLOAD"} = "${who}::$name"; goto &{"${who}::AUTOLOAD"}; }; } } sub new { my ($class, %args) = @_; # ignore the prefix on extension modules built from top level. my $base_path = Cwd::abs_path($FindBin::Bin); unless ( Cwd::abs_path(Cwd::cwd()) eq $base_path ) { delete $args{prefix}; } return $args{_self} if $args{_self}; $args{dispatch} ||= 'Admin'; $args{prefix} ||= 'inc'; $args{author} ||= ($^O eq 'VMS' ? '_author' : '.author'); $args{bundle} ||= 'inc/BUNDLES'; $args{base} ||= $base_path; $class =~ s/^\Q$args{prefix}\E:://; $args{name} ||= $class; $args{version} ||= $class->VERSION; unless ( $args{path} ) { $args{path} = $args{name}; $args{path} =~ s!::!/!g; } $args{file} ||= "$args{base}/$args{prefix}/$args{path}.pm"; $args{wrote} = 0; bless( \%args, $class ); } sub call { my ($self, $method) = @_; my $obj = $self->load($method) or return; splice(@_, 0, 2, $obj); goto &{$obj->can($method)}; } sub load { my ($self, $method) = @_; $self->load_extensions( "$self->{prefix}/$self->{path}", $self ) unless $self->{extensions}; foreach my $obj (@{$self->{extensions}}) { return $obj if $obj->can($method); } my $admin = $self->{admin} or die <<"END_DIE"; The '$method' method does not exist in the '$self->{prefix}' path! Please remove the '$self->{prefix}' directory and run $0 again to load it. END_DIE my $obj = $admin->load($method, 1); push @{$self->{extensions}}, $obj; $obj; } sub load_extensions { my ($self, $path, $top) = @_; unless ( grep { lc $_ eq lc $self->{prefix} } @INC ) { unshift @INC, $self->{prefix}; } foreach my $rv ( $self->find_extensions($path) ) { my ($file, $pkg) = @{$rv}; next if $self->{pathnames}{$pkg}; local $@; my $new = eval { require $file; $pkg->can('new') }; unless ( $new ) { warn $@ if $@; next; } $self->{pathnames}{$pkg} = delete $INC{$file}; push @{$self->{extensions}}, &{$new}($pkg, _top => $top ); } $self->{extensions} ||= []; } sub find_extensions { my ($self, $path) = @_; my @found; File::Find::find( sub { my $file = $File::Find::name; return unless $file =~ m!^\Q$path\E/(.+)\.pm\Z!is; my $subpath = $1; return if lc($subpath) eq lc($self->{dispatch}); $file = "$self->{path}/$subpath.pm"; my $pkg = "$self->{name}::$subpath"; $pkg =~ s!/!::!g; # If we have a mixed-case package name, assume case has been preserved # correctly. Otherwise, root through the file to locate the case-preserved # version of the package name. if ( $subpath eq lc($subpath) || $subpath eq uc($subpath) ) { my $content = Module::Install::_read($subpath . '.pm'); my $in_pod = 0; foreach ( split //, $content ) { $in_pod = 1 if /^=\w/; $in_pod = 0 if /^=cut/; next if ($in_pod || /^=cut/); # skip pod text next if /^\s*#/; # and comments if ( m/^\s*package\s+($pkg)\s*;/i ) { $pkg = $1; last; } } } push @found, [ $file, $pkg ]; }, $path ) if -d $path; @found; } ##################################################################### # Utility Functions sub _caller { my $depth = 0; my $call = caller($depth); while ( $call eq __PACKAGE__ ) { $depth++; $call = caller($depth); } return $call; } sub _read { local *FH; open FH, "< $_[0]" or die "open($_[0]): $!"; my $str = do { local $/; <FH> }; close FH or die "close($_[0]): $!"; return $str; } sub _write { local *FH; open FH, "> $_[0]" or die "open($_[0]): $!"; foreach ( 1 .. $#_ ) { print FH $_[$_] or die "print($_[0]): $!" } close FH or die "close($_[0]): $!"; } sub _version { my $s = shift || 0; $s =~ s/^(\d+)\.?//; my $l = $1 || 0; my @v = map { $_ . '0' x (3 - length $_) } $s =~ /(\d{1,3})\D?/g; $l = $l . '.' . join '', @v if @v; return $l + 0; } 1; # Copyright 2008 Adam Kennedy. �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Graph-Easy-As_svg-0.23/inc/Module/AutoInstall.pm����������������������������������������������������0000644�0001750�0001750�00000050772�11015337103�017220� 0����������������������������������������������������������������������������������������������������ustar �te������������������������������te���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#line 1 package Module::AutoInstall; use strict; use Cwd (); use ExtUtils::MakeMaker (); use vars qw{$VERSION}; BEGIN { $VERSION = '1.03'; } # special map on pre-defined feature sets my %FeatureMap = ( '' => 'Core Features', # XXX: deprecated '-core' => 'Core Features', ); # various lexical flags my ( @Missing, @Existing, %DisabledTests, $UnderCPAN, $HasCPANPLUS ); my ( $Config, $CheckOnly, $SkipInstall, $AcceptDefault, $TestOnly ); my ( $PostambleActions, $PostambleUsed ); # See if it's a testing or non-interactive session _accept_default( $ENV{AUTOMATED_TESTING} or ! -t STDIN ); _init(); sub _accept_default { $AcceptDefault = shift; } sub missing_modules { return @Missing; } sub do_install { __PACKAGE__->install( [ $Config ? ( UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config} ) : () ], @Missing, ); } # initialize various flags, and/or perform install sub _init { foreach my $arg ( @ARGV, split( /[\s\t]+/, $ENV{PERL_AUTOINSTALL} || $ENV{PERL_EXTUTILS_AUTOINSTALL} || '' ) ) { if ( $arg =~ /^--config=(.*)$/ ) { $Config = [ split( ',', $1 ) ]; } elsif ( $arg =~ /^--installdeps=(.*)$/ ) { __PACKAGE__->install( $Config, @Missing = split( /,/, $1 ) ); exit 0; } elsif ( $arg =~ /^--default(?:deps)?$/ ) { $AcceptDefault = 1; } elsif ( $arg =~ /^--check(?:deps)?$/ ) { $CheckOnly = 1; } elsif ( $arg =~ /^--skip(?:deps)?$/ ) { $SkipInstall = 1; } elsif ( $arg =~ /^--test(?:only)?$/ ) { $TestOnly = 1; } } } # overrides MakeMaker's prompt() to automatically accept the default choice sub _prompt { goto &ExtUtils::MakeMaker::prompt unless $AcceptDefault; my ( $prompt, $default ) = @_; my $y = ( $default =~ /^[Yy]/ ); print $prompt, ' [', ( $y ? 'Y' : 'y' ), '/', ( $y ? 'n' : 'N' ), '] '; print "$default\n"; return $default; } # the workhorse sub import { my $class = shift; my @args = @_ or return; my $core_all; print "*** $class version " . $class->VERSION . "\n"; print "*** Checking for Perl dependencies...\n"; my $cwd = Cwd::cwd(); $Config = []; my $maxlen = length( ( sort { length($b) <=> length($a) } grep { /^[^\-]/ } map { ref($_) ? ( ( ref($_) eq 'HASH' ) ? keys(%$_) : @{$_} ) : '' } map { +{@args}->{$_} } grep { /^[^\-]/ or /^-core$/i } keys %{ +{@args} } )[0] ); while ( my ( $feature, $modules ) = splice( @args, 0, 2 ) ) { my ( @required, @tests, @skiptests ); my $default = 1; my $conflict = 0; if ( $feature =~ m/^-(\w+)$/ ) { my $option = lc($1); # check for a newer version of myself _update_to( $modules, @_ ) and return if $option eq 'version'; # sets CPAN configuration options $Config = $modules if $option eq 'config'; # promote every features to core status $core_all = ( $modules =~ /^all$/i ) and next if $option eq 'core'; next unless $option eq 'core'; } print "[" . ( $FeatureMap{ lc($feature) } || $feature ) . "]\n"; $modules = [ %{$modules} ] if UNIVERSAL::isa( $modules, 'HASH' ); unshift @$modules, -default => &{ shift(@$modules) } if ( ref( $modules->[0] ) eq 'CODE' ); # XXX: bugward combatability while ( my ( $mod, $arg ) = splice( @$modules, 0, 2 ) ) { if ( $mod =~ m/^-(\w+)$/ ) { my $option = lc($1); $default = $arg if ( $option eq 'default' ); $conflict = $arg if ( $option eq 'conflict' ); @tests = @{$arg} if ( $option eq 'tests' ); @skiptests = @{$arg} if ( $option eq 'skiptests' ); next; } printf( "- %-${maxlen}s ...", $mod ); if ( $arg and $arg =~ /^\D/ ) { unshift @$modules, $arg; $arg = 0; } # XXX: check for conflicts and uninstalls(!) them. if ( defined( my $cur = _version_check( _load($mod), $arg ||= 0 ) ) ) { print "loaded. ($cur" . ( $arg ? " >= $arg" : '' ) . ")\n"; push @Existing, $mod => $arg; $DisabledTests{$_} = 1 for map { glob($_) } @skiptests; } else { print "missing." . ( $arg ? " (would need $arg)" : '' ) . "\n"; push @required, $mod => $arg; } } next unless @required; my $mandatory = ( $feature eq '-core' or $core_all ); if ( !$SkipInstall and ( $CheckOnly or _prompt( qq{==> Auto-install the } . ( @required / 2 ) . ( $mandatory ? ' mandatory' : ' optional' ) . qq{ module(s) from CPAN?}, $default ? 'y' : 'n', ) =~ /^[Yy]/ ) ) { push( @Missing, @required ); $DisabledTests{$_} = 1 for map { glob($_) } @skiptests; } elsif ( !$SkipInstall and $default and $mandatory and _prompt( qq{==> The module(s) are mandatory! Really skip?}, 'n', ) =~ /^[Nn]/ ) { push( @Missing, @required ); $DisabledTests{$_} = 1 for map { glob($_) } @skiptests; } else { $DisabledTests{$_} = 1 for map { glob($_) } @tests; } } $UnderCPAN = _check_lock(); # check for $UnderCPAN if ( @Missing and not( $CheckOnly or $UnderCPAN ) ) { require Config; print "*** Dependencies will be installed the next time you type '$Config::Config{make}'.\n"; # make an educated guess of whether we'll need root permission. print " (You may need to do that as the 'root' user.)\n" if eval '$>'; } print "*** $class configuration finished.\n"; chdir $cwd; # import to main:: no strict 'refs'; *{'main::WriteMakefile'} = \&Write if caller(0) eq 'main'; } # Check to see if we are currently running under CPAN.pm and/or CPANPLUS; # if we are, then we simply let it taking care of our dependencies sub _check_lock { return unless @Missing; if ($ENV{PERL5_CPANPLUS_IS_RUNNING}) { print <<'END_MESSAGE'; *** Since we're running under CPANPLUS, I'll just let it take care of the dependency's installation later. END_MESSAGE return 1; } _load_cpan(); # Find the CPAN lock-file my $lock = MM->catfile( $CPAN::Config->{cpan_home}, ".lock" ); return unless -f $lock; # Check the lock local *LOCK; return unless open(LOCK, $lock); if ( ( $^O eq 'MSWin32' ? _under_cpan() : <LOCK> == getppid() ) and ( $CPAN::Config->{prerequisites_policy} || '' ) ne 'ignore' ) { print <<'END_MESSAGE'; *** Since we're running under CPAN, I'll just let it take care of the dependency's installation later. END_MESSAGE return 1; } close LOCK; return; } sub install { my $class = shift; my $i; # used below to strip leading '-' from config keys my @config = ( map { s/^-// if ++$i; $_ } @{ +shift } ); my ( @modules, @installed ); while ( my ( $pkg, $ver ) = splice( @_, 0, 2 ) ) { # grep out those already installed if ( defined( _version_check( _load($pkg), $ver ) ) ) { push @installed, $pkg; } else { push @modules, $pkg, $ver; } } return @installed unless @modules; # nothing to do return @installed if _check_lock(); # defer to the CPAN shell print "*** Installing dependencies...\n"; return unless _connected_to('cpan.org'); my %args = @config; my %failed; local *FAILED; if ( $args{do_once} and open( FAILED, '.#autoinstall.failed' ) ) { while (<FAILED>) { chomp; $failed{$_}++ } close FAILED; my @newmod; while ( my ( $k, $v ) = splice( @modules, 0, 2 ) ) { push @newmod, ( $k => $v ) unless $failed{$k}; } @modules = @newmod; } if ( _has_cpanplus() ) { _install_cpanplus( \@modules, \@config ); } else { _install_cpan( \@modules, \@config ); } print "*** $class installation finished.\n"; # see if we have successfully installed them while ( my ( $pkg, $ver ) = splice( @modules, 0, 2 ) ) { if ( defined( _version_check( _load($pkg), $ver ) ) ) { push @installed, $pkg; } elsif ( $args{do_once} and open( FAILED, '>> .#autoinstall.failed' ) ) { print FAILED "$pkg\n"; } } close FAILED if $args{do_once}; return @installed; } sub _install_cpanplus { my @modules = @{ +shift }; my @config = _cpanplus_config( @{ +shift } ); my $installed = 0; require CPANPLUS::Backend; my $cp = CPANPLUS::Backend->new; my $conf = $cp->configure_object; return unless $conf->can('conf') # 0.05x+ with "sudo" support or _can_write($conf->_get_build('base')); # 0.04x # if we're root, set UNINST=1 to avoid trouble unless user asked for it. my $makeflags = $conf->get_conf('makeflags') || ''; if ( UNIVERSAL::isa( $makeflags, 'HASH' ) ) { # 0.03+ uses a hashref here $makeflags->{UNINST} = 1 unless exists $makeflags->{UNINST}; } else { # 0.02 and below uses a scalar $makeflags = join( ' ', split( ' ', $makeflags ), 'UNINST=1' ) if ( $makeflags !~ /\bUNINST\b/ and eval qq{ $> eq '0' } ); } $conf->set_conf( makeflags => $makeflags ); $conf->set_conf( prereqs => 1 ); while ( my ( $key, $val ) = splice( @config, 0, 2 ) ) { $conf->set_conf( $key, $val ); } my $modtree = $cp->module_tree; while ( my ( $pkg, $ver ) = splice( @modules, 0, 2 ) ) { print "*** Installing $pkg...\n"; MY::preinstall( $pkg, $ver ) or next if defined &MY::preinstall; my $success; my $obj = $modtree->{$pkg}; if ( $obj and defined( _version_check( $obj->{version}, $ver ) ) ) { my $pathname = $pkg; $pathname =~ s/::/\\W/; foreach my $inc ( grep { m/$pathname.pm/i } keys(%INC) ) { delete $INC{$inc}; } my $rv = $cp->install( modules => [ $obj->{module} ] ); if ( $rv and ( $rv->{ $obj->{module} } or $rv->{ok} ) ) { print "*** $pkg successfully installed.\n"; $success = 1; } else { print "*** $pkg installation cancelled.\n"; $success = 0; } $installed += $success; } else { print << "."; *** Could not find a version $ver or above for $pkg; skipping. . } MY::postinstall( $pkg, $ver, $success ) if defined &MY::postinstall; } return $installed; } sub _cpanplus_config { my @config = (); while ( @_ ) { my ($key, $value) = (shift(), shift()); if ( $key eq 'prerequisites_policy' ) { if ( $value eq 'follow' ) { $value = CPANPLUS::Internals::Constants::PREREQ_INSTALL(); } elsif ( $value eq 'ask' ) { $value = CPANPLUS::Internals::Constants::PREREQ_ASK(); } elsif ( $value eq 'ignore' ) { $value = CPANPLUS::Internals::Constants::PREREQ_IGNORE(); } else { die "*** Cannot convert option $key = '$value' to CPANPLUS version.\n"; } } else { die "*** Cannot convert option $key to CPANPLUS version.\n"; } } return @config; } sub _install_cpan { my @modules = @{ +shift }; my @config = @{ +shift }; my $installed = 0; my %args; _load_cpan(); require Config; if (CPAN->VERSION < 1.80) { # no "sudo" support, probe for writableness return unless _can_write( MM->catfile( $CPAN::Config->{cpan_home}, 'sources' ) ) and _can_write( $Config::Config{sitelib} ); } # if we're root, set UNINST=1 to avoid trouble unless user asked for it. my $makeflags = $CPAN::Config->{make_install_arg} || ''; $CPAN::Config->{make_install_arg} = join( ' ', split( ' ', $makeflags ), 'UNINST=1' ) if ( $makeflags !~ /\bUNINST\b/ and eval qq{ $> eq '0' } ); # don't show start-up info $CPAN::Config->{inhibit_startup_message} = 1; # set additional options while ( my ( $opt, $arg ) = splice( @config, 0, 2 ) ) { ( $args{$opt} = $arg, next ) if $opt =~ /^force$/; # pseudo-option $CPAN::Config->{$opt} = $arg; } local $CPAN::Config->{prerequisites_policy} = 'follow'; while ( my ( $pkg, $ver ) = splice( @modules, 0, 2 ) ) { MY::preinstall( $pkg, $ver ) or next if defined &MY::preinstall; print "*** Installing $pkg...\n"; my $obj = CPAN::Shell->expand( Module => $pkg ); my $success = 0; if ( $obj and defined( _version_check( $obj->cpan_version, $ver ) ) ) { my $pathname = $pkg; $pathname =~ s/::/\\W/; foreach my $inc ( grep { m/$pathname.pm/i } keys(%INC) ) { delete $INC{$inc}; } my $rv = $args{force} ? CPAN::Shell->force( install => $pkg ) : CPAN::Shell->install($pkg); $rv ||= eval { $CPAN::META->instance( 'CPAN::Distribution', $obj->cpan_file, ) ->{install} if $CPAN::META; }; if ( $rv eq 'YES' ) { print "*** $pkg successfully installed.\n"; $success = 1; } else { print "*** $pkg installation failed.\n"; $success = 0; } $installed += $success; } else { print << "."; *** Could not find a version $ver or above for $pkg; skipping. . } MY::postinstall( $pkg, $ver, $success ) if defined &MY::postinstall; } return $installed; } sub _has_cpanplus { return ( $HasCPANPLUS = ( $INC{'CPANPLUS/Config.pm'} or _load('CPANPLUS::Shell::Default') ) ); } # make guesses on whether we're under the CPAN installation directory sub _under_cpan { require Cwd; require File::Spec; my $cwd = File::Spec->canonpath( Cwd::cwd() ); my $cpan = File::Spec->canonpath( $CPAN::Config->{cpan_home} ); return ( index( $cwd, $cpan ) > -1 ); } sub _update_to { my $class = __PACKAGE__; my $ver = shift; return if defined( _version_check( _load($class), $ver ) ); # no need to upgrade if ( _prompt( "==> A newer version of $class ($ver) is required. Install?", 'y' ) =~ /^[Nn]/ ) { die "*** Please install $class $ver manually.\n"; } print << "."; *** Trying to fetch it from CPAN... . # install ourselves _load($class) and return $class->import(@_) if $class->install( [], $class, $ver ); print << '.'; exit 1; *** Cannot bootstrap myself. :-( Installation terminated. . } # check if we're connected to some host, using inet_aton sub _connected_to { my $site = shift; return ( ( _load('Socket') and Socket::inet_aton($site) ) or _prompt( qq( *** Your host cannot resolve the domain name '$site', which probably means the Internet connections are unavailable. ==> Should we try to install the required module(s) anyway?), 'n' ) =~ /^[Yy]/ ); } # check if a directory is writable; may create it on demand sub _can_write { my $path = shift; mkdir( $path, 0755 ) unless -e $path; return 1 if -w $path; print << "."; *** You are not allowed to write to the directory '$path'; the installation may fail due to insufficient permissions. . if ( eval '$>' and lc(`sudo -V`) =~ /version/ and _prompt( qq( ==> Should we try to re-execute the autoinstall process with 'sudo'?), ((-t STDIN) ? 'y' : 'n') ) =~ /^[Yy]/ ) { # try to bootstrap ourselves from sudo print << "."; *** Trying to re-execute the autoinstall process with 'sudo'... . my $missing = join( ',', @Missing ); my $config = join( ',', UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config} ) if $Config; return unless system( 'sudo', $^X, $0, "--config=$config", "--installdeps=$missing" ); print << "."; *** The 'sudo' command exited with error! Resuming... . } return _prompt( qq( ==> Should we try to install the required module(s) anyway?), 'n' ) =~ /^[Yy]/; } # load a module and return the version it reports sub _load { my $mod = pop; # class/instance doesn't matter my $file = $mod; $file =~ s|::|/|g; $file .= '.pm'; local $@; return eval { require $file; $mod->VERSION } || ( $@ ? undef: 0 ); } # Load CPAN.pm and it's configuration sub _load_cpan { return if $CPAN::VERSION; require CPAN; if ( $CPAN::HandleConfig::VERSION ) { # Newer versions of CPAN have a HandleConfig module CPAN::HandleConfig->load; } else { # Older versions had the load method in Config directly CPAN::Config->load; } } # compare two versions, either use Sort::Versions or plain comparison sub _version_check { my ( $cur, $min ) = @_; return unless defined $cur; $cur =~ s/\s+$//; # check for version numbers that are not in decimal format if ( ref($cur) or ref($min) or $cur =~ /v|\..*\./ or $min =~ /v|\..*\./ ) { if ( ( $version::VERSION or defined( _load('version') )) and version->can('new') ) { # use version.pm if it is installed. return ( ( version->new($cur) >= version->new($min) ) ? $cur : undef ); } elsif ( $Sort::Versions::VERSION or defined( _load('Sort::Versions') ) ) { # use Sort::Versions as the sorting algorithm for a.b.c versions return ( ( Sort::Versions::versioncmp( $cur, $min ) != -1 ) ? $cur : undef ); } warn "Cannot reliably compare non-decimal formatted versions.\n" . "Please install version.pm or Sort::Versions.\n"; } # plain comparison local $^W = 0; # shuts off 'not numeric' bugs return ( $cur >= $min ? $cur : undef ); } # nothing; this usage is deprecated. sub main::PREREQ_PM { return {}; } sub _make_args { my %args = @_; $args{PREREQ_PM} = { %{ $args{PREREQ_PM} || {} }, @Existing, @Missing } if $UnderCPAN or $TestOnly; if ( $args{EXE_FILES} and -e 'MANIFEST' ) { require ExtUtils::Manifest; my $manifest = ExtUtils::Manifest::maniread('MANIFEST'); $args{EXE_FILES} = [ grep { exists $manifest->{$_} } @{ $args{EXE_FILES} } ]; } $args{test}{TESTS} ||= 't/*.t'; $args{test}{TESTS} = join( ' ', grep { !exists( $DisabledTests{$_} ) } map { glob($_) } split( /\s+/, $args{test}{TESTS} ) ); my $missing = join( ',', @Missing ); my $config = join( ',', UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config} ) if $Config; $PostambleActions = ( $missing ? "\$(PERL) $0 --config=$config --installdeps=$missing" : "\$(NOECHO) \$(NOOP)" ); return %args; } # a wrapper to ExtUtils::MakeMaker::WriteMakefile sub Write { require Carp; Carp::croak "WriteMakefile: Need even number of args" if @_ % 2; if ($CheckOnly) { print << "."; *** Makefile not written in check-only mode. . return; } my %args = _make_args(@_); no strict 'refs'; $PostambleUsed = 0; local *MY::postamble = \&postamble unless defined &MY::postamble; ExtUtils::MakeMaker::WriteMakefile(%args); print << "." unless $PostambleUsed; *** WARNING: Makefile written with customized MY::postamble() without including contents from Module::AutoInstall::postamble() -- auto installation features disabled. Please contact the author. . return 1; } sub postamble { $PostambleUsed = 1; return << "."; config :: installdeps \t\$(NOECHO) \$(NOOP) checkdeps :: \t\$(PERL) $0 --checkdeps installdeps :: \t$PostambleActions . } 1; __END__ #line 1003 ������Graph-Easy-As_svg-0.23/lib/�������������������������������������������������������������������������0000755�0001750�0001750�00000000000�11015337113�013161� 5����������������������������������������������������������������������������������������������������ustar �te������������������������������te���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Graph-Easy-As_svg-0.23/lib/Graph/�������������������������������������������������������������������0000755�0001750�0001750�00000000000�11015337113�014222� 5����������������������������������������������������������������������������������������������������ustar �te������������������������������te���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Graph-Easy-As_svg-0.23/lib/Graph/Easy/��������������������������������������������������������������0000755�0001750�0001750�00000000000�11015337113�015123� 5����������������������������������������������������������������������������������������������������ustar �te������������������������������te���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Graph-Easy-As_svg-0.23/lib/Graph/Easy/As_svg.pm�����������������������������������������������������0000644�0001750�0001750�00000162132�11015335572�016717� 0����������������������������������������������������������������������������������������������������ustar �te������������������������������te���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������############################################################################# # output the a Graph::Easy as SVG (Scalable Vector Graphics) # ############################################################################# package Graph::Easy::As_svg; use vars qw/$VERSION/; $VERSION = '0.23'; use strict; use utf8; sub _text_length { # Take a string, and return it's length, based on the font-size and the # contents ("iii" is shorter than "WWW") my ($em, $text) = @_; # For each len entry, count how often it matches the string # if it matches 2 times "[Ww]", and 3 times "[i]" then we have # (X - (2+3)) * EM + 2*$W*EM + 3*$I*EM where X is length($text), and # $W and $I are sizes of "[Ww]" and "[i]", respectively. my $count = length($text); my $len = 0; my $match; $match = $text =~ tr/'`//; $len += $match * 0.25 * $em; $count -= $match; $match = $text =~ tr/Iijl!.,;:\|//; $len += $match * 0.33 * $em; $count -= $match; $match = $text =~ tr/"Jft\(\)\[\]\{\}//; $len += $match * 0.4 * $em; $count -= $match; $match = $text =~ tr/?//; $len += $match * 0.5 * $em; $count -= $match; $match = $text =~ tr/crs_//; $len += $match * 0.55 * $em; $count -= $match; $match = $text =~ tr/ELPaäevyz\\\/-//; $len += $match * 0.6 * $em; $count -= $match; $match = $text =~ tr/1BZFbdghknopqux~üö//; $len += $match * 0.65 * $em; $count -= $match; $match = $text =~ tr/KCVXY%023456789//; $len += $match * 0.7 * $em; $count -= $match; $match = $text =~ tr/§€//; $len += $match * 0.75 * $em; $count -= $match; $match = $text =~ tr/ÜÖÄßHGDSNQU$&//; $len += $match * 0.8 * $em; $count -= $match; $match = $text =~ tr/AwO=+<>//; $len += $match * 0.85 * $em; $count -= $match; $match = $text =~ tr/W//; $len += $match * 0.90 * $em; $count -= $match; $match = $text =~ tr/M//; $len += $match * 0.95 * $em; $count -= $match; $match = $text =~ tr/m//; $len += $match * 1.03 * $em; $count -= $match; $match = $text =~ tr/@//; $len += $match * 1.15 * $em; $count -= $match; $match = $text =~ tr/æ//; $len += $match * 1.25 * $em; $count -= $match; $len += $count * $em; # anything else is 1.0 # return length in "characters" $len / $em; } sub _quote_name { my $name = shift; my $out_name = $name; # "--" is not allowed inside comments: $out_name =~ s/--/- - /g; # "&", "<" and ">" will not work in comments, so quote them $out_name =~ s/&/&/g; $out_name =~ s/</</g; $out_name =~ s/>/>/g; $out_name; } sub _quote { my ($txt) = @_; # "&", ,'"', "<" and ">" will not work in hrefs or texts $txt =~ s/&/&/g; $txt =~ s/</</g; $txt =~ s/>/>/g; $txt =~ s/"/"/g; # remove "\n" $txt =~ s/(^|[^\\])\\[lcnr]/$1 /g; $txt; } sub _sprintf { my $form = '%0.2f'; my @rc; for my $x (@_) { push @rc, undef and next unless defined $x; my $y = sprintf($form, $x); # convert "10.00" to "10" $y =~ s/\.0+\z//; # strip tailing zeros on "0.10", but not from "100" $y =~ s/(\.[0-9]+?)0+\z/$1/; push @rc, $y; } wantarray ? @rc : $rc[0]; } ############################################################################# ############################################################################# package Graph::Easy; use strict; BEGIN { *_quote = \&Graph::Easy::As_svg::_quote; *_svg_attributes_as_txt = \&Graph::Easy::Node::_svg_attributes_as_txt; } sub EM { # return the height of one line in pixels, taking the font-size into account my $self = shift; # default is 16 pixels (and 0.5 of that is a nice round number, like, oh, 8) $self->_font_size_in_pixels( 16 ); } sub LINE_HEIGHT { # return the height of one line in pixels, taking the font-size into account my $self = shift; # default is 20% bigger than EM (to make a bit more space on multi-line # labels for underlines etc) $self->_font_size_in_pixels( 16 ) * 18 / 16; } my $devs = { 'ah' => " <!-- open arrow -->\n <g id=" . '"ah" stroke-linecap="round" stroke-width="1">' . "\n" . ' <line x1="-8" y1="-4" x2="1" y2="0" />'. "\n" . ' <line x1="1" y1="0" x2="-8" y2="4" />'. "\n" . " </g>\n", 'ahb' => " <!-- open arrow for bold edges -->\n <g id=" . '"ahb" stroke-linecap="round" stroke-width="1">' . "\n" . ' <line x1="-8" y1="-4" x2="1" y2="0" />'. "\n" . ' <line x1="1" y1="0" x2="-8" y2="4" />'. "\n" . ' <polygon points="1,0, -4,-2, -4,2" />'. "\n" . " </g>\n", 'ahc' => " <!-- closed arrow -->\n <g id=" . '"ahc" stroke-linecap="round" stroke-width="1">' . "\n" . ' <polygon points="-8,-4, 1,0, -8,4"/>'. "\n" . " </g>\n", 'ahf' => " <!-- filled arrow -->\n <g id=" . '"ahf" stroke-linecap="round" stroke-width="1">' . "\n" . ' <polygon points="-8,-4, 1,0, -8,4"/>'. "\n" . " </g>\n", # point-shapes 'diamond' => " <g id=" . '"diamond">' . "\n" . ' <polygon points="0,-6, 6,0, 0,6, -6,0"/>'. "\n" . " </g>\n", 'circle' => " <g id=" . '"circle">' . "\n" . ' <circle r="6" />'. "\n" . " </g>\n", 'star' => " <g id=" . '"star">' . "\n" . ' <polygon points="0,-6, 1.5,-2, 6,-2, 2.5,1, 4,6, 0,3, -4,6, -2.5,1, -6,-2, -1.5,-2"/>'. "\n" . " </g>\n", 'square' => " <g id=" . '"square">' . "\n" . ' <rect width="10" height="10" />'. "\n" . " </g>\n", 'dot' => " <g id=" . '"dot">' . "\n" . ' <circle r="1" />'. "\n" . " </g>\n", 'cross' => " <g id=" . '"cross">' . "\n" . ' <line x1="0" y1="-5" x2="0" y2="5" />'. "\n" . ' <line x1="-5" y1="0" x2="5" y2="0" />'. "\n" . " </g>\n", # point-shapes with double border 'd-diamond' => " <g id=" . '"d-diamond">' . "\n" . ' <polygon points="0,-6, 6,0, 0,6, -6,0"/>'. "\n" . ' <polygon points="0,-3, 3,0, 0,3, -3,0"/>'. "\n" . " </g>\n", 'd-circle' => " <g id=" . '"d-circle">' . "\n" . ' <circle r="6" />'. "\n" . ' <circle r="3" />'. "\n" . " </g>\n", 'd-square' => " <g id=" . '"d-square">' . "\n" . ' <rect width="10" height="10" />'. "\n" . ' <rect width="6" height="6" transform="translate(2,2)" />'. "\n" . " </g>\n", 'd-star' => " <g id=" . '"d-star">' . "\n" . ' <polygon points="0,-6, 1.5,-2, 6,-2, 2.5,1, 4,6, 0,3, -4,6, -2.5,1, -6,-2, -1.5,-2"/>'. "\n" . ' <polygon points="0,-4, 1,-1, 4,-1.5, 1.5,0.5, 2.5,3.5, 0,1, -2.5,3.5, -1.5,0.5, -4,-1.5, -1,-1"/>'. "\n" . " </g>\n", }; my $strokes = { 'dashed' => '3, 1', 'dotted' => '1, 1', 'dot-dash' => '1, 1, 3, 1', 'dot-dot-dash' => '1, 1, 1, 1, 3, 1', 'double-dash' => '3, 1', 'bold-dash' => '3, 1', }; sub _svg_use_def { # mark a certain def as used (to output it's definition later) my ($self, $def_name) = @_; $self->{_svg_defs}->{$def_name} = 1; } sub text_styles_as_svg { my $self = shift; my $style = ''; my $ts = $self->text_styles(); $style .= ' font-style="italic"' if $ts->{italic}; $style .= ' font-weight="bold"' if $ts->{bold}; if ($ts->{underline} || $ts->{none} || $ts->{overline} || $ts->{'line-through'}) { # XXX TODO: HTML does seem to allow only one of them my @s; foreach my $k (qw/underline overline line-through none/) { push @s, $k if $ts->{$k}; } my $s = join(' ', @s); $style .= " text-decoration=\"$s\"" if $s; } my @styles; # XXX TODO: this will needless include the font-family if set via # "node { font: X }: my $ff = $self->attribute('font'); push @styles, "font-family:$ff" if $ff; # XXX TODO: this will needless include the font-size if set via # "node { font-size: X }: my $fs = $self->_font_size_in_pixels( 16 ); $fs = '' if $fs eq '16'; # XXX TODO: # the 'style="font-size:XXpx"' is nec. for Batik 1.5 (Firefox and Opera also # handle 'font-size="XXpx"'): push @styles, "font-size:${fs}px" if $fs; $style .= ' style="' . (join(";", @styles)) . '"' if @styles > 0; $style; } my $al_map = { 'c' => 'middle', 'l' => 'start', 'r' => 'end', }; sub _svg_text { # create a text via <text> at pos x,y, indented by "$indent" my ($self, $color, $indent, $x, $y, $style, $xl, $xr) = @_; my $align = $self->attribute('align'); my $text_wrap = $self->attribute('textwrap'); my ($lines, $aligns) = $self->_aligned_label($align, $text_wrap); # We can't just join them togeter with 'x=".." dy="1em"' because Firefox 1.5 # doesn't support this (Batik does, tho). So calculate x and y on each tspan: #print STDERR "# xl $xl xr $xr\n"; my $label = ''; if (@$lines > 1) { my $lh = $self->LINE_HEIGHT(); my $em = $self->EM(); my $in = $indent . $indent; my $dy = $y - $lh + $em; $label = "\n$in<tspan x=\"$x\" y=\"$dy\">"; $dy += $lh; my $i = 0; for my $line (@$lines) { # quote "<" and ">", "&" and also '"' $line = _quote($line); my $all = $aligns->[$i+1] || substr($align,0,1); my $al = ' text-anchor="' . $al_map->{$all} . '"'; #print STDERR "$line $al $all $align\n"; $al = '' if $all eq substr($align,0,1); my $xc = $x; $xc = $xl if ($all eq 'l'); $xc = $xr if ($all eq 'r'); my $join = "</tspan>"; $join .= "\n$in<tspan x=\"$xc\" y=\"$dy\"$al>" if $i < @$lines - 1; $dy += $lh; $label .= $line . $join; $i++; } $label .= "\n "; } else { $label = _quote($lines->[0]) if @$lines; } my $fs; $fs = $self->text_styles_as_svg() if $label ne ''; $fs = '' unless defined $fs; # For an edge, the default stroke is black, but this will render a black # outline around colored text. So disable the stroke with "none". my $stroke = ''; $stroke = ' stroke="none"' if ref($self) =~ /Edge/; if (!defined $style) { $x = $xl if $align eq 'left'; $x = $xr if $align eq 'right'; $style = ''; my $def_align = $self->default_attribute('align'); $style = ' text-anchor="' . $al_map->{substr($align,0,1)} . '"'; } my $svg = "$indent<text x=\"$x\" y=\"$y\"$fs fill=\"$color\"$stroke$style>$label</text>\n"; $svg . "\n" } sub _remap_align { my ($self, $att, $val) = @_; # align: center; => text-anchor: middle; => supress as it is the default? # return (undef,undef)if $val eq 'center'; $val = 'middle' if $val eq 'center'; # align: center; => text-anchor: middle; ('text-anchor', $val); } sub _remap_font_size { my ($self, $att, $val) = @_; # "16" to "16px" $val .= 'px' if $val =~ /^\d+\z/; if ($val =~ /em\z/) { $val = $self->_font_size_in_pixels( 16, $val ) . 'px'; } ('font-size', $val); } sub _adjust_dasharray { # If the border is bigger than 1px, we need to adjust the dasharray to # match it. my ($self,$att) = @_; # convert "20px" to "20" # convert "2em" to "xx" my $s = $att->{'stroke-width'} || 1; $s =~ s/px//; if ($s =~ /(\d+)em/) { my $em = $self->EM(); $s = $1 * $em; } $att->{'stroke-width'} = $s; delete $att->{'stroke-width'} if $s eq '1'; return $att unless exists $att->{'stroke-dasharray'}; # for very thin line, make it a bit bigger as to be actually visible $s = 2 if $s < 2; my @dashes = split /\s*,\s*/, $att->{'stroke-dasharray'}; for my $d (@dashes) { $d *= $s; # modify in place } $att->{'stroke-dasharray'} = join (',', @dashes); $att; } sub _as_svg { # convert the graph to SVG my ($self, $options) = @_; # set the info fields to defaults $self->{svg_info} = { width => 0, height => 0 }; $self->layout() unless defined $self->{score}; my ($rows,$cols,$max_x,$max_y) = $self->_prepare_layout('svg'); my $cells = $self->{cells}; my $txt; if ($options->{standalone}) { $txt .= <<EOSVG <?xml version="1.0" encoding="UTF-8" standalone="yes"?> <!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN" "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd"> EOSVG ; } my $em = $self->EM(); my $LINE_HEIGHT = $self->LINE_HEIGHT(); # XXX TODO: that should use the padding/margin attribute from the graph my $xl = int($em / 2); my $yl = int($em / 2); my $xr = int($em / 2); my $yr = int($em / 2); my $mx = $max_x + $xl + $xr; my $my = $max_y + $yl + $yr; # we need both xmlns= and xmlns:xlink to make Firefix 1.5 happy :-( $txt .= # '<svg viewBox="0 0 ##MX## ##MY##" width="##MX##" height="##MY##" version="1.1" xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink">' '<svg width="##MX##" height="##MY##" version="1.1" xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink">' ."\n<!-- Generated at " . scalar localtime() . " by:\n " . "Graph::Easy v$Graph::Easy::VERSION\n Graph::Easy::As_svg v$Graph::Easy::As_svg::VERSION\n-->\n\n"; my $title = _quote($self->title()); $txt .= "<title>$title\n" if $title ne ''; $txt .= "\n##devs##"; # clear used definitions $self->{_svg_defs} = {}; # which attributes must be output as what name: my $mutator = { background => 'fill', 'align' => \&_remap_align, 'color' => 'stroke', 'fontsize' => \&_remap_font_size, 'font' => 'font-family', }; my $skip = qr/^( arrow(style|shape)| (auto)?(link|title|label)| bordercolor| borderstyle| borderwidth| border| color| colorscheme| comment| columns| flow| format| gid| labelpos| labelcolor| linkbase| line-height| letter-spacing| margin.*| nodeclass| padding.*| rows| root| size| style| shape| title| type| textstyle| width| rotate| )\z/x; my $overlay = { edge => { "stroke" => 'black', "text-align" => 'center', "font-size" => '13px', }, node => { "font-size" => '16px', "text-align" => 'center', }, }; $overlay->{graph} = { "font-size" => '16px', "text-align" => 'center', "border" => '1px dashed #808080', }; # generate the class attributes first my $style = $self->_class_styles( $skip, $mutator, '', ' ', $overlay); $txt .= "\n \n" ." \n" if $style ne ''; $txt .="\n\n"; ########################################################################### # prepare graph label output my $lp = 'top'; my ($lw,$lh) = Graph::Easy::Node::_svg_dimensions($self); # some padding on the label $lw = int($em*$lw + $em + 0.5); $lh = int($LINE_HEIGHT*$lh+0.5); my $label = $self->label(); if ($label ne '') { $lp = $self->attribute('labelpos'); # handle the case where the graph label is bigger than the graph itself if ($mx < ($lw+$em)) { # move the content to the right to center it $xl += (($lw+$em) - $mx) / 2; # and then make the graph more wide $mx = $em + $lw; } $my += $lh; } ########################################################################### # output the graph's background and border my $em2 = $em / 2; { # 'inherit' only works for HTML, not for SVG my $bg = $self->color_attribute('fill'); $bg = 'white' if $bg eq 'inherit'; my $bs = $self->attribute('borderstyle'); my $cl = $self->color_attribute('bordercolor'); $cl = $bg if $bs eq 'none'; my $bw = $self->attribute('borderwidth') || 1; $bw =~ s/px//; # We always need to output a background rectangle, otherwise printing the # SVG from Firefox ends you up with a black background, which rather ruins # the day: # XXX TODO adjust dasharray my $att = { 'stroke-dasharray' => $strokes->{$bs} || '', 'stroke-width' => $bw, 'stroke' => $cl, 'fill' => $bg, }; # avoid stroke-dasharray="": delete $att->{'stroke-dasharray'} unless $att->{'stroke-dasharray'} ne ''; my $d = $self->_svg_attributes_as_txt($self->_adjust_dasharray($att)); my $xr = $mx + $em2; my $yr = $my + $em2; if ($bs ne '') { # Provide some padding around the graph to avoid that the border sticks # very close to the edge $xl += $em2 + $bw; $yl += $em2 + $bw; $xr += $em2 + 2 * $bw; $yr += $em2 + 2 * $bw; $mx += $em + 4 * $bw; $my += $em + 4 * $bw; } my $bw_2 = $bw / 2; $txt .= '' . "\n\n\n"; } # end outpuf of background ########################################################################### # adjust space for the graph label and output the label if ($label ne '') { my $y = $yl + $em2; $y = $my - $lh + $em2 if $lp eq 'bottom'; # also include a link on the label if nec. my $link = _quote($self->link()); my $l = Graph::Easy::Node::_svg_text($self, $self->color_attribute('color') || 'black', ' ', $mx / 2, $y, undef, $em2, $mx - $em2); $l =~ s/groups(), $self->edges(), $self->sorted_nodes()) { my $x = $xl; my $y = $yl; if ((ref($n) eq 'Graph::Easy::Node') || (ref($n) eq 'Graph::Easy::Node::Anon')) { # get position from cell $x += $cols->{ $n->{x} }; $y += $rows->{ $n->{y} }; } my $class = $n->class(); $class =~ s/\./_/; # node.city => node-city my $obj_txt = $n->as_svg($x,$y,' ', $rows, $cols); if ($obj_txt ne '') { $obj_txt =~ s/\n\z/<\/g>\n\n/; my $id = $n->attribute('id'); $id = $n->{id} if $id eq ''; $id =~ s/([\"\\])/\\$1/g; $txt .= "\n" . $obj_txt; } } # include the used definitions into my $d = ''; for my $key (keys %{$self->{_svg_defs}}) { $d .= $devs->{$key}; } $txt =~ s/##devs##/$d/; $txt =~ s/##MX##/$mx/; $txt =~ s/##MY##/$my/; $txt .= ""; # finish $txt .= "\n" if $options->{standalone}; # set the info fields: $self->{svg_info}->{width} = $mx; $self->{svg_info}->{height} = $my; $txt; } =pod =head1 NAME Graph::Easy::As_svg - Output a Graph::Easy as Scalable Vector Graphics (SVG) =head1 SYNOPSIS use Graph::Easy; my $graph = Graph::Easy->new(); $graph->add_edge ('Bonn', 'Berlin'); print $graph->as_svg_file(); =head1 DESCRIPTION C contains just the code for converting a L object to a SVG text. X X X X X X X =head1 EXPORT Exports nothing. =head1 SEE ALSO L. =head1 AUTHOR Copyright (C) 2004 - 2008 by Tels L See the LICENSE file for information. X =cut ############################################################################# ############################################################################# package Graph::Easy::Node::Cell; use vars qw/$VERSION/; $VERSION = '0.01'; sub as_svg { ''; } sub _correct_size_svg { my $self = shift; $self->{w} = 3; $self->{h} = 3; $self; } ############################################################################# ############################################################################# package Graph::Easy::Group::Cell; use vars qw/$VERSION/; $VERSION = '0.01'; sub as_svg { my ($self,$x, $y, $indent) = @_; my $svg = $self->_svg_background($x,$y,$indent); $svg .= $self->SUPER::as_svg($x,$y,$indent) if $self->{has_label}; $svg; } my $coords = { 'gl' => 'x1="XX0" y1="YY0" x2="XX0" y2="YY1"', 'gt' => 'x1="XX0" y1="YY0" x2="XX1" y2="YY0"', 'gb' => 'x1="XX0" y1="YY1" x2="XX1" y2="YY1"', 'gr' => 'x1="XX1" y1="YY0" x2="XX1" y2="YY1"', }; sub _svg_background { # draw the background for this node/cell, if nec. my ($self, $x, $y, $indent) = @_; my $bg = $self->background(); $bg = $self->{group}->default_attribute('fill') if $bg eq ''; my $svg = ''; if ($bg ne '') { $bg = $self->{group}->color_attribute('fill') if $bg eq 'inherit'; $bg = '' if $bg eq 'inherit'; if ($bg ne '') { my $w = $self->{w}; my $h = $self->{h}; $svg .= "$indent\n"; } } # draw the border pieces my $x2 = $x + $self->{w} - 0.5; my $y2 = $y + $self->{h} - 0.5; my $style = $self->attribute('border-style')||'dashed'; my $att = { 'stroke' => $self->color_attribute('bordercolor'), 'stroke-dasharray' => $strokes->{$style}||'3, 1', 'stroke-width' => $self->attribute('borderwidth') || 1, }; $self->_adjust_dasharray($att); my $stroke = $self->_svg_attributes_as_txt($att, 0, 0); # x,y are not used my $c = $self->{cell_class}; $c =~ s/^\s+//; $c =~ s/\s+\z//; $x += 0.5; $y += 0.5; for my $class (split /\s+/, $c) { last if $class =~ /^(\s+|gi)\z/; # inner => no border, skip empty my $l = "$indent{$class} . " $stroke/>\n"; $l =~ s/XX0/$x/g; $l =~ s/XX1/$x2/g; $l =~ s/YY0/$y/g; $l =~ s/YY1/$y2/g; $svg .= $l; } $svg .= "\n"; $svg; } ############################################################################# ############################################################################# package Graph::Easy::Group; use vars qw/$VERSION/; $VERSION = '0.01'; sub as_svg { # output all cells of the group as svg my ($self, $xl, $yl, $indent, $rows, $cols) = @_; my $txt = ''; for my $cell (values %{$self->{_cells}}) { # get position from cell my $x = $cols->{ $cell->{x} } + $xl; my $y = $rows->{ $cell->{y} } + $yl; $txt .= $cell->as_svg($x,$y,$indent); } $txt; } ############################################################################# ############################################################################# package Graph::Easy::Edge; use vars qw/$VERSION/; $VERSION = '0.01'; use Graph::Easy::Edge::Cell qw/EDGE_HOLE/; sub as_svg { # output all cells of the edge as svg my ($self, $xl, $yl, $indent, $rows, $cols) = @_; my $cells = $self->{cells}; my $from = Graph::Easy::As_svg::_quote_name($self->{from}->{name}); my $to = Graph::Easy::As_svg::_quote_name($self->{to}->{name}); my $txt = " \n"; my $done_cells = 0; for my $cell (@$cells) { next if $cell->{type} == EDGE_HOLE; $done_cells++; # get position from cell my $x = $cols->{ $cell->{x} } + $xl; my $y = $rows->{ $cell->{y} } + $yl; $txt .= $cell->as_svg($x,$y,$indent); } # had no cells or only one "HOLE" return '' if $done_cells == 0; $txt; } ############################################################################# ############################################################################# package Graph::Easy::Node::Empty; use vars qw/$VERSION/; $VERSION = '0.01'; sub as_svg { # empty nodes are not rendered at all ''; } ############################################################################# ############################################################################# package Graph::Easy::Node; use vars qw/$VERSION/; $VERSION = '0.01'; BEGIN { *_sprintf = \&Graph::Easy::As_svg::_sprintf; *_quote = \&Graph::Easy::As_svg::_quote; *LINE_HEIGHT = \&Graph::Easy::LINE_HEIGHT; } sub _svg_dimensions { # Returns the dimensions of the node/cell derived from the label (or name) in characters. my ($self) = @_; # my $align = $self->attribute('align') || $self->default_attribute('align') || 'center'; # my $text_wrap = $self->attribute('text-wrap') || 'none'; my $align = $self->attribute('align'); my $text_wrap = $self->attribute('textwrap'); my ($lines, $aligns) = $self->_aligned_label($align, $text_wrap); my $w = 0; my $h = scalar @$lines; my $em = $self->EM(); foreach my $line (@$lines) { $line =~ s/^\s+//; $line =~ s/\s+$//; # rem spaces my $line_length = Graph::Easy::As_svg::_text_length($em, $line); $w = $line_length if $line_length > $w; } ($w,$h); } sub _svg_background { # draw the background for this node/cell, if nec. my ($self, $x, $y, $indent) = @_; my $bg = $self->background(); my $s = ''; if (ref $self->{edge}) { $bg = $self->{edge}->{group}->default_attribute('fill')||'#a0d0ff' if $bg eq '' && ref $self->{edge}->{group}; $s = ' stroke="none"'; } my $svg = ''; if ($bg ne 'inherit' && $bg ne '') { my $w = $self->{w}; my $h = $self->{h}; $svg .= "$indent\n"; } $svg; } BEGIN { *EM = \&Graph::Easy::EM; *text_styles_as_svg = \&Graph::Easy::text_styles_as_svg; *_svg_text = \&Graph::Easy::_svg_text; *_adjust_dasharray = \&Graph::Easy::_adjust_dasharray; } sub as_svg { # output a node as SVG my ($self,$x,$y,$indent) = @_; my $name = $self->{att}->{label}; $name = $self->{name} if !defined $name; $name = 'anon node ' . $self->{name} if $self->{class} eq 'node.anon'; my $em = $self->EM(); # multiplication factor chars * em = units (pixels) # the attributes of the element we will finally output my $att = $self->_svg_attributes($x,$y); # the output shape as svg-tag my $shape = $att->{shape}; # rect, circle etc delete $att->{shape}; return '' if $shape eq 'invisible'; # set a potential title my $title = _quote($self->title()); $att->{title} = $title if $title ne ''; # the original shape my $s = ''; $s = $self->attribute('shape') unless $self->isa_cell(); my $link = _quote($self->link()); my $old_indent = $indent; $indent = $indent x 2 if $link ne ''; my $out_name = Graph::Easy::As_svg::_quote_name($name); my $svg = "$indent\n"; # render the background, except for "rect" where it is not visible # (use the original shape in $s, or "rounded" will be wrong) $svg .= $self->_svg_background($x,$y, $indent) if $s ne 'rect'; my $bs = $self->attribute('borderstyle'); my $xt = int($x + $self->{w} / 2); my $yt = int($y + $self->{h} / 2); # render the node shape itself if ($shape eq 'point') { # include the point-shape my $s = $self->attribute('pointshape'); if ($s ne 'invisible') { $s = 'd-' . $s if $bs =~ /^double/ && $s =~ /^(square|diamond|circle|star)\z/; my $ps = $self->attribute('pointstyle'); # circle => filledcircle #$s = 'f-' . $s if $ps eq 'filled' && $s =~ /^(square|diamond|circle|star)\z/; my $a = { }; for my $key (keys %$att) { $a->{$key} = $att->{$key}; } $a->{stroke} = $self->color_attribute('bordercolor'); if ($s eq 'dot' || $ps eq 'filled') { $a->{fill} = $a->{stroke}; } my $att_txt = $self->_svg_attributes_as_txt($a, $xt, $yt); # center a square point-node $yt -= 5 if $s =~ 'square'; $xt -= 5 if $s =~ 'square'; $self->{graph}->_svg_use_def($s); $svg .= "$indent\n\n"; } else { $svg .= "\n"; } } elsif ($shape eq 'img') { require Image::Info; my $label = $self->label(); my $info = Image::Info::image_info($label); my $w = $info->{width}; my $h = $info->{height}; if ($info->{error}) { $self->_croak("Couldn't determine image dimensions from '$label': $info->{error}"); } # center the image my $x1 = $xt - $w / 2; my $y1 = $yt - $h / 2; $label = _quote($label); $svg .= "\n"; } else { # no border/shape for Group cells (we need to draw the border in pieces) if ($shape ne 'none' && !$self->isa('Graph::Easy::Group::Cell')) { # If we need to draw the border shape twice, put common attributes on # a around it. (In the case there is only "stroke: #000000;" it will # waste 4 bytes, but in all other cases save quite a few. my $group = {}; if ($bs =~ /^double/) { for my $a (qw/fill stroke stroke-dasharray/) { $group->{$a} = $att->{$a} if exists $att->{$a}; delete $att->{$a}; } } my $att_txt = $self->_svg_attributes_as_txt($att, $xt, $yt); my $shape_svg = "$indent<$shape$att_txt />\n"; # if border-style is double, do it again, sam. if ($bs =~ /^double/) { my $group_txt = $self->_svg_attributes_as_txt($group, $xt, $yt); $shape_svg = "$indent\n$indent" . $shape_svg; my $att = $self->_svg_attributes($x,$y, 3); for my $a (qw/fill stroke stroke-dasharray/) { delete $att->{$a}; } my $shape = $att->{shape}; # circle etc delete $att->{shape}; my $att_txt = $self->_svg_attributes_as_txt( $att, $xt, $yt ); $shape_svg .= "$indent$indent<$shape$att_txt />\n"; $shape_svg .= "$indent\n"; # close group } $svg .= $shape_svg; } ########################################################################### # include the label/name/text my ($w,$h) = $self->_svg_dimensions(); my $lh = $self->LINE_HEIGHT(); my $yt = int($y + $self->{h} / 2 + $lh / 3 - ($h -1) * $lh / 2); $yt += $self->{h} * 0.25 if $s =~ /^(triangle|trapezium)\z/; $yt -= $self->{h} * 0.25 if $s =~ /^inv(triangle|trapezium)\z/; $yt += $self->{h} * 0.10 if $s eq 'house'; $yt -= $self->{h} * 0.10 if $s eq 'invhouse'; my $color = $self->color_attribute('color') || 'black'; $svg .= $self->_svg_text($color, $indent, $xt, $yt, # left # right undef, int($x + $em/2), int($x + $self->{w} - $em/2)); } # Create the link $svg = $self->_link($svg, $old_indent, $title, $link) if $link ne ''; $svg; } sub _link { # put a link around a shape (including onclick handler to work around bugs) my ($self, $svg, $indent, $title, $link) = @_; # although the title is already included on the outer shape, we need to # add it to the link, too (for shape: none, and some user agents like # FF 1.5 display the title only while outside the text-area) $title = ' xlink:title="' . $title . '"' if $title ne ''; $svg =~ s/\n\z//; $svg = $indent . "\n" . $svg . $indent . "\n\n"; $svg; } sub _svg_attributes { # Return a hash with attributes for the node, like "x => 1, y => 1, w => 1, h => 1" # Especially usefull for shapes other than boxes. my ($self,$x,$y, $sub) = @_; # subtract factor, 0 or 2 for border-style: double $sub ||= 0; my $att = {}; my $shape = $self->shape(); my $em = $self->EM(); my $border_width = Graph::Easy::_border_width_in_pixels($self,$em); # subtract half of our border-width because the border-center would otherwise # be on the node's border-line and thus extending outward: my $bw2 = $border_width / 2; $sub += $bw2; my $w2 = $self->{w} / 2; my $h2 = $self->{h} / 2; # center my $cx = $x + $self->{w} / 2; my $cy = $y + $self->{h} / 2; my $double = 0; $double = 1 if ($self->attribute('border-style') || '') eq 'double'; my $x2 = $x + $self->{w} - $sub; my $y2 = $y + $self->{h} - $sub; $x += $sub; $y += $sub; my $sub3 = $sub / 3; # 0.333 * $sub my $sub6 = 2 * $sub / 3; # 0.666 * $sub if ($shape =~ /^(point|none)\z/) { } elsif ($shape eq 'circle') { $att->{cx} = $cx; $att->{cy} = $cy; $att->{r} = $self->{minw} > $self->{minh} ? $self->{minw} : $self->{minh}; $att->{r} /= 2; $att->{r} -= $sub; } elsif ($shape eq 'parallelogram') { my $xll = _sprintf($x - $sub3 + $self->{w} * 0.25); my $xrl = _sprintf($x2 + $sub3 - $self->{w} * 0.25); my $xl = _sprintf($x + $sub6); my $xr = _sprintf($x2 - $sub6); $shape = "polygon points=\"$xll,$y, $xr,$y, $xrl,$y2, $xl,$y2\""; } elsif ($shape eq 'trapezium') { my $xl = _sprintf($x - $sub3 + $self->{w} * 0.25); my $xr = _sprintf($x2 + $sub3 - $self->{w} * 0.25); my $xl1 = _sprintf($x + $sub3); my $xr1 = _sprintf($x2 - $sub3); $shape = "polygon points=\"$xl,$y, $xr,$y, $xr1,$y2, $xl1,$y2\""; } elsif ($shape eq 'invtrapezium') { my $xl = _sprintf($x - $sub3 + $self->{w} * 0.25); my $xr = _sprintf($x2 + $sub3 - $self->{w} * 0.25); my $xl1 = _sprintf($x + $sub3); my $xr1 = _sprintf($x2 - $sub3); $shape = "polygon points=\"$xl1,$y, $xr1,$y, $xr,$y2, $xl,$y2\""; } elsif ($shape eq 'diamond') { my $x1 = $cx; my $y1 = $cy; my $xl = _sprintf($x + $sub3); my $xr = _sprintf($x2 - $sub3); $shape = "polygon points=\"$xl,$y1, $x1,$y, $xr,$y1, $x1,$y2\""; } elsif ($shape eq 'house') { my $x1 = $cx; my $y1 = _sprintf($y - $sub3 + $self->{h} * 0.333); $shape = "polygon points=\"$x1,$y, $x2,$y1, $x2,$y2, $x,$y2, $x,$y1\""; } elsif ($shape eq 'pentagon') { my $x1 = $cx; my $x11 = _sprintf($x - $sub3 + $self->{w} * 0.25); my $x12 = _sprintf($x2 + $sub3 - $self->{w} * 0.25); my $y1 = _sprintf($y - $sub6 + $self->{h} * 0.333); my $xl = _sprintf($x + $sub3); my $xr = _sprintf($x2 - $sub3); $shape = "polygon points=\"$x1,$y, $xr,$y1, $x12,$y2, $x11,$y2, $xl,$y1\""; } elsif ($shape eq 'invhouse') { my $x1 = $cx; my $y1 = _sprintf($y - (1.4 * $sub) + $self->{h} * 0.666); $shape = "polygon points=\"$x,$y, $x2,$y, $x2,$y1, $x1,$y2, $x,$y1\""; } elsif ($shape eq 'septagon') { my $x15 = $cx; my $x11 = _sprintf($x2 + $sub3 - $self->{w} * 0.10); my $x14 = _sprintf($x - $sub3 + $self->{w} * 0.10); my $y11 = _sprintf($y - $sub3 + $self->{h} * 0.15); my $y13 = _sprintf($y2 + 0.85 * $sub - $self->{h} * 0.40); my $x12 = _sprintf($x2 + $sub6 - $self->{w} * 0.25); my $x13 = _sprintf($x - $sub6 + $self->{w} * 0.25); my $xl = _sprintf($x - 0.15 * $sub); my $xr = _sprintf($x2 + 0.15 * $sub); $shape = "polygon points=\"$x15,$y, $x11,$y11, $xr,$y13, $x12,$y2, $x13,$y2, $xl,$y13, $x14, $y11\""; } elsif ($shape eq 'octagon') { my $x11 = _sprintf($x - $sub3 + $self->{w} * 0.25); my $x12 = _sprintf($x2 + $sub3 - $self->{w} * 0.25); my $y11 = _sprintf($y - $sub6 + $self->{h} * 0.25); my $y12 = _sprintf($y2 + $sub6 - $self->{h} * 0.25); my $xl = _sprintf($x + $sub * 0.133); my $xr = _sprintf($x2 - $sub * 0.133); $shape = "polygon points=\"$xl,$y11, $x11,$y, $x12,$y, $xr,$y11, $xr,$y12, $x12,$y2, $x11,$y2, $xl,$y12\""; } elsif ($shape eq 'hexagon') { my $y1 = $cy; my $x11 = _sprintf($x - $sub6 + $self->{w} * 0.25); my $x12 = _sprintf($x2 + $sub6 - $self->{w} * 0.25); my $xl = _sprintf($x + $sub3); my $xr = _sprintf($x2 - $sub3); $shape = "polygon points=\"$xl,$y1, $x11,$y, $x12,$y, $xr,$y1, $x12,$y2, $x11,$y2\""; } elsif ($shape eq 'triangle') { my $x1 = $cx; my $xl = _sprintf($x + $sub); my $xr = _sprintf($x2 - $sub); my $yd = _sprintf($y2 + ($sub * 0.2 )); $shape = "polygon points=\"$x1,$y, $xr,$yd, $xl,$yd\""; } elsif ($shape eq 'invtriangle') { my $x1 = $cx; my $xl = _sprintf($x + $sub); my $xr = _sprintf($x2 - $sub); my $yd = _sprintf($y - ($sub * 0.2)); $shape = "polygon points=\"$xl,$yd, $xr,$yd, $x1,$y2\""; } elsif ($shape eq 'ellipse') { $att->{cx} = $cx; $att->{cy} = $cy; $att->{rx} = $w2 - $sub; $att->{ry} = $h2 - $sub; } else { if ($shape eq 'rounded') { # round corners by a fixed value $att->{ry} = '15'; $att->{rx} = '15'; $shape = 'rect'; } $att->{x} = $x; $att->{y} = $y; $att->{width} = _sprintf($self->{w} - $sub * 2); $att->{height} = _sprintf($self->{h} - $sub * 2); } $att->{shape} = $shape; my $border_style = $self->attribute('border-style') || 'solid'; my $border_color = $self->color_attribute('border-color') || 'black'; $att->{'stroke-width'} = $border_width if $border_width ne '1'; $att->{stroke} = $border_color; if ($border_style !~ /^(none|solid)/) { $att->{'stroke-dasharray'} = $strokes->{$border_style} if exists $strokes->{$border_style}; $self->_adjust_dasharray($att); } if ($border_style eq 'none') { delete $att->{'stroke-width'}; delete $att->{stroke}; } $att->{fill} = $self->color_attribute('fill') || 'white'; # include the fill for renderers that can't cope with CSS styles # delete $att->{fill} if $att->{fill} eq 'white'; # white is default $att->{rotate} = $self->angle(); $att; } sub _svg_attributes_as_txt { # convert hash with attributes to text to be included in SVG tag my ($self, $att, $x, $y) = @_; my $att_line = ''; # attributes as text (cur line) my $att_txt = ''; # attributes as text (all) foreach my $e (sort keys %$att) { # skip these next if $e =~ /^(arrow-?style|arrow-?shape|text-?style|label-?color| rows|columns|size|offset|origin|rotate|colorscheme)\z/x; $att_line .= " $e=\"$att->{$e}\""; if (length($att_line) > 75) { $att_txt .= "$att_line\n "; $att_line = ''; } } ########################################################################### # include the rotation my $r = $att->{rotate} || 0; $att_line .= " transform=\"rotate($r, $x, $y)\"" if $r != 0; if (length($att_line) > 75) { $att_txt .= "$att_line\n "; $att_line = ''; } $att_txt .= $att_line; $att_txt =~ s/\n \z//; # avoid a " >" on last line $att_txt; } sub _correct_size_svg { # Correct {w} and {h} for the node after parsing. my $self = shift; my $em = $self->EM(); # multiplication factor chars * em = units (pixels) return if defined $self->{w}; my $shape = $self->shape(); if ($shape eq 'point') { $self->{w} = $em * 3; $self->{h} = $em * 3; return; } my ($w,$h) = $self->_svg_dimensions(); my $lh = $self->LINE_HEIGHT(); # XXX TODO: that should use a changable padding factor (like "0.2 em" or "4") $self->{w} = int($w * $em + $em); $self->{h} = int($h * $lh + $em); my $border = 'none'; $border = $self->attribute('borderstyle') || '' if $shape ne 'none'; if ($border ne 'none') { my $bw = Graph::Easy::_border_width_in_pixels($self,$em); $self->{w} += $bw * 2; # *2 due to left/right and top/bottom $self->{h} += $bw * 2; } # for triangle or invtriangle: $self->{w} *= 1.4 if $shape =~ /triangle/; $self->{h} *= 1.8 if $shape =~ /triangle|trapezium/; $self->{w} *= 1.2 if $shape =~ /(parallelogram|trapezium|pentagon)/; if ($shape =~ /^(diamond|circle|octagon|hexagon|triangle)\z/) { # the min size is either w or h, depending on which is bigger my $max = $self->{w}; $max = $self->{h} if $self->{h} > $max; $self->{h} = $max; $self->{w} = $max; } } 1; ############################################################################# ############################################################################# package Graph::Easy::Edge::Cell; use vars qw/$VERSION/; $VERSION = '0.01'; BEGIN { *_sprintf = \&Graph::Easy::As_svg::_sprintf; *_quote = \&Graph::Easy::As_svg::_quote; } ############################################################################# ############################################################################# # Line drawing code for edges # define the line lengths for the different edge types sub LINE_HOR () { 0x0; } sub LINE_VER () { 0x1; } sub LINE_PATH() { 0x2; } sub LINE_MASK () { 0x0F; } sub LINE_DOUBLE () { 0x10; } # edge type line type spacing left/top # spacing right/bottom my $draw_lines = { # for selfloops, we use paths EDGE_N_W_S() => [ LINE_PATH, 'M', -1, -0.5, 'L', -1, -1.5, 'L', 1, -1.5, 'L', 1, -0.5 ], # v--| EDGE_S_W_N() => [ LINE_PATH, 'M', -1, 0.5, 'L', -1, 1.5, 'L', 1, 1.5, 'L', 1, 0.5 ], # ^--| EDGE_E_S_W() => [ LINE_PATH, 'M', 0.5, 1, 'L', 1.5, 1, 'L', 1.5, -1, 'L', 0.5, -1 ], # [_ EDGE_W_S_E() => [ LINE_PATH, 'M', -0.5, 1, 'L', -1.5, 1, 'L', -1.5, -1, 'L', -0.5, -1 ], # _] # everything else draws straight lines EDGE_VER() => [ LINE_VER, 0, 0 ], # | vertical line EDGE_HOR() => [ LINE_HOR, 0, 0 ], # -- vertical line EDGE_CROSS() => [ LINE_HOR, 0, 0, LINE_VER, 0, 0 ], # + crossing EDGE_S_E() => [ LINE_VER, 0.5, 0, LINE_HOR, 0.5, 0 ], # |_ corner (N to E) EDGE_N_W() => [ LINE_VER, 0, 0.5, LINE_HOR, 0, 0.5 ], # _| corner (N to W) EDGE_N_E() => [ LINE_VER, 0, 0.5, LINE_HOR, 0.5, 0 ], # ,- corner (S to E) EDGE_S_W() => [ LINE_VER, 0.5, 0, LINE_HOR, 0, 0.5 ], # -, corner (S to W) EDGE_S_E_W() => [ LINE_HOR, 0, 0, LINE_VER, 0.5, 0 ], # joint EDGE_N_E_W() => [ LINE_HOR, 0, 0, LINE_VER, 0, 0.5 ], # joint EDGE_E_N_S() => [ LINE_HOR, 0.5, 0, LINE_VER, 0, 0 ], # joint EDGE_W_N_S() => [ LINE_HOR, 0, 0.5, LINE_VER, 0, 0 ], # joint }; my $dimensions = { EDGE_VER() => [ 1, 2 ], # | EDGE_HOR() => [ 2, 1 ], # - EDGE_CROSS() => [ 2, 2 ], # + crossing EDGE_N_E() => [ 2, 2 ], # |_ corner (N to E) EDGE_N_W() => [ 2, 2 ], # _| corner (N to W) EDGE_S_E() => [ 2, 2 ], # ,- corner (S to E) EDGE_S_W() => [ 2, 2 ], # -, corner (S to W) EDGE_S_E_W => [ 2, 2 ], # -,- three-sided corner (S to W/E) EDGE_N_E_W => [ 2, 2 ], # -'- three-sided corner (N to W/E) EDGE_E_N_S => [ 2, 2 ], # |- three-sided corner (E to S/N) EDGE_W_N_S => [ 2, 2 ], # -| three-sided corner (W to S/N) EDGE_N_W_S() => [ 4, 2 ], # loops EDGE_S_W_N() => [ 4, 2 ], EDGE_E_S_W() => [ 2, 4 ], EDGE_W_S_E() => [ 2, 4 ], }; my $arrow_pos = { EDGE_N_W_S() => [ 1, -0.5 ], EDGE_S_W_N() => [ 1, 0.5 ], EDGE_E_S_W() => [ 0.5, -1 ], EDGE_W_S_E() => [ -0.5, -1 ], }; my $arrow_correct = { EDGE_END_S() => [ 'h', 1.5 ], EDGE_END_N() => [ 'h', 1.5 ], EDGE_START_S() => [ 'h', 1 ], EDGE_START_N() => [ 'h', 1 ], EDGE_END_W() => [ 'w', 1.5 ], EDGE_END_E() => [ 'w', 1.5 ], EDGE_START_W() => [ 'w', 1, ], EDGE_START_E() => [ 'w', 1, ], # EDGE_END_S() => [ 'h', 3.5, 'w', 2 ], # EDGE_END_N() => [ 'h', 3.5, 'w', 2 ], # EDGE_START_S() => [ 'h', 3 ], # EDGE_START_N() => [ 'h', 3 ], # EDGE_END_W() => [ 'w', 1.5, 'h', 2 ], # EDGE_END_E() => [ 'w', 1.5, 'h', 2 ], # EDGE_START_W() => [ 'w', 1, ], # EDGE_START_E() => [ 'w', 1, ], }; sub _arrow_pos { # compute the position of the arrow my ($self, $x, $w, $y, $h, $ddx, $ddy, $dx, $dy) = @_; my $em = $self->EM(); my $cell_type = $self->{type} & EDGE_TYPE_MASK; if (exists $arrow_pos->{$cell_type}) { $dx = $arrow_pos->{$cell_type}->[0] * $em; $dy = $arrow_pos->{$cell_type}->[1] * $em; $dx = $w + $dx if $dx < 0; $dy = $h + $dy if $dy < 0; $dx += $x; $dy += $y; } _sprintf($dx,$dy); } sub _svg_arrow { my ($self, $att, $x, $y, $type, $indent, $s) = @_; my $w = $self->{w}; my $h = $self->{h}; $s ||= 0; my $arrow_style = $self->attribute('arrow-style') || ''; return '' if $arrow_style eq 'none'; my $class = 'ah' . substr($arrow_style,0,1); # aho => ah $class = 'ah' if $class eq 'aho'; # ah => ahb for bold/broad/wide edges with open arrows $class .= 'b' if $s > 1 && $class eq 'ah'; # For the things to be "used" define these attributes, so if they # match, we can skip them, generating shorter output: my $DEF = { "stroke-linecap" => 'round', }; my $a = {}; for my $key (keys %$att) { next if $key =~ /^(stroke-dasharray|arrow-style|stroke-width)\z/; $a->{$key} = $att->{$key} unless exists $DEF->{$key} && $DEF->{$key} eq $att->{$key}; } if ($arrow_style eq 'closed') { $a->{fill} = $self->color_attribute('background') || 'inherit'; $a->{fill} = $self->{graph}->color_attribute('graph', 'background') || 'inherit' if $a->{fill} eq 'inherit'; $a->{fill} = 'white' if $a->{fill} eq 'inherit'; } elsif ($arrow_style eq 'filled') { # if fill is not defind, use the color my $fill = $self->raw_attribute('fill'); if (defined $fill) { $a->{fill} = $self->color_attribute('fill'); } else { $a->{fill} = $self->color_attribute('color'); } } elsif ($class eq 'ahb') { $a->{fill} = $self->color_attribute('color'); delete $a->{fill} unless $a->{fill}; } my $att_txt = $self->_svg_attributes_as_txt($a); $self->{graph}->_svg_use_def($class) if ref $self->{graph}; my $ar = "$indent 1; # displacement of the arrow, to account for wider lines my $dis = 0.1; my ($x1,$x2, $y1,$y2); if ($type & EDGE_END_N) { my $d = $dis; $d += $ss/150 if $ss > 1; $d *= $h if $d < 1; ($x1, $y1) = $self->_arrow_pos($x,$w,$y,$h, 0, $d, $x + $w / 2, $y + $d); $svg .= $ar . "transform=\"translate($x1 $y1)rotate(-90)$scale\"/>\n"; } if ($type & EDGE_END_S) { my $d = $dis; $d += $ss/150 if $ss > 1; $d *= $h if $d < 1; ($x1, $y1) = $self->_arrow_pos($x,$w,$y,$h, 0, $d, $x + $w / 2, $y + $h - $d); $svg .= $ar . "transform=\"translate($x1 $y1)rotate(90)$scale\"/>\n"; } if ($type & EDGE_END_W) { my $d = $dis; $d += $ss/50 if $ss > 1; $d *= $w if $d < 1; ($x1, $y1) = $self->_arrow_pos($x,$w,$y,$h, $d, 0, $x + $d, $y + $h / 2); $svg .= $ar . "transform=\"translate($x1 $y1)rotate(180)$scale\"/>\n"; } if ($type & EDGE_END_E) { my $d = $dis; $d += $ss/50 if $ss > 1; $d *= $w if $d < 1; ($x1, $y1) = $self->_arrow_pos($x,$w,$y,$h, $d, 0, $x + $w - $d, $y + $h / 2); my $a = $ar . "x=\"$x1\" y=\"$y1\"/>\n"; $a = $ar . "transform=\"translate($x1 $y1)$scale\"/>\n" if $scale; $svg .= $a; } $svg; } sub _svg_line_straight { # Generate SVG tags for a vertical/horizontal line, bounded by (x,y), (x+w,y+h). # $l and $r shorten the line left/right, or top/bottom, respectively. If $l/$r < 1, # in % (aka $l * w), otherwise in units. # "$s" means there is a starting point, so the line needs to be shorter. Likewise # for "$e", only on the "other" side. # VER: s = north, e = south, HOR: s = left, e= right my ($self, $x, $y, $type, $l, $r, $s, $e, $add, $lw) = @_; my $w = $self->{w}; my $h = $self->{h}; $add = '' unless defined $add; # additinal styles? my ($x1,$x2, $y1,$y2, $x3, $x4, $y3, $y4); $lw ||= 1; # line-width my $ltype = $type & LINE_MASK; if ($ltype == LINE_HOR) { $l += $s if $s; $r += $e if $e; # +/-$lw to close the gaps at corners $l *= $w - $lw if $l == 0.5; $r *= $w - $lw if $r == 0.5; $l *= $w if $l < 1; $r *= $w if $r < 1; $x1 = $x + $l; $x2 = $x + $w - $r; $y1 = $y + $h / 2; $y2 = $y1; if (($type & LINE_DOUBLE) != 0) { $y1--; $y2--; $y3 = $y1 + 2; $y4 = $y3; # shorten the line for end/start points $x1 += 1.5 if $s; $x2 -= 1.5 if $e; $x3 = $x1; $x4 = $x2; } } else { $l += $s if $s; $r += $e if $e; # +/-$lw to close the gaps at corners $l *= $h - $lw if $l == 0.5; $r *= $h - $lw if $r == 0.5; $l *= $h if $l < 1; $r *= $h if $r < 1; $x1 = $x + $w / 2; $x2 = $x1; $y1 = $y + $l; $y2 = $y + $h - $r; if (($type & LINE_DOUBLE) != 0) { $x1--; $x2--; $x3 = $x1 + 2; $x4 = $x3; # shorten the line for end/start points $y1 += 1.5 if $s; $y2 -= 1.5 if $e; $y3 = $y1; $y4 = $y2; } } ($x1,$y1,$x2,$y2,$x3,$y3,$x4,$y4) = _sprintf($x1,$y1,$x2,$y2,$x3,$y3,$x4,$y4); my @r = ( "" ); # for a double line push @r, "" if defined $x3; @r; } sub _svg_path { # Generate SVG tags for a path, bounded by (x,y), (x+w,y+h). # "$s" means there is a starting point, so the line needs to be shorter. Likewise # for "$e", only on the "other" end side. # The passed coords are relative to x,y, and in EMs. my ($self, $x, $y, $s, $e, $add, $lw, @coords) = @_; my $em = $self->EM(); my $w = $self->{w}; my $h = $self->{h}; $add = '' unless defined $add; # additinal styles? $lw ||= 1; # line-width my $d = ''; while (@coords) { my ($t, $xa, $ya) = splice (@coords,0,3); # 'M', '1', '-1' $xa *= $em; $xa += $w if $xa < 0; $ya *= $em; $ya += $h if $ya < 0; ($xa,$ya) = _sprintf($xa+$x,$ya+$y); $d .= "$t$xa $ya"; } ""; } ############################################################################# ############################################################################# sub _correct_size_svg { # correct the size for the edge cell my ($self,$format) = @_; return if defined $self->{w}; my $em = $self->EM(); # multiplication factor chars * em = units (pixels) #my $border = $self->{edge}->attribute('borderstyle'); # set the minimum width/height my $type = $self->{type} & EDGE_TYPE_MASK(); my $dim = $dimensions->{$type} || [ 3, 3 ]; ($self->{w}, $self->{h}) = ($dim->[0], $dim->[1]); # print STDERR "# min size at ($self->{x},$self->{y}): $self->{w} $self->{h} for $self->{type}\n"; # make it bigger for cells with the label if ($self->{type} & EDGE_LABEL_CELL) { my ($w,$h) = $self->_svg_dimensions(); # for vertical edges, multiply $w * 2 $w = $w * 2 + 2 if ($type == EDGE_VER); # add a bit for HOR edges $w = $w + 1 if ($type == EDGE_HOR); $self->{w} += $w; my $lh = $self->LINE_HEIGHT(); $self->{h} += $h * ($lh - $em) + 0.5; # add a bit for HOR edges $self->{h} += 2 if ($type == EDGE_HOR); } my $style = $self->{style}; # correct for bigger arrows my $ac = $self->arrow_count(); # if ($style =~ /^(broad|wide)/) { # for each end point, correct the size my $flags = ($self->{type} & EDGE_ARROW_MASK); # select the first bit (hopefully EDGE_ARROW_MASK == 0xFF my $start_bit = 0x800; while ($start_bit > 0x8) { my $a = $flags & $start_bit; $start_bit >>= 1; if ($a != 0) { my $ac = $arrow_correct->{$a}; my $idx = 0; while ($idx < @$ac) { my ($where, $add) = ($ac->[$idx], $ac->[$idx+1]); $idx +=2; $add += 0.5 if $style =~ /^wide/; $self->{$where} += $add; } } } } ($self->{w}, $self->{h}) = ($self->{w} * $em, $self->{h} * $em); } ############################################################################# ############################################################################# sub _svg_attributes { # Return a hash with attributes for the cell. my ($self, $em) = @_; my $att = {}; $att->{stroke} = $self->color_attribute('color') || 'black'; # include the stroke for renderers that can't cope with CSS styles # delete $att->{stroke} if $att->{stroke} eq 'black'; # black is default $att->{'stroke-width'} = 1; my $style = $self->{style}; if ($style ne 'solid') # solid line { $att->{'stroke-dasharray'} = $strokes->{$style} if exists $strokes->{$style}; } $att->{'stroke-width'} = 3 if $style =~ /^bold/; $att->{'stroke-width'} = $em / 2 if $style =~ /^broad/; $att->{'stroke-width'} = $em if $style =~ /^wide/; $self->_adjust_dasharray($att); $att->{'arrow-style'} = $self->attribute('arrow-style') || ''; $att; } sub _draw_edge_line_and_arrows { } sub as_svg { my ($self,$x,$y, $indent) = @_; my $em = $self->EM(); # multiplication factor chars * em = units (pixels) my $lh = $self->LINE_HEIGHT(); # the attributes of the element we will finally output my $att = $self->_svg_attributes($em); # set a potential title my $title = _quote($self->title()); $att->{title} = $title if $title ne ''; my $att_txt = $self->_svg_attributes_as_txt($att); my $type = $self->{type} & EDGE_TYPE_MASK(); my $end = $self->{type} & EDGE_END_MASK(); my $start = $self->{type} & EDGE_START_MASK(); my $svg = "$indent\n"; $svg .= $self->_svg_background($x,$y, $indent); my $style = $self->{style}; # dont render invisible edges return $svg if $style eq 'invisible'; my $sw = $att->{'stroke-width'} || 1; # for each line, include one SVG tag my $lines = [ @{$draw_lines->{$type}} ]; # make copy my $cross = ($self->{type} & EDGE_TYPE_MASK) == EDGE_CROSS; # we are a cross section? my $add; my @line_tags; while (@$lines > 0) { my ($type) = shift @$lines; my @coords; if ($type != LINE_PATH) { @coords = splice (@$lines, 0, 2); } else { # eat all @coords = @$lines; @$lines = (); } # start/end points my ($s,$e) = (undef,undef); # LINE_VER must come last if ($cross && $type == LINE_VER) { $style = $self->{style_ver}; my $sn = 1; $sn = 3 if $style =~ /^bold/; $sn = $em / 2 if $style =~ /^broad/; $sn = $em if $style =~ /^wide/; # XXX adjust dash array $add = ' stroke="' . $self->{color_ver} . '"' if $self->{color_ver}; $add .= ' stroke-dasharray="' . ($strokes->{$style}||'1 0') .'"'; $add .= ' stroke-width="' . $sn . '"' if $sn ne $sw; $add =~ s/^\s//; } my $bw = $self->{w} * 0.1; my $bwe = $self->{w} * 0.1 + $sw; my $bh = $em * 0.5; # self->{h} my $bhe = $self->{h} * 0.1 + $sw * 1; # VER: s = north, e = south, HOR: s = left, e= right if ($type == LINE_VER) { $e = $bhe if ($end & EDGE_END_S); $s = $bhe if ($end & EDGE_END_N); $e = $bh if ($start & EDGE_START_S); $s = $bh if ($start & EDGE_START_N); } else # $type == LINE_HOR { $e = $bwe if ($end & EDGE_END_E); $s = $bwe if ($end & EDGE_END_W); $e = $bw if ($start & EDGE_START_E); $s = $bw if ($start & EDGE_START_W); } if ($type != LINE_PATH) { $type += LINE_DOUBLE if $style =~ /^double/; push @line_tags, $self->_svg_line_straight($x, $y, $type, $coords[0], $coords[1], $s, $e, $add, $sw); } else { push @line_tags, $self->_svg_path($x, $y, $s, $e, $add, $sw, @coords); } } # end lines # XXX TODO: put these on the edge group, not on each cell # we can put the line tags into a and put stroke attributes on the g, # this will shorten the output $lines = ''; my $p = "\n"; my $i = $indent; if (@line_tags > 1) { $lines = "$indent\n"; $i .= $indent; $p = "\n$indent\n"; } else { $line_tags[0] =~ s/ \/>/$att_txt \/>/; } $lines .= $i . join("\n$i", @line_tags) . $p; $svg .= $lines; my $arrow = $end; # depending on end points, add the arrows my $scale = $att->{'stroke-width'}||1; $svg .= $self->_svg_arrow($att, $x, $y, $arrow, $indent, $scale) unless $arrow == 0 || $self->{edge}->undirected(); ########################################################################### # include the label/name/text if we are the label cell if (($self->{type} & EDGE_LABEL_CELL())) { my $label = $self->label(); $label = '' unless defined $label; if ($label ne '') { my ($w,$h) = $self->dimensions(); my $em2 = $em / 2; my $xt = int($x + $self->{w} / 2); my $yt = int($y + $self->{h} / 2 - $lh / 3 - ($h - 1) * $lh); # my $yt = int($y + ($self->{h} / 2) - $em2); my $style = ''; my $stype = $self->{type}; # for HOR edges if ($type == EDGE_HOR) { # put the edge text left-aligned on the line $xt = $x + 2 * $em; # if we have only one big arrow, shift the text left/right my $ac = $self->arrow_count(); my $style = $self->{style}; if ($ac == 1) { my $shift = 0.2; $shift = 0.5 if $style =~ /^broad/; $shift = 0.8 if $style =~ /^wide/; # <-- edges, shift right, otherwise left $shift = -$shift if ($end & EDGE_END_E) != 0; #print STDERR "# shift=$shift \n"; $xt = int($xt + 2 * $em * $shift); } } elsif ($type == EDGE_VER) { # put label on the right side of the edge $xt = $xt + $em2; my ($w,$h) = $self->dimensions(); $yt = int($y + $self->{h} / 2 - $h * $em2 + $em2); $style = ' text-anchor="start"'; } # selfloops else { # put label right of the edge # my ($w,$h) = $self->dimensions(); # hor loops: $yt += $em2 if $stype & EDGE_START_N; $yt -= $em2 if $stype & EDGE_START_S; $yt += $em if ($h > 1) && ($stype & EDGE_START_S); # vertical loops $yt = int($y + $self->{h} / 2) if ($stype & EDGE_START_E) || ($stype & EDGE_START_W); $xt = int($x + $em * 2) if ($stype & EDGE_START_E); $xt = int($x + $self->{w} - 2*$em) if ($stype & EDGE_START_W); $style = ' text-anchor="start"'; $style = ' text-anchor="middle"' if ($stype & EDGE_START_N) || ($stype & EDGE_START_S); $style = ' text-anchor="end"' if ($stype & EDGE_START_W); } my $color = $self->raw_attribute('labelcolor'); # fall back to color if label-color not defined $color = $self->color_attribute('color') if !defined $color; my $text = $self->_svg_text($color, $indent, $xt, $yt, $style, $xt, $x + $self->{w} - $em); my $link = _quote($self->link()); $text = Graph::Easy::Node::_link($self, $indent.$text, $indent, $title, $link) if $link ne ''; $svg .= $text; } } $svg .= "\n" unless $svg =~ /\n\n\z/; $svg; } ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Graph-Easy-As_svg-0.23/TODO�������������������������������������������������������������������������0000644�0001750�0001750�00000002720�10775534163�013124� 0����������������������������������������������������������������������������������������������������ustar �te������������������������������te���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Todo for Graph-Easy-As_svg ========================== Output bugs: * a graph border of double is rendered as single * Anon groups should not have a border * Borders on nodes/graph are placed on the path center. Instead they should be inside the shape, aka moved BORDER-WIDTH/2 to the inside. * Rotated nodes: + Node texts are moved wrongly on rotated nodes (their new center should rotate along with the shape) + do not increase the graph size, so corners might get cut off + the label text is not rotated with the rest of the shape * implement border- and edge-style: wave * _text_length() could be more accurate * edges with style "double" have wrong corner pieces * wide and broad self-loops are too small and the line must be moved * support different edge starting point styles ala: -----> |-----> o-----> +-----> *-----> >>-----> Shorter output: * instead of rendering individual edge cells, we should create one path, this would allow better rendering of non-solid edges, like dashed or dotted ones * put the stroke-width and stroke on the instead on each * merge all group cells together to create a minimum number of rectangles to render * font-family and font-size are output needless even when they are the default values Browser-specific woes: * Firefox 1.5 gets tspan with 'x="..." dy="1em"' wrong * Firefox 1.5 seems to ignore text-decoration on * Batik 1.5.1 has problems with 'font-size="12px"' on ������������������������������������������������Graph-Easy-As_svg-0.23/SIGNATURE��������������������������������������������������������������������0000644�0001750�0001750�00000006151�11015337113�013702� 0����������������������������������������������������������������������������������������������������ustar �te������������������������������te���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������This file contains message digests of all files listed in MANIFEST, signed via the Module::Signature module, version 0.55. To verify the content in this distribution, first make sure you have Module::Signature installed, then type: % cpansign -v It will check each file's integrity, as well as the signature's validity. If "==> Signature verified OK! <==" is not displayed, the distribution may already have been compromised, and you should not run its Makefile.PL or Build.PL. -----BEGIN PGP SIGNED MESSAGE----- Hash: SHA1 SHA1 32e3c086eb0ff3dfb1cabffdec5c1d84a7611b1a CHANGES SHA1 a43df772ac178d64884214866bdce1ce95cc9795 INSTALL SHA1 02154445bc9831e791c35050f1a018ed99030016 LICENSE SHA1 4b99695b0c16bd93cc6b0814cc880c1c9c9f3c3c MANIFEST SHA1 2182d84c7f11a82660b3dcc69511350de4489fc0 MANIFEST.SKIP SHA1 f2202fc62eb008680fd2f3f1563e72b35744c821 META.yml SHA1 0c02c928b779f9620f28730247963594fe32930d Makefile.PL SHA1 bb5aa2b2a4e3d5c02ce3191be09397d8f5a0dec6 README SHA1 88fec724d5b1b010d8346b4b6bd05abc0d9f191f TODO SHA1 d7be1e7d1b9469989eb93adfb133e47619065dff examples/as_ascii SHA1 5dd2df50e3eda30a2abc542f4369d21264434885 examples/as_boxart SHA1 63ab4a7efeadde26d0de6f7c9dbd181121ea04e8 examples/as_graphviz SHA1 cec99efdf4dc8746782509b1531eea791afe30a2 examples/as_html SHA1 d1dae0dca3e8602a37697497f75c56650ca08ec5 examples/as_svg SHA1 5e48c6cc058fe4b73fadde3e7ae8570770f38cdc examples/as_txt SHA1 603bb9de29fb8cba7f13409c546750972eff645d inc/Module/AutoInstall.pm SHA1 d8f6d2df4e75cb9e6e77a8377457f0ececd00e31 inc/Module/Install.pm SHA1 af0833ed8863138d63c446ab756b868d9ec1a8da inc/Module/Install/AutoInstall.pm SHA1 03590cde5c3de0d0d8a84d2b96917ed1a2cf9a30 inc/Module/Install/Base.pm SHA1 8ef3c70e905be7d1007b446f21d4eb3ff6ae24cb inc/Module/Install/Can.pm SHA1 79054604a1cd4e99443b05cbb62832568a204a33 inc/Module/Install/Fetch.pm SHA1 160e1fc7baca4f31c50fe498df10280c9a218ada inc/Module/Install/Include.pm SHA1 dfa433f2f41d990946f1b3d68a29299539f2dea6 inc/Module/Install/Makefile.pm SHA1 72cab336b6be5716aae0a1cb6d9add6c98a7a1f5 inc/Module/Install/Metadata.pm SHA1 35a62725a7eade0fa617ef2ba4cf2f4d4a69a3fe inc/Module/Install/Win32.pm SHA1 19dcc6d1e9f02c56d3f6d184642f4cd68aa371e6 inc/Module/Install/WriteAll.pm SHA1 633213aaac3fc9ed63b5fa7e6ab793ebf77b4c86 lib/Graph/Easy/As_svg.pm SHA1 0dce90945da99b01c024d5d483c0a1f9a4d54c20 t/group.t SHA1 ee5c692533559b46d18c832a3d5b9bd2b07633b8 t/output.t SHA1 3c376f8a1abcc6c6b4b6df93927a6e9c097fdac2 t/pod.t SHA1 5abda62f24a81f74a68ba8afca79dc898f771b19 t/pod_cov.t SHA1 a59505548ef2a59c38cf46ac574af090c3bbfd6d t/svg.t SHA1 105eb97147f35f83e3e8441f2c0450fc242709ac t/svg/svg.txt SHA1 76378e84609186dcf16a510c444b0822a0e06b31 t/text.t -----BEGIN PGP SIGNATURE----- Version: GnuPG v1.4.6 (GNU/Linux) iQEVAwUBSDW+S3cLPEOTuEwVAQIqqwf+Mf+WP3D1jQRK2hqjqlat8tNY014gOCj5 T8SUfUxZvpDeGqc5c4hr6Vb8+BCPVyG70L5SPFd6dCZgbL/rzVFH2FsbYty6m+/k QXRBwq/YurjNvtamofpcCQpVPKq4jUYGg/4ngrymt/pCI9yF1LI3gWsPhSNMlyGG CE9/8DhSc+iZr3dy1OZ+LZ8OrRWUcPIPk55V4pHyxKf9Wg2W0XNPwGQ0qLmdqCfv HyeAvU5gjrlfhPr67nOrgENy7QZdflX3jodEzJiAuamMPdZWU9i4Q8hURak1Q03p HMGfjsuSbsq+SNgIpxTAVAQ0ljKTrdzCw+GUwnsCYuTfbMBbqKqfbw== =ONj5 -----END PGP SIGNATURE----- �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Graph-Easy-As_svg-0.23/LICENSE����������������������������������������������������������������������0000644�0001750�0001750�00000035435�10163301003�013422� 0����������������������������������������������������������������������������������������������������ustar �te������������������������������te��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������� GNU GENERAL PUBLIC LICENSE Version 2, June 1991 Copyright (C) 1989, 1991 Free Software Foundation, Inc. 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. This General Public License applies to most of the Free Software Foundation's software and to any other program whose authors commit to using it. (Some other Free Software Foundation software is covered by the GNU Library General Public License instead.) You can apply it to your programs, too. When we speak of free software, we are referring to freedom, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for this service if you wish), that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must show them these terms so they know their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. Finally, any free program is threatened constantly by software patents. We wish to avoid the danger that redistributors of a free program will individually obtain patent licenses, in effect making the program proprietary. To prevent this, we have made it clear that any patent must be licensed for everyone's free use or not licensed at all. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any derivative work under copyright law: that is to say, a work containing the Program or a portion of it, either verbatim or with modifications and/or translated into another language. (Hereinafter, translation is included without limitation in the term "modification".) Each licensee is addressed as "you". Activities other than copying, distribution and modification are not covered by this License; they are outside its scope. The act of running the Program is not restricted, and the output from the Program is covered only if its contents constitute a work based on the Program (independent of having been made by running the Program). Whether that is true depends on what the Program does. 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this License and to the absence of any warranty; and give any other recipients of the Program a copy of this License along with the Program. You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. 2. You may modify your copy or copies of the Program or any portion of it, thus forming a work based on the Program, and copy and distribute such modifications or work under the terms of Section 1 above, provided that you also meet all of these conditions: a) You must cause the modified files to carry prominent notices stating that you changed the files and the date of any change. b) You must cause any work that you distribute or publish, that in whole or in part contains or is derived from the Program or any part thereof, to be licensed as a whole at no charge to all third parties under the terms of this License. c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the most ordinary way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this License. (Exception: if the Program itself is interactive but does not normally print such an announcement, your work based on the Program is not required to print an announcement.) These requirements apply to the modified work as a whole. If identifiable sections of that work are not derived from the Program, and can be reasonably considered independent and separate works in themselves, then this License, and its terms, do not apply to those sections when you distribute them as separate works. But when you distribute the same sections as part of a whole which is a work based on the Program, the distribution of the whole must be on the terms of this License, whose permissions for other licensees extend to the entire whole, and thus to each and every part regardless of who wrote it. Thus, it is not the intent of this section to claim rights or contest your rights to work written entirely by you; rather, the intent is to exercise the right to control the distribution of derivative or collective works based on the Program. In addition, mere aggregation of another work not based on the Program with the Program (or with a work based on the Program) on a volume of a storage or distribution medium does not bring the other work under the scope of this License. 3. You may copy and distribute the Program (or a work based on it, under Section 2) in object code or executable form under the terms of Sections 1 and 2 above provided that you also do one of the following: a) Accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, b) Accompany it with a written offer, valid for at least three years, to give any third party, for a charge no more than your cost of physically performing source distribution, a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, c) Accompany it with the information you received as to the offer to distribute corresponding source code. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form with such an offer, in accord with Subsection b above.) The source code for a work means the preferred form of the work for making modifications to it. For an executable work, complete source code means all the source code for all modules it contains, plus any associated interface definition files, plus the scripts used to control compilation and installation of the executable. However, as a special exception, the source code distributed need not include anything that is normally distributed (in either source or binary form) with the major components (compiler, kernel, and so on) of the operating system on which the executable runs, unless that component itself accompanies the executable. If distribution of executable or object code is made by offering access to copy from a designated place, then offering equivalent access to copy the source code from the same place counts as distribution of the source code, even though third parties are not compelled to copy the source along with the object code. 4. You may not copy, modify, sublicense, or distribute the Program except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense or distribute the Program is void, and will automatically terminate your rights under this License. However, parties who have received copies, or rights, from you under this License will not have their licenses terminated so long as such parties remain in full compliance. 5. You are not required to accept this License, since you have not signed it. However, nothing else grants you permission to modify or distribute the Program or its derivative works. These actions are prohibited by law if you do not accept this License. Therefore, by modifying or distributing the Program (or any work based on the Program), you indicate your acceptance of this License to do so, and all its terms and conditions for copying, distributing or modifying the Program or works based on it. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. You are not responsible for enforcing compliance by third parties to this License. 7. If, as a consequence of a court judgment or allegation of patent infringement or for any other reason (not limited to patent issues), conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot distribute so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not distribute the Program at all. For example, if a patent license would not permit royalty-free redistribution of the Program by all those who receive copies directly or indirectly through you, then the only way you could satisfy both it and this License would be to refrain entirely from distribution of the Program. If any portion of this section is held invalid or unenforceable under any particular circumstance, the balance of the section is intended to apply and the section as a whole is intended to apply in other circumstances. It is not the purpose of this section to induce you to infringe any patents or other property right claims or to contest validity of any such claims; this section has the sole purpose of protecting the integrity of the free software distribution system, which is implemented by public license practices. Many people have made generous contributions to the wide range of software distributed through that system in reliance on consistent application of that system; it is up to the author/donor to decide if he or she is willing to distribute software through any other system and a licensee cannot impose that choice. This section is intended to make thoroughly clear what is believed to be a consequence of the rest of this License. 8. If the distribution and/or use of the Program is restricted in certain countries either by patents or by copyrighted interfaces, the original copyright holder who places the Program under this License may add an explicit geographical distribution limitation excluding those countries, so that distribution is permitted only in or among countries not thus excluded. In such case, this License incorporates the limitation as if written in the body of this License. 9. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of this License which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of this License, you may choose any version ever published by the Free Software Foundation. 10. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Graph-Easy-As_svg-0.23/README�����������������������������������������������������������������������0000644�0001750�0001750�00000001625�10355765070�013314� 0����������������������������������������������������������������������������������������������������ustar �te������������������������������te���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Graph-Easy-As_svg ================= Render Graph-Easy as SVG (Scalable Vector Graphics). Graphs can be generated by Perl code, or parsed from a simple text format that is human readable and maintainable. Manual ====== The manual is contained in the extra package Graph::Easy::Manual. You can also view the manual online at: http://bloodgate.com/perl/graph/manual/ Many more examples and documentation, especially on integrating this into a Mediawiki installation, can be found at: http://bloodgate.com/perl/graph/ Have fun! Installation ============ See INSTALL on how to install this module. AUTHOR ====== Copyright (C) 2004 - 2006 by Tels http://bloodgate.com/ This library is free software; you can redistribute it and/or modify it under the same terms of the GPL version 2. This module was formerly known as Graph-Simple, but has been renamed because it can also easily create non-simple graphs. �����������������������������������������������������������������������������������������������������������Graph-Easy-As_svg-0.23/MANIFEST.SKIP����������������������������������������������������������������0000644�0001750�0001750�00000000251�10773752165�014331� 0����������������������������������������������������������������������������������������������������ustar �te������������������������������te���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������.*\.tar\.gz ^blib.* ^[\w\.]+\.(html|txt|png|gif|dot|pl|svg|old|bak|org|vcg|gdl) ^Makefile\z ^Makefile.(old|bak)\z ^fun\z ^Graph-Easy-As pm_to_blib tmon.out ^todos[\\\/] �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Graph-Easy-As_svg-0.23/Makefile.PL������������������������������������������������������������������0000644�0001750�0001750�00000000701�10775525075�014405� 0����������������������������������������������������������������������������������������������������ustar �te������������������������������te��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������� require 5.008001; # Load the Module::Install bundled in ./inc/ use inc::Module::Install; # Get most of the details from the primary module all_from 'lib/Graph/Easy/As_svg.pm'; requires 'Graph::Easy' => 0.63; requires 'Image::Info' => 1.28; build_requires 'Test::More' => 0.62; license 'gpl'; # Do not index these no_index directory => 'examples'; # Auto-install all dependencies from CPAN auto_install; # Generate the Makefile WriteAll; ���������������������������������������������������������������Graph-Easy-As_svg-0.23/META.yml���������������������������������������������������������������������0000644�0001750�0001750�00000000757�11015337104�013675� 0����������������������������������������������������������������������������������������������������ustar �te������������������������������te���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������--- abstract: 'Output a Graph::Easy as Scalable Vector Graphics (SVG)' author: - 'Copyright (C) 2004 - 2008 by Tels L' build_requires: Test::More: 0.62 distribution_type: module generated_by: 'Module::Install version 0.71' license: gpl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.3.html version: 1.3 name: Graph-Easy-As_svg no_index: directory: - examples - inc - t requires: Graph::Easy: 0.63 Image::Info: 1.28 version: 0.23 �����������������Graph-Easy-As_svg-0.23/INSTALL����������������������������������������������������������������������0000644�0001750�0001750�00000004232�10773762137�013467� 0����������������������������������������������������������������������������������������������������ustar �te������������������������������te��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������� =head1 INSTALL To install this module do the following: =head2 LINUX, UNIX etc. Untar the package: tar -xzf Graph-Easy-As_svg-0.13.tar.gz (Replace 0.13 with the actual version you got) Change into the directory: chdir Graph-Easy-As_svg-0.13/ Then you need to check the signature on the package to verify that it is untampered and intact. To do this you have to: =over 2 =item * Install the Perl module Module::Signature from http://search.cpan.org =item * Get my key from http://bloodgate.com/tels.asc, import it into GnuPG with: gpg --import tels.asc You may also let the C utility fetch it automatically from a keyserver, if that works for you. =item * Type on a console: cpansign --verify inside the unpacked directory. =back If the last step says "good signature" or "SIGNATURE VERIFIED OK", everything is all right. Note that if C let GnuPG download my key from a keyserver, it might put a C file in the package directory, and then afterward complain that "tels.asc" is not in the MANIFEST: Not in MANIFEST: tels.asc ==> MISMATCHED content between MANIFEST and distribution files! <== You can safely ignore this warning. B Please notify me immidiately if the signature does not verify. In that case do B install this software, your system might get compromised! When the package verified okay, then proceed: perl Makefile.PL If you get warnings about missing or outdated modules, then upgrade/install these first. Then run the testsuite: make test If all tests pass, install the package: sudo make install =head2 WINDOWS When the package verified okay (see above), then proceed: You need the "nmake" utility from Microsoft: http://johnbokma.com/perl/make-for-windows.html =head3 nmake Then you can build the Makefile and finally run the tests and install this package: perl Makefile.PL nmake test If all tests pass, install the package: nmake install AUTHOR ====== Copyright (C) 2004 - 2008 by Tels http://bloodgate.com/perl/ This library is free software; you can redistribute it and/or modify it under the same terms of the GPL version 2. ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Graph-Easy-As_svg-0.23/CHANGES����������������������������������������������������������������������0000644�0001750�0001750�00000026072�11015337101�013412� 0����������������������������������������������������������������������������������������������������ustar �te������������������������������te���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Revision history for Graph::Easy::As_svg: 2008-05-22 v0.23 Tels 137 tests - Fix, fix, fix, fix the bugs... * require Graph::Easy v0.63 (for correct graph attribute output) * suppress attributes without "-" (like "labelpos" vs. "label-pos") * output the "font-family" style to support the "font" attribute * center graph when the graph label is wider than the graph itself * shift graph by half the border with down and right to prevent the border from getting cut off * don't draw end arrows on undirected edges (with more than one cell) * "rounded" nodes have their corners correctly filled with the background color (f.i. when inside a group) (Thanx Dieter Wunderer!) * quote "&" in links (Thanx Emmanuel Quevillon!) * links on edge labels were missing (Thanx Emmanuel Quevillon!) * tweak width of digits to create more fitting labels (Thanx Emmanuel Quevillon!) * better text for labels (alignment and tweaks) (Thanx Emmanuel Quevillon!) 2008-03-30 v0.22 Tels 127 tests * require Graph::Easy v0.62 * remove Build.PL (bundle Module::Install 0.71) * fix class attribute set on primary class, this colors all nodes red: node { class: red; } node.red { color: red; } * amend INSTALL * don't needlessly output polygon points in comments * fix suppression of attributes (included all the added ones) * fix support for point-style/point-shape * anonymous nodes: + fix comment + fix misplacement * fix multi-line labels (Thanx Amanda B. Hickman!) + multi-line graph labels no longer cross into content + render alignments like \r,\l etc. properly + remove escapes (like \l etc.) from title for a better title-tag * better rendering of open/filled stars * a set fontsize on the graph no longer affacts nodes/edges/groups * filled arrows fall back to the edge color (instead of inherit) if the fill attribute is not set 2006-12-17 v0.21 Tels 93 tests * require Graph::Easy v0.50 * fixes for the changes attribute system in Graph::Easy v0.50 * fix alignment of node labels under align: left, align: right etc. * don't output needless things like 'fill=""' or default text-anchor * handle borderwidths like "20px" and "2em" 2006-09-03 v0.20 Tels 89 tests * require Graph::Easy v0.47 * fix invalid output on multi-line aligned labels * fix alignment of labels on loops and vertical edges (text-align takes "start" or "end", not "left" or "right" - duh!) * correct the placement of multi-line node labels, especially when using \r, \l or \c instead of \n * fix warning and missing arrows when using edge { arrow-style: open; } * fix undef warning when using closed arrows * fix problem with dasharrays when using groups 2006-08-13 v0.19 Tels 89 tests - Fix, fix, fix, fix the bugs... * single-line labels were not properly quoted (for "<>&) * add encoding="UTF-8" to XML header to make encoding explicit * require Graph::Easy v0.46 * require Image::Info v1.22 * add a Build.PL file * add support for color schemes * fix for very wide borders: + make dash:dot ratio 3:1 vs. 2:1 + don't include "stroke-linecap: round" for diamon shapes + scale the dasharray according to stroke-width * remove the workaround for Firefox bug with links: + it works now in the latest Firefox, so upgrade! + In the newest Firefox, it spawned a second new window 2006-04-17 v0.18 Tels 87 tests * require Graph::Easy v0.44 * require Image::Info v1.20 * don't output empty tags * _svg_background() returns SVG code instead of modifying $$svg * don't draw borders on Group::Cells * fix background color for edges and invisible nodes inside groups * fix alignment for labels * size-correction for overly big arrows now also works for vertical edges * close the hole in open arrows on bold/broad/wide edges * edge corners no longer have holes * close the gaps on edges with style double * fix the fontsize (was missing a "px") and also use 16 as the base vs. 14 This makes the text independed from the user setting in the browser, and also increases it to be more readable. * always include the fill, to help renderers that can't cope with CSS styles * fix rendering of multiline labels: + lineheight is 18px vs 1em to not have the lines drawn together + no longer contain a spurious empty last -pair * reorder output order of elements: first groups, then nodes, then edges * correct the displacement on edge end/start points for wide/broad/bold edges * render selfloops with paths * don't render invisible edges * a set background on edge cells did have a stray border * edge labels have a 80% font-size as default * only add 0.5EM (currently 8 pixels) as padding around the graph (was 14) * add a few characters to make the _text_length() calculation more accurate * a Node::Empty should not be rendered * font is really font-family in CSS section * support point-shaped nodes with point-style: invisible 2006-01-29 v0.17 Tels 73 tests * use Module::Install (and bundle it) * require Graph::Easy v0.40 * require Image::Info v1.17 (for nodes with "shape: img") * fix VERSION in packages as to not conflict with the ones from Graph::Easy * add support for: + invisible edges + nodes with "shape: img" (Thanx to Jeff Schiller for pointing out svg:image!) * add an onclick-handler to links to force them to open in the current window/tab - work around bug in FF 1.5 (Thanx Jeff Schiller again!) * put the link around the node shape, not just the text. Makes it easier to hit the link. * nodes with shape: point get a link, too (although the area is tiny) 2006-01-01 v0.16 Tels 72 tests * require Graph::Easy v0.38 * use $self->angle() to get the correct shape rotation * forgot to limit precision on some edge-line coordinates 2005-12-18 v0.15 Tels 72 tests * require Graph::Easy v0.36 * fix edge crossings with different widths (wide vs. broad etc) * add rendering of edge joints 2005-12-10 v0.14 Tels 72 tests * require Graph::Easy v0.35 * quote "&", "<", ">" and '"' in links and titles (Thanx Mutante!) * add "xlink:show" and "xlink:target" on links to open them in a new window (but Firefox ignores this anyway, see mozilla bug #315389) 2005-12-04 v0.13 Tels 72 tests * require Graph::Easy v0.34 * handle multi-celled nodes * better support labels on vertical edges * fix unitialized warning in line 298 * use strict; in Makefile.PL * support svg_info fields (mainly for wikipedia SVG integration) 2005-11-13 v0.12 Tels 64 tests * require Graph::Easy v0.33 * add PREREQ_FATAL to Makefile.PL * support bold-dash, broad and wide edge/border styles * correct node-sizes to accomodate border-width * shorten edge-pieces with labels a bit * implement a crude version of _text_length(), returning the text length in pixels depending on EM and the string content ("WW" vs. "ii"). This stops nodes from being overly broad with lots of padding. * don't generate invalid SVG on labels/node names with "--", "&", "<" or ">" * limit precision on edge-lines and arrows to 2 digits (instead of 4) 2005-11-06 v0.11 Tels 56 tests * limit precision to 2 digits (instead of 4) for coordinates * put common attributes on double-border shapes into a to shorten output * indent output by ' ' instead of ' ' to shorten it a bit * support "rotate" attribute on Nodes 2005-10-30 v0.10 Tels 56 tests * require Graph::Easy v0.31 * don't draw background if bg eq '' * add support for attribute "font-size" * add support for attribute "text-style" * calculate the correct size for edge cells with a label * include xmlns:xlink too, to make Firefox 1.5x happy * include version of Graph::Easy::As_svg in output, too * for edge labels: fallback to the color of the edge did not work * triangle-shaped nodes have equal height/width (if possible) * the "autolink" and "link" attributes correctly create links with mouseover titles * nodes with shape "none" result no longer in invalid SVG * only include the actually used defitinons, that shortens the output, especially for small graphs * don't need to output "stroke-width" for including arrow heads, this shortens the output a bit * shorten output by grouping multiple lines of an edge together * text in (invert)-triangle etc nodes is better displaced to fit better * better rendering of multi-line labels on edges * support multi-line labels on nodes (correct hight, multi-line text) * output fontsize is 14 pixels instead of 11 (for bigger graphs in FF 1.5) * close gaps in hor/ver edge pieces with style "double" * examples/as_svg: input utf8 from STDIN, output utf-8 to STDOUT * Nodes with "shape: rounded" are rounded by a fixed amount * edge crossings with different styles and colors are now rendered correctly * output a title for the SVG graph * output "width" and "height" instead of viewbox on for Firefox 1.5 * render the graph label with label-pos bottom or top, incl. optional link 2005-09-23 v0.09 Tels 41 tests * require Graph::Easy v0.30 * fix README * fix SVG header (standlone="yes", xmlns for [ B ]" | examples/as_boxart BEGIN { $|++; } use lib 'lib'; use Graph::Easy::Parser; my $file = shift; my $id = shift || ''; my $debug = shift; my $parser = Graph::Easy::Parser->new( debug => $debug ); if (!defined $file) { $file = \*STDIN; binmode STDIN, ':utf8' or die ("binmode STDIN, ':utf8' failed: $!"); } my $graph = $parser->from_file( $file ); die ($parser->error()) unless defined $graph; $graph->id($id); $graph->timeout(360); $graph->layout(); warn($graph->error()) if $graph->error(); binmode STDOUT, ':utf8' or die ("binmode STDOUT, ':utf8' failed: $!"); print $graph->as_boxart(); ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Graph-Easy-As_svg-0.23/examples/as_svg��������������������������������������������������������������0000755�0001750�0001750�00000001363�10775526437�015471� 0����������������������������������������������������������������������������������������������������ustar �te������������������������������te���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#!/usr/bin/perl -w # Convert an input file containing a Graph::Easy description to # standalone SVG file # Example usage: # examples/as_svg t/in/2nodes.txt >test.svg # echo "[ A ] -> [ B ]" | examples/as_svg BEGIN { $|++; } use strict; use lib 'lib'; use Graph::Easy::Parser; my $file = shift; if (!defined $file) { $file = \*STDIN; binmode STDIN, ':utf8' or die ("binmode STDIN, ':utf8' failed: $!"); } my $parser = Graph::Easy::Parser->new( debug => (shift||0) ); my $graph = $parser->from_file( $file ); die ($parser->error()) unless defined $graph; $graph->timeout(60); $graph->layout(); warn ($graph->error()) if $graph->error(); binmode STDOUT, ':utf8' or die ("binmode STDOUT, ':utf8' failed: $!"); print $graph->as_svg_file(); �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Graph-Easy-As_svg-0.23/examples/as_txt��������������������������������������������������������������0000755�0001750�0001750�00000001367�10330652131�015467� 0����������������������������������������������������������������������������������������������������ustar �te������������������������������te���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#!/usr/bin/perl -w # Convert an input file containing a Graph::Easy object, then dump # it again as textual description. # Example usage: # examples/as_txt t/in/2nodes.txt # echo "[ A ] -> [ B ]" | examples/as_txt BEGIN { $|++; } use lib 'lib'; use Graph::Easy::Parser; my $file = shift; my $id = shift || ''; my $debug = shift; my $parser = Graph::Easy::Parser->new( debug => $debug ); if (!defined $file) { $file = \*STDIN; binmode STDIN, ':utf8' or die ("binmode STDIN, ':utf8' failed: $!"); } my $graph = $parser->from_file( $file ); die ($parser->error()) unless defined $graph; $graph->id($id); warn($graph->error()) if $graph->error(); binmode STDOUT, ':utf8' or die ("binmode STDOUT, ':utf8' failed: $!"); print $graph->as_txt(); �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Graph-Easy-As_svg-0.23/examples/as_graphviz���������������������������������������������������������0000755�0001750�0001750�00000001334�10330653171�016501� 0����������������������������������������������������������������������������������������������������ustar �te������������������������������te���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#!/usr/bin/perl -w # Convert an input file containing a Graph::Easy description to # graphviz output that can be feed to dot etc. # Example usage: # examples/as_graphviz t/in/2nodes.txt | dot -Tpng >test.png # echo "[ A ] -> [ B ]" | examples/as_graphviz | dot -Tpng >test.png BEGIN { $|++; } use strict; use lib 'lib'; use Graph::Easy::Parser; my $file = shift; my $parser = Graph::Easy::Parser->new( debug => 0 ); if (!defined $file) { $file = \*STDIN; binmode STDIN, ':utf8' or die ("binmode STDIN, ':utf8' failed: $!"); } my $graph = $parser->from_file( $file ); die ($parser->error()) unless defined $graph; binmode STDOUT, ':utf8' or die ("binmode STDOUT, ':utf8' failed: $!"); print $graph->as_graphviz(); ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Graph-Easy-As_svg-0.23/examples/as_ascii������������������������������������������������������������0000755�0001750�0001750�00000001415�10355524330�015740� 0����������������������������������������������������������������������������������������������������ustar �te������������������������������te���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#!/usr/bin/perl -w # Convert an input file containing a Graph::Easy description to # ASCII art. # Example usage: # examples/as_ascii t/in/2nodes.txt # echo "[ A ] -> [ B ]" | examples/as_ascii BEGIN { $|++; } use lib 'lib'; use Graph::Easy::Parser; my $file = shift; my $id = shift || ''; my $debug = shift; my $parser = Graph::Easy::Parser->new( debug => $debug ); if (!defined $file) { $file = \*STDIN; binmode STDIN, ':utf8' or die ("binmode STDIN, ':utf8' failed: $!"); } my $graph = $parser->from_file( $file ); die ($parser->error()) unless defined $graph; $graph->id($id); $graph->timeout(360); $graph->layout(); warn($graph->error()) if $graph->error(); binmode STDOUT, ':utf8' or die ("binmode STDOUT, ':utf8' failed: $!"); print $graph->as_ascii(); ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Graph-Easy-As_svg-0.23/examples/as_html�������������������������������������������������������������0000755�0001750�0001750�00000001457�10335377467�015641� 0����������������������������������������������������������������������������������������������������ustar �te������������������������������te���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#!/usr/bin/perl -w # Convert an input file containing a Graph::Easy description to # an HTML page. # Example usage: # examples/as_html t/in/2nodes.txt >test.html # echo "[ A ] -> [ B ]" | examples/as_ascii BEGIN { $|++; } use strict; use lib 'lib'; use Graph::Easy::Parser; my $file = shift; my $id = shift || ''; my $debug = shift || 0; my $parser = Graph::Easy::Parser->new( debug => $debug ); if (!defined $file) { $file = \*STDIN; binmode STDIN, ':utf8' or die ("binmode STDIN, ':utf8' failed: $!"); } my $graph = $parser->from_file( $file ); die ($parser->error()) unless defined $graph; $graph->id($id); $graph->timeout(360); $graph->layout(); warn ($graph->error()) if $graph->error(); binmode STDOUT, ':utf8' or die ("binmode STDOUT, ':utf8' failed: $!"); print $graph->as_html_page(); �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Graph-Easy-As_svg-0.23/MANIFEST���������������������������������������������������������������������0000644�0001750�0001750�00000001526�11013116045�013545� 0����������������������������������������������������������������������������������������������������ustar �te������������������������������te���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������CHANGES examples/as_ascii examples/as_boxart examples/as_graphviz examples/as_html examples/as_svg parse text and output as standalone SVG examples/as_txt inc/Module/AutoInstall.pm inc/Module/Install.pm inc/Module/Install/AutoInstall.pm inc/Module/Install/Base.pm inc/Module/Install/Can.pm inc/Module/Install/Fetch.pm inc/Module/Install/Include.pm inc/Module/Install/Makefile.pm inc/Module/Install/Metadata.pm inc/Module/Install/Win32.pm inc/Module/Install/WriteAll.pm INSTALL lib/Graph/Easy/As_svg.pm generate SVG output LICENSE Makefile.PL MANIFEST MANIFEST.SKIP META.yml Module meta-data (added by MakeMaker) README SIGNATURE t/group.t SVG output for groups (subgraphs/clusters) t/output.t t/pod.t test POD for correctness t/pod_cov.t test POD for covering all subroutines t/svg.t SVG output t/svg/svg.txt t/text.t _text_length() TODO ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������