SVG-2.84/0000755000175000017500000000000013242535444011450 5ustar manwarmanwarSVG-2.84/t/0000755000175000017500000000000013242535444011713 5ustar manwarmanwarSVG-2.84/t/05-processinginstruction.t0000644000175000017500000000322013057520366016776 0ustar manwarmanwaruse strict; use warnings; use Test::More tests => 9; use SVG; my $svg = SVG->new( width => 100, height => 100 ); my $pi = $svg->pi( "Hello world", "I am a PI" ); ok( $pi, "PI: add 2 arbitrary processing instructions" ); ok( $svg->rect( x => 0, y => 0, width => 10, height => 10, fill => 'red', stroke => 'brick' ), "add a drawing element" ); $svg->rect( x => 0, y => 0, width => 10, height => 10, fill => 'red', stroke => 'brick' ); $svg->rect( x => 0, y => 0, width => 10, height => 10, fill => 'red', stroke => 'brick' ); $svg->rect( x => 0, y => 0, width => 10, height => 10, fill => 'red', stroke => 'brick' ); $svg->rect( x => 0, y => 0, width => 10, height => 10, fill => 'red', stroke => 'brick' ); $svg->rect( x => 0, y => 0, width => 10, height => 10, fill => 'red', stroke => 'brick' ); $svg->rect( x => 0, y => 0, width => 10, height => 10, fill => 'red', stroke => 'brick' ); my $xml = $svg->xmlify(); ok( $xml, "serialize the svg" ); like( $xml, qr/<\?Hello\sworld\?>/, "serialize arbitrary processing instruction 1" ); like( $xml, qr/<\?I\sam\sa\sPI\?>/, "serialize arbitrary processing instruction 2" ); like( $xml, qr/rect/, "PI 2: add non-PI elements" ); is( scalar @{ $svg->pi }, 2, "PI 3 - fetch PI array" ); $svg->pi("Third PI entry"); $xml = $svg->xmlify(); like( $xml, qr/<\?Third\sPI\sentry\?>/, "pi 2" ); is( scalar @{ $svg->pi }, 3, "PI 3" ); SVG-2.84/t/16-siblings.t0000644000175000017500000000110013057520366014127 0ustar manwarmanwaruse strict; use warnings; use Test::More tests => 4; use SVG; # test: getFirstChild, getLastChild, getParent, getChildren my $svg = SVG->new; my $parent = $svg->group(); my $child1 = $parent->text->cdata("I am the first child"); my $child2 = $parent->text->cdata("I am the second child"); ok( $child1->hasSiblings(), "hasSiblings" ); is( $child1->getNextSibling(), $child2, "getNextSibling" ); is( $child2->getPreviousSibling(), $child1, "getPreviousSibling" ); $child2->insertSiblingAfter($child1); is( $child2->getNextSibling(), $child1, "insertSiblingAfter" ); SVG-2.84/t/11-customtags.t0000644000175000017500000000062613057520366014515 0ustar manwarmanwaruse strict; use warnings; use Test::More tests => 2; use SVG qw(star planet moon); my $svg = SVG->new; $svg->star( id => "Sol" )->planet( id => "Jupiter" ) ->moon( id => "Ganymede" ); like $svg->xmlify, qr{\s+\s+\s+\s+}, 'stars and planets'; ok( !eval { $svg->asteroid( id => "Ceres" ); }, "undefined custom tag" ); SVG-2.84/t/23-xmlescape.t0000644000175000017500000000320613057520366014305 0ustar manwarmanwaruse strict; use warnings; use Test::More tests => 14; use SVG ( -printerror => 0, -raiseerror => 0 ); # test: special characters my $bad_chars = '>new; ok( my $out1 = $svg->text()->cdata_noxmlesc( $svg->xmlescp($bad_chars) ), "Testing toxic characters to xmlescp" ); like( $out1->xmlify(), qr/$esc_chars/, 'Toxic chars are escaped' ); ok( my $out2 = $svg->text()->cdata($bad_chars), "Testing toxic characters to cdata" ); like( $out2->xmlify(), qr/$esc_chars/, 'Toxic chars are escaped' ); $bad_chars = "Line one\nLine two"; $esc_chars = "Line one\nLine two"; ok( my $out3 = $svg->text()->cdata($bad_chars), 'Testing new line characters' ); like( $out3->xmlify(), qr/$esc_chars/, 'New lines are allowed' ); $bad_chars = "Col1\tcol2"; $esc_chars = "Col1\tcol2"; ok( my $out4 = $svg->text()->cdata($bad_chars), 'Testing tab characters' ); like( $out4->xmlify(), qr/$esc_chars/, 'Tabs are allowed' ); $bad_chars = '`backticks`'; $esc_chars = '`backticks`'; ok( my $out5 = $svg->text()->cdata($bad_chars), 'Testing backticks' ); like( $out5->xmlify(), qr/$esc_chars/, 'Backticks are ok' ); $bad_chars = "Remove these: \x01, \x02, \x03, \x04, \x05, \x06, \x07, \x08, \x0b, \x1f"; $esc_chars = 'Remove these: , , , , , , , , , '; ok( my $out6 = $svg->text()->cdata($bad_chars), 'Testing restricted characters' ); like( $out6->xmlify(), qr/$esc_chars/, 'Restricted characters removed' ); $bad_chars = '[@hkb:536:8bp]: hkb-536'; $esc_chars = '\[@hkb:536:8bp\]: hkb-536'; ok( my $out7 = $svg->text()->cdata($bad_chars), 'More weird input' ); like( $out7->xmlify(), qr/$esc_chars/ ); SVG-2.84/t/21-polygon.t0000644000175000017500000000123713057520366014013 0ustar manwarmanwaruse strict; use warnings; use Test::More tests => 4; use SVG; # test: style my $svg = SVG->new; my $defs = $svg->defs(); diag 'a five-sided polygon'; my $xv = [ 0, 2, 4, 5, 1 ]; my $yv = [ 0, 0, 2, 7, 5 ]; my $points = $svg->get_path( x => $xv, y => $yv, -type => 'polygon' ); my $c = $svg->polygon( %$points, id => 'pgon1', style => { fill => 'red', stroke => 'green', }, opacity => 0.6, ); ok( $c, "polygon 1: define" ); my $out = $svg->xmlify(); like( $out, qr/polygon/, "polygon 2: serialize" ); like( $out, qr/style/, "inline css style 1" ); like( $out, qr/opacity/, "inline css style 2" ); SVG-2.84/t/07-extension.t0000644000175000017500000000045013057520366014340 0ustar manwarmanwaruse strict; use warnings; use Test::More tests => 1; use SVG; my $svg = SVG->new( -extension => q{} ); $svg->group->text->cdata("Extensions"); my $xml = $svg->render; like( $xml, qr/[\n\n]>/, "ENTITY myentity myvalue" ); SVG-2.84/t/14-attributes.t0000644000175000017500000000052013057520366014506 0ustar manwarmanwaruse strict; use warnings; use Test::More tests => 2; use SVG; my $svg = SVG->new(); my $g = $svg->group( fill => "white", stroke => "black" ); my $fill = $g->attribute("fill"); is( $fill, "white", "attribute (get)" ); $g->attribute( stroke => "red" ); my $stroke = $g->attribute("stroke"); is( $stroke, "red", "attribute (set)" ); SVG-2.84/t/30-shapes.t0000644000175000017500000000272013057520366013605 0ustar manwarmanwaruse strict; use warnings; use Test::More tests => 3; use SVG; # test: style subtest rectangle => sub { plan tests => 1; my $svg = SVG->new; my $tag = $svg->rectangle( x => 10, y => 20, width => 4, height => 5, rx => 5.2, ry => 2.4, id => 'rect_1', ); my $xml = $svg->xmlify; like $xml, qr{}; #diag $xml; }; subtest circle => sub { plan tests => 1; my $svg = SVG->new; my $tag = $svg->circle( cx => 100, cy => 100, r => 50, id => 'circle_in_group_y' ); my $xml = $svg->xmlify; like $xml, qr{}; #diag $xml; }; subtest ellipse => sub { plan tests => 1; my $svg = SVG->new; my $tag = $svg->ellipse( cx => 10, cy => 10, rx => 5, ry => 7, id => 'ellipse', style => { 'stroke' => 'red', 'fill' => 'green', 'stroke-width' => '4', 'stroke-opacity' => '0.5', 'fill-opacity' => '0.2', } ); my $xml = $svg->xmlify; like $xml, qr{}; #diag $xml; }; SVG-2.84/t/00-load.t0000644000175000017500000000062013101532353013220 0ustar manwarmanwar#!/usr/bin/env perl use strict; use warnings; use Test::More tests => 5; BEGIN { use_ok('SVG') || print "Bail out!\n"; use_ok('SVG::DOM') || print "Bail out!\n"; use_ok('SVG::Element') || print "Bail out!\n"; use_ok('SVG::Extension') || print "Bail out!\n"; use_ok('SVG::XML') || print "Bail out!\n"; } diag("Testing SVG $SVG::VERSION, Perl $], $^X"); SVG-2.84/t/18-filter.t0000644000175000017500000000120213057520366013607 0ustar manwarmanwaruse strict; use warnings; use Test::More tests => 2; use SVG; # test: fe my $svg = SVG->new; my $parent = $svg->group(); my $child1 = $parent->text->cdata("I am the first child"); my $child2 = $parent->text->cdata("I am the second child"); my $fe = $svg->fe( -type => 'diffuselighting', # required - element name omitting 'fe' id => 'filter_1', style => { 'font' => [qw(Arial Helvetica sans)], 'font-size' => 10, 'fill' => 'red', }, transform => 'rotate(-45)' ); ok( $fe, "fe 1: generation" ); my $out = $svg->xmlify; like( $out, qr/feDiffuseLighting/, "fe 2: result" ); SVG-2.84/t/duplicate_credits.t0000644000175000017500000000031313210233610015545 0ustar manwarmanwaruse strict; use warnings; use Test::More tests => 1; use SVG; my $svg = SVG->new; $svg->xmlify; unlike $svg->xmlify => qr/Generated.*Generated/s, "don't add the author credits more than once"; SVG-2.84/t/17-tagtypes.t0000644000175000017500000000117213057520366014167 0ustar manwarmanwaruse strict; use warnings; use Test::More tests => 4; use SVG; # test: getElementTypes, getElementsByType, getElementType, getElementsByType, getElementTypes my $svg = SVG->new; my $parent = $svg->group(); my $child1 = $parent->text->cdata("I am the first child"); my $child2 = $parent->text->cdata("I am the second child"); is( $child1->getElementType(), "text", "getElementType" ); is( scalar( @{ $svg->getElementsByType("g") } ), 1, "getElementsByType test 1" ); is( scalar( @{ $svg->getElementsByType("text") } ), 2, "getElementsByType test 2" ); is( scalar( @{ $svg->getElementTypes() } ), 3, "getElementTypes" ); SVG-2.84/t/19-style.t0000644000175000017500000000054413057520366013473 0ustar manwarmanwaruse strict; use warnings; use Test::More tests => 1; use SVG; # test: style my $svg = SVG->new; my $defs = $svg->defs(); my $rect = $svg->rect( x => 10, y => 10, width => 10, height => 10, style => { fill => 'red', stroke => 'green' } ); my $out = $svg->xmlify; like( $out, qr/stroke\s*:\s*green/, "inline css defs" ); SVG-2.84/t/08-looknfeel.t0000644000175000017500000000053513057520366014307 0ustar manwarmanwaruse strict; use warnings; use Test::More tests => 2; use SVG ( -indent => '*', -elsep => '|', -nocredits => 1 ); # test: -indent -elsep -nocredits my $svg = SVG->new(); $svg->group->text->cdata("Look and Feel"); my $xml = $svg->render(); like( $xml, qr/\n|\|/, "correct element separation" ); like( $xml, qr/\*\*/, "correct indent string" ); SVG-2.84/t/04-inline.t0000644000175000017500000000172513102112140013557 0ustar manwarmanwaruse strict; use warnings; use Test::More tests => 12; use SVG qw(-inline 1); # test: -inline my $svg1 = SVG->new(); isa_ok $svg1, 'SVG'; isa_ok $svg1->text->cdata("An inline document"), 'SVG::Element'; my $xml1a = $svg1->render(); unlike $xml1a, qr/DOCTYPE/, "1 render inline document"; unlike $xml1a, qr/^<\?xml .*?\?>\s*/sm; like $xml1a, qr{}; like $xml1a, qr{An inline document}; my $xml1b = $svg1->render( -inline => 0 ); like $xml1b, qr/DOCTYPE/, "2 render not inline"; like $xml1b, qr/^<\?xml .*?\?>\s*/sm; my $svg2 = SVG->new( -inline => 0 ); my $xml2a = $svg2->render(); like $xml2a, qr/DOCTYPE/, "3 render for not inline"; like $xml2a, qr/^<\?xml .*?\?>\s*/sm; my $xml2b = $svg2->render( -inline => 1 ); unlike $xml2b, qr/DOCTYPE/, "4 render inline render"; unlike $xml2b, qr/^<\?xml .*?\?>\s*/sm; �������������������������������������������SVG-2.84/t/01-loadsvg.t�����������������������������������������������������������������������������0000644�0001750�0001750�00000000603�13057520366�013755� 0����������������������������������������������������������������������������������������������������ustar �manwar��������������������������manwar�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use strict; use warnings; use Test::More tests => 5; use_ok( 'SVG', "Use SVG" ); # I am not sure why were these tests incluced, # but maybe there was a related bug? use_ok( 'SVG', "call SVG twice without warnings" ); use_ok( 'SVG', "call SVG three times without warnings" ); use_ok( 'SVG', "call SVG ; do not blow it away without warnings" ); my $svg = SVG->new; isa_ok $svg, 'SVG'; �����������������������������������������������������������������������������������������������������������������������������SVG-2.84/t/13-duplicateids.t������������������������������������������������������������������������0000644�0001750�0001750�00000001023�13057520366�014770� 0����������������������������������������������������������������������������������������������������ustar �manwar��������������������������manwar�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use strict; use warnings; use Test::More tests => 2; use SVG; # test: duplicate ids, -raiseerror my $svga = SVG->new(); my $dupnotdetected = eval { $svga->group( id => 'the_group' ); $svga->group( id => 'the_group' ); 1; }; ok( !$dupnotdetected, "raiseerror" ); my $svgb = SVG->new( -raiseerror => 0, -printerror => 0 ); $svgb->group( id => 'the_group' ); $svgb->group( id => 'the_group' ); my $xml = $svgb->render(); like( $xml, qr/errors=/, "raiseerror and printerror attribute in constructor" ); �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������SVG-2.84/t/00-report-prereqs.t����������������������������������������������������������������������0000644�0001750�0001750�00000014226�13240335252�015305� 0����������������������������������������������������������������������������������������������������ustar �manwar��������������������������manwar�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#!perl use strict; use warnings; # This test was generated by Dist::Zilla::Plugin::Test::ReportPrereqs 0.027 use Test::More tests => 1; use ExtUtils::MakeMaker; use File::Spec; # from $version::LAX my $lax_version_re = qr/(?: undef | (?: (?:[0-9]+) (?: \. | (?:\.[0-9]+) (?:_[0-9]+)? )? | (?:\.[0-9]+) (?:_[0-9]+)? ) | (?: v (?:[0-9]+) (?: (?:\.[0-9]+)+ (?:_[0-9]+)? )? | (?:[0-9]+)? (?:\.[0-9]+){2,} (?:_[0-9]+)? ) )/x; # hide optional CPAN::Meta modules from prereq scanner # and check if they are available my $cpan_meta = "CPAN::Meta"; my $cpan_meta_pre = "CPAN::Meta::Prereqs"; my $HAS_CPAN_META = eval "require $cpan_meta; $cpan_meta->VERSION('2.120900')" && eval "require $cpan_meta_pre"; ## no critic # Verify requirements? my $DO_VERIFY_PREREQS = 1; sub _max { my $max = shift; $max = ( $_ > $max ) ? $_ : $max for @_; return $max; } sub _merge_prereqs { my ( $collector, $prereqs ) = @_; # CPAN::Meta::Prereqs object if ( ref $collector eq $cpan_meta_pre ) { return $collector->with_merged_prereqs( CPAN::Meta::Prereqs->new($prereqs) ); } # Raw hashrefs for my $phase ( keys %$prereqs ) { for my $type ( keys %{ $prereqs->{$phase} } ) { for my $module ( keys %{ $prereqs->{$phase}{$type} } ) { $collector->{$phase}{$type}{$module} = $prereqs->{$phase}{$type}{$module}; } } } return $collector; } my @include = qw( ); my @exclude = qw( ); # Add static prereqs to the included modules list my $static_prereqs = do './t/00-report-prereqs.dd'; # Merge all prereqs (either with ::Prereqs or a hashref) my $full_prereqs = _merge_prereqs( ( $HAS_CPAN_META ? $cpan_meta_pre->new : {} ), $static_prereqs ); # Add dynamic prereqs to the included modules list (if we can) my ($source) = grep {-f} 'MYMETA.json', 'MYMETA.yml'; my $cpan_meta_error; if ( $source && $HAS_CPAN_META && ( my $meta = eval { CPAN::Meta->load_file($source) } ) ) { $full_prereqs = _merge_prereqs( $full_prereqs, $meta->prereqs ); } else { $cpan_meta_error = $@; # capture error from CPAN::Meta->load_file($source) $source = 'static metadata'; } my @full_reports; my @dep_errors; my $req_hash = $HAS_CPAN_META ? $full_prereqs->as_string_hash : $full_prereqs; # Add static includes into a fake section for my $mod (@include) { $req_hash->{other}{modules}{$mod} = 0; } for my $phase (qw(configure build test runtime develop other)) { next unless $req_hash->{$phase}; next if ( $phase eq 'develop' and not $ENV{AUTHOR_TESTING} ); for my $type (qw(requires recommends suggests conflicts modules)) { next unless $req_hash->{$phase}{$type}; my $title = ucfirst($phase) . ' ' . ucfirst($type); my @reports = [qw/Module Want Have/]; for my $mod ( sort keys %{ $req_hash->{$phase}{$type} } ) { next if $mod eq 'perl'; next if grep { $_ eq $mod } @exclude; my $file = $mod; $file =~ s{::}{/}g; $file .= ".pm"; my ($prefix) = grep { -e File::Spec->catfile( $_, $file ) } @INC; my $want = $req_hash->{$phase}{$type}{$mod}; $want = "undef" unless defined $want; $want = "any" if !$want && $want == 0; my $req_string = $want eq 'any' ? 'any version required' : "version '$want' required"; if ($prefix) { my $have = MM->parse_version( File::Spec->catfile( $prefix, $file ) ); $have = "undef" unless defined $have; push @reports, [ $mod, $want, $have ]; if ( $DO_VERIFY_PREREQS && $HAS_CPAN_META && $type eq 'requires' ) { if ( $have !~ /\A$lax_version_re\z/ ) { push @dep_errors, "$mod version '$have' cannot be parsed ($req_string)"; } elsif ( !$full_prereqs->requirements_for( $phase, $type ) ->accepts_module( $mod => $have ) ) { push @dep_errors, "$mod version '$have' is not in required range '$want'"; } } } else { push @reports, [ $mod, $want, "missing" ]; if ( $DO_VERIFY_PREREQS && $type eq 'requires' ) { push @dep_errors, "$mod is not installed ($req_string)"; } } } if (@reports) { push @full_reports, "=== $title ===\n\n"; my $ml = _max( map { length $_->[0] } @reports ); my $wl = _max( map { length $_->[1] } @reports ); my $hl = _max( map { length $_->[2] } @reports ); if ( $type eq 'modules' ) { splice @reports, 1, 0, [ "-" x $ml, "", "-" x $hl ]; push @full_reports, map { sprintf( " %*s %*s\n", -$ml, $_->[0], $hl, $_->[2] ) } @reports; } else { splice @reports, 1, 0, [ "-" x $ml, "-" x $wl, "-" x $hl ]; push @full_reports, map { sprintf( " %*s %*s %*s\n", -$ml, $_->[0], $wl, $_->[1], $hl, $_->[2] ) } @reports; } push @full_reports, "\n"; } } } if (@full_reports) { diag "\nVersions for all modules listed in $source (including optional ones):\n\n", @full_reports; } if ( $cpan_meta_error || @dep_errors ) { diag "\n*** WARNING WARNING WARNING WARNING WARNING WARNING WARNING WARNING ***\n"; } if ($cpan_meta_error) { my ($orig_source) = grep {-f} 'MYMETA.json', 'MYMETA.yml'; diag "\nCPAN::Meta->load_file('$orig_source') failed with: $cpan_meta_error\n"; } if (@dep_errors) { diag join( "\n", "\nThe following REQUIRED prerequisites were not satisfied:\n", @dep_errors, "\n" ); } pass; # vim: ts=4 sts=4 sw=4 et: ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������SVG-2.84/t/09-script.t������������������������������������������������������������������������������0000644�0001750�0001750�00000002632�13057520366�013636� 0����������������������������������������������������������������������������������������������������ustar �manwar��������������������������manwar�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use strict; use warnings; use Test::More tests => 8; use SVG; my $svg = SVG->new; my $tag = $svg->script( type => "text/ecmascript" ); # populate the script tag with cdata # be careful to manage the javascript line ends. # qq│text│ or qq§text§ where text is the script # works well for this. $tag->CDATA( qq| function d(){ //simple display function for(cnt = 0; cnt < d.length; cnt++) document.write(d[cnt]);//end for loop document.write("
");//write a line break document.write('
');//write a horizontal rule }| ); ok( $tag, "create script element" ); my $out = $svg->xmlify; like( $out, qr{"text/ecmascript"}, "specify script type" ); like( $out, qr/function/, "generate script content" ); like( $out, qr/'
'/, "handle single quotes" ); like( $out, qr/"
/, "handle double quotes" ); #test for adding scripting commands in an element $out = $svg->xmlify; my $rect = $svg->rect( x => 10, y => 10, fill => 'red', stroke => 'black', width => '10', height => '10', onclick => "alert('hello'+' '+'world')" ); $out = $rect->xmlify; like( $out, qr/'hello'/, 'mouse event' ); like( $out, qr/'world'/, "mouse event script call" ); $svg = new SVG; $svg->script()->CDATA("TESTTESTTEST"); $out = $svg->xmlify; chomp $out; like( $out, qr/\s*<\/script>/, "script without type" ); SVG-2.84/t/12-elementid.t0000644000175000017500000000042313057520366014266 0ustar manwarmanwaruse strict; use warnings; use Test::More tests => 2; use SVG; my $svg = SVG->new(); my $group = $svg->group( id => 'the_group' ); is( $group->getElementID(), "the_group", "getElementID" ); is( $svg->getElementByID("the_group"), $group, "getElementByID" ); SVG-2.84/t/20-anchor.t0000644000175000017500000000274513057520366013602 0ustar manwarmanwaruse strict; use warnings; use Test::More tests => 6; use SVG; # test: style my $svg = SVG->new; my $defs = $svg->defs(); # generate an anchor my $tag0 = $svg->anchor( -href => 'http://here.com/some/simpler/SVG.svg' ); # add a circle to the anchor. The circle can be clicked on. $tag0->circle( cx => 10, cy => 10, r => 1 ); # more complex anchor with both URL and target $svg->comment("anchor with: -href, target"); my $tag1 = $svg->anchor( -href => 'http://example.com/some/page.html', target => 'new_window_1', ); $tag1->circle( cx => 10, cy => 10, r => 1 ); $svg->comment("anchor with: -href, -title, -actuate, -show"); my $tag2 = $svg->anchor( -href => 'http://example.com/some/other/page.html', -actuate => 'onLoad', -title => 'demotitle', -show => 'embed', ); $tag2->circle( cx => 10, cy => 10, r => 1 ); my $out = $tag0->xmlify; like( $out, qr{http://here\.com/some/simpler/SVG\.svg}, "anchor 3: xlink href" ); $out = $tag1->xmlify; like( $out, qr/target="new_window_1"/, "anchor 4: target" ); $out = $tag2->xmlify; like( $out, qr/xlink:title="demotitle"/, "anchor 6: title" ); $out = $tag2->xmlify; like( $out, qr/actuate/, "anchor 7: actuate" ); $out = $tag2->xmlify; like( $out, qr/xlink:show="embed"/, "anchor 8: show" ); my $tag3 = $svg->a( -href => 'http://example.com/some/page.html', -title => 'direct_a_tag', target => 'new_window_1', ); $out = $tag3->xmlify; like( $out, qr/direct_a_tag/, "anchor 9: direct a method" ); SVG-2.84/t/06-doctype.t0000644000175000017500000000213413057520366013773 0ustar manwarmanwaruse strict; use warnings; use Test::More tests => 8; use SVG (); # test: -sysid -pubid -docroot my $svg = SVG->new(); $svg->text->cdata("Document type declaration test"); my $xml = $svg->dtddecl(); ok( $xml, "dtd reclaration" ); like( $xml, qr/DOCTYPE svg /, "doctype found" ); like( $xml, qr{ PUBLIC "-//W3C//DTD SVG 1.0//EN" }, "PUBLIC found" ); like( $xml, qr{ "http://www.w3.org/TR/2001/REC-SVG-20010904/DTD/svg10.dtd">}, "SVG 1.0 TR" ); $svg = SVG->new( -docroot => "mysvg" ); $xml = $svg->dtddecl(); like( $xml, qr/DOCTYPE mysvg /, "DOCTYPE mysvg" ); $svg = SVG->new( -pubid => "-//ROIT Systems/DTD MyCustomDTD 1.0//EN" ); $xml = $svg->dtddecl(); like( $xml, qr{ PUBLIC "-//ROIT Systems/DTD MyCustomDTD 1.0//EN" }, "pubid 2" ); $svg = SVG->new( -pubid => undef ); $xml = $svg->dtddecl(); like( $xml, qr{ SYSTEM "http://www.w3.org/TR/2001/REC-SVG-20010904/DTD/svg10.dtd">}, "pubid 3" ); $svg = SVG->new( -sysid => "http://www.perlsvg.com/svg/my_custom_svg10.dtd" ); $xml = $svg->dtddecl(); like( $xml, qr{ "http://www.perlsvg.com/svg/my_custom_svg10.dtd">}, "custom sysid" ); SVG-2.84/t/10-autoload.t0000644000175000017500000000061413057520366014130 0ustar manwarmanwaruse strict; use warnings; use Test::More tests => 1; use SVG ( -auto => 1 ); my $svg = SVG->new( -foo => "bar" ); ok( eval { $svg->make->it->up->as->we->go->along; }, "autoload arbitrary xml tags" ); #--> currently this is allowed, in fact. It just has no effect. #print("Failed in rejecting -auto argument") and exit(0) # if eval { # my $svg=new SVG(-auto => 1); # 1; # }; SVG-2.84/t/22-xlink.t0000644000175000017500000000055513057520366013454 0ustar manwarmanwaruse strict; use warnings; use Test::More tests => 2; use SVG; # test: style my $svg = SVG->new; my $defs = $svg->defs(); my $out = $svg->xmlify(); like( $out, qr{xmlns:xlink="http://www.w3.org/1999/xlink"}, "xlink definition in svg - part 1" ); like( $out, qr{xmlns="http://www.w3.org/2000/svg"}, "xlink definition in svg - part 2" ); SVG-2.84/t/03-render.t0000644000175000017500000000117513102112140013556 0ustar manwarmanwaruse strict; use warnings; use Test::More tests => 6; use SVG; my $svg = SVG->new; diag "add circle"; my $e = $svg->circle(); isa_ok $e, 'SVG::Element'; my $output = $svg->render(); ok( $output, "nonempty output of render" ); like $output, qr{<\?xml version="1.0" encoding="UTF-8" standalone="yes"\?>}; like $output, qr{}; like $output, qr{}; like $output, qr{}; ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������SVG-2.84/t/15-parentage.t���������������������������������������������������������������������������0000644�0001750�0001750�00000002642�13057520366�014276� 0����������������������������������������������������������������������������������������������������ustar �manwar��������������������������manwar�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use strict; use warnings; use Test::More tests => 18; use SVG; # test: getFirstChild, getLastChild, getParent, getChildren my $svg = SVG->new; my $parent = $svg->group(); my $child1 = $parent->text->cdata("I am the first child"); my $child2 = $parent->text->cdata("I am the second child"); my $child3 = $parent->text->cdata("I am the third child"); is( $parent->getFirstChild(), $child1, "getFirstChild" ); is( $child1->getParent(), $parent, "getParent 1" ); is( $parent->getLastChild(), $child3, "getLastChild" ); is( $child2->getParent(), $parent, "getParent 2" ); ok( $parent->hasChildren(), "hasChildren" ); my @children = $parent->getChildren(); is( scalar(@children), 3, "correct number of children" ); is( $children[0], $child1, "getChildren 1" ); is( $children[1], $child2, "getChildren 2" ); is( $children[2], $child3, "getChildren 3" ); is( $parent->removeChild($child1), $child1, 'removeChild1' ); is( $parent->removeChild($child3), $child3, 'removeChild3' ); is( $parent->removeChild($child2), $child2, 'removeChild2' ); is( $parent->removeChild($child1), 0, 'no such child' ); is( $parent->findChildIndex($child1), -1, 'child1 is gone' ); is( $parent->insertAtIndex( $child1, 0 ), 1 ); is( $parent->findChildIndex($child1), 0, 'child1 is back' ); is( $parent->removeAtIndex(0), $child1 ); is( $parent->findChildIndex($child1), -1, 'child1 is gone again' ); ����������������������������������������������������������������������������������������������SVG-2.84/lib/���������������������������������������������������������������������������������������0000755�0001750�0001750�00000000000�13242535444�012216� 5����������������������������������������������������������������������������������������������������ustar �manwar��������������������������manwar�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������SVG-2.84/lib/SVG/�����������������������������������������������������������������������������������0000755�0001750�0001750�00000000000�13242535444�012655� 5����������������������������������������������������������������������������������������������������ustar �manwar��������������������������manwar�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������SVG-2.84/lib/SVG/DOM.pm�����������������������������������������������������������������������������0000644�0001750�0001750�00000045605�13242534721�013641� 0����������������������������������������������������������������������������������������������������ustar �manwar��������������������������manwar�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������package SVG::DOM; use strict; use warnings; use Scalar::Util qw/weaken/; our $VERSION = '2.84'; # this module extends SVG::Element package SVG::Element; #----------------- # sub getFirstChild sub getFirstChild { my $self = shift; if ( my @children = $self->getChildren ) { return $children[0]; } return; } #----------------- # sub getChildIndex # return the array index of this element in the parent # or the passed list (if there is one). sub getChildIndex { my ( $self, @children ) = @_; unless (@children) { my $parent = $self->getParent(); @children = $parent->getChildren(); return unless @children; } for my $index ( 0 .. $#children ) { return $index if $children[$index] == $self; } return; } #----------------- # sub getChildAtIndex # return the element at the specified index # (the index can be negative) sub getChildAtIndex { my ( $self, $index, @children ) = @_; unless (@children) { my $parent = $self->getParent(); @children = $parent->getChildren(); return unless @children; } return $children[$index]; } #----------------- # sub getNextSibling sub getNextSibling { my $self = shift; if ( my $parent = $self->getParent ) { my @children = $parent->getChildren(); my $index = $self->getChildIndex(@children); if ( defined $index and scalar(@children) > $index ) { return $children[ $index + 1 ]; } } return; } #----------------- # sub getPreviousSibling sub getPreviousSibling { my $self = shift; if ( my $parent = $self->getParent ) { my @children = $parent->getChildren(); my $index = $self->getChildIndex(@children); if ($index) { return $children[ $index - 1 ]; } } return; } #----------------- # sub getLastChild sub getLastChild { my $self = shift; if ( my @children = $self->getChildren ) { return $children[-1]; } return; } #----------------- # sub getChildren sub getChildren { my $self = shift; if ( $self->{-childs} ) { if (wantarray) { return @{ $self->{-childs} }; } return $self->{-childs}; } return; } *getChildElements = \&getChildren; *getChildNodes = \&getChildren; #----------------- sub hasChildren { my $self = shift; if ( exists $self->{-childs} ) { if ( scalar @{ $self->{-childs} } ) { return 1; } } return 0; } *hasChildElements = \&hasChildren; *hasChildNodes = \&hasChildren; #----------------- # sub getParent / getParentElement # return the ref of the parent of the current node sub getParent { my $self = shift; if ( $self->{-parent} ) { return $self->{-parent}; } return; } *getParentElement = \&getParent; *getParentNode = \&getParent; #----------------- # sub getParents / getParentElements sub getParents { my $self = shift; my $parent = $self->{-parent}; return unless $parent; my @parents; while ($parent) { push @parents, $parent; $parent = $parent->{-parent}; } return @parents; } *getParentElements = \&getParents; *getParentNodes = \&getParents; *getAncestors = \&getParents; #----------------- # sub isAncestor sub isAncestor { my ( $self, $descendant ) = @_; my @parents = $descendant->getParents(); foreach my $parent (@parents) { return 1 if $parent == $self; } return 0; } #----------------- # sub isDescendant sub isDescendant { my ( $self, $ancestor ) = @_; my @parents = $self->getParents(); foreach my $parent (@parents) { return 1 if $parent == $ancestor; } return 0; } #----------------- # sub getSiblings sub getSiblings { my $self = shift; if ( my $parent = $self->getParent ) { return $parent->getChildren(); } return; } #----------------- # sub hasSiblings sub hasSiblings { my $self = shift; if ( my $parent = $self->getParent ) { my $siblings = scalar( $parent->getChildren ); return 1 if $siblings >= 2; } return; } #----------------- # sub getElementName / getType sub getElementName { my $self = shift; if ( exists $self->{-name} ) { return $self->{-name}; } return; } *getType = \&getElementName; *getElementType = \&getElementName; *getTagName = \&getElementName; *getTagType = \&getElementName; *getNodeName = \&getElementName; *getNodeType = \&getElementName; #----------------- # sub getElements # get all elements of the specified type # if none is specified, get all elements in document. sub getElements { my ( $self, $element ) = @_; return unless exists $self->{-docref}; return unless exists $self->{-docref}->{-elist}; my $elist = $self->{-docref}->{-elist}; if ( defined $element ) { if ( exists $elist->{$element} ) { return wantarray ? @{ $elist->{$element} } : $elist->{$element}; } return; } else { my @elements; foreach my $element_type ( keys %$elist ) { push @elements, @{ $elist->{$element_type} }; } return wantarray ? @elements : \@elements; } } # forces the use of the second argument for element name sub getElementsByName { return shift->getElements(shift); } *getElementsByType = \&getElementsByName; #----------------- sub getElementNames { my $self = shift; my @types = keys %{ $self->{-docref}->{-elist} }; return wantarray ? @types : \@types; } *getElementTypes = \&getElementNames; #----------------- # sub getElementID sub getElementID { my $self = shift; if ( exists $self->{id} ) { return $self->{id}; } return; } #----------------- # sub getElementByID / getElementbyID sub getElementByID { my ( $self, $id ) = @_; return unless defined($id); my $idlist = $self->{-docref}->{-idlist}; if ( exists $idlist->{$id} ) { return $idlist->{$id}; } return; } *getElementbyID = \&getElementByID; #----------------- # sub getAttribute # see also SVG::attrib() sub getAttribute { my ( $self, $attr ) = @_; if ( exists $self->{$attr} ) { return $self->{$attr}; } return; } #----------------- # sub getAttributes sub getAttributes { my $self = shift; my $out = {}; foreach my $i ( keys %$self ) { $out->{$i} = $self->{$i} unless $i =~ /^-/; } return wantarray ? %{$out} : $out; } #----------------- # sub setAttribute sub setAttributes { my ( $self, $attr ) = @_; foreach my $i ( keys %$attr ) { $self->attrib( $i, $attr->{$i} ); } } #----------------- # sub setAttribute sub setAttribute { my ( $self, $att, $val ) = @_; $self->attrib( $att, $val ); } #----------------- # sub getCDATA / getCdata / getData sub getCDATA { my $self = shift; if ( exists $self->{-cdata} ) { return $self->{-cdata}; } return; } *getCdata = \&getCDATA; *getData = \&getCDATA; # ---------------- # 2005-12-30 - Martin Owens, apply greater DOM specification (write) # http://www.w3.org/TR/1998/REC-DOM-Level-1-19981001/level-one-core.html # ---------------- # sub document sub document { my ($self) = @_; return $self->{-docref}; } # DOM specified method names *createElement = \&tag; *firstChild = \&getFirstChild; *lastChild = \&getLastChild; *previousSibling = \&getPreviousSibling; *nextSibling = \&getNextSibling; # ---------------- # sub insertBefore sub insertBefore { my ( $self, $newChild, $refChild ) = @_; return $self->appendElement($newChild) if not $refChild; my $index = $self->findChildIndex($refChild); return 0 if $index < 0; # NO_FOUND_ERR return $self->insertAtIndex( $newChild, $index ); } *insertChildBefore = \&insertBefore; *insertNodeBefore = \&insertBefore; *insertElementBefore = \&insertBefore; # ---------------- # sub insertAfter sub insertAfter { my ( $self, $newChild, $refChild ) = @_; return $self->appendElement($newChild) if not $refChild; my $index = $self->findChildIndex($refChild); return 0 if $index < 0; # NO_FOUND_ERR return $self->insertAtIndex( $newChild, $index + 1 ); } *insertChildAfter = \&insertAfter; *insertNodeAfter = \&insertAfter; *insertElementAfter = \&insertAfter; # ---------------- # sub insertSiblingAfter (Not in W3C DOM) sub insertSiblingAfter { my ( $self, $newChild ) = @_; return $self->getParent->insertAfter( $newChild, $self ) if $self->getParent; return 0; } # ---------------- # sub insertSiblingBefore (Not in W3C DOM) sub insertSiblingBefore { my ( $self, $newChild ) = @_; return $self->getParent->insertBefore( $newChild, $self ) if $self->getParent; return 0; } # ---------------- # sub replaceChild sub replaceChild { my ( $self, $newChild, $oldChild ) = @_; # Replace newChild if it is in this list of children already $self->removeChild($newChild) if $newChild->{-parent} eq $self; # We need the index of the node to replace my $index = $self->findChildIndex($oldChild); return 0 if ( $index < 0 ); # NOT_FOUND_ERR # Replace and bind new node with its family $self->removeChildAtIndex($index); $self->insertChildAtIndex($index); return $oldChild; } *replaceElement = \&replaceChild; *replaceNode = \&replaceChild; # ---------------- # sub removeChild sub removeChild { my ( $self, $oldChild ) = @_; my $index = $self->findChildIndex($oldChild); return 0 if ( $index < 0 ); # NOT_FOUND_ERR return $self->removeChildAtIndex($index); } *removeElement = \&removeChild; *removeNode = \&removeChild; # ---------------- # sub appendChild sub appendChild { my ( $self, $element ) = @_; my $index = ( defined $self->{-childs} && scalar @{ $self->{-childs} } ) || 0; $self->insertAtIndex( $element, $index ); return 1; } *appendElement = \&appendChild; *appendNode = \&appendChild; # ---------------- # sub cloneNode sub cloneNode { my ( $self, $deep ) = @_; my $clone = new SVG::Element; foreach my $key ( keys( %{$self} ) ) { next if $key eq '-childs' or $key eq '-parent'; if ( $key eq '-docref' ) { # need to forge a docref based on the docref of the template element foreach my $dockey ( keys( %{ $self->{-docref} } ) ) { next if $dockey eq '-childs' or $dockey eq '-parent' or $dockey eq '-idlist' or $dockey eq '-elist' or $dockey eq '-document' or $dockey eq '-docref'; $clone->{-docref}->{$dockey} = $self->{-docref}->{$dockey}; } } else { $clone->{$key} = $self->{$key}; } } # We need to clone the children if deep is specified. if ($deep) { foreach my $child ( @{ $self->{-childs} } ) { my $childClone = $child->cloneNode($deep); $clone->appendChild($childClone); } } return $clone; } *cloneElement = \&cloneNode; # --------------------------------------- # NONE DOM Supporting methodss # ---------------- # sub findChildIndex sub findChildIndex { my ( $self, $refChild ) = @_; my $index = 0; foreach my $child ( @{ $self->{-childs} } ) { if ( $child eq $refChild ) { return $index; # Child found } $index++; } return -1; # Child not found } # --------------- # sub insertAtIndex sub insertAtIndex { my ( $self, $newChild, $index ) = @_; # add child splice @{ $self->{-childs} }, $index, 0, $newChild; # update parent and document reference $newChild->{-docref} = $self->{-docref}; weaken( $newChild->{-docref} ); $newChild->{-parent} = $self; weaken( $newChild->{-parent} ); # update ID and element list if ( defined( $newChild->{id} ) ) { $self->{-docref}->{-idlist}->{ $newChild->{id} } = $newChild; } $self->{-docref}->{-elist} = {} unless ( defined $self->{-docref}->{-elist} ); $self->{-docref}->{-elist}->{ $newChild->{-name} } = [] unless ( defined $self->{-docref}->{-elist}->{ $newChild->{-name} } ); unshift @{ $self->{-docref}->{-elist}->{ $newChild->{-name} } }, $newChild; return 1; } *insertChildAtIndex = \&insertAtIndex; # ---------------- # sub removeChildAtIndex sub removeChildAtIndex { my ( $self, $index ) = @_; # remove child my $oldChild = splice @{ $self->{-childs} }, $index, 1; if ( not @{ $self->{-childs} } ) { delete $self->{-childs}; } # update parent and document reference $oldChild->{-docref} = undef; $oldChild->{-parent} = undef; # update ID and element list if ( defined( $oldChild->{id} ) && exists $self->{-docref}->{-idlist}->{ $oldChild->{id} } ) { delete $self->{-docref}->{-idlist}->{ $oldChild->{id} }; } if ( exists $self->{-docref}->{-elist}->{ $oldChild->{-name} } ) { delete $self->{-docref}->{-elist}->{ $oldChild->{-name} }; } return $oldChild; } *removeAtIndex = \&removeChildAtIndex; #------------------------------------------------------------------------------- =pod =head1 NAME SVG::DOM - A library of DOM (Document Object Model) methods for SVG objects. =head1 SUMMARY SVG::DOM provides a selection of methods for accessing and manipulating SVG elements through DOM-like methods such as getElements, getChildren, getNextSibling and so on. =head1 SYNOPSIS my $svg=new SVG(id=>"svg_dom_synopsis", width=>"100", height=>"100"); my %attributes=$svg->getAttributes; my $group=$svg->group(id=>"group_1"); my $name=$group->getElementName; my $id=$group->getElementID; $group->circle(id=>"circle_1", cx=>20, cy=>20, r=>5, fill=>"red"); my $rect=$group->rect(id=>"rect_1", x=>10, y=>10, width=>20, height=>30); my $width=$rect->getAttribute("width"); my $has_children=$group->hasChildren(); my @children=$group->getChildren(); my $kid=$group->getFirstChild(); do { print $kid->xmlify(); } while ($kid=$kid->getNextSibling); my @ancestors=$rect->getParents(); my $is_ancestor=$group->isAncestor($rect); my $is_descendant=$rect->isDescendant($svg); my @rectangles=$svg->getElements("rect"); my $allelements_arrayref=$svg->getElements(); $group->insertBefore($newChild,$rect); $group->insertAfter($newChild,$rect); $rect = $group->replaceChild($newChild,$rect); $group->removeChild($newChild); my $newRect = $rect->cloneNode($deep); ...and so on... =head1 METHODS =head2 @elements = $obj->getElements($element_name) Return a list of all elements with the specified name (i.e. type) in the document. If no element name is provided, returns a list of all elements in the document. In scalar context returns an array reference. =head2 @children = $obj->getChildren() Return a list of all children defined on the current node, or undef if there are no children. In scalar context returns an array reference. Alias: getChildElements(), getChildNodes() =head2 @children = $obj->hasChildren() Return 1 if the current node has children, or 0 if there are no children. Alias: hasChildElements, hasChildNodes() =head2 $ref = $obj->getFirstChild() Return the first child element of the current node, or undef if there are no children. =head2 $ref = $obj->getLastChild() Return the last child element of the current node, or undef if there are no children. =head2 $ref = $obj->getSiblings() Return a list of all children defined on the parent node, containing the current node. =head2 $ref = $obj->getNextSibling() Return the next child element of the parent node, or undef if this is the last child. =head2 $ref = $obj->getPreviousSibling() Return the previous child element of the parent node, or undef if this is the first child. =head2 $index = $obj->getChildIndex() Return the place of this element in the parent node's list of children, starting from 0. =head2 $element = $obj->getChildAtIndex($index) Returns the child element at the specified index in the parent node's list of children. =head2 $ref = $obj->getParentElement() Return the parent of the current node. Alias: getParent() =head2 @refs = $obj->getParentElements() Return a list of the parents of the current node, starting from the immediate parent. The last member of the list should be the document element. Alias: getParents() =head2 $name = $obj->getElementName() Return a string containing the name (i.e. the type, not the ID) of an element. Alias: getType(), getTagName(), getNodeName() =head2 $ref = $svg->getElementByID($id) Alias: getElementbyID() Return a reference to the element which has ID $id, or undef if no element with this ID exists. =head2 $id = $obj->getElementID() Return a string containing the ID of the current node, or undef if it has no ID. =head2 $ref = $obj->getAttributes() Return a hash reference of attribute names and values for the current node. =head2 $value = $obj->getAttribute($name); Return the string value attribute value for an attribute of name $name. =head2 $ref = $obj->setAttributes({name1=>$value1,name2=>undef,name3=>$value3}) Set a set of attributes. If $value is undef, deletes the attribute. =head2 $value = $obj->setAttribute($name,$value); Set attribute $name to $value. If $value is undef, deletes the attribute. =head2 $cdata = $obj->getCDATA() Return the canonical data (i.e. textual content) of the current node. Alias: getCdata(), getData() =head2 $boolean = $obj->isAncestor($element) Returns 1 if the current node is an ancestor of the specified element, otherwise 0. =head2 $boolean = $obj->isDescendant($element) Returns 1 if the current node is a descendant of the specified element, otherwise 0. =head2 $boolean = $obj->insertBefore( $element, $child ); Returns 1 if $element was successfully inserted before $child in $obj =head2 $boolean = $obj->insertAfter( $element, $child ); Returns 1 if $element was successfully inserted after $child in $obj =head2 $boolean = $obj->insertSiblingBefore( $element ); Returns 1 if $element was successfully inserted before $obj =head2 $boolean = $obj->insertSiblingAfter( $element ); Returns 1 if $element was successfully inserted after $obj =head2 $element = $obj->replaceChild( $element, $child ); Returns $child if $element successfully replaced $child in $obj =head2 $element = $obj->removeChild( $child ); Returns $child if it was removed successfully from $obj =head2 $element = $obj->cloneNode( $deep ); Returns a new $element clone of $obj, without parents or children. If deep is set to 1, all children are included recursively. =head1 AUTHOR Ronan Oger, ronan@roitsystems.com Martin Owens, doctormo@postmaster.co.uk =head1 SEE ALSO perl(1), L, L, L, L L ROIT Systems: Commercial SVG perl solutions L SVG at the W3C =cut 1; ���������������������������������������������������������������������������������������������������������������������������SVG-2.84/lib/SVG/XML.pm�����������������������������������������������������������������������������0000644�0001750�0001750�00000011570�13242534721�013654� 0����������������������������������������������������������������������������������������������������ustar �manwar��������������������������manwar�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������package SVG::XML; use strict; use warnings; our $VERSION = '2.84'; =pod =head1 NAME SVG::XML - Handle the XML generation bits for SVG.pm =head1 AUTHOR Ronan Oger, cpan@roitsystems.com =head1 SEE ALSO L, L, L, L, L For Commercial Perl/SVG development, refer to the following sites: L, L, L =cut use Exporter; use vars qw(@ISA @EXPORT); @ISA = ('Exporter'); @EXPORT = qw( xmlesc xmlescape xmlescp cssstyle xmlattrib xmlcomment xmlpi xmltag xmltagopen xmltagclose xmltag_ln xmltagopen_ln xmltagclose_ln processtag xmldecl dtddecl ); sub xmlescp { my ( $self, $s ) = @_; $s = '0' unless defined $s; $s = join( ', ', @{$s} ) if ( ref($s) eq 'ARRAY' ); # Special XML entities are escaped $s =~ s/&(?!#(x\w\w|\d+?);)/&/g; $s =~ s/>/>/g; $s =~ s/error( $char => 'This forbidden XML character was removed' ); } # Per suggestion from Adam Schneider $s =~ s/([\200-\377])/'&#'.ord($1).';'/ge; return $s; } *xmlesc = \&xmlescp; *xmlescape = \&xmlescp; sub cssstyle { my %attrs = @_; return ( join( '; ', map { qq($_: ) . $attrs{$_} } sort keys(%attrs) ) ); } # Per suggestion from Adam Schneider sub xmlattrib { my %attrs = @_; return '' unless ( scalar( keys %attrs ) ); return ( ' ' . join( ' ', map { qq($_=") . $attrs{$_} . q(") } sort keys(%attrs) ) ); } sub xmltag { my ( $name, $ns, %attrs ) = @_; $ns = $ns ? "$ns:" : ''; my $at = xmlattrib(%attrs) || ''; return qq(<$ns$name$at />); } sub xmltag_ln { my ( $name, $ns, %attrs ) = @_; return xmltag( $name, $ns, %attrs ); } sub xmltagopen { my ( $name, $ns, %attrs ) = @_; $ns = $ns ? "$ns:" : ''; my $at = xmlattrib(%attrs) || ''; return qq(<$ns$name$at>); } sub xmltagopen_ln { my ( $name, $ns, %attrs ) = @_; return xmltagopen( $name, $ns, %attrs ); } sub xmlcomment { my ( $self, $r_comment ) = @_; my $ind = $self->{-docref}->{-elsep} . $self->{-docref}->{-indent} x $self->{-docref}->{-level}; # If the comment starts with newline character then do not prefix # with space (RT #123896). return ( $ind . join( $ind, map { ( (/^\n/) ? (q()) : (q( -->)) ); } @$r_comment ) ); } sub xmlpi { my ( $self, $r_pi ) = @_; my $ind = $self->{-docref}->{-elsep} . $self->{-docref}->{-indent} x $self->{-docref}->{-level}; return ( join( $ind, map {qq()} @$r_pi ) ); } *processinginstruction = \&xmlpi; sub xmltagclose { my ( $name, $ns ) = @_; $ns = $ns ? "$ns:" : ''; return qq(); } sub xmltagclose_ln { my ( $name, $ns ) = @_; return xmltagclose( $name, $ns ); } sub dtddecl { my $self = shift; my $docroot = $self->{-docroot} || 'svg'; my $id; if ( $self->{-pubid} ) { $id = 'PUBLIC "' . $self->{-pubid} . '"'; $id .= ' "' . $self->{-sysid} . '"' if ( $self->{-sysid} ); } elsif ( $self->{-sysid} ) { $id = 'SYSTEM "' . $self->{-sysid} . '"'; } else { $id = 'PUBLIC "-//W3C//DTD SVG 1.0//EN"' . $self->{-docref}->{-elsep} . "\"$self->{-docref}->{-dtd}\""; } my $at = join( ' ', ( $docroot, $id ) ); #>>>TBD: add internal() method to return this my $extension = ( exists $self->{-internal} ) ? $self->{-internal}->render() : q{}; if ( exists $self->{-extension} and $self->{-extension} ) { $extension .= $self->{-docref}{-elsep} . $self->{-extension} . $self->{-docref}{-elsep}; } $extension = ' [' . $self->{-docref}{-elsep} . $extension . ']' if $extension; return qq[$self->{-docref}{-elsep}]; } sub xmldecl { my $self = shift; my $version = $self->{-version} || '1.0'; my $encoding = $self->{-encoding} || 'UTF-8'; my $standalone = $self->{-standalone} || 'yes'; return qq{}; } #------------------------------------------------------------------------------- 1; ����������������������������������������������������������������������������������������������������������������������������������������SVG-2.84/lib/SVG/Element.pm�������������������������������������������������������������������������0000644�0001750�0001750�00000046773�13242534721�014622� 0����������������������������������������������������������������������������������������������������ustar �manwar��������������������������manwar�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������package SVG::Element; use strict; use warnings; our $VERSION = '2.84'; =pod =encoding UTF-8 =head1 NAME SVG::Element - Generate the element bits for SVG.pm =head1 AUTHOR Ronan Oger, cpan@roitsystems.com =head1 SEE ALSO For descreption of the methods see L L ROASP.com: Serverside SVG server L ROIT Systems: Commercial SVG perl solutions L SVG at the W3C =cut use SVG::XML; use SVG::DOM; use SVG::Extension; use Scalar::Util qw/weaken/; our $AUTOLOAD; my @autosubs = qw( animateMotion animateColor animateTransform circle ellipse rect polyline path polygon line title desc defs altGlyph altGlyphDef altGlyphItem clipPath color-profile cursor definition-src font-face-format font-face-name font-face-src font-face-url foreignObject glyph glyphRef hkern marker mask metadata missing-glyph mpath switch symbol textPath tref tspan view vkern marker textbox flowText style script image a g ); our %autosubs = map { $_ => 1 } @autosubs; #------------------------------------------------------------------------------- sub new { my ( $proto, $name, %attrs ) = @_; my $class = ref($proto) || $proto; my $self = { -name => $name }; foreach my $key ( keys %attrs ) { #handle escapes for special elements such as anchor if ( $key =~ /^-/ ) { if ( $key eq '-href' ) { $self->{'xlink:href'} = $attrs{$key}; $self->{'xlink:type'} = $attrs{-type} if $attrs{-type}; $self->{'xlink:role'} = $attrs{-role} if $attrs{-role}; $self->{'xlink:title'} = $attrs{-title} if $attrs{-title}; $self->{'xlink:show'} = $attrs{-show} if $attrs{-show}; $self->{'xlink:arcrole'} = $attrs{-arcrole} if $attrs{-arcrole}; $self->{'xlink:actuate'} = $attrs{-actuate} if $attrs{-actuate}; next; } } $self->{$key} = $attrs{$key}; } return bless( $self, $class ); } #------------------------------------------------------------------------------- sub release { my $self = shift; foreach my $key ( keys( %{$self} ) ) { next if $key =~ /^-/; if ( ref( $self->{$key} ) =~ /^SVG/ ) { eval { $self->{$key}->release; }; } delete( $self->{$key} ); } return $self; } sub xmlify { my $self = shift; my $ns = $self->{-namespace} || $self->{-docref}->{-namespace} || undef; my $xml = ''; #prep the attributes my %attrs; foreach my $k ( keys( %{$self} ) ) { if ( $k =~ /^-/ ) { next; } if ( ref( $self->{$k} ) eq 'ARRAY' ) { $attrs{$k} = join( ', ', @{ $self->{$k} } ); } elsif ( ref( $self->{$k} ) eq 'HASH' ) { $attrs{$k} = cssstyle( %{ $self->{$k} } ); } elsif ( ref( $self->{$k} ) eq '' ) { $attrs{$k} = $self->{$k}; } } #prep the tag if ( $self->{-comment} ) { $xml .= $self->xmlcomment( $self->{-comment} ); return $xml; } elsif ( $self->{-name} eq 'document' ) { #write the xml header $xml .= $self->xmldecl unless $self->{-inline}; $xml .= $self->xmlpi( $self->{-document}->{-pi} ) if $self->{-document}->{-pi}; #and write the dtd if this is inline $xml .= $self->dtddecl unless $self->{-inline}; #rest of the xml foreach my $k ( @{ $self->{-childs} } ) { if ( ref($k) =~ /^SVG::Element/ ) { $xml .= $k->xmlify($ns); } } return $xml; } my $is_cdataish = defined $self->{-cdata} || defined $self->{-CDATA} || defined $self->{-cdata_noxmlesc}; if ( defined $self->{-childs} || $is_cdataish ) { $xml .= $self->{-docref}->{-elsep} unless ( $self->{-inline} && $self->{-name} ); $xml .= $self->{-docref}->{-indent} x $self->{-docref}->{-level}; $xml .= xmltagopen_ln( $self->{-name}, $ns, %attrs ); $self->{-docref}->{-level}++; foreach my $k ( @{ $self->{-childs} } ) { if ( ref($k) =~ /^SVG::Element/ ) { $xml .= $k->xmlify($ns); } } if ( defined $self->{-cdata} ) { $xml .= $self->xmlescp( $self->{-cdata} ); } if ( defined $self->{-CDATA} ) { $xml .= '' . $self->{-CDATA} . ''; } if ( defined $self->{-cdata_noxmlesc} ) { $xml .= $self->{-cdata_noxmlesc}; } #return without writing the tag out if it the document tag $self->{-docref}->{-level}--; unless ($is_cdataish) { $xml .= $self->{-docref}->{-elsep}; $xml .= $self->{-docref}->{-indent} x $self->{-docref}->{-level}; } $xml .= xmltagclose_ln( $self->{-name}, $ns ); } else { $xml .= $self->{-docref}->{-elsep}; $xml .= $self->{-docref}->{-indent} x $self->{-docref}->{-level}; $xml .= xmltag_ln( $self->{-name}, $ns, %attrs ); } #return the finished tag return $xml; } sub perlify { my $self = shift; my $code = ''; #prep the attributes my %attrs; foreach my $k ( keys( %{$self} ) ) { next if $k =~ /^-/; if ( ref( $self->{$k} ) eq 'ARRAY' ) { $attrs{$k} = join( ', ', @{ $self->{$k} } ); } elsif ( ref( $self->{$k} ) eq 'HASH' ) { $attrs{$k} = cssstyle( %{ $self->{$k} } ); } elsif ( ref( $self->{$k} ) eq '' ) { $attrs{$k} = $self->{$k}; } } if ( $self->{-comment} ) { $code .= "->comment($self->{-comment})"; return $code; } elsif ( $self->{-pi} ) { $code .= "->pi($self->{-pi})"; return $code; } elsif ( $self->{-name} eq 'document' ) { #write the xml header #$xml .= $self->xmldecl; #and write the dtd if this is inline #$xml .= $self->dtddecl unless $self->{-inline}; foreach my $k ( @{ $self->{-childs} } ) { if ( ref($k) =~ /^SVG::Element/ ) { $code .= $k->perlify(); } } return $code; } if ( defined $self->{-childs} ) { $code .= $self->{-docref}->{-elsep}; $code .= $self->{-docref}->{-indent} x $self->{-docref}->{-level}; $code .= $self->{-name} . '(' . ( join ', ', ( map {"$_=>'$attrs{$_}'"} sort keys %attrs ) ) . ')'; if ( $self->{-cdata} ) { $code .= "->cdata($self->{-cdata})"; } elsif ( $self->{-CDATA} ) { $code .= "->CDATA($self->{-CDATA})"; } elsif ( $self->{-cdata_noxmlesc} ) { $code .= "->cdata_noxmlesc($self->{-cdata_noxmlesc})"; } $self->{-docref}->{-level}++; foreach my $k ( @{ $self->{-childs} } ) { if ( ref($k) =~ /^SVG::Element/ ) { $code .= $k->perlify(); } } $self->{-docref}->{-level}--; } else { $code .= $self->{-docref}->{-elsep}; $code .= $self->{-docref}->{-indent} x $self->{-docref}->{-level}; $code .= $self->{-name} . '(' . ( join ', ', ( map {"$_=>'$attrs{$_}'"} sort keys %attrs ) ) . ')'; } return $code; } *toperl = \&perlify; sub addchilds { my $self = shift; push @{ $self->{-childs} }, @_; return $self; } sub tag { my ( $self, $name, %attrs ) = @_; unless ( $self->{-parent} ) { #traverse down the tree until you find a non-document entry while ( $self->{-document} ) { $self = $self->{-document} } } my $tag = new SVG::Element( $name, %attrs ); #define the element namespace $tag->{-namespace} = $attrs{-namespace} if ( $attrs{-namespace} ); #add the tag to the document element $tag->{-docref} = $self->{-docref}; weaken( $tag->{-docref} ); #create the empty idlist hash ref unless it already exists $tag->{-docref}->{-idlist} = {} unless ( defined $tag->{-docref}->{-idlist} ); #verify that the current id is unique. compain on exception #>>>TBD: add -strictids option to disable this check if desired if ( $tag->{id} ) { if ( $self->getElementByID( $tag->{id} ) ) { $self->error( $tag->{id} => 'ID already exists in document' ); return; } } #add the current id reference to the document id hash if ( defined( $tag->{id} ) ) { $tag->{-docref}->{-idlist}->{ $tag->{id} } = $tag; } #create the empty idlist hash ref unless it already exists $tag->{-docref}->{-elist} = {} unless ( defined $tag->{-docref}->{-elist} ); #create the empty idlist hash ref unless it already exists $tag->{-docref}->{-elist}->{ $tag->{-name} } = [] unless ( defined $tag->{-docref}->{-elist}->{ $tag->{-name} } ); #add the current element ref to the corresponding element-hash array # -elist is a hash of element names. key name is element, content is object ref. # add the reference to $tag to the array of refs that belong to the # key $tag->{-name}. unshift @{ $tag->{-docref}->{-elist}->{ $tag->{-name} } }, $tag; # attach element to the DOM of the document $tag->{-parent} = $self; weaken( $tag->{-parent} ); $tag->{-parentname} = $self->{-name}; $self->addchilds($tag); return ($tag); } *element = \&tag; sub anchor { my ( $self, %attrs ) = @_; my $an = $self->tag( 'a', %attrs ); #$an->{'xlink:href'}=$attrs{-href} if(defined $attrs{-href}); #$an->{'target'}=$attrs{-target} if(defined $attrs{-target}); return ($an); } sub svg { my ( $self, %attrs ) = @_; my $svg = $self->tag( 'svg', %attrs ); $svg->{'height'} = '100%' unless ( $svg->{'height'} ); $svg->{'width'} = '100%' unless ( $svg->{'width'} ); return ($svg); } sub rectangle { my ( $self, %attrs ) = @_; return $self->tag( 'rect', %attrs ); } #sub image { # my ($self,%attrs)=@_; # my $im=$self->tag('image',%attrs); # #$im->{'xlink:href'}=$attrs{-href} if(defined $attrs{-href}); # return $im; #} sub use { my ( $self, %attrs ) = @_; my $u = $self->tag( 'use', %attrs ); $u->{'xlink:href'} = $attrs{-href} if ( defined $attrs{-href} ); return $u; } sub text { my ( $self, %attrs ) = @_; my $pre = ''; $pre = $attrs{-type} || 'std'; my %get_pre = ( std => 'text', path => 'textPath', span => 'tspan', ); $pre = $get_pre{ lc($pre) }; my $text = $self->tag( $pre, %attrs ); $text->{'xlink:href'} = $attrs{-href} if ( defined $attrs{-href} ); $text->{'target'} = $attrs{-target} if ( defined $attrs{-target} ); return ($text); } sub comment { my ( $self, @text ) = @_; my $tag = $self->tag('comment'); $tag->{-comment} = [@text]; return $tag; } sub pi { my ( $self, @text ) = @_; return $self->{-document}->{-pi} unless scalar @text; my @pi; @pi = @{ $self->{-document}->{-pi} } if $self->{-document}->{-pi}; unshift( @text, @pi ) if @pi; $self->{-document}->{-pi} = \@text; my $tag = $self->tag('pi'); return $tag; } =pod =head2 get_path Documented as L. =cut sub get_path { my ( $self, %attrs ) = @_; my $type = $attrs{-type} || 'path'; my @x = @{ $attrs{x} }; my @y = @{ $attrs{y} }; my $points; # we need a path-like point string returned if ( lc($type) eq 'path' ) { my $char = 'M'; $char = ' m ' if ( defined $attrs{-relative} && lc( $attrs{-relative} ) ); while (@x) { #scale each value my $x = shift @x; my $y = shift @y; #append the scaled value to the graph $points .= "$char $x $y "; $char = ' L '; $char = ' l ' if ( defined $attrs{-relative} && lc( $attrs{-relative} ) ); } $points .= ' z ' if ( defined $attrs{-closed} && lc( $attrs{-closed} ) ); my %out = ( d => $points ); return \%out; } elsif ( lc($type) =~ /^poly/ ) { while (@x) { #scale each value my $x = shift @x; my $y = shift @y; #append the scaled value to the graph $points .= "$x,$y "; } } my %out = ( points => $points ); return \%out; } sub make_path { my ( $self, %attrs ) = @_; return get_path(%attrs); } sub set_path { my ( $self, %attrs ) = @_; return get_path(%attrs); } sub animate { my ( $self, %attrs ) = @_; my %rtr = %attrs; my $method = $rtr{'-method'}; # Set | Transform | Motion | Color $method = lc($method); # we do not want this to pollute the generation of the tag delete $rtr{-method}; #bug report from briac. my %animation_method = ( transform => 'animateTransform', motion => 'animateMotion', color => 'animateColor', set => 'set', attribute => 'animate', ); my $name = $animation_method{$method} || 'animate'; #list of legal entities for each of the 5 methods of animations my %legal = ( animate => q{ begin dur end min max restart repeatCount repeatDur fill attributeType attributeName additive accumulate calcMode values keyTimes keySplines from to by }, animateTransform => q{ begin dur end min max restart repeatCount repeatDur fill additive accumulate calcMode values keyTimes keySplines from to by calcMode path keyPoints rotate origin type attributeName attributeType }, animateMotion => q{ begin dur end min max restart repeatCount repeatDur fill additive accumulate calcMode values to by keyTimes keySplines from path keyPoints rotate origin }, animateColor => q{ begin dur end min max restart repeatCount repeatDur fill additive accumulate calcMode values keyTimes keySplines from to by }, set => q{ begin dur end min max restart repeatCount repeatDur fill to }, ); foreach my $k ( keys %rtr ) { next if ( $k =~ /\-/ ); if ( $legal{$name} !~ /\b$k\b/ ) { $self->error( "$name.$k" => 'Illegal animation command' ); } } return $self->tag( $name, %rtr ); } sub group { my ( $self, %attrs ) = @_; return $self->tag( 'g', %attrs ); } sub STYLE { my ( $self, %attrs ) = @_; $self->{style} = $self->{style} || {}; foreach my $k ( keys %attrs ) { $self->{style}->{$k} = $attrs{$k}; } return $self; } sub mouseaction { my ( $self, %attrs ) = @_; $self->{mouseaction} = $self->{mouseaction} || {}; foreach my $k ( keys %attrs ) { $self->{mouseaction}->{$k} = $attrs{$k}; } return $self; } sub attrib { my ( $self, $name, $val ) = @_; #verify that the current id is unique. compain on exception if ( $name eq 'id' ) { if ( $self->getElementByID($val) ) { $self->error( $val => 'ID already exists in document' ); return; } } if ( not defined $val ) { if ( scalar(@_) == 2 ) { # two arguments only - retrieve return $self->{$name}; } else { # 3rd argument is undef - delete delete $self->{$name}; } } else { # 3 defined arguments - set $self->{$name} = $val; } return $self; } *attr = \&attrib; *attribute = \&attrib; sub cdata { my ( $self, @txt ) = @_; $self->{-cdata} = join( ' ', @txt ); return ($self); } sub CDATA { my ( $self, @txt ) = @_; $self->{-CDATA} = join( '\n', @txt ); return ($self); } sub cdata_noxmlesc { my ( $self, @txt ) = @_; $self->{-cdata_noxmlesc} = join( '\n', @txt ); return ($self); } sub filter { my ( $self, %attrs ) = @_; return $self->tag( 'filter', %attrs ); } sub fe { my ( $self, %attrs ) = @_; return 0 unless ( $attrs{'-type'} ); my %allowed = ( blend => 'feBlend', colormatrix => 'feColorMatrix', componenttrans => 'feComponentTrans', Componenttrans => 'feComponentTrans', composite => 'feComposite', convolvematrix => 'feConvolveMatrix', diffuselighting => 'feDiffuseLighting', displacementmap => 'feDisplacementMap', distantlight => 'feDistantLight', flood => 'feFlood', funca => 'feFuncA', funcb => 'feFuncB', funcg => 'feFuncG', funcr => 'feFuncR', gaussianblur => 'feGaussianBlur', image => 'feImage', merge => 'feMerge', mergenode => 'feMergeNode', morphology => 'feMorphology', offset => 'feOffset', pointlight => 'fePointLight', specularlighting => 'feSpecularLighting', spotlight => 'feSpotLight', tile => 'feTile', turbulence => 'feTurbulence', ); my $key = lc( $attrs{'-type'} ); my $fe_name = $allowed{ lc($key) } || 'error:illegal_filter_element'; delete $attrs{'-type'}; return $self->tag( $fe_name, %attrs ); } sub pattern { my ( $self, %attrs ) = @_; return $self->tag( 'pattern', %attrs ); } sub set { my ( $self, %attrs ) = @_; return $self->tag( 'set', %attrs ); } sub stop { my ( $self, %attrs ) = @_; return $self->tag( 'stop', %attrs ); } sub gradient { my ( $self, %attrs ) = @_; my $type = $attrs{'-type'} || 'linear'; unless ( $type =~ /^(linear|radial)$/ ) { $type = 'linear'; } delete $attrs{'-type'}; return $self->tag( $type . 'Gradient', %attrs ); } #------------------------------------------------------------------------------- # Internal methods sub error { my ( $self, $command, $error ) = @_; if ( $self->{-docref}->{-raiseerror} ) { die "$command: $error\n"; } elsif ( $self->{-docref}->{-printerror} ) { print STDERR "$command: $error\n"; } $self->{errors}{$command} = $error; } # This AUTOLOAD method is activated when '-auto' is passed to SVG.pm sub autoload { my $self = shift; my ( $package, $sub ) = ( $AUTOLOAD =~ /(.*)::([^:]+)$/ ); if ( $sub eq 'DESTROY' ) { return $self->release(); } else { # the import routine may call us with a tag name involving '-'s my $tag = $sub; $sub =~ tr/-/_/; # N.B.: The \ on \@_ makes sure that the incoming arguments are # used and not the ones passed when the subroutine was created. # eval "sub $package\:\:$sub (\$;\@) { return shift->tag('$tag',\@_) }"; #per rt.perl.org comment by slaven. if ( !$package->can($sub) ) { ## no critic (TestingAndDebugging::ProhibitNoStrict) no strict 'refs'; *{ $package . '::' . $sub } = sub { return shift->tag( $tag, @_ ) }; } return $self->$sub(@_) if $self; } } #------------------------------------------------------------------------------- # GD Routines sub colorAllocate { my ( $self, $red, $green, $blue ) = @_; return 'rgb(' . int($red) . ',' . int($green) . ',' . int($blue) . ')'; } #------------------------------------------------------------------------------- 1; �����SVG-2.84/lib/SVG/Extension.pm�����������������������������������������������������������������������0000644�0001750�0001750�00000026501�13242534721�015170� 0����������������������������������������������������������������������������������������������������ustar �manwar��������������������������manwar�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������package SVG::Extension; use strict; use warnings; our $VERSION = '2.84'; =head1 NAME SVG::Extension - additional methods =cut # although DTD declarations are not elements, we use the same API so we can # manipulate the internal DTD subset using the same methods available for # elements. At this state, all extensions are the same object class, but # may be subclassed in the future to e.g. SVG::Extension::ELEMENT. Use # e.g. isElementDecl() to determine types; this API will be retained # irrespective. use parent qw/SVG::Element/; # DTD declarations handled in this module use constant ELEMENT => 'ELEMENT'; use constant ATTLIST => 'ATTLIST'; use constant NOTATION => 'NOTATION'; use constant ENTITY => 'ENTITY'; our @TYPES = ( ELEMENT, ATTLIST, NOTATION, ENTITY ); our %TYPES = map { $_ => 1 } @TYPES; #----------------- sub new { return shift->SUPER::new(@_); } sub internal_subset { my $self = shift; my $document = $self->{-docref}; unless ( exists $document->{-internal} ) { $document->{-internal} = new SVG::Extension('internal'); $document->{-internal}{-docref} = $document; } return $document->{-internal}; } =head2 extension return the element object =cut sub extension { my $self = shift; my $class = ref($self) || $self; return bless $self->SUPER::element(@_), $class; } #----------------- =head2 element_decl generate an element declaration in the DTD =cut sub element_decl { my ( $self, %attrs ) = @_; my $subset = $self->internal_subset(); return $subset->extension( 'ELEMENT', %attrs ); } =head2 attribute_decl return generate an attribute list for an element =cut sub attribute_decl { my ( $element_decl, %attrs ) = @_; unless ( $element_decl->getElementType eq 'ELEMENT' ) { $element_decl->error( $element_decl => 'is not an ELEMENT declaration' ); return; } return $element_decl->extension( 'ATTLIST', %attrs ); } =head2 attlist_decl =cut sub attlist_decl { my ( $self, %attrs ) = @_; my $subset = $self->internal_subset(); my $element_decl = $subset->getElementDeclByName( $attrs{name} ); unless ($element_decl) { $subset->error( "ATTLIST declaration '$attrs{attr}'" => "ELEMENT declaration '$attrs{name}' does not exist" ); return; } return $element_decl->attribute_decl(%attrs); } =head2 notation_decl(%attrs) return an extension object of type NOTATION =cut sub notation_decl { my ( $self, %attrs ) = @_; my $subset = $self->internal_subset(); return $subset->extension( 'NOTATION', %attrs ); } =head2 entity_decl(%attrs) return an extension object of type 'ENTITY' =cut sub entity_decl { my ( $self, %attrs ) = @_; my $subset = $self->internal_subset(); return $subset->extension( 'ENTITY', %attrs ); } #----------------- # this interim version of xmlify handles the vanilla extension # format of one parent 'internal' element containing a list of # extension elements. A hierarchical model will follow in time # with the same render API. =head2 xmilfy =cut sub xmlify { my $self = shift; my $decl = q{}; if ( $self->{-name} ne 'internal' ) { $decl = '{-name} ) { /^ELEMENT$/ and do { $decl .= "ELEMENT $self->{name}"; $decl .= q{ } . $self->{model} if exists $self->{model}; last SWITCH; }; /^ATTLIST$/ and do { $decl .= "ATTLIST $self->{name} $self->{attr}"; $decl .= " $self->{type} " . ( $self->{fixed} ? '#FIXED ' : q{} ) . $self->{default}; last SWITCH; }; /^NOTATION$/ and do { $decl .= "NOTATION $self->{name}"; $decl .= q{ } . $self->{base} if exists $self->{base}; if ( exists $self->{pubid} ) { $decl .= "PUBLIC $self->{pubid} "; $decl .= q{ } . $self->{sysid} if exists $self->{sysid}; } elsif ( exists $self->{sysid} ) { $decl .= ' SYSTEM ' . $self->{sysid} if exists $self->{sysid}; } last SWITCH; }; /^ENTITY$/ and do { $decl .= 'ENTITY ' . ( $self->{isp} ? '% ' : q{} ) . $self->{name}; if ( exists $self->{value} ) { $decl .= ' "' . $self->{value} . '"'; } elsif ( exists $self->{pubid} ) { $decl .= "PUBLIC $self->{pubid} "; $decl .= q{ } . $self->{sysid} if exists $self->{sysid}; $decl .= q{ } . $self->{ndata} if $self->{ndata}; } else { $decl .= ' SYSTEM ' . $self->{sysid} if exists $self->{sysid}; $decl .= q{ } . $self->{ndata} if $self->{ndata}; } last SWITCH; DEFAULT: # we don't know what this is, but the underlying parser allowed it $decl .= "$self->{-name} $self->{name}"; }; } $decl .= '>' . $self->{-docref}{-elsep}; } my $result = q{}; if ( $self->hasChildren ) { $self->{-docref}->{-level}++; foreach my $child ( $self->getChildren ) { $result .= ( $self->{-docref}{-indent} x $self->{-docref}->{-level} ) . $child->render(); } $self->{-docref}->{-level}--; } return $decl . $result; } #some aliases for xmilfy =head2 render alias for xmlify =head2 to_xml alias for xmlify =head2 serialise alias for xmlify =head2 serialise alias for xmlify =cut *render = \&xmlify; *to_xml = \&xmlify; *serialise = \&xmlify; *serialize = \&xmlify; #----------------- =head2 getDeclName Simply an alias for the general method for SVG::Extension objects =head2 getExtensionName alias to getDeclName =cut # simply an alias for the general method for SVG::Extension objects sub getDeclName { return shift->SUPER::getElementName(); } *getExtensionName = \&getDeclName; =head2 getDeclNames return list of existing decl types by extracting it from the overall list of existing element types sub getDeclNames { =head2 getExtensionNames alias to getDeclNames =cut # return list of existing decl types by extracting it from the overall list # of existing element types sub getDeclNames { my $self = shift; return grep { exists $TYPES{$_} } $self->SUPER::getElementNames(); } *getExtensionNames = \&getDeclNames; #----------------- # we can have only one element decl of a given name... sub getElementDeclByName { my ( $self, $name ) = @_; my $subset = $self->internal_subset(); my @element_decls = $subset->getElementsByName('ELEMENT'); foreach my $element_decl (@element_decls) { return $element_decl if $element_decl->{name} eq $name; } return; } # ...but we can have multiple attributes. Note that this searches the master list # which is not what you are likely to want in most cases. See getAttributeDeclByName # (no 's') below, to search for an attribute decl on a particular element decl. # You can use the result of this method along with getParent to find the list of # all element decls that define a given attribute. sub getAttributeDeclsByName { my ( $self, $name ) = @_; my $subset = $self->internal_subset(); my @element_decls = $subset->getElementsByName('ELEMENT'); foreach my $element_decl (@element_decls) { return $element_decl if $element_decl->{name} eq $name; } return; } #----------------- sub getElementDecls { return shift->SUPER::getElements('ELEMENT'); } sub getNotations { return shift->SUPER::getElements('NOTATION'); } *getNotationDecls = \&getNotations; sub getEntities { return shift->SUPER::getElements('ENTITY'); } *getEntityDecls = \&getEntities; sub getAttributeDecls { return shift->SUPER::getElements('ATTLIST'); } #----------------- # until/unless we subclass these, use the name. After (if) we # subclass, will use the object class. sub isElementDecl { return ( shift->getElementName eq ELEMENT ) ? 1 : 0; } sub isNotation { return ( shift->getElementName eq NOTATION ) ? 1 : 0; } sub isEntity { return ( shift->getElementName eq ENTITY ) ? 1 : 0; } sub isAttributeDecl { return ( shift->getElementName eq ATTLIST ) ? 1 : 0; } #----------------- # the Decl 'name' is an attribute, the name is e.g. 'ELEMENT' # use getElementName if you want the actual decl type sub getElementDeclName { my $self = shift; if ( exists $self->{name} ) { return $self->{name}; } return; } # identical to the above; will be smarter as and when we subclass # as above, the name is ATTLIST, the 'name' is a property of the decl sub getAttributeDeclName { my $self = shift; if ( exists $self->{name} ) { return $self->{name}; } return; } # unlike other 'By' methods, attribute searches work from their parent element # del only. Multiple element decls with the same attribute name is more than # likely, so searching the master ATTLIST is not very useful. If you really want # to do that, use getAttributeDeclsByName (with an 's') above. sub getAttributeDeclByName { my ( $self, $name ) = @_; my @attribute_decls = $self->getElementAttributeDecls(); foreach my $attribute_decl (@attribute_decls) { return $attribute_decl if $attribute_decl->{name} eq $name; } return; } # as this is element specific, we allow a 'ElementAttribute' name too, # for those that like consistency at the price of brevity. Not that # the shorter name is all that brief to start with... *getElementAttributeDeclByName = \&getAttributeDeclByName; # ...and for those who live their brevity: *getAttributeDecl = \&getAttributeDeclByName; sub hasAttributeDecl { return ( shift->getElementDeclByName(shift) ) ? 1 : 0; } #----------------- # directly map to Child/Siblings: we presume this is being called from an # element decl. You can use 'getChildIndex', 'getChildAtIndex' etc. as well sub getElementAttributeAtIndex { my ( $self, $index, @children ) = @_; return $self->SUPER::getChildAtIndex( $index, @children ); } sub getElementAttributeIndex { return shift->SUPER::getChildIndex(@_); } sub getFirstAttributeDecl { return shift->SUPER::getFirstChild(); } sub getNextAttributeDecl { return shift->SUPER::getNextSibling(); } sub getLastAttributeDecl { return shift->SUPER::getLastChild(); } sub getPreviousAttributeDecl { return shift->SUPER::getPreviousSibling(); } sub getElementAttributeDecls { return shift->SUPER::getChildren(); } #------------------------------------------------------------------------------- # These methods are slated for inclusion in a future release of SVG.pm. They # will allow programmatic advance determination of the validity of various DOM # manipulations. If you are in a hurry for this feature, get in touch! # # example: # if ($svg_object->allowsElement("symbol")) { ... } # #package SVG::Element; # #sub allowedElements {} #sub allowedAttributes {} # #sub allowsElement {} #sub allowsAttribute {} # #------------------------------------------------------------------------------- 1; �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������SVG-2.84/lib/SVG.pm���������������������������������������������������������������������������������0000644�0001750�0001750�00000123010�13242534721�013205� 0����������������������������������������������������������������������������������������������������ustar �manwar��������������������������manwar�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������package SVG; use strict; use warnings; use SVG::XML; use parent qw(SVG::Element SVG::Extension); use Scalar::Util qw/weaken/; our $VERSION = '2.84'; =pod =encoding UTF-8 =head1 NAME SVG - Perl extension for generating Scalable Vector Graphics (SVG) documents. =head1 SYNOPSIS #!/usr/bin/perl use strict; use warnings; use SVG; # create an SVG object my $svg= SVG->new( width => 200, height => 200); # use explicit element constructor to generate a group element my $y = $svg->group( id => 'group_y', style => { stroke => 'red', fill => 'green' }, ); # add a circle to the group $y->circle( cx => 100, cy => 100, r => 50, id => 'circle_in_group_y' ); # or, use the generic 'tag' method to generate a group element by name my $z = $svg->tag('g', id => 'group_z', style => { stroke => 'rgb(100,200,50)', fill => 'rgb(10,100,150)' } ); # create and add a circle using the generic 'tag' method $z->tag('circle', cx => 50, cy => 50, r => 100, id => 'circle_in_group_z'); # create an anchor on a rectangle within a group within the group z my $k = $z->anchor( id => 'anchor_k', -href => 'http://test.hackmare.com/', target => 'new_window_0' )->rectangle( x => 20, y => 50, width => 20, height => 30, rx => 10, ry => 5, id => 'rect_k_in_anchor_k_in_group_z' ); # now render the SVG object, implicitly use svg namespace print $svg->xmlify; # or render a child node of the SVG object without rendering the entire object print $k->xmlify; #renders the anchor $k above containing a rectangle, but does not #render any of the ancestor nodes of $k # or, explicitly use svg namespace and generate a document with its own DTD print $svg->xmlify(-namespace=>'svg'); # or, explicitly use svg namespace and generate an inline docunent print $svg->xmlify( -namespace => "svg", -pubid => "-//W3C//DTD SVG 1.0//EN", -inline => 1 ); See the other modules in this distribution: L, L, L, L, L =head2 Converting SVG to PNG and other raster image formats The B command of L (also via L ) can convert SVG files to PNG and other formats. L can convert SVG to other format. =head1 EXAMPLES examples/circle.pl generates the following image: I am a title That you can either embed directly into HTML or can include it using: =for HTML

SVG example circle

(The image was converted to png using L. See the svg2png.pl script in the examples directory.) =for HTML

SVG example circle

See also the B directory in this distribution which contain several fully documented examples. =head1 DESCRIPTION SVG is a 100% Perl module which generates a nested data structure containing the DOM representation of an SVG (Scalable Vector Graphics) image. Using SVG, you can generate SVG objects, embed other SVG instances into it, access the DOM object, create and access javascript, and generate SMIL animation content. =head2 General Steps to generating an SVG document Generating SVG is a simple three step process: =over 4 =item 1 Construct a new SVG object with L<"new">. =item 2 Call element constructors such as L<"circle"> and L<"path"> to create SVG elements. =item 3 Render the SVG object into XML using the L<"xmlify"> method. =back The L<"xmlify"> method takes a number of optional arguments that control how SVG renders the object into XML, and in particular determine whether a standalone SVG document or an inline SVG document fragment is generated: =head2 -standalone A complete SVG document with its own associated DTD. A namespace for the SVG elements may be optionally specified. =head2 -inline An inline SVG document fragment with no DTD that be embedded within other XML content. As with standalone documents, an alternate namespace may be specified. No XML content is generated until the third step is reached. Up until this point, all constructed element definitions reside in a DOM-like data structure from which they can be accessed and modified. =head2 EXPORTS None. However, SVG permits both options and additional element methods to be specified in the import list. These options and elements are then available for all SVG instances that are created with the L<"new"> constructor. For example, to change the indent string to two spaces per level: use SVG (-indent => " "); With the exception of -auto, all options may also be specified to the L<"new"> constructor. The currently supported options and their default value are: # processing options -auto => 0, # permit arbitrary autoloading of all unrecognised elements -printerror => 1, # print error messages to STDERR -raiseerror => 1, # die on errors (implies -printerror) # rendering options -indent => "\t", # what to indent with -elsep => "\n", # element line (vertical) separator # (note that not all agents ignor trailing blanks) -nocredits => 0, # enable/disable credit note comment -namespace => '', # The root element's (and it's children's) namespace prefix # XML and Doctype declarations -inline => 0, # inline or stand alone -docroot => 'svg', # The document's root element -version => '1.0', -extension => '', -encoding => 'UTF-8', -xml_svg => 'http://www.w3.org/2000/svg', # the svg xmlns attribute -xml_xlink => 'http://www.w3.org/1999/xlink', # the svg tag xmlns:xlink attribute -standalone => 'yes', -pubid => "-//W3C//DTD SVG 1.0//EN", # formerly -identifier -sysid => 'http://www.w3.org/TR/2001/REC-SVG-20010904/DTD/svg10.dtd', # the system id SVG also allows additional element generation methods to be specified in the import list. For example to generate 'star' and 'planet' element methods: use SVG qw(star planet); or: use SVG ("star","planet"); This will add 'star' to the list of elements supported by SVG.pm (but not of course other SVG parsers...). Alternatively the '-auto' option will allow any unknown method call to generate an element of the same name: use SVG (-auto => 1, "star", "planet"); Any elements specified explicitly (as 'star' and 'planet' are here) are predeclared; other elements are defined as and when they are seen by Perl. Note that enabling '-auto' effectively disables compile-time syntax checking for valid method names. use SVG ( -auto => 0, -indent => " ", -raiseerror => 0, -printerror => 1, "star", "planet", "moon" ); =head2 Default SVG tag The Default SVG tag will generate the following XML: $svg = SVG->new; print $svg->xmlify; Resulting XML snippet: =head1 METHODS SVG provides both explicit and generic element constructor methods. Explicit generators are generally (with a few exceptions) named for the element they generate. If a tag method is required for a tag containing hyphens, the method name replaces the hyphen with an underscore. ie: to generate tag you would use method $svg->column_heading(id=>'new'). All element constructors take a hash of element attributes and options; element attributes such as 'id' or 'border' are passed by name, while options for the method (such as the type of an element that supports multiple alternate forms) are passed preceded by a hyphen, e.g '-type'. Both types may be freely intermixed; see the L<"fe"> method and code examples throughout the documentation for more examples. =head2 new (constructor) $svg = SVG->new(%attributes) Creates a new SVG object. Attributes of the document SVG element be passed as an optional list of key value pairs. Additionally, SVG options (prefixed with a hyphen) may be set on a per object basis: my $svg1 = SVG->new; my $svg2 = SVG->new(id => 'document_element'); my $svg3 = SVG->new( -printerror => 1, -raiseerror => 0, -indent => ' ', -docroot => 'svg', #default document root element (SVG specification assumes svg). Defaults to 'svg' if undefined -sysid => 'abc', #optional system identifyer -pubid => "-//W3C//DTD SVG 1.0//EN", #public identifyer default value is "-//W3C//DTD SVG 1.0//EN" if undefined -namespace => 'mysvg', -inline => 1 id => 'document_element', width => 300, height => 200, ); BsvgE> root element.> Default SVG options may also be set in the import list. See L<"EXPORTS"> above for more on the available options. Furthermore, the following options: -version -encoding -standalone -namespace Defines the document or element level namespace. The order of assignment priority is element,document . -inline -identifier -nostub -dtd (standalone) may also be set in xmlify, overriding any corresponding values set in the SVG->new declaration =head2 xmlify (alias: to_xml render serialise serialize) $string = $svg->xmlify(%attributes); Returns xml representation of svg document. B Name Default Value -version '1.0' -encoding 'UTF-8' -standalone 'yes' -namespace 'svg' - namespace for elements -inline '0' - If '1', then this is an inline document. -pubid '-//W3C//DTD SVG 1.0//EN'; -dtd (standalone) 'http://www.w3.org/TR/2001/REC-SVG-20010904/DTD/svg10.dtd' =head2 tag (alias: element) $tag = $svg->tag($name, %attributes) Generic element generator. Creates the element named $name with the attributes specified in %attributes. This method is the basis of most of the explicit element generators. my $tag = $svg->tag('g', transform=>'rotate(-45)'); =head2 anchor $tag = $svg->anchor(%attributes) Generate an anchor element. Anchors are put around objects to make them 'live' (i.e. clickable). It therefore requires a drawn object or group element as a child. =head3 optional anchor attributes the following attributes are expected for anchor tags (any any tags which use -href links): =head2 -href required =head2 -type optional =head2 -role optional =head2 -title optional =head2 -show optional =head2 -arcrole optional =head2 -actuate optional =head2 target optional For more information on the options, refer to the w3c XLink specification at L B # generate an anchor $tag = $SVG->anchor( -href=>'http://here.com/some/simpler/SVG.SVG' -title => 'new window 2 example title', -actuate => 'onLoad', -show=> 'embed', ); for more information about the options above, refer to Link section in the SVG recommendation: L # add a circle to the anchor. The circle can be clicked on. $tag->circle(cx => 10, cy => 10, r => 1); # more complex anchor with both URL and target $tag = $SVG->anchor( -href => 'http://somewhere.org/some/other/page.html', target => 'new_window' ); # generate an anchor $tag = $svg->anchor( -href=>'http://here.com/some/simpler/svg.svg' ); # add a circle to the anchor. The circle can be clicked on. $tag->circle(cx => 10, cy => 10, r => 1); # more complex anchor with both URL and target $tag = $svg->anchor( -href => 'http://somewhere.org/some/other/page.html', target => 'new_window' ); =head2 circle $tag = $svg->circle(%attributes) Draw a circle at (cx,cy) with radius r. my $tag = $svg->circle(cx => 4, cy => 2, r => 1); =head2 ellipse $tag = $svg->ellipse(%attributes) Draw an ellipse at (cx,cy) with radii rx,ry. use SVG; # create an SVG object my $svg= SVG->new( width => 200, height => 200); my $tag = $svg->ellipse( cx => 10, cy => 10, rx => 5, ry => 7, id => 'ellipse', style => { 'stroke' => 'red', 'fill' => 'green', 'stroke-width' => '4', 'stroke-opacity' => '0.5', 'fill-opacity' => '0.2', } ); See The B =for HTML

SVG example ellipse

=head2 rectangle (alias: rect) $tag = $svg->rectangle(%attributes) Draw a rectangle at (x,y) with width 'width' and height 'height' and side radii 'rx' and 'ry'. $tag = $svg->rectangle( x => 10, y => 20, width => 4, height => 5, rx => 5.2, ry => 2.4, id => 'rect_1' ); =head2 image $tag = $svg->image(%attributes) Draw an image at (x,y) with width 'width' and height 'height' linked to image resource '-href'. See also L<"use">. $tag = $svg->image( x => 100, y => 100, width => 300, height => 200, '-href' => "image.png", #may also embed SVG, e.g. "image.svg" id => 'image_1' ); B =head2 use $tag = $svg->use(%attributes) Retrieve the content from an entity within an SVG document and apply it at (x,y) with width 'width' and height 'height' linked to image resource '-href'. $tag = $svg->use( x => 100, y => 100, width => 300, height => 200, '-href' => "pic.svg#image_1", id => 'image_1' ); B According to the SVG specification, the 'use' element in SVG can point to a single element within an external SVG file. =head2 polygon $tag = $svg->polygon(%attributes) Draw an n-sided polygon with vertices at points defined by a string of the form 'x1,y1,x2,y2,x3,y3,... xy,yn'. The L<"get_path"> method is provided as a convenience to generate a suitable string from coordinate data. # a five-sided polygon my $xv = [0, 2, 4, 5, 1]; my $yv = [0, 0, 2, 7, 5]; my $points = $svg->get_path( x => $xv, y => $yv, -type =>'polygon' ); my $poly = $svg->polygon( %$points, id => 'pgon1', style => \%polygon_style ); SEE ALSO: L<"polyline">, L<"path">, L<"get_path">. =head2 polyline $tag = $svg->polyline(%attributes) Draw an n-point polyline with points defined by a string of the form 'x1,y1,x2,y2,x3,y3,... xy,yn'. The L<"get_path"> method is provided as a convenience to generate a suitable string from coordinate data. # a 10-pointsaw-tooth pattern my $xv = [0, 1, 2, 3, 4, 5, 6, 7, 8, 9]; my $yv = [0, 1, 0, 1, 0, 1, 0, 1, 0, 1]; my $points = $svg->get_path( x => $xv, y => $yv, -type => 'polyline', -closed => 'true' #specify that the polyline is closed. ); my $tag = $svg->polyline ( %$points, id =>'pline_1', style => { 'fill-opacity' => 0, 'stroke' => 'rgb(250,123,23)' } ); =head2 line $tag = $svg->line(%attributes) Draw a straight line between two points (x1,y1) and (x2,y2). my $tag = $svg->line( id => 'l1', x1 => 0, y1 => 10, x2 => 10, y2 => 0, ); To draw multiple connected lines, use L<"polyline">. =head2 text $text = $svg->text(%attributes)->cdata(); $text_path = $svg->text(-type=>'path'); $text_span = $text_path->text(-type=>'span')->cdata('A'); $text_span = $text_path->text(-type=>'span')->cdata('B'); $text_span = $text_path->text(-type=>'span')->cdata('C'); Define the container for a text string to be drawn in the image. B -type = path type (path | polyline | polygon) -type = text element type (path | span | normal [default]) my $text1 = $svg->text( id => 'l1', x => 10, y => 10 )->cdata('hello, world'); my $text2 = $svg->text( id => 'l1', x => 10, y => 10, -cdata => 'hello, world', ); my $text = $svg->text( id => 'tp', x => 10, y => 10, -type => path, ) ->text(id=>'ts' -type=>'span') ->cdata('hello, world'); SEE ALSO: L<"desc">, L<"cdata">. =head2 title $tag = $svg->title(%attributes) Generate the title of the image. my $tag = $svg->title(id=>'document-title')->cdata('This is the title'); =head2 desc $tag = $svg->desc(%attributes) Generate the description of the image. my $tag = $svg->desc(id=>'document-desc')->cdata('This is a description'); =head2 comment $tag = $svg->comment(@comments) Generate the description of the image. my $tag = $svg->comment('comment 1','comment 2','comment 3'); =head2 pi (Processing Instruction) $tag = $svg->pi(@pi) Generate a set of processing instructions my $tag = $svg->pi('instruction one','instruction two','instruction three'); returns: ?instruction one? ?instruction two? ?instruction three? =head2 script $tag = $svg->script(%attributes) Generate a script container for dynamic (client-side) scripting using ECMAscript, Javascript or other compatible scripting language. my $tag = $svg->script(-type=>"text/ecmascript"); #or my $tag = $svg->script(); #note that type ecmascript is not Mozilla compliant # populate the script tag with cdata # be careful to manage the javascript line ends. # Use qq{text} or q{text} as appropriate. # make sure to use the CAPITAL CDATA to poulate the script. $tag->CDATA(qq{ function d() { //simple display function for(cnt = 0; cnt < d.length; cnt++) document.write(d[cnt]);//end for loop document.write("
");//write a line break } }); =head2 path $tag = $svg->path(%attributes) Draw a path element. The path vertices may be provided as a parameter or calculated using the L<"get_path"> method. # a 10-pointsaw-tooth pattern drawn with a path definition my $xv = [0,1,2,3,4,5,6,7,8,9]; my $yv = [0,1,0,1,0,1,0,1,0,1]; $points = $svg->get_path( x => $xv, y => $yv, -type => 'path', -closed => 'true' #specify that the polyline is closed ); $tag = $svg->path( %$points, id => 'pline_1', style => { 'fill-opacity' => 0, 'fill' => 'green', 'stroke' => 'rgb(250,123,23)' } ); SEE ALSO: L<"get_path">. =head2 get_path $path = $svg->get_path(%attributes) Returns the text string of points correctly formatted to be incorporated into the multi-point SVG drawing object definitions (path, polyline, polygon) B attributes including: -type = path type (path | polyline | polygon) x = reference to array of x coordinates y = reference to array of y coordinates B a hash reference consisting of the following key-value pair: points = the appropriate points-definition string -type = path|polygon|polyline -relative = 1 (define relative position rather than absolute position) -closed = 1 (close the curve - path and polygon only) #generate an open path definition for a path. my ($points,$p); $points = $svg->get_path(x=>\@x,y=>\@y,-relative=>1,-type=>'path'); #add the path to the SVG document my $p = $svg->path(%$path, style=>\%style_definition); #generate an closed path definition for a a polyline. $points = $svg->get_path( x=>\@x, y=>\@y, -relative=>1, -type=>'polyline', -closed=>1 ); # generate a closed path definition for a polyline # add the polyline to the SVG document $p = $svg->polyline(%$points, id=>'pline1'); B get_path set_path =head2 animate $tag = $svg->animate(%attributes) Generate an SMIL animation tag. This is allowed within any nonempty tag. Refer to the W3C for detailed information on the subtleties of the animate SMIL commands. B -method = Transform | Motion | Color my $an_ellipse = $svg->ellipse( cx => 30, cy => 150, rx => 10, ry => 10, id => 'an_ellipse', stroke => 'rgb(130,220,70)', fill =>'rgb(30,20,50)' ); $an_ellipse-> animate( attributeName => "cx", values => "20; 200; 20", dur => "10s", repeatDur => 'indefinite' ); $an_ellipse-> animate( attributeName => "rx", values => "10;30;20;100;50", dur => "10s", repeatDur => 'indefinite', ); $an_ellipse-> animate( attributeName => "ry", values => "30;50;10;20;70;150", dur => "15s", repeatDur => 'indefinite', ); $an_ellipse-> animate( attributeName=>"rx",values=>"30;75;10;100;20;20;150", dur=>"20s", repeatDur=>'indefinite'); $an_ellipse-> animate( attributeName=>"fill",values=>"red;green;blue;cyan;yellow", dur=>"5s", repeatDur=>'indefinite'); $an_ellipse-> animate( attributeName=>"fill-opacity",values=>"0;1;0.5;0.75;1", dur=>"20s",repeatDur=>'indefinite'); $an_ellipse-> animate( attributeName=>"stroke-width",values=>"1;3;2;10;5", dur=>"20s",repeatDur=>'indefinite'); =head2 group $tag = $svg->group(%attributes) Define a group of objects with common properties. Groups can have style, animation, filters, transformations, and mouse actions assigned to them. $tag = $svg->group( id => 'xvs000248', style => { 'font' => [ qw( Arial Helvetica sans ) ], 'font-size' => 10, 'fill' => 'red', }, transform => 'rotate(-45)' ); =head2 defs $tag = $svg->defs(%attributes) define a definition segment. A Defs requires children when defined using SVG.pm $tag = $svg->defs(id => 'def_con_one',); =head2 style $svg->tag('style', %styledef); Sets/Adds style-definition for the following objects being created. Style definitions apply to an object and all its children for all properties for which the value of the property is not redefined by the child. $tag = $SVG->style(%attributes) Generate a style container for inline or xlink:href based styling instructions my $tag = $SVG->style(type=>"text/css"); # Populate the style tag with cdata. # Be careful to manage the line ends. # Use qq{text}, where text is the script $tag1->CDATA(qq{ rect fill:red;stroke:green; circle fill:red;stroke:orange; ellipse fill:none;stroke:yellow; text fill:black;stroke:none; }); # Create a external CSS stylesheet reference my $tag2 = $SVG->style(type=>"text/css", -href="/resources/example.css"); =pod =head2 mouseaction $svg->mouseaction(%attributes) Sets/Adds mouse action definitions for tag =head2 attrib $svg->attrib($name, $value) Sets/Adds attributes of an element. Retrieve an attribute: $svg->attrib($name); Set a scalar attribute: $SVG->attrib $name, $value Set a list attribute: $SVG->attrib $name, \@value Set a hash attribute (i.e. style definitions): $SVG->attrib $name, \%value Remove an attribute: $svg->attrib($name,undef); B attr attribute Sets/Replaces attributes for a tag. =head2 cdata $svg->cdata($text) Sets cdata to $text. SVG.pm allows you to set cdata for any tag. If the tag is meant to be an empty tag, SVG.pm will not complain, but the rendering agent will fail. In the SVG DTD, cdata is generally only meant for adding text or script content. $svg->text( style => { 'font' => 'Arial', 'font-size' => 20 })->cdata('SVG.pm is a perl module on CPAN!'); my $text = $svg->text( style => { 'font' => 'Arial', 'font-size' => 20 } ); $text->cdata('SVG.pm is a perl module on CPAN!'); B SVG.pm is a perl module on CPAN! SEE ALSO: L<"CDATA">, L<"desc">, L<"title">, L<"text">, L<"script">. =head2 cdata_noxmlesc $script = $svg->script(); $script->cdata_noxmlesc($text); Generates cdata content for text and similar tags which do not get xml-escaped. In othe words, does not parse the content and inserts the exact string into the cdata location. =head2 CDATA $script = $svg->script(); $script->CDATA($text); Generates a tag with the contents of $text rendered exactly as supplied. SVG.pm allows you to set cdata for any tag. If the tag is meant to be an empty tag, SVG.pm will not complain, but the rendering agent will fail. In the SVG DTD, cdata is generally only meant for adding text or script content. my $text = qq{ var SVGDoc; var groups = new Array(); var last_group; /***** * * init * * Find this SVG's document element * Define members of each group by id * *****/ function init(e) { SVGDoc = e.getTarget().getOwnerDocument(); append_group(1, 4, 6); // group 0 append_group(5, 4, 3); // group 1 append_group(2, 3); // group 2 }}; $svg->script()->CDATA($text); B Escript E ![CDATA[ var SVGDoc; var groups = new Array(); var last_group; /***** * * init * * Find this SVG's document element * Define members of each group by id * *****/ function init(e) { SVGDoc = e.getTarget().getOwnerDocument(); append_group(1, 4, 6); // group 0 append_group(5, 4, 3); // group 1 append_group(2, 3); // group 2 } ]]E SEE ALSO: L<"cdata">, L<"script">. =head2 xmlescp and xmlescape $string = $svg->xmlescp($string) $string = $svg->xmlesc($string) $string = $svg->xmlescape($string) SVG module does not xml-escape characters that are incompatible with the XML specification. B and B provides this functionality. It is a helper function which generates an XML-escaped string for reserved characters such as ampersand, open and close brackets, etcetera. The behaviour of xmlesc is to apply the following transformation to the input string $s: $s=~s/&(?!#(x\w\w|\d+?);)/&/g; $s=~s/>/>/g; $s=~s/filter(%attributes) Generate a filter. Filter elements contain L<"fe"> filter sub-elements. my $filter = $svg->filter( filterUnits=>"objectBoundingBox", x=>"-10%", y=>"-10%", width=>"150%", height=>"150%", filterUnits=>'objectBoundingBox' ); $filter->fe(); SEE ALSO: L<"fe">. =head2 fe $tag = $svg->fe(-type=>'type', %attributes) Generate a filter sub-element. Must be a child of a L<"filter"> element. my $fe = $svg->fe( -type => 'DiffuseLighting' # required - element name omitting 'fe' id => 'filter_1', style => { 'font' => [ qw(Arial Helvetica sans) ], 'font-size' => 10, 'fill' => 'red', }, transform => 'rotate(-45)' ); Note that the following filter elements are currently supported: Also note that the elelemts are defined in lower case in the module, but as of version 2.441, any case combination is allowed. =head2 * feBlend =head2 * feColorMatrix =head2 * feComponentTransfer =head2 * feComposite =head2 * feConvolveMatrix =head2 * feDiffuseLighting =head2 * feDisplacementMap =head2 * feDistantLight =head2 * feFlood =head2 * feFuncA =head2 * feFuncB =head2 * feFuncG =head2 * feFuncR =head2 * feGaussianBlur =head2 * feImage =head2 * feMerge =head2 * feMergeNode =head2 * feMorphology =head2 * feOffset =head2 * fePointLight =head2 * feSpecularLighting =head2 * feSpotLight =head2 * feTile =head2 * feTurbulence SEE ALSO: L<"filter">. =head2 pattern $tag = $svg->pattern(%attributes) Define a pattern for later reference by url. my $pattern = $svg->pattern( id => "Argyle_1", width => "50", height => "50", patternUnits => "userSpaceOnUse", patternContentUnits => "userSpaceOnUse" ); =head2 set $tag = $svg->set(%attributes) Set a definition for an SVG object in one section, to be referenced in other sections as needed. my $set = $svg->set( id => "Argyle_1", width => "50", height => "50", patternUnits => "userSpaceOnUse", patternContentUnits => "userSpaceOnUse" ); =head2 stop $tag = $svg->stop(%attributes) Define a stop boundary for L<"gradient"> my $pattern = $svg->stop( id => "Argyle_1", width => "50", height => "50", patternUnits => "userSpaceOnUse", patternContentUnits => "userSpaceOnUse" ); =head2 gradient $tag = $svg->gradient(%attributes) Define a color gradient. Can be of type B or B my $gradient = $svg->gradient( -type => "linear", id => "gradient_1" ); =head1 GENERIC ELEMENT METHODS The following elements are generically supported by SVG: =head2 * altGlyph =head2 * altGlyphDef =head2 * altGlyphItem =head2 * clipPath =head2 * color-profile =head2 * cursor =head2 * definition-src =head2 * font-face-format =head2 * font-face-name =head2 * font-face-src =head2 * font-face-url =head2 * foreignObject =head2 * glyph =head2 * glyphRef =head2 * hkern =head2 * marker =head2 * mask =head2 * metadata =head2 * missing-glyph =head2 * mpath =head2 * switch =head2 * symbol =head2 * tref =head2 * view =head2 * vkern See e.g. L<"pattern"> for an example of the use of these methods. =head1 METHODS IMPORTED BY SVG::DOM The following L elements are accessible through SVG: =head2 * getChildren =head2 * getFirstChild =head2 * getNextChild =head2 * getLastChild =head2 * getParent =head2 * getParentElement =head2 * getSiblings =head2 * getElementByID =head2 * getElementID =head2 * getElements =head2 * getElementName =head2 * getType =head2 * getAttributes =head2 * getAttribute =head2 * setAttributes =head2 * setAttribute =head2 * insertBefore =head2 * insertAfter =head2 * insertSiblingBefore =head2 * insertSiblingAfter =head2 * replaceChild =head2 * removeChild =head2 * cloneNode =cut #------------------------------------------------------------------------------- my %default_attrs = ( # processing options -auto => 0, # permit arbitrary autoloads (only at import) -printerror => 1, # print error messages to STDERR -raiseerror => 1, # die on errors (implies -printerror) # rendering options -indent => "\t", # what to indent with -elsep => "\n", # element line (vertical) separator -nocredits => 0, # enable/disable credit note comment -namespace => '', # The root element's (and it's children's) namespace prefix # XML and Doctype declarations -inline => 0, # inline or stand alone -docroot => 'svg', # The document's root element -version => '1.0', -extension => '', -encoding => 'UTF-8', -xml_svg => 'http://www.w3.org/2000/svg', -xml_xlink => 'http://www.w3.org/1999/xlink', -standalone => 'yes', -pubid => '-//W3C//DTD SVG 1.0//EN', # formerly -identifier -sysid => 'http://www.w3.org/TR/2001/REC-SVG-20010904/DTD/svg10.dtd', ); sub import { my $package = shift; my $attr = undef; foreach (@_) { if ($attr) { $default_attrs{$attr} = $_; undef $attr; } elsif ( exists $default_attrs{$_} ) { $attr = $_; } else { /^-/ and die "Unknown attribute '$_' in import list\n"; $SVG::Element::autosubs{$_} = 1; # add to list of autoloadable tags } } # switch on AUTOLOADer, if asked. if ( $default_attrs{'-auto'} ) { *SVG::Element::AUTOLOAD = \&SVG::Element::autoload; } # predeclare any additional elements asked for by the user foreach my $sub ( keys %SVG::Element::autosubs ) { $SVG::Element::AUTOLOAD = ("SVG::Element::$sub"); SVG::Element::autoload(); } delete $default_attrs{-auto}; # -auto is only allowed here, not in new return (); } #------------------------------------------------------------------------------- =pod =head1 Methods SVG provides both explicit and generic element constructor methods. Explicit generators are generally (with a few exceptions) named for the element they generate. If a tag method is required for a tag containing hyphens, the method name replaces the hyphen with an underscore. ie: to generate tag you would use method $svg->column_heading(id=>'new'). All element constructors take a hash of element attributes and options; element attributes such as 'id' or 'border' are passed by name, while options for the method (such as the type of an element that supports multiple alternate forms) are passed preceded by a hyphen, e.g '-type'. Both types may be freely intermixed; see the L<"fe"> method and code examples throughout the documentation for more examples. =head2 new (constructor) $svg = SVG->new(%attributes) Creates a new SVG object. Attributes of the document SVG element be passed as an optional list of key value pairs. Additionally, SVG options (prefixed with a hyphen) may be set on a per object basis: my $svg1 = SVG->new; my $svg2 = SVG->new(id => 'document_element'); my $svg3 = SVG->new( -printerror => 1, -raiseerror => 0, -indent => ' ', -elsep => "\n", # element line (vertical) separator -docroot => 'svg', # default document root element (SVG specification assumes svg). Defaults to 'svg' if undefined -xml_xlink => 'http://www.w3.org/1999/xlink', # required by Mozilla's embedded SVG engine -sysid => 'abc', # optional system identifier -pubid => "-//W3C//DTD SVG 1.0//EN", # public identifier default value is "-//W3C//DTD SVG 1.0//EN" if undefined -namespace => 'mysvg', -inline => 1 id => 'document_element', width => 300, height => 200, ); Default SVG options may also be set in the import list. See L<"EXPORTS"> above for more on the available options. Furthermore, the following options: -version -encoding -standalone -namespace -inline -pubid (formerly -identifier) -sysid (standalone) may also be set in xmlify, overriding any corresponding values set in the SVG->new declaration =cut #------------------------------------------------------------------------------- # # constructor for the SVG data model. # # the new constructor creates a new data object with a document tag at its base. # this document tag then has either: # a child entry parent with its child svg generated (when -inline = 1) # or # a child entry svg created. # # Because the new method returns the $self reference and not the # latest child to be created, a hash key -document with the reference to the hash # entry of its already-created child. hence the document object has a -document reference # to parent or svg if inline is 1 or 0, and parent will have a -document entry # pointing to the svg child. # # This way, the next tag constructor will descend the # tree until it finds no more tags with -document, and will add # the next tag object there. # refer to the SVG::tag method sub new { my ( $proto, %attrs ) = @_; my $class = ref $proto || $proto; my $self; # establish defaults for unspecified attributes foreach my $attr ( keys %default_attrs ) { $attrs{$attr} = $default_attrs{$attr} unless exists $attrs{$attr}; } $self = $class->SUPER::new('document'); if ( not $self->{-docref} ) { $self->{-docref} = $self; weaken( $self->{-docref} ); } unless ( $attrs{-namespace} ) { $attrs{'xmlns'} = $attrs{'xmlns'} || $attrs{'-xml_svg'}; } $attrs{'xmlns:xlink'} = $attrs{'xmlns:xlink'} || $attrs{'-xml_xlink'} || 'http://www.w3.org/1999/xlink'; $attrs{'xmlns:svg'} = $attrs{'xmlns:svg'} || $attrs{'-xml_svg'} || 'http://www.w3.org/2000/svg'; $self->{-level} = 0; $self->{$_} = $attrs{$_} foreach keys %default_attrs; # create SVG object according to nostub attribute my $svg; unless ( $attrs{-nostub} ) { $svg = $self->svg(%attrs); $self->{-document} = $svg; weaken( $self->{-document} ); } # add -attributes to SVG object # $self->{-elrefs}->{$self}->{name} = 'document'; # $self->{-elrefs}->{$self}->{id} = ''; return $self; } #------------------------------------------------------------------------------- =pod =head2 xmlify (alias: to_xml render serialize serialise ) $string = $svg->xmlify(%attributes); Returns xml representation of svg document. B Name Default Value -version '1.0' -encoding 'UTF-8' -standalone 'yes' -namespace 'svg' - namespace prefix for elements. Can also be used in any element method to over-ride the current namespace prefix. Make sure to have declared the prefix before using it. -inline '0' - If '1', then this is an inline document. -pubid '-//W3C//DTD SVG 1.0//EN'; -sysid 'http://www.w3.org/TR/2001/REC-SVG-20010904/DTD/svg10.dtd' =cut sub xmlify { my ( $self, %attrs ) = @_; my ( $decl, $ns ); my $credits = ''; # Give the module and myself credit unless explicitly turned off unless ( $self->{-docref}->{-nocredits} or $self->{-docref}{-creditsinserted} ) { $self->comment( "\n\tGenerated using the Perl SVG Module V$VERSION\n\tby Ronan Oger\n\tInfo: http://www.roitsystems.com/\n\t" ); $self->{-docref}{-creditsinserted} = 1; } foreach my $key ( keys %attrs ) { next if $key !~ /^-/; $self->{$key} = $attrs{$key}; } foreach my $key ( keys %$self ) { next if $key !~ /^-/; $attrs{$key} ||= $self->{$key}; } return $self->SUPER::xmlify( $self->{-namespace} ); } *render = \&xmlify; *to_xml = \&xmlify; *serialise = \&xmlify; *serialize = \&xmlify; =head2 perlify () return the perl code which generates the SVG document as it currently exists. =cut sub perlify { return shift->SUPER::perlify(); } =head2 toperl () Alias for method perlify() =cut *toperl = \&perlify; 1; =pod =head1 AUTHOR Ronan Oger, RO IT Systemms GmbH, cpan@roitsystems.com =head1 MAINTAINER L =head1 CREDITS I would like to thank the following people for contributing to this module with patches, testing, suggestions, and other nice tidbits: Peter Wainwright, Excellent ideas, beta-testing, writing SVG::Parser and much of SVG::DOM. Fredo, http://www.penguin.at0.net/~fredo/ - provided example code and initial feedback for early SVG.pm versions and the idea of a simplified svg generator. Adam Schneider, Brial Pilpré, Ian Hickson Steve Lihn, Allen Day Martin Owens - SVG::DOM improvements in version 3.34 =head1 COPYRIGHT & LICENSE Copyright 2001- Ronan Oger The modules in the SVG distribution are distributed under the same license as Perl itself. It is provided free of warranty and may be re-used freely. =head1 ARTICLES L L L =head1 SEE ALSO L, L, L, L, L For Commercial Perl/SVG development, refer to the following sites: L, L, L =cut ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������SVG-2.84/Makefile.PL��������������������������������������������������������������������������������0000644�0001750�0001750�00000004203�13242534747�013426� 0����������������������������������������������������������������������������������������������������ustar �manwar��������������������������manwar�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#!/usr/bin/perl use 5.006; use strict; use warnings FATAL => 'all'; use ExtUtils::MakeMaker; WriteMakefile( NAME => 'SVG', VERSION_FROM => 'lib/SVG.pm', PREREQ_PM => { 'strict' => 0, 'warnings' => 0, 'constant' => 0, 'parent' => 0, 'vars' => 0, 'Exporter' => 0, 'Scalar::Util' => 0, }, BUILD_REQUIRES => { 'strict' => 0, 'warnings' => 0, 'ExtUtils::MakeMaker' => 0, 'File::Spec' => 0, 'Test::More' => '0.94', }, CONFIGURE_REQUIRES => { 'perl' => '5.006', 'strict' => 0, 'warnings' => 0, 'ExtUtils::MakeMaker' => 0, }, MIN_PERL_VERSION => 5.006, dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', }, clean => { FILES => 'SVG-*' }, ($] >= 5.005 ? (ABSTRACT_FROM => 'lib/SVG.pm', LICENSE => 'perl', AUTHOR => 'Ronan Oger ') : ()), (eval { ExtUtils::MakeMaker->VERSION(6.46) } ? (META_MERGE => { 'meta-spec' => { version => 2 }, provides => { 'SVG' => { file => 'lib/SVG.pm' , version => '2.84' }, 'SVG::DOM' => { file => 'lib/SVG/DOM.pm' , version => '2.84' }, 'SVG::Element' => { file => 'lib/SVG/Element.pm' , version => '2.84' }, 'SVG::Extension' => { file => 'lib/SVG/Extension.pm', version => '2.84' }, 'SVG::XML' => { file => 'lib/SVG/XML.pm' , version => '2.84' }, }, resources => { repository => { type => 'git', url => 'https://github.com/manwar/SVG.git', web => 'https://github.com/manwar/SVG', }, }, x_contributors => [ 'Peter Wainwright', 'Ian Hickson', 'Adam Schneider', 'Steve Lihn', 'Allen Day', 'Gabor Szabo', 'Mohammad S Anwar', ], }) : () ), ); ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������SVG-2.84/README�������������������������������������������������������������������������������������0000644�0001750�0001750�00000006602�13074467331�012336� 0����������������������������������������������������������������������������������������������������ustar �manwar��������������������������manwar�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������README for SVG.pm SVG.pm is a perl extension to generate standalone or inline SVG (short for "Scalable Vector Graphics") images using the W3C's SVG XML recommendation. Refer to the POD documentation for full documentation and an example script or to the following mirror: https://metacpan.org/module/SVG The complete POD documentation for SVG resides in the SVG module itself - type "perldoc SVG" on the command line. (c) 2001-2008 Ronan Oger, RO IT Systems, GmbH homepage: http://www.roitsystems.com CONTACT POINT ------------- szabgab@cpan.org This software is provided as is and without warranty. It is freely distributed under the general perl license. LICENSE ------- This software is provided under the terms of the Perl license OVERVIEW -------- SVG.pm makes it possible to generate fully-functional SVG images in perl. 100% of the SVG tags are supported, and any new arbitrary element tag can be added by users by declaring it. DOCUMENTATION ------------- The following documentation is available: * POD in perldoc format (type "perldoc SVG" on the command line.) RESOURCES --------- The following URLs offer additional resources for users of SVG.pm: * Perl SVG tutorials http://www.roitsystems.com/tutorial/ * Perl SVG Zone homepage http://www.roitsystems.com/ * gallery of the use of SVG.pm on the web http://roitsystems.com/gallery/svg/index.html * W3 Consortium http://www.w3.org/Graphics/SVG/ * Sams Publishing, "SVG Unleashed", September 2002. There is a Perl chapter * SVG Open Conference proceedings http://www.svgopen.org/ INSTALLATION INSTRUCTIONS ------------------------- ***THERE ARE FOUR WAYS TO INSTALL THE SVG MODULE IN PERL*** 1) Systems with CPAN support (all Windows/Unix/Linux/BSD/Mac): ----------------------------------------------------------- Install the new distribution via the Perl CPAN module: In a shell: /home/somewhere% cpan install SVG You can alternatively use CPANPLUS or cpanm. 2) (Windows) install Perl from ActiveState: ---------------------------------------- Make sure you already have perl or get it here: http://www.activestate.com On the command line: C:\> ppm install SVG 3) Use RPMs: --------- Download the source RPM of your choice. In a shell: /hom/somewhere/% rpm -ihv SVG-source-rpm-name You may be prompted for the root password 4) The hard way (requires make, dmake or nmake, tar, gunzip, and gcc): ------------------------------------------------------------------- This method was tested in DOS, Windows, AS400, Linux, Unix, BSD, Mac. Hard-headed users can directly get the distribution from a CPAN mirror. First download the source. Then, in a shell: /home/somewhere% gunzip SVG-2.27.tar.gz /home/somewhere% tar-xvf SVG-2.27.tar cd SVG-2.1 make make test make install KNOWN BUGS & ISSUES ------------------- Comments tags before the element are toxic. This is being worked on but I can not promise anything. Please submit bug reports to http://rt.cpan.org SEE ALSO -------- SVG::Parser SVG::DOM SVG::XML SVG::Element CHANGE LOG ---------- You can find details about the changes over time in the change log file: Changes COMMENTS/FEEDBACK ----------------- Please email your feedback, comments, questions to the email address at the top of this document. I will do my best to answer promptly. To date, I have not knowingly failed to answer any emails. ������������������������������������������������������������������������������������������������������������������������������SVG-2.84/.perltidyrc��������������������������������������������������������������������������������0000644�0001750�0001750�00000000113�13057520366�013626� 0����������������������������������������������������������������������������������������������������ustar �manwar��������������������������manwar�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������-pbp -nst # Break a line after opening/before closing token. -vt=0 -vtc=0 �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������SVG-2.84/META.json����������������������������������������������������������������������������������0000664�0001750�0001750�00000004317�13242535444�013100� 0����������������������������������������������������������������������������������������������������ustar �manwar��������������������������manwar�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������{ "abstract" : "Perl extension for generating Scalable Vector Graphics (SVG) documents.", "author" : [ "Ronan Oger " ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 7.24, CPAN::Meta::Converter version 2.150005", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "SVG", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "0", "File::Spec" : "0", "Test::More" : "0.94", "strict" : "0", "warnings" : "0" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0", "perl" : "5.006", "strict" : "0", "warnings" : "0" } }, "runtime" : { "requires" : { "Exporter" : "0", "Scalar::Util" : "0", "constant" : "0", "parent" : "0", "perl" : "5.006", "strict" : "0", "vars" : "0", "warnings" : "0" } } }, "provides" : { "SVG" : { "file" : "lib/SVG.pm", "version" : "2.84" }, "SVG::DOM" : { "file" : "lib/SVG/DOM.pm", "version" : "2.84" }, "SVG::Element" : { "file" : "lib/SVG/Element.pm", "version" : "2.84" }, "SVG::Extension" : { "file" : "lib/SVG/Extension.pm", "version" : "2.84" }, "SVG::XML" : { "file" : "lib/SVG/XML.pm", "version" : "2.84" } }, "release_status" : "stable", "resources" : { "repository" : { "type" : "git", "url" : "https://github.com/manwar/SVG.git", "web" : "https://github.com/manwar/SVG" } }, "version" : "2.84", "x_contributors" : [ "Peter Wainwright", "Ian Hickson", "Adam Schneider", "Steve Lihn", "Allen Day", "Gabor Szabo", "Mohammad S Anwar" ], "x_serialization_backend" : "JSON::PP version 2.27400" } �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������SVG-2.84/LICENSE������������������������������������������������������������������������������������0000644�0001750�0001750�00000000227�13057520366�012457� 0����������������������������������������������������������������������������������������������������ustar �manwar��������������������������manwar�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������The modules in the SVG distribution are distributed under the same license as Perl itself. It is provided free of warranty and may be re-used freely. �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������SVG-2.84/.perlcriticrc������������������������������������������������������������������������������0000644�0001750�0001750�00000001540�13057520366�014137� 0����������������������������������������������������������������������������������������������������ustar �manwar��������������������������manwar�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������# please alpha sort config items as you add them severity = 5 verbose = 11 theme = core #[TestingAndDebugging::RequireUseStrict] #equivalent_modules = Moo Dancer Dancer2 #[TestingAndDebugging::RequireUseWarnings] #severity = 5 #equivalent_modules = Moo Dancer Dancer2 #[-ControlStructures::ProhibitPostfixControls] #[-Documentation::RequirePodLinksIncludeText] #[-Documentation::RequirePodSections] #[-Modules::RequireVersionVar] #[-RegularExpressions::RequireDotMatchAnything] #[-RegularExpressions::RequireExtendedFormatting] #[-RegularExpressions::RequireLineBoundaryMatching] #[-Variables::ProhibitPunctuationVars] # [CodeLayout::RequireTrailingCommas] severity = 5 #[ValuesAndExpressions::ProhibitEmptyQuotes] #severity = 5 [ValuesAndExpressions::ProhibitInterpolationOfLiterals] severity = 5 #[ValuesAndExpressions::ProhibitNoisyQuotes] #severity = 5 ����������������������������������������������������������������������������������������������������������������������������������������������������������������SVG-2.84/MANIFEST�����������������������������������������������������������������������������������0000644�0001750�0001750�00000002535�13242535444�012606� 0����������������������������������������������������������������������������������������������������ustar �manwar��������������������������manwar�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������.perlcriticrc .perltidyrc .tidyallrc Changes examples/01_circle.pl examples/02_circle_with_color.pl examples/03_circle_and_square.pl examples/attributeManip.pl examples/circle.pl examples/ellipse.pl examples/image_sample.pl examples/inline_sample.pl examples/inlinesvg.pl examples/minsvg.pl examples/starpath.cgi examples/sun_text_sample.pl examples/svg.psgi examples/svg2png.pl examples/SVG_02_sample.pl examples/svg_dom_sample.pl examples/svgtest2.pl examples/yaph5.cgi lib/SVG.pm lib/SVG/DOM.pm lib/SVG/Element.pm lib/SVG/Extension.pm lib/SVG/XML.pm LICENSE Makefile.PL MANIFEST This list of files README t/00-report-prereqs.t t/00-load.t t/01-loadsvg.t t/03-render.t t/04-inline.t t/05-processinginstruction.t t/06-doctype.t t/07-extension.t t/08-looknfeel.t t/09-script.t t/10-autoload.t t/11-customtags.t t/12-elementid.t t/13-duplicateids.t t/14-attributes.t t/15-parentage.t t/16-siblings.t t/17-tagtypes.t t/18-filter.t t/19-style.t t/20-anchor.t t/21-polygon.t t/22-xlink.t t/23-xmlescape.t t/30-shapes.t t/duplicate_credits.t xt/author/perl-critic.t xt/author/perl-critic-tidy.t xt/author/pod-coverage.t xt/author/pod-syntax.t xt/author/tidyall.t xt/release/meta-json.t xt/release/meta-yml.t META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) �������������������������������������������������������������������������������������������������������������������������������������������������������������������SVG-2.84/examples/����������������������������������������������������������������������������������0000755�0001750�0001750�00000000000�13242535444�013266� 5����������������������������������������������������������������������������������������������������ustar �manwar��������������������������manwar�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������SVG-2.84/examples/image_sample.pl�������������������������������������������������������������������0000755�0001750�0001750�00000003440�13057520366�016253� 0����������������������������������������������������������������������������������������������������ustar �manwar��������������������������manwar�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#!/usr/bin/perl use strict; use warnings; # # Incorporating an SVG image into another SVG image as an image object. # # use SVG; use CGI ':new :header'; my $p = CGI->new; $| = 1; my $svg = SVG->new(width=>800,height=>400); $svg->desc( id=>'root-desc')->cdata('hello this is a description'); $svg->title( id=>'root-title')->cdata('Dynamic SVG - Image usage within SVG using Perl'); #use another SVG component as an image inside our image $svg->image(id=>'image_1', -href=>'SVG_02_sample.pl', x=>150, y=>150, width=>100, height=>100); #create a link to an other site through a png image #We must first generate an anchor tag, give it agroup as a child, #and put the image as a child in it. $svg->anchor('-href'=>"http://www.hackmare.com/",target=>'new_window') ->group(id=>'png_group') ->image(id=>'image_2', -href=>'http://www.hackmare.com/icons/logo/hackmaresplash600_1.png', x=>10, y=>10, width=>600, height=>94,); $svg->text(x=>20,y=>280)->cdata('EXPLANATION'); $svg->text(x=>20,y=>310)->cdata('One image is imported as a full SVG image'); $svg->text(x=>20,y=>325)->cdata('The second (hackmare) image is imported is an .png image'); $svg->text(x=>20,y=>340)->cdata('Notice that the hackmare image contains a url anchor'); $svg->text(x=>20,y=>355,style=>{fill=>'red'})->cdata('Actually, the link anchor contains a group which contains the image'); $svg->text(x=>200,y=>385,style=>{fill=>'red','fill-opacity'=>0.2})->cdata("This image was generated with perl using Ronan Oger's SVG module"); print $p->header('image/svg-xml'); print $svg->xmlify; print "\n"; ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������SVG-2.84/examples/ellipse.pl������������������������������������������������������������������������0000644�0001750�0001750�00000000667�13057520366�015272� 0����������������������������������������������������������������������������������������������������ustar �manwar��������������������������manwar�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use strict; use warnings; use 5.010; use SVG; # create an SVG object my $svg= SVG->new( width => 200, height => 200); my $tag = $svg->ellipse( cx => 10, cy => 10, rx => 5, ry => 7, id => 'ellipse', style => { 'stroke' => 'red', 'fill' => 'green', 'stroke-width' => '4', 'stroke-opacity' => '0.5', 'fill-opacity' => '0.2', } ); say $svg->xmlify; �������������������������������������������������������������������������SVG-2.84/examples/svg_dom_sample.pl�����������������������������������������������������������������0000755�0001750�0001750�00000007271�13057520366�016635� 0����������������������������������������������������������������������������������������������������ustar �manwar��������������������������manwar�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#!/usr/bin/perl -w use strict; use SVG(-indent=>" "); # subroutine to print out attributes # sub show_attributes ($) { my $node = shift; my $ref = $node->getAttributes(); my @attrs = keys %$ref; print "This node has ".(scalar @attrs)." attributes:\n"; foreach my $i (@attrs) { print " $i=\"$ref->{$i}\"\n"; } } my $s = SVG->new(width=>100,height=>50); my $g1 = $s->group(id=>'group_1'); $g1->circle(width=>1,height=>1,id=>'test_id'); $g1->rect(id=>'id_2'); $g1->rect(id=>'id_3'); $g1->rect(id=>'id_4',x=>15,y=>150); $g1->anchor(-xref=>'http://www.roitsystems.com/tutorial/',id=>'anchor_1') ->text(id=>'text_1',x=>15,y=>150,stroke=>'red')->cdata('Hello, World'); my $g2 = $s->group(id=>'group_2'); $g2->ellipse(id=>'id_5'); $g2->ellipse(id=>'id_6'); $g2->ellipse(id=>'id_7'); $s->ellipse(id=>'id_8'); $s->ellipse(id=>'id_9'); print "SVG::DOM Demonstration\n"; print "\n","="x40,"\n\n"; print "The example document looks like this:\n\n"; print $s->xmlify(); print "\n\n","="x40,"\n\n"; # # Test of getElementName # print "The document element is of type \"".$s->getElementName()."\"\n"; # # Test of getAttributes # show_attributes($s); print "\n","-"x40,"\n\n"; print "Document contents by element type:\n"; # # Test of getElements # my @e_names = qw/rect ellipse a g svg/; foreach my $e_name (@e_names) { print " There are ".scalar @{$s->getElements($e_name)}." '$e_name' elements\n"; foreach my $e (@{$s->getElements($e_name)}) { if (my $e_id = $e->getElementID) { print " $e has id \"$e_id\"\n"; die "The id should always map back to the element" unless $s->getElementByID($e_id)==$e; } else { print " $e has no id\n"; } } } print "\n","-"x40,"\n\n"; my @kids = $s->getChildren(); print "The document element has ",scalar (@kids)," children (should be 1)\n"; foreach my $kid (@kids) { print "Found a <",$kid->getElementName(),"> child element:\n"; show_attributes($kid); } # Test of getElementByID # my $group=$s->getElementByID("group_1"); print "Group 1 relocated by id group_1\n" if $group==$g1; print "\n","="x40,"\n"; # Test of getChildren # my $children = $group->getChildren(); foreach my $v (0..$#{$children}) { # Test of getElementName on this child # my $name = $children->[$v]->getElementName; print "\nChild element $v is is a <$name> element.\n"; print "It looks like this:\n\n"; print $children->[$v]->xmlify(); print "\n"; # Test of getParent # my $parent = $children->[$v]->getParent; my $parent_name = $parent->getElementName; print "Its parent is a <$parent_name> element\n"; # Test of getChildIndex # print "It is index number ",$children->[$v]->getChildIndex()," in the parent.\n"; # Test of getAttributes # my $ref = $children->[$v]->getAttributes(); my @attrs = keys %$ref; print "It has ".(scalar @attrs)." attribute".($#attrs?"s":"").":\n"; foreach my $attr (@attrs) { print " $attr=\"$ref->{$attr}\"\n"; } # Test of getPreviousSibling # if (my $prev = $children->[$v]->getPreviousSibling) { print "The element before it is a <".$prev->getElementName.">\n"; } else { print "It is the first child element\n"; } # Test of getNextSibling # if (my $next = $children->[$v]->getNextSibling) { print "The element after it is a <".$next->getElementName.">\n"; } else { print "It is the last child element\n"; } print "\n","-"x40,"\n"; } # Test of getCDATA # my $text_element=$s->getElementByID("text_1"); print "\nAnd finally, element 'text_1' says ",$text_element->getCDATA(),"!\n"; print "\n","="x40,"\n"; ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������SVG-2.84/examples/03_circle_and_square.pl�����������������������������������������������������������0000644�0001750�0001750�00000003302�13057520366�017567� 0����������������������������������������������������������������������������������������������������ustar �manwar��������������������������manwar�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#!/usr/bin/perl use strict; use warnings; use SVG; # create an SVG object with a size of 100x100 pixels my $svg = SVG->new( width => 100, height => 100, ); # create a rectangle (actually square) with the top left # corner being at (40, 50) # (0, 0) would mean being in the top left corner of the image. # The width and the height of the rectangular are also given # in pixels and we can add style just asw we did with the circle. $svg->rectangle( x => 40, y => 50, width => 40, height => 40, style => { 'fill' => 'rgb(0, 255, 0)', 'stroke' => 'black', 'stroke-width' => 0, 'stroke-opacity' => 1, 'fill-opacity' => 1, }, ); $svg->circle( cx => 40, cy => 40, r => 20, style => { 'fill' => 'rgb(255, 0, 0)', 'stroke' => 'black', 'stroke-width' => 0, 'stroke-opacity' => 1, 'fill-opacity' => 1, }, ); # In order to create a triangle we are going to create a polygon # To make it easy to create various path based constructs, SVG.pm # provides a "get_path" method that, give a series of coordinates # and a type, return the respective data structure that is needed # for SVG. my $path = $svg->get_path( x => [40, 60, 80], y => [40, 6, 40], -type => 'polygon'); # Then we use that data structure to create a polygon $svg->polygon( %$path, style => { 'fill' => 'rgb(0,0,255)', 'stroke' => 'black', 'stroke-width' => 0, 'stroke-opacity' => 1, 'fill-opacity' => 1, }, ); # now render the SVG object, implicitly use svg namespace print $svg->xmlify, "\n"; ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������SVG-2.84/examples/SVG_02_sample.pl������������������������������������������������������������������0000755�0001750�0001750�00000002414�13057520366�016131� 0����������������������������������������������������������������������������������������������������ustar �manwar��������������������������manwar�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#!/usr/bin/perl BEGIN { push @INC , '../'; push @INC , '../SVG'; } use SVG; use strict; use CGI ':new :header'; my $p = CGI->new; $| = 1; my $svg= SVG->new(width=>200,height=>200); my $y=$svg->group( id => 'group_y', style => {stroke=>'red', fill=>'green'} ); my $z=$svg->tag('g', id=>'group_z', style=>{ stroke=>'rgb(100,200,50)', fill=>'rgb(10,100,150)'} ); $y->circle(cx=>100, cy=>100, r=>50, id=>'circle_y',); $z->tag('circle',cx=>50, cy=>50, r=>100, id=>'circle_z',); # an anchor with a rectangle within group within group z my $k = $z -> anchor( -href => 'http://test.hackmare.com/', -target => 'new_window_0') -> rectangle ( x=>20, y=>50, width=>20, height=>30, rx=>10, ry=>5, id=>'rect_z',); print $p->header('image/svg-xml'); print $svg->xmlify; ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������SVG-2.84/examples/inline_sample.pl������������������������������������������������������������������0000755�0001750�0001750�00000003535�13057520366�016454� 0����������������������������������������������������������������������������������������������������ustar �manwar��������������������������manwar�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#!/usr/bin/perl -w # # Incorporating an SVG image into another SVG image as an image object. # # BEGIN { push @INC , '../'; push @INC , '../SVG'; } use SVG; use strict; my $svg = SVG->new(width=>800,height=>400,); $svg->desc( id=>'root-desc')->cdata('hello this is a description'); $svg->title( id=>'root-title')->cdata('Dynamic SVG - Image usage within SVG using Perl'); #use another SVG component as an image inside our image $svg->image(id=>'image_1', -href=>'SVG_02_sample.pl', x=>150, y=>150, width=>100, height=>100); #create a link to an other site through a png image #We must first generate an anchor tag, give it agroup as a child, #and put the image as a child in it. $svg->anchor('-href'=>"http://www.hackmare.com/",target=>'new_window') ->group(id=>'png_group') ->image(id=>'image_2', -href=>'http://www.hackmare.com/icons/logo/hackmaresplash600_1.png', x=>10, y=>10, width=>600, height=>94,); $svg->text(x=>20,y=>280)->cdata('EXPLANATION'); $svg->text(x=>20,y=>310)->cdata('One image is imported as a full SVG image'); $svg->text(x=>20,y=>325)->cdata('The second (hackmare) image is imported is an .png image'); $svg->text(x=>20,y=>340)->cdata('Notice that the hackmare image contains a url anchor'); $svg->text(x=>20,y=>355,style=>{fill=>'red'})->cdata('Actually, the link anchor contains a group which contains the image'); $svg->text(x=>200,y=>385,style=>{fill=>'red','fill-opacity'=>0.2})->cdata("This image was generated with perl using Ronan Oger's SVG module"); print $svg->xmlify(namespace=>'abc',); �������������������������������������������������������������������������������������������������������������������������������������������������������������������SVG-2.84/examples/yaph5.cgi�������������������������������������������������������������������������0000755�0001750�0001750�00000034653�13057520366�015017� 0����������������������������������������������������������������������������������������������������ustar �manwar��������������������������manwar�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#!/usr/bin/perl use strict; use warnings; use SVG; my $points; my $path; my $style; my $transform; my $string; my $gradient; my $svg = SVG->new(width=>800,height=>600); my $lg = $svg->gradient(-type=>'linear', 'id'=>"transparent-sky_1", 'x1'=>"0%", 'y1'=>"0%", 'x2'=>"100%", 'y2'=>"0%", 'spreadMethod'=>"pad", 'gradientUnits'=>"userSpaceOnUse"); $lg->stop(offset=>"0%", style=>{'stop-color'=>'rgb(1,71,1)','stop-opacity'=>1}); $lg->stop(offset=>"37%", style=>{'stop-color'=>'rgb(0,128,0)','stop-opacity'=>1}); $lg->stop(offset=>"38%", style=>{'stop-color'=>'rgb(255,255,255)','stop-opacity'=>1}); $lg->stop(offset=>"45%", style=>{'stop-color'=>'rgb(192,192,255)','stop-opacity'=>1}); $svg->gradient(-type=>'linear', id => "custom-paint_1", x1=>"0%", y1=>"0%", x2=>"100%", y2=>"0%", spreadMethod=>"pad", gradientUnits=>"objectBoundingBox"); $lg = $svg->gradient(-type=>'linear', id =>'red-dark-green', x1=>'0%', y1=>'0%', x2=>'100%', y2=>'0%', spreadMethod=>'pad', gradientUnits=>'userSpaceOnUse'); $lg->stop(offset=>'0%', style=>{'stop-color'=>'rgb(225,0,25)','stop-opacity'=>'0.75'}); $lg->stop(offset=>"100%", style=>{'stop-color'=>'rgb(0,96,27)','stop-opacity'=>0.5}); my $lg2 = $svg->gradient(-type=>'linear', id => 'black-white_1', x1=>"0%", y1=>"0%", x2=>"100%", y2=>"0%", spreadMethod=>"pad", gradientUnits=>"userSpaceOnUse"); $lg2->stop(offset=>"0%", style=>{'stop-color'=>'rgb(0,0,0)','stop-opacity'=>"0.8"}); $lg2->stop(offset=>"100%", style=>{'stop-color'=>'rgb(255,255,255)','stop-opacity'=>"1"}); #XXX Is this the right parent? my $Argyle_1 = $svg->pattern(id=>"Argyle_1", width=>"50", height=>"50", patternUnits=>"userSpaceOnUse", patternContentUnits=>"userSpaceOnUse"); my $Argyle_1_lg = $Argyle_1->gradient(id=>"red-yellow-red", x1=>"0%", y1=>"0%", x2=>"100%", y2=>"0%", spreadMethod=>"pad", gradientUnits=>"objectBoundingBox" ); $Argyle_1_lg->stop(offset=>"10%", style=>{'stop-color'=>'rgb(255,0,0)','stop-opacity'=>1}); $Argyle_1_lg->stop(offset=>"50%", style=>{'stop-color'=>'rgb(253,215,0)','stop-opacity'=>1}); $Argyle_1_lg->stop(offset=>"90%", style=>{'stop-color'=>'rgb(255,0,0)','stop-opacity'=>1}); my $argyle_1_1 = $Argyle_1->gradient(-type=>'linear', id=>"black-white", x1=>"0%", y1=>"0%", x2=>"100%", y2=>"0%", spreadMethod=>"pad", gradientUnits=>"objectBoundingBox"); $argyle_1_1->stop(offset=>"0%", style=>{'stop-color'=>'rgb(255,0,0)','stop-opacity'=>'1'}); $argyle_1_1->stop(offset=>"100%", style=>{'stop-color'=>'rgb(255,255,0)','stop-opacity'=>'1'}); my $Bumpy = $svg->filter(id=>'Bumpy',filterUnits=>"objectBoundingBox", x=>"-10%",y=>"-10%", width=>"150%", height=>"150%", filterUnits=>'objectBoundingBox',); $Bumpy->fe(-type=>'turbulence', baseFrequency=>'0.15', numOctaves=>'1', result=>'image0'); $Bumpy->fe(-type=>"gaussianblur", stdDeviation=>"3", in=>"image0", result=>"image1"); $Bumpy->fe(-type=>"diffuselighting",'in'=>"image1", 'surfaceScale'=>10,'diffuseConstant'=>"1",'result'=>"image3", style=>{'lighting-color'=>'rgb(255,255,255)'}) ->fe(-type=>'distantlight',azimuth=>"0", elevation=>"45"); $Bumpy->fe(-type=>"composite",in=>"image3", in2=>"SourceGraphic",operator=>"arithmetic", k2=>"0.5",k3=>"0.5",result=>"image4"); $Bumpy->fe(-type=>"composite",in=>"image4", in2=>"SourceGraphic", operator=>"in", result=>"image5"); my $pointillist = $svg->filter(id=>"pointillist", filterUnits=>"objectBoundingBox", x=>"-10%", y=>"-10%", width=>"150%", height=>"150%"); $pointillist->fe(-type=>'turbulence', baseFrequency=>"0.1", numOctaves=>"2", result=>'I1'); $pointillist->fe(-type=>'morphology', in=>"I1", radius=>"5", operator=>"dilate", result=>"I2"); $pointillist->fe(-type=>'colormatrix', in=>"I2", type=>"matrix", values=>"1 0 0 0 0 0 1 0 0 0 0 0 1 0 0 0 0 0 0 255", result=>"I3"); $pointillist->fe(-type=>'composite', in=>"I3", in2=>"SourceGraphic", operator=>"in"); my $arg_1_grad_1 = $Argyle_1->gradient(id=>'custom-paint', spreadMethod=>'pad', gradientUnits=>'objectBoundingBox', x1=>'0%', x2=>'100%', y1=>'0%', y2=>'100%',); $arg_1_grad_1->stop(offset=>'0%' ,'stop-color'=>'rgb(128,0,0)', 'stop-opacity'=>1); $arg_1_grad_1->stop(offset=>'37%','stop-color'=>'rgb(222,0,0)', 'stop-opacity'=>.8); $arg_1_grad_1->stop(offset=>'43%','stop-color'=>'rgb(255,128,128)', 'stop-opacity'=>1); $arg_1_grad_1->stop(offset=>'45%','stop-color'=>'rgb(255,0,0)', 'stop-opacity'=>1); $arg_1_grad_1->stop( offset=>'54%','stop-color'=>'rgb(192,0,0)', 'stop-opacity'=>0.7); $arg_1_grad_1->stop(offset=>'100%','stop-color'=>'rgb(240,0,175)', 'stop-opacity'=>1); my $arg_1_g_1 = $Argyle_1->group(id=>'group_inside_pattern_1'); # $svg->emptyTag('polygon', # style=>"stroke:rgb(112,97,66);stroke-width:1;stroke-opacity:1;stroke-miterlimit:30;fill:rgb(215,207,189);fill-opacity:1", # points=>"25,10 34,25 25,40 16,25"); $points = "25,10 34,25 25,40 16,25"; $style = { 'stroke' => 'rgb(112,97,66)', 'stroke-width' => 1, 'stroke-opacity' => 1, 'stroke-miterlimit' => 30, 'fill' => 'rgb(215,207,189)', 'fill-opacity' => '1' }; my $r_pts = $arg_1_g_1->get_path(x=>[25,34,25,16],y=>[10,25,40,25],-type=>'polygon'); $arg_1_g_1->polygon(id=>'pg1',%$r_pts,style=>$style); $r_pts = $arg_1_g_1->get_path(x=>[50,59,50,41],y=>[10,25,40,25],-type=>'polygon'); $arg_1_g_1->polygon(id=>'pg2',%$r_pts,style=>$style); $r_pts = $arg_1_g_1->get_path(x=>[0,9,0,-9],y=>[10,25,40,25],-type=>'polygon'); $arg_1_g_1->polygon(id=>'pg3',%$r_pts,style=>$style); $r_pts = $arg_1_g_1->get_path(x=>[11,21,11,1],y=>[0,25,50,25],-type=>'polygon'); $arg_1_g_1->polygon(id=>'pg4',%$r_pts,style=>$style); $r_pts = $arg_1_g_1->get_path(x=>[25,34,25,16],y=>[10,25,40,25],-type=>'polygon'); $arg_1_g_1->polygon(id=>'pg5',%$r_pts,style=>$style); $style = { 'stroke' => 'rgb(52,48,40)', 'stroke-width' => 1, 'stroke-opacity' => 1, 'stroke-miterlimit' => 30, 'fill' => 'rgb(172,152,112)', 'fill-opacity' => '1' }; $r_pts = $arg_1_g_1->get_path(x=>[20,30,25],y=>[0,0,9],-type=>'polygon'); $arg_1_g_1->polygon(id=>'pg6',%$r_pts,style=>$style); $r_pts = $arg_1_g_1->get_path(x=>[20,25,30],y=>[50,41,50],-type=>'polygon'); $arg_1_g_1->polygon(id=>'pg7',%$r_pts,style=>$style); $svg->rect(x=>"193", y=>"201", width=>"422", height=>"140", rx=>"3",ry=>"6", 'stroke-miterlimit'=>4, 'stroke-linejoin'=>'miter', 'stroke-width'=>1, 'stroke-opacity'=>1, 'stroke'=>'rgb(0,0,0)', 'fill-opacity'=>1, 'fill'=>'rgb(148,65,175)', 'opacity'=>0.31); $style = {'stroke-miterlimit'=>4, 'stroke-linejoin'=>'miter', 'stroke-linecap'=>'round', 'stroke-width'=>'11', 'stroke-opacity'=>1, 'stroke'=>'rgb(0,0,0)', 'fill-opacity'=>1, 'fill'=>'rgb(0,0,0)', 'opacity'=>'0.5'}; $svg->text(x=>"318", y=>"333", transform=>'matrix(1.58041 -0.293543 0.333969 1.3891 -396.141 -55.3847)', style=>{'font-family'=>'Arial Rounded MT Bold', 'font-size'=>100,'stroke-width'=>1,'stroke-opacity'=>1, stroke=>'rgb(0,0,0)', 'fill-opacity'=>1,fill=>'rgb(0,0,0)', opacity=>1,visibility=>'inherit'}, filter=>'url(#pointillist)') ->cdata('A'); $svg->polygon(points=>'33.6776,266.425 34.408,266.795 33.6684,267.165 33.8903,266.795', 'stroke-miterlimit'=>4, 'stroke-linejoin'=>'miter', fill=>'rgb(0,0,0)'); $svg->polygon(points=>'75.8931,140.313 -18,268.028 77.0816,395.744 48.5571,268.028', 'stroke-linejoin'=>'miter', fill=>'url(#red-yellow-red)', filter=>'url(#Bumpy)'); $style = {'stroke-miterlimit'=>'4', 'stroke-linejoin'=>'miter', 'stroke-linecap'=>'round', 'stroke-width'=>'11', 'stroke-opacity'=>'1', 'stroke'=>'url(#Argyle_1)', 'fill-opacity'=>'1', 'fill'=>'rgb(12,5,1)', 'opacity'=>'0.5'}; $path = "M311.591 367.68 L354.854 124.686 L459.18 160.388 L455.469 199.691 L404.735 219.984 L360.521 215.961 L326.636 369.343"; $svg->path(d=>$path,style=>$style); $transform = 'matrix(0.994363 0.10603 -0.10603 0.994363 32.2186 -53.9305)'; $style = { 'stroke-width' =>1, 'stroke-opacity'=>1, 'stroke' =>'rgb(241,19,19)', 'fill-opacity' =>1, 'fill' =>'rgb(243,214,21)', 'opacity' =>1 }; my $shape_array = [ {cx=>"474.862" , cy=>"178.408" , rx=>"9.24547" , ry=>"9.61528"}, {cx=>"478.93" , cy=>"224.266" , rx=>"8.87565" , ry=>"8.13601"}, {cx=>"477.081" , cy=>"260.878" , rx=>"9.9851" , ry=>"10.7247"}, {cx=>"481.519" , cy=>"319.309" , rx=>"11.4644" , ry=>"11.4644"}, {cx=>"479.3" , cy=>"366.646" , rx=>"10.7247" , ry=>"10.7247"}, {cx=>"559.181" , cy=>"183.955" , rx=>"9.9851" , ry=>"9.9851"}, {cx=>"561.03" , cy=>"231.662" , rx=>"9.61528" , ry=>"9.61528"}, {cx=>"568.796" , cy=>"283.067" , rx=>"12.204" , ry=>"12.204"}, {cx=>"563.988" , cy=>"332.992" , rx=>"8.13601" , ry=>"8.13601"}, {cx=>"563.619" , cy=>"375.521" , rx=>"7.76619" , ry=>"7.76619"}, {cx=>"508.885" , cy=>"270.493" , rx=>"5.54728" , ry=>"5.54728"}, {cx=>"525.527" , cy=>"266.425" , rx=>"4.43782" , ry=>"4.43782"}, {cx=>"521.459" , cy=>"278.629" , rx=>"2.58873" , ry=>"2.58873"}, {cx=>"532.184" , cy=>"276.04" , rx=>"2.21891" , ry=>"2.21891"}, {cx=>"541.06" , cy=>"268.644" , rx=>"5.9171" , ry=>"5.9171"}, {cx=>"544.018" , cy=>"283.437" , rx=>"2.95855" , ry=>"2.95855"}, {cx=>"482.628" , cy=>"285.655" , rx=>"8.13601" , ry=>"8.13601"}, {cx=>"476.341" , cy=>"338.54" , rx=>"6.28692" , ry=>"6.28692"}, {cx=>"478.19" , cy=>"202.816" , rx=>"6.65674" , ry=>"6.65674"}, {cx=>"561.4" , cy=>"207.624" , rx=>"7.76619" , ry=>"7.76619"}, {cx=>"548.826" , cy=>"199.118" , rx=>"2.58873" , ry=>"2.21891"}, {cx=>"562.509" , cy=>"255.33" , rx=>"5.9171" , ry=>"5.9171"}, {cx=>"555.113" , cy=>"269.383" , rx=>"2.21891" , ry=>"2.21891"}, {cx=>"565.468" , cy=>"313.022" , rx=>"8.13601" , ry=>"8.13601"}, {cx=>"558.811" , cy=>"300.448" , rx=>"3.69819" , ry=>"3.69819"}, {cx=>"560.66" , cy=>"351.853" , rx=>"5.54728" , ry=>"5.54728"}, {cx=>"574.713" , cy=>"349.634" , rx=>"2.58873" , ry=>"2.58873"}, {cx=>"569.905" , cy=>"358.88" , rx=>"2.21891" , ry=>"2.21891"}, {cx=>"487.806" , cy=>"347.785" , rx=>"2.21891" , ry=>"2.21891"}, {cx=>"488.915" , cy=>"337.06" , rx=>"2.58873" , ry=>"2.58873"}, {cx=>"474.122" , cy=>"299.339" , rx=>"4.80764" , ry=>"4.80764"}, {cx=>"485.957" , cy=>"303.037" , rx=>"2.58873" , ry=>"2.58873"}, {cx=>"472.643" , cy=>"275.67" , rx=>"2.58873" , ry=>"2.58873"}, {cx=>"488.176" , cy=>"272.712" , rx=>"2.58873" , ry=>"2.58873"}, {cx=>"473.383" , cy=>"237.949" , rx=>"3.32837" , ry=>"3.32837"}, {cx=>"487.806" , cy=>"239.798" , rx=>"5.17746" , ry=>"5.17746"}, {cx=>"471.164" , cy=>"191.352" , rx=>"3.32837" , ry=>"3.32837"}, {cx=>"489.655" , cy=>"192.831" , rx=>"4.06801" , ry=>"4.06801"}, {cx=>"501.489" , cy=>"285.286" , rx=>"3.32837" , ry=>"3.32837"} ]; #Draw the ellipses for the H my $ellipse_group = $svg->group(id=>'ellipse_group',transform=>$transform,style=>$style); foreach my $shape (@{$shape_array}) { $svg->ellipse(%$shape,style=>$style); } $points = "617.074,364.474 663.435,173 671.162,173 616.371,379 596,327.5 610.751,327.5"; $style = { 'stroke-miterlimit' =>4, 'stroke-linejoin' =>'miter', 'stroke-width' =>1, 'stroke-opacity' =>1, 'stroke' =>'inherit', 'fill-opacity' =>1, 'fill' =>'rgb(0,0,0)', 'opacity' =>1}; my $font_style = {'font-family'=>'Arial','font-size'=>24,'stroke-width'=>'1.2', 'stroke-opacity'=>0.9,stroke=>'url(#custom-paint)', 'fill-opacity'=>0.8, fill=>'rgb(0,0,0)',opacity=>0.8}; $svg->polygon(points=>$points,style=>$style); $svg->anchor(-href => "http://burks.brighton.ac.uk/burks/foldoc/49/60.htm",id=>'a_1'); my $ytg = $svg->group(id=>'yaph_text_group',style=>$font_style); $ytg->text(x=>"441",y=>"302",style=>$font_style, transform => 'matrix(0.767738 -0.769086 0.91578 0.644758 80.4565 534.986)' )->cdata('Yet Another'); $ytg->text(x=>441,y=>302,style=>$font_style, transform => 'matrix(0.774447 0.760459 0 0.924674 357.792 -428.792)', )->cdata('PERL Hack'); my $j_style = {'stroke-miterlimit'=>4, 'stroke-width' =>10, 'stroke-opacity' =>1, 'stroke' =>'url(#red-dark-green)', 'fill-opacity' =>0.85, 'opacity' =>0.70, 'font-family'=>'Arial monospaced for SAP', 'font-size'=>250, 'stroke'=>'url(#custom-paint_1)', 'fill'=>'rgb(71,254,130)',}; my $j_trans = 'matrix(1.58041 0.293543 0.333969 1.3891 -396.141 -55.3847)'; $svg->text(id=>'big_J',x=>217,y=>270,style=>$j_style,transform=>$j_trans)->cdata('J'); $path = "M128 130 L202 130"; $style={'stroke-miterlimit'=>4, 'stroke-linejoin'=>'miter', 'stroke-linecap'=>'round', 'stroke-width'=>11, 'stroke-opacity'=>1, 'stroke'=>'url(#transparent-sky_1)', 'fill-opacity'=>1, 'fill'=>'rgb(0,0,0)', 'opacity'=>0.5}; $svg->path(d=>$path,style=>$style); $string = '( Well..., almost )'; $style = {'font-family'=>'Arial monospaced for SAP', 'font-size'=>32, 'stroke-width'=>1, 'stroke-opacity'=>1, 'stroke'=>'url(#custom-paint_1)', 'fill-opacity'=>1, 'fill'=>'rgb(74,214,130)', 'opacity'=>1}; $svg->text(x=>273,y=>437,style=>$style)->cdata($string); print $svg->xmlify; �������������������������������������������������������������������������������������SVG-2.84/examples/circle.pl�������������������������������������������������������������������������0000755�0001750�0001750�00000001162�13057520366�015070� 0����������������������������������������������������������������������������������������������������ustar �manwar��������������������������manwar�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#!/usr/bin/perl use strict; use warnings; use SVG; # create an SVG object with a size of 200x200 pixels my $svg = SVG->new( width => 200, height => 200, ); $svg->title()->cdata('I am a title'); # use explicit element constructor to generate a group element my $y = $svg->group( id => 'group_y', style => { stroke => 'red', fill =>'green', }, ); # add a circle to the group $y->circle( cx => 100, cy => 100, r => 50, id => 'circle_in_group_y', ); $y->comment('This is a comment'); # now render the SVG object, implicitly use svg namespace print $svg->xmlify; ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������SVG-2.84/examples/inlinesvg.pl����������������������������������������������������������������������0000755�0001750�0001750�00000014156�13057520366�015634� 0����������������������������������������������������������������������������������������������������ustar �manwar��������������������������manwar�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#!/usr/bin/perl -w use strict; use CGI; BEGIN { push @INC , '../'; push @INC , '../SVG'; } use SVG; my $VERSION = 3; #---------Create the CGI object which is required to handle the header my $p = CGI->new(); $| = 1; #---------print the header just before outputting to screen #--------- #---------Create the svg object my $height = $p->param('h') || 400; my $width = $p->param('w') || 800; my $svg= SVG->new(width=>$width,height=>$height,-inline=>1, -namespace=>'abc'); my $y=$svg->group( id=>'group_generated_group',style=>{ stroke=>'red', fill=>'green' }); my $z=$svg->tag('g', id=>'tag_generated_group',style=>{ stroke=>'red', fill=>'black' }); my $ya = $y -> anchor( -href => 'http://somewhere.org/some/line.html', -target => 'new_window_0'); my $line_transform = 'matrix(0.774447 0.760459 0 0.924674 357.792 -428.792)'; my $line = $svg->line(id=>'l1',x1=>(rand()*$width+5), y1=>(rand()*$height+5), x2=>(rand()*$width-5), y2=>(rand()*$height-5), style=>&obj_style,); #--------- foreach (1..&round_up(rand(20))) { my $myX = $width-rand(2*$width); my $myY = $height-rand(2*$height); my $rect = $y->rectangle (x=>$width/2, y=>$height/2, width=>(50+50*rand()), height=>(50+50*rand()), rx=>20*rand(), ry=>20*rand(), id=>'rect_1', style=>&obj_style); $rect->animate(attributeName=>'transform', attributeType=>'XML', from=>'0 0', to=>$myX.' '.$myY, dur=>&round_up(rand(20),2).'s', repeatCount=>&round_up(rand(30)), restart=>'always', -method=>'Transform',); } my $a = $z -> anchor( -href => 'http://somewhere.org/some/other/page.html', -target => 'new_window_0', id=>'anchor a'); my $a1 = $z -> anchor( -href => '/index.html', -target => 'new_window_1', id=>'anchor a1'); my $a2 = $z -> anchor( -href => '/svg/index.html', -target => 'new_window_2', id=>'anchor a2'); #--------- my $c; foreach (1..&round_up(rand(5))) { $c= $a->circle(cx=>($width-20)*rand(), cy=>($height-20)*rand(), r=>100*rand(), id=>'c1', style=>&obj_style); $c = $a1->circle(cx=>($width-20)*rand(), cy=>($height-20)*rand(), r=>100*rand(), id=>'c2', style=>&obj_style); } #--------- my $xv = [$width*rand(), $width*rand(), $width*rand(), $width*rand()]; my $yv = [$height*rand(), $height*rand(), $height*rand() ,$height*rand()]; my $points = $a->get_path(x=>$xv, y=>$yv, -type=>'polyline', -closed=>'true',); $c = $a1->polyline (%$points, id=>'pline1', style=>&obj_style); #--------- $xv = [$width*rand(), $width*rand(), $width*rand(), $width*rand()]; $yv = [$height*rand(), $height*rand(), $height*rand() ,$height*rand()]; $points = $a->get_path(x=>$xv, y=>$yv, -type=>'polygon',); $c = $a->polygon (%$points, id=>'pgon1', style=>&obj_style); #--------- my $t=$a2->text(id=>'t1', transform=>'rotate(-45)', style=>&text_style); #--------- my $u=$a2->text(id=>'t3', x=>$width/2*rand(), y=>($height-80)*rand(), transform=>'rotate('.(-2.5*5*rand()).')', style=>&text_style); my $v=$a2->tag('text', id=>'t5', x=>$width/2*rand(), y=>$height-40+5*rand(), transform=>'rotate('.(-2.5*5*rand()).')', style=>&text_style); my $w=$a2->text(id=>'t5', x=>$width/2*rand(), y=>$height-20+5*rand(), transform=>'rotate('.(-2.5*5*rand()).')', style=>&text_style); $t->cdata('Text generated using the high-level "text" tag'); $t->cdata('Courtesy of RO IT Systems GmbH'); $v->cdata('Text generated using the low-level "tag" tag'); $w->cdata('But what about inline SVG? Yes, we do that too'); $w->cdata('All this with SVG.pm? Wow.'); print $p->header('image/svg-xml'); print $svg->render(-inline=>1); exit; ################# # Subroutine to round up the value of a number or of a text representation of number # sub round_up { my ($x, $precision) = shift; $x =~ s/^\s+//g; $x =~ s/\s+$//g; $x =~ s/,//g; my $y; $precision = 0 unless $precision; ($x, $y) = split( /\./, $x) if $x =~ /\./; my $y1 = substr($y, 0, $precision); my $y2 = substr($y, $precision, 1); if ($y2 >= 5) { $precision?$y1++:$x++; } return "$x$y1"; } # sub round_val sub obj_style { my $style = {'stroke-miterlimit'=>(4*rand()), 'stroke-linejoin'=>'miter', 'stroke-linecap'=>'round', 'stroke-width'=>(0.1+0.5*rand()), 'stroke-opacity'=>(0.5+0.5*rand()), 'stroke'=>'rgb('.255*round_up(rand()).','.255*round_up(rand()).','.255*round_up(rand()).')', 'fill-opacity'=>(0.5+0.5*rand()), 'fill'=>'rgb('.255*round_up(rand()).','.255*round_up(rand()).','.255*round_up(rand()).')', 'opacity'=>(0.5+0.5*rand()) }; return $style; } sub text_style { my $style = {'font-family'=>'Arial', 'font-size'=>8+5*rand(), 'stroke-width'=>1+2*rand(), 'stroke-opacity'=>(0.2+0.5*rand()), 'stroke'=>'rgb('.255*round_up(rand()).','.255*round_up(rand()).','.255*round_up(rand()).')', 'fill-opacity'=>1, 'fill'=>'rgb('.255*round_up(rand()).','.255*round_up(rand()).','.255*round_up(rand()).')', 'opacity'=>(0.5+0.5*rand()) }; return $style; } #--------- ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������SVG-2.84/examples/svg.psgi��������������������������������������������������������������������������0000644�0001750�0001750�00000000706�13057520366�014755� 0����������������������������������������������������������������������������������������������������ustar �manwar��������������������������manwar�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#!/usr/bin/perl use strict; use warnings; # run this example using plackup -r examples/svg.psgi use SVG; my $app = sub { my $svg = SVG->new( width => 200, height => 200, ); $svg->title()->cdata('I am a title'); # add a circle $svg->circle( cx => 100, cy => 100, r => 50, id => 'circle_in_group_y', style => { fill => '#FF0000', } ); return [ '200', [ 'Content-Type' => 'image/svg+xml' ], [ $svg->xmlify ], ]; }; ����������������������������������������������������������SVG-2.84/examples/minsvg.pl�������������������������������������������������������������������������0000755�0001750�0001750�00000000726�13057520366�015137� 0����������������������������������������������������������������������������������������������������ustar �manwar��������������������������manwar�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#!/usr/bin/perl use strict; use warnings; use SVG; # create an SVG object my $svg = SVG->new( width => 100, height => 100, ); $svg->pi('we are surround you', 'surrender all your bases'); $svg->comment('I am a comment', 'and another comment'); $svg->circle( cx => 100, cy => 100, r => 50, id => 'circle_in_group_y', ); # now render the SVG object, implicitly use svg namespace print $svg->xmlify(-dtd=>'http://this-is-my-dtd.html.hereIam'); ������������������������������������������SVG-2.84/examples/01_circle.pl����������������������������������������������������������������������0000644�0001750�0001750�00000000505�13057520366�015365� 0����������������������������������������������������������������������������������������������������ustar �manwar��������������������������manwar�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#!/usr/bin/perl use strict; use warnings; use SVG; # create an SVG object with a size of 40x40 pixels my $svg = SVG->new( width => 40, height => 40, ); # add a circle $svg->circle( cx => 20, cy => 20, r => 18, ); # now render the SVG object, implicitly use svg namespace print $svg->xmlify, "\n"; �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������SVG-2.84/examples/svgtest2.pl�����������������������������������������������������������������������0000755�0001750�0001750�00000014106�13057520366�015412� 0����������������������������������������������������������������������������������������������������ustar �manwar��������������������������manwar�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#!/usr/bin/perl -w use strict; use CGI; BEGIN { push @INC , '../'; push @INC , '../SVG'; } use SVG; my $VERSION = 3; #---------Create the CGI object which is required to handle the header my $p = CGI->new(); $| = 1; #---------print the header just before outputting to screen #--------- #---------Create the svg object my $height = $p->param('h') || 400; my $width = $p->param('w') || 800; my $svg= SVG->new(width=>$width,height=>$height); my $y=$svg->group( id=>'group_generated_group',style=>{ stroke=>'red', fill=>'green' }); my $z=$svg->tag('g', id=>'tag_generated_group',style=>{ stroke=>'red', fill=>'black' }); my $ya = $y -> anchor( -href => 'http://somewhere.org/some/line.html', -target => 'new_window_0'); my $line_transform = 'matrix(0.774447 0.760459 0 0.924674 357.792 -428.792)'; my $line = $svg->line(id=>'l1',x1=>(rand()*$width+5), y1=>(rand()*$height+5), x2=>(rand()*$width-5), y2=>(rand()*$height-5), style=>&obj_style,); #--------- foreach (1..&round_up(rand(20))) { my $myX = $width-rand(2*$width); my $myY = $height-rand(2*$height); my $rect = $y->rectangle (x=>$width/2, y=>$height/2, width=>(50+50*rand()), height=>(50+50*rand()), rx=>20*rand(), ry=>20*rand(), id=>'rect_1', style=>&obj_style); $rect->animate(attributeName=>'transform', attributeType=>'XML', from=>'0 0', to=>$myX.' '.$myY, dur=>&round_up(rand(20),2).'s', repeatCount=>&round_up(rand(30)), restart=>'always', #-method=>'transform', ); } my $a = $z -> anchor( -href => 'http://somewhere.org/some/other/page.html', -target => 'new_window_0', id=>'anchor a'); my $a1 = $z -> anchor( -href => '/index.html', -target => 'new_window_1', id=>'anchor a1'); my $a2 = $z -> anchor( -href => '/svg/index.html', -target => 'new_window_2', id=>'anchor a2'); #--------- my $c; foreach (1..&round_up(rand(5))) { $c= $a->circle(cx=>($width-20)*rand(), cy=>($height-20)*rand(), r=>100*rand(), id=>'c1', style=>&obj_style); $c = $a1->circle(cx=>($width-20)*rand(), cy=>($height-20)*rand(), r=>100*rand(), id=>'c2', style=>&obj_style); } #--------- my $xv = [$width*rand(), $width*rand(), $width*rand(), $width*rand()]; my $yv = [$height*rand(), $height*rand(), $height*rand() ,$height*rand()]; my $points = $a->get_path(x=>$xv, y=>$yv, -type=>'polyline', -closed=>'true',); $c = $a1->polyline (%$points, id=>'pline1', style=>&obj_style); #--------- $xv = [$width*rand(), $width*rand(), $width*rand(), $width*rand()]; $yv = [$height*rand(), $height*rand(), $height*rand() ,$height*rand()]; $points = $a->get_path(x=>$xv, y=>$yv, -type=>'polygon',); $c = $a->polygon (%$points, id=>'pgon1', style=>&obj_style); #--------- my $t=$a2->text(id=>'t1', transform=>'rotate(-45)', style=>&text_style); #--------- my $u=$a2->text(id=>'t3', x=>$width/2*rand(), y=>($height-80)*rand(), transform=>'rotate('.(-2.5*5*rand()).')', style=>&text_style); my $v=$a2->tag('text', id=>'t5', x=>$width/2*rand(), y=>$height-40+5*rand(), transform=>'rotate('.(-2.5*5*rand()).')', style=>&text_style); my $w=$a2->text(id=>'t5', x=>$width/2*rand(), y=>$height-20+5*rand(), transform=>'rotate('.(-2.5*5*rand()).')', style=>&text_style); $t->cdata('Text generated using the high-level "text" tag'); $t->cdata('Courtesy of RO IT Systems GmbH'); $v->cdata('Text generated using the low-level "tag" tag'); $w->cdata('But what about inline SVG? Yes, we do that too'); $w->cdata('All this with SVG.pm? Wow.'); print $p->header('image/svg-xml'); print $svg->render ; exit; ################# # Subroutine to round up the value of a number or of a text representation of number # sub round_up { my ($x, $precision) = shift; $x =~ s/^\s+//g; $x =~ s/\s+$//g; $x =~ s/,//g; my $y; $precision = 0 unless $precision; ($x, $y) = split( /\./, $x) if $x =~ /\./; my $y1 = substr($y, 0, $precision); my $y2 = substr($y, $precision, 1); if ($y2 >= 5) { $precision?$y1++:$x++; } return "$x$y1"; } # sub round_val sub obj_style { my $style = {'stroke-miterlimit'=>(4*rand()), 'stroke-linejoin'=>'miter', 'stroke-linecap'=>'round', 'stroke-width'=>(0.1+0.5*rand()), 'stroke-opacity'=>(0.5+0.5*rand()), 'stroke'=>'rgb('.255*round_up(rand()).','.255*round_up(rand()).','.255*round_up(rand()).')', 'fill-opacity'=>(0.5+0.5*rand()), 'fill'=>'rgb('.255*round_up(rand()).','.255*round_up(rand()).','.255*round_up(rand()).')', 'opacity'=>(0.5+0.5*rand()) }; return $style; } sub text_style { my $style = {'font-family'=>'Arial', 'font-size'=>8+5*rand(), 'stroke-width'=>1+2*rand(), 'stroke-opacity'=>(0.2+0.5*rand()), 'stroke'=>'rgb('.255*round_up(rand()).','.255*round_up(rand()).','.255*round_up(rand()).')', 'fill-opacity'=>1, 'fill'=>'rgb('.255*round_up(rand()).','.255*round_up(rand()).','.255*round_up(rand()).')', 'opacity'=>(0.5+0.5*rand()) }; return $style; } #--------- ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������SVG-2.84/examples/attributeManip.pl�����������������������������������������������������������������0000755�0001750�0001750�00000002065�13057520366�016622� 0����������������������������������������������������������������������������������������������������ustar �manwar��������������������������manwar�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#!/usr/bin/perl # # Attribute manipulations # use strict; use warnings; use SVG; # Create an SVG object # (c) 2003 Ronan Oger my $svg = SVG->new(width=>200,height=>200); $svg->title()->cdata('I am a title'); # Use explicit element constructor to generate a group element: my $y = $svg->group( id => 'group_y', style => { stroke=>'red', fill=>'green' } ); # Add some circles to the group $y->circle(cx=>100, cy=>100, r=>50, id=>'circle_in_group_y_1'); $y->circle(cx=>100, cy=>100, r=>50, id=>'circle_in_group_y_2'); $y->comment('This is a comment'); $y->circle(cx=>100, cy=>100, r=>50, id=>'circle_in_group_y_3'); # Now render the SVG object, while implicitly using the "svg" namespace. print "\nfirst drawing\n"; print $svg->xmlify; print "\n\nSet stroke to red on circle_in_group_y_1:\n"; my $node = $y->getElementByID('circle_in_group_y_1'); $node->setAttribute('stroke','red'); print $svg->xmlify; print "\n\nSet stroke to green and undef the cx on circle_in_group_y_1\n"; $node->setAttributes({'stroke'=>'green',cx=>undef}); print $svg->xmlify, "\n"; ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������SVG-2.84/examples/starpath.cgi����������������������������������������������������������������������0000755�0001750�0001750�00000001065�13057520366�015606� 0����������������������������������������������������������������������������������������������������ustar �manwar��������������������������manwar�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#!/usr/bin/perl -w BEGIN { push @INC , '../'; push @INC , '../SVG'; } use strict; use SVG; my $svg = SVG->new(); my $def = $svg->defs( id => 'myStar' ); my $r_star_path = $svg->get_path(type=>'path',x=>[-0.951,0.951,-0.588,0.000,0.588],y=>[-0.309,-0.309,-0.809,-1.000,0.809],-closed=>1); my $star = $def->path('transform' => "scale(100, 100)",%$r_star_path,); $svg->use(-href => "#myStar", stroke=>"red",fill => "yellow", transform => "translate(200, 200)" ); print "Content-Type: image/svg+xml\n\n"; print $svg->xmlify; ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������SVG-2.84/examples/02_circle_with_color.pl�����������������������������������������������������������0000644�0001750�0001750�00000001671�13057520366�017624� 0����������������������������������������������������������������������������������������������������ustar �manwar��������������������������manwar�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#!/usr/bin/perl use strict; use warnings; use SVG; # create an SVG object with a size of 200x200 pixels my $svg = SVG->new( width => 40, height => 40, ); # add a circle with style # fill is the color used tof fill the circle # stroke is the color of the line used to draw the circle # these both can be either a name of a color or an RGB triplet # stroke-width is a non-negative integer, thw width of thr drawing line # stroke-opacity and fill-opacity are floating point numbers between 0 and 1. # 1 means the line is totally opaque # 0 means the line is totally transparent $svg->circle( cx => 20, cy => 20, r => 15, style => { 'fill' => 'rgb(255, 0, 0)', 'stroke' => 'blue', 'stroke-width' => 5, 'stroke-opacity' => 0.5, 'fill-opacity' => 0.5, }, ); # now render the SVG object, implicitly use svg namespace print $svg->xmlify, "\n"; �����������������������������������������������������������������������SVG-2.84/examples/sun_text_sample.pl����������������������������������������������������������������0000755�0001750�0001750�00000041420�13057520366�017042� 0����������������������������������������������������������������������������������������������������ustar �manwar��������������������������manwar�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#!/usr/bin/perl BEGIN { push @INC , '../'; push @INC , '../SVG'; } use SVG; use strict; use CGI ':header'; my $p = CGI->new; print $p->header(-type=>'image/svg+xml'); my $svg = SVG->new(width=>500,height=>500); $svg->desc()->cdata('This example shows some more features of SVG Text'); $svg->title()->cdata('Sample 3: text'); $svg->comment( 'hello I am a dog. Actually, I am an SVG demo of the perl SVG.pm module', 'While the original static example was done by SUN, this is a 100% dynamic', 'sample. Case in point. Last time I looked, the SUN sample did not work on any', 'of my browser implementations.', '=========================================================================', 'SVG Sample Pool : Text', 'This sample shows some powerful features of SVG Text elements ', 'among which are the "text" element; "tspan" element; "textPath" element;', 'text orientation management using "writing-mode" and text alignment', 'using property of "text-anchor". Some font-related features are also', 'Sun @author Sheng Pei, Vincent Hardy ', 'Copyright Sun Microsystems Inc., 2000-2002 ', 'Notice that the copyright is next year!! Today is 13.10.01 (editor)', 'I wondef if the copyright includes machine-generated renditions of', 'the content, like I am doing. Awfully presumptuous to copyright', 'content that is being offered as a sample of SVG application', '=========================================================================', ); my $defg_m = $svg->defs()->group(id=>'marker',style=>{"stroke-width"=>1}); $defg_m->line(x1=>-15,y1=>0,x2=>15,y2=>0,style=>{'stroke'=>'currentColor'}); $defg_m->line(y1=>-15,x1=>0,y2=>15,x2=>0,style=>{'stroke'=>'currentColor'}); $svg->comment( '=====================================================================', 'Simple text element, for the graphics title. ', 'This illustrates a very simple text element where text is centered ', 'about its anchor. ', '=====================================================================', 'Draw simple text'); $svg->text(x=>200, y=>80, style=> {'text-anchor'=>'middle', 'font-size'=>60, 'font-weight'=>800, 'font-family'=>'Verdana', 'font-style'=>'italic'})->cdata('hello, Sun.'); $svg->comment('Display marker for the anchor point'); $svg->use(-href=>"#marker", style=>"color:black", transform=>'translate(200, 80)'); $svg->comment( '=====================================================================', "The first part of the picture: 'SVG' following the upper curved line", 'defs / xlink:href in textPath is the way to achieve text on a path.', 'This illustrates: text, textPath and tspan', '=====================================================================', 'Define the path on which text is laid out'); my $path = $svg->get_path(x=>[-100,0, 200,200],y=>[0,-100,-100,0]); $svg->defs()->path(id=>"Path1",%$path); my $textLayout1 = $svg->group(id=>"textLayout1", transform=>"translate(200, 250)"); $textLayout1->comment('Draw the path on which text is laid out'); $textLayout1->use(-href=>"#Path1", style=>{stroke=>'yellow','stroke-width'=>40, 'fill'=>'none'}); $textLayout1->use(-href=>"#Path1", style=>{stroke=>'black','stroke-width'=>1, fill=>'none'}); $textLayout1->comment('Layout text on path'); $textLayout1->text(style=>{'font-family'=>'Verdana', 'font-size'=>80, 'font-weight'=>800, fill=>'blue', 'text-anchor'=>'middle'}); my $textLayoutpath1 = $textLayout1->text(-type=>'path', -href=>"#Path1", startOffset=>"0"); $textLayoutpath1->text(-type=>'span', style=>"fill:black")->cdata('S'); $textLayoutpath1->text(-type=>'span', style=>{stroke=>'black',fill=>'white'})->cdata('V'); $textLayoutpath1->text(-type=>'span', style=>"fill:red")->cdata('G'); $svg->comment('textLayout1', '=======================================================================', "The second part of the picture: 'is' following the right vertical line ", 'This illustrates glyph layout capabilities, here top to bottom layout.', '=======================================================================' ); $svg->defs()->path(id=>"Path2", d=>"M 100 0 l 0 150"); my $tl2 = $svg->group(id=>"textLayout2" ,transform=>"translate(200, 250)"); $tl2->use(-href=>"#Path2", style=>{stroke=>'red', 'stroke-width'=>40}); $tl2->comment("Here we change the writing-mode of the text element to 'tb' (for 'top to bottom')"); $tl2->text( x=>"100", y=>"75", style=>{'font-family'=>'Verdana', 'font-weight'=>800, 'font-size'=>50,fill=>'white', 'writing-mode'=>'tb', 'text-anchor'=>'middle'})->cdata('is'); $tl2->use( -href=>"#marker", style=>"color:black;", transform=>"translate(100, 75)" ); $svg->comment('======================================================================', "Third part of the picture: 'very' following the bottom horizontal line", 'This illustrates one way of displaying text upside down. ', '======================================================================', 'Define the path where the text is laid out'); $svg->defs()->path(id=>"Path3", d=>"M 100 150 l -200 0"); $svg->comment('Draw the path on which text is laid out'); my $tl3 = $svg->group( id=>"textLayout3", transform=>"translate(200, 250)"); $tl3->use(-href=>"#Path3", style=>"stroke:yellow; stroke-width:40"); $tl3->use( -href=>"#Path3", style=>{stroke=>'black','stroke-width'=>1}); $tl3->text(style=>{ 'font-family'=>'Verdana', 'font-size'=>40, 'font-weight'=>900, fill=>'black', stroke=>'none', 'text-anchor'=>'middle'} ); $tl3->text(type=>'path', -href=>"#Path3", 'xml:space'=>"default")->cdata('very'); $svg->comment('textLayout3'); $svg->comment('========================================================================', "The fourth part of the picture: 'cool' following the left vertical line", 'This further illustrates tspan, this time directly in a text element.', '========================================================================'); $svg->defs()->path(id=>"Path4", d=>"M -100 150 l 0 -150" ); my $tl4 = $svg->group(id=>"textLayout4", transform=>"translate(200, 250)"); $tl4->use( -href=>"#Path4", style=>"stroke:red; stroke-width:40"); my $tl4_t = $tl4->text( x=>"0", y=>"0", style=>{'font-family'=>'Verdana', 'font-size'=>50, 'font-style'=>'italic',fill=>'white', stroke=>'black', 'writing-mode'=>'lr', 'text-anchor'=>"middle"}, transform=>"translate(-100, 75) rotate(-90)"); $tl4_t->tspan(dy=>"0")->cdata('cool!'); $tl4_t->tspan(dy=>"-25", style=>{'font-size'=>10, stroke=>'none', fill=>'black'}) ->cdata('SVG'); $tl4_t->tspan(dy=>"0",style=>{'font-size'=>10, stroke=>'none', fill=>'black'})->cdata('SVG'); $tl4->use(transform=>"translate(-100, 75)", -href=>"#marker", style=>"color:black;"); $svg->comment( '=============================================================================', "Below are steps to produce the 'SVG' in the box, mainly using the text-anchor", 'to align the three glyphs ', 'This illustrates the various text anchors. ', '============================================================================='); my $tl5 = $svg->group( id=>"textLayout5", transform=>"translate(180, 290)", style=>"font-weight:800"); $tl5->use( -href=>"#marker", style=>{fill=>'black', stroke=>'black',transform=>'translate(30, 50)'}); $tl5->comment('Anchored to the end'); $tl5->text( x=>"30", y=>"50", style=>{'font-family'=>'Verdana','font-size'=>100, stroke=>'black', fill=>'none', 'text-anchor'=>'end'})->cdata('S'); $tl5->comment('Anchored to the start'); $tl5->text( x=>"30", y=>"50", style=>{'font-family'=>'Verdana', 'font-size'=>40, 'font-weight'=>700, stroke=>'black',fill=>'none', 'text-anchor'=>'start'}) ->cdata('G'); $tl5->comment("When the orientation is 'top_bottom' using 'start' as the anchor makes", 'the glyph aligns to the upper line',); $tl5->use(-href=>"#marker", style=>"color:red", transform=>"translate(48, -30)"); $tl5->comment('Anchored to the start, with top to bottom text layout'); $tl5->text( x=>"48", y=>"-30", style=>{'font-family'=>'Verdana', 'font-size'=>50,stroke=>'red', fill=>'none','writing-mode'=>'tb', 'text-anchor'=>'start'}) ->cdata('V'); $svg->anchor(-href=>"http://roitsystems.com/")->text(x=>200, y=>160, style=> {'text-anchor'=>'middle', 'font-size'=>30, 'font-weight'=>800, 'font-family'=>'Verdana', 'font-style'=>'italic', opacity=>0.3})->cdata('Use SVG.pm'); print $svg->xmlify; __END__ This example shows some more features of SVG Text. Sample 3: text SVG Text S V G is very cool! SVG S G V ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������SVG-2.84/examples/svg2png.pl������������������������������������������������������������������������0000644�0001750�0001750�00000000410�13057520366�015205� 0����������������������������������������������������������������������������������������������������ustar �manwar��������������������������manwar�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#!/usr/bin/perl use strict; use warnings; use Image::LibRSVG; my ($in, $out) = @ARGV; if (not $out) { die <<"END_USAGE"; Converting svg file to png file: Usage: $0 file.svg file.png END_USAGE } my $rsvg = Image::LibRSVG->new(); $rsvg->convert( $in, $out ); ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������SVG-2.84/META.yml�����������������������������������������������������������������������������������0000664�0001750�0001750�00000002453�13242535444�012727� 0����������������������������������������������������������������������������������������������������ustar �manwar��������������������������manwar�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������--- abstract: 'Perl extension for generating Scalable Vector Graphics (SVG) documents.' author: - 'Ronan Oger ' build_requires: ExtUtils::MakeMaker: '0' File::Spec: '0' Test::More: '0.94' strict: '0' warnings: '0' configure_requires: ExtUtils::MakeMaker: '0' perl: '5.006' strict: '0' warnings: '0' dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 7.24, CPAN::Meta::Converter version 2.150005' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: SVG no_index: directory: - t - inc provides: SVG: file: lib/SVG.pm version: '2.84' SVG::DOM: file: lib/SVG/DOM.pm version: '2.84' SVG::Element: file: lib/SVG/Element.pm version: '2.84' SVG::Extension: file: lib/SVG/Extension.pm version: '2.84' SVG::XML: file: lib/SVG/XML.pm version: '2.84' requires: Exporter: '0' Scalar::Util: '0' constant: '0' parent: '0' perl: '5.006' strict: '0' vars: '0' warnings: '0' resources: repository: https://github.com/manwar/SVG.git version: '2.84' x_contributors: - 'Peter Wainwright' - 'Ian Hickson' - 'Adam Schneider' - 'Steve Lihn' - 'Allen Day' - 'Gabor Szabo' - 'Mohammad S Anwar' x_serialization_backend: 'CPAN::Meta::YAML version 0.018' ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������SVG-2.84/Changes������������������������������������������������������������������������������������0000644�0001750�0001750�00000025742�13242534645�012757� 0����������������������������������������������������������������������������������������������������ustar �manwar��������������������������manwar�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Revision history for Perl extension SVG. 2.84 2018.02.19 MANWAR - Removed '+x' bits from the script "xt/author/pod-syntax.t". 2.83 2018.02.12 MANWAR - Merged PR #11 (Test Reports), thanks @genio. 2.82 2017.12.18 MANWAR - Fixed subquery (txn-1762542) of the issue RT #123896. 2.81 2017.12.17 MANWAR - Fixed issue RT #123896 (trailing space in credit comment). 2.80 2017.11.30 MANWAR - Added one more test author only as suggested by @DAVE. (RT #123705) 2.79 2017.11.30 MANWAR - Addressed RT #123705, making test t/96-perl-critic.t and t/99_test_pod_coverage.t author only. 2.78 2017.07.07 MANWAR - Merged PR #10 (fix entity escaping), thanks @haarg. This also resolved RT #121612. 2.77 2017.05.18 MANWAR - Proposed fix to the following test failure: http://www.cpantesters.org/cpan/report/ddc7eefc-3429-11e7-8430-9cfb106f656a 2.76 2017.05.08 MANWAR - Added AUTHOR ONLY test scripts (meta-json.t and meta-yml.t). 2.75 2017.05.07 MANWAR - Tidied up unit test scripts and removed '+x' attributes. - Tidied up SEE ALSO section in SVG::XML package pod. 2.74 2017.05.04 MANWAR - Added key 'provides' to the Makefile.PL script as recommended by CPANTS. 2.73 2017.05.03 MANWAR - Merged PR #8, thanks @CSSON. Modified slightly to keep tidyall happy. - Correct some spelling errors that were detected by codespell. - Don't insert whitespace between tag name and closing bracked when a tag has no attributes 2.72 2017.05.02 MANWAR - Added test script t/00-load.t - Fixed typo in the pod document. 2.71 2017.05.01 MANWAR - Fixed issue RT #57000 with regard to be explici about SVG instance. 2.70 2017.04.27 MANWAR - Added MIN_PERL_VERSION to the Makefile.PL script as suggested by CPANTS. 2.69 2017.04.20 MANWAR - Fixed issue RT #118091, skip test if Perl::Tidy is missing. 2.68 2017.04.19 MANWAR - Fixed issue RT #109521, adding min ver of Test::More v0.94. 2.67 2017.04.18 MANWAR - Fixed the issue with regard to github respository info in the Makefile.PL script, thanks @KENTNL. 2.66 2017.04.17 MANWAR - Addressed issue RT #121197 (incorrect meta spec), thanks @KENTNL. - Added 'clean' and 'dist' keys to the Makefile.PL script. - Tidied up .gitignore file. - Added MANIFEST file, no need to generate every time. 2.65 2017.04.16 MANWAR - Merged PR #9, correcting typo in the pod. Thanks @vti. - Tidied up Changes file. - Tidied up Makefile.PL script. - Tidied up README file. 2.64 2015.06.02 - RT #103938 SVG::DOM insertSiblingAfter calls nonexistent 'parent' method (Marius Gavrilescu) 2.63 2015.03.06 - Move SVG results from POD to external files. 2.62 2015.03.06 - Remove more duplicate pod. - Encoding of the pod RT #89414 2.61 2015.03.03 - Eliminate a bunch of duplicate documentation. - Skip tidy testing if module is not available (RT #102484) - POD formatting. 2.60 2015.03.03 - Convert source files to utf8 - Add more tests - CSS styles are now sorted to make it easeier to test - Run Perltidy on the code 2.59 2013.03.31 - Experiment to show images on MetaCPAN 2.56 2013.03.30 - Move all the content of SVG::Manual to SVG 2.55 2013.03.30 - Add an image to the pod generated by and example. - Rename SVG::Manual from .pm to .pod. - Stop violating the Subroutines::ProhibitExplicitReturnUndef policy, eliminate 'return undef' and return wantarray?():undef; from the code. 2.54 2013.02.16 - Update the dates in the Changes file. - Remove the function prototypes that don't work on methods anyway. Stop violating the Subroutines::ProhibitSubroutinePrototypes policy. 2.53 2012.08.09 - missing test file removed from MANIFEST (RT #78856) 2.52 2012.05.29 - move POD testing to xt/ - Some example cleanup - Shlomi Fish - Removing prototype - Shlomi Fish - POD fixes - David Paleino 2.51 2012.03.30 - Maintenance by Gabor Szabo - Some documentation fixes. - Modernizing test suite. - Link to new public repository. 2.50 2010.04.05 - Fixed inline SVG generation method (bug # 43814 and 50075) - Fixed XML-escaped characters (bug # 53918 and 44454) - Fixed undef bug in findChildIndex (bug # 48932) - Fixed memory leaks with Scalar::Util::weaken() (bug # 54458) - Fixed cloning method (bug # 36194) - DOM::insertAtIndex() and removeAtIndex() now update the ID and element list 2.49 2009.01.23 - Fixed bugtracker URL in YAML 2.48 2009.01.08 - Improved YAML and MANIFEST for cpan testers game 2.47 2008.12.15 - Fixed MANIFEST - replaced Changes entry 2.46 2008.12.15 - Improved META.yml - Fixed MANIFEST - Removed all pointless files 2.45 2008.12.15 - Improved META.yml 2.44 2008.04.21 - Improved META.yml 2.43 2008.04.21 - Improved META.yml 2.42 2008.04.16 - Removed Makefile from MANIFEST 2.41 2008.04.16 - Fixed MANIFEST and added license data to the SVG.pm file 2.40 2008.04.14 - Changed tests to current recommendation. Moved to t/ directory. - Added POD and POD Coverage tests 2.39 2008.04.08 - Added warnings 2.38 2008.04.03 - Modified SVG::Element to answer a bug report in rt.perl.org by slaven regarding the redefined methods warnings when SVG is used twice. - Fixed the POD to reflect annotation comments. 2.37 2008.03.02 - Added NS definitions for svg and xlink to enable xlink:href and svg: namespace usage in Firefox. 2.36 2007.09.16 - Fixed SVG::DOM POD 2.35 2007.09.14 - Fixed SVG::DOM POD 2.34 2005.05.17 - SVG::Element - Removed elsep entry for CDATA, cdata, cdata_noxmlesc fields to get rid of artificial blank spaces that confuse some browsers - SVG::DOM - added getRootNode method - Added user-contributed DOM2 methods to SVG::DOM 2.33 2005.05.14 - Fixed the xlink reference behaviour which was wrong and broke Mozilla native SVG. Fix submitted by Ian Hickson 2.32 2004.10.10 - Bufgix to repair broken test which causes failure of make test - Added sorting to attribute list so output is consistent - Added generic support for -href for any method that adds it as an attribute - Added xlink support to any tag with an -href attribute - Added 'a' and 'g' autosubs - Added numerous tests including pi, polygon, script, anchor, style tests - Bugfix for pi() method - Repaired script and style examples 2.31 2004.10.08 - Bugfix to stop xml escaping of attribute data. - Additional support of making fe element types case insensitive 2.30 2004.09.30 - POD changes 2.29 2004.09.26 - Exposed SVG::Extension - Exposed perlify - Added Mozilla native SVG support as default behaviour 2.28 2003.11.03 - Added SVG::GD to allow GD users to output SVG for simple GD drawings (RO) - Added perlify support: Generate Perl code from an SVG document (PW) - Added SVG::Extension for DTD validation support during serialisation (PW) - Took away automatic xml escaping code. This belongs in user codei (RO). - Added attributeName and attributeType to legal animateTransform in SVG::Element SMIL animation per Mike Churchill bug report 2003.12.03 - Bug fix to the inlinesvg.pl example Also per Mike Churchill bug report 2.27 2002.01.29 - Added setAttribute and setAttributes to SVG::DOM 2.26 2002.08.04 - Moved all -specialarguments to %default_attrs so they can be set at import time - Added strict checking for duplicate IDs in tag() and attribute() - Created test suite of 17 initial regession test scripts - Improved xmlesc method in 2.25 2002.07.13 - Extended DOM module to cover many more DOM functions - Rewrote attrib() to also set and delete attributes - Added 'attribute' and 'attr' aliases for attrib() 2.22 2002.06.24 - Minor bug fix - method script was changed to uppercase accidentally. Repaired this error. 2.21 2002.06.20 - Added the internal hash $svg->{-docref} which contains the -elist and -idlist hashes for tracking the elements and ids in the document in the DOM - Added functionality to SVG::DOM including getElements, getElementByID - Added an example of the use of SVG DOM in the examples directory - Added element-level namespace support to override the document namespace 2.2 2002.06.15 - Bug fix for SVG::DOM - Enabled SVG::DOM and added additional functionality 2.1 2002.05.27 - Separated out the SVG module documentation and moved it to SVG::Manual.pm - Added experimental SVG::DOM - Improved script support and commenting. - Added an end-of-output credit 2.0 2001.12.24 - Improved POD, and moved it to SVG::manual - Tested significantly - Added aliases for xmlify - broke out Element.pm module from SVG.pm file - Repaired scripting support - Added CDATA tag for unmollested text support - changed underlying datastructure to support SVG::Parser - Repaired inline SVG generation - Added configurability and NON-SVG support 1.12 2001.10.18 - Repaired Animate command - Added import functionality - Improved AUTOLOAD functionality - Improved POD - Tested significantly - Modified constructor to accept XML-definition parameters in preparation for supporting SVG::Parser - 0.60-1.0 Internal releases - Not released to public. 0.50 2001.10.13 - Maintenance release. - Repaired and added consistency to pod - Repaired small bug in inline. - Added svg.pm to examples. Tested sample of the synopsis script. 0.31 2001.10.10 - Bug fix for careless error. Left a debugging comment in the code. - Next time, run the code through an interpreted rather than just looking at the raw XML. 0.30 2001.10.10 - Now support -T and inline and namespace. 0.29 2001.10.09 - Repaired bug in method $self->use(). The method was generating an tag. 0.28 2001.10.08 - Got the program to pass -w - Fixed user-reported bug in animate function $rtr{-method} was missing the minus. - ran significant tests for complex files. Most work but some crash. 0.26 2001.10.07 - Repaired the pod file - Added title and desc support 0.25 2001.10.06 - added image support; improved POD; - Provided DTD & XML version support: XML version '1.0' XML encoding 'UTF-8' standalone 'yes' namespace 'svg' DTD identifier '-//W3C//DTD SVG 1.0//EN'; DTD url 'http://www.w3.org/TR/2001/REC-SVG-20010904/DTD/svg10.dtd' 0.2 2001.10.06 - date: Sat Oct 6 02:47:02 - added filter support; improved POD. 0.1 2001.10.04 - date was: Thu Oct 4 09:46:28 2001 - original version; created by h2xs 1.19 ������������������������������SVG-2.84/.tidyallrc���������������������������������������������������������������������������������0000644�0001750�0001750�00000000212�13057520366�013434� 0����������������������������������������������������������������������������������������������������ustar �manwar��������������������������manwar�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������[PerlTidy] select = {bin,lib,t}/**/*.{pl,pm,t,psgi} select = app.psgi argv = --profile=$ROOT/.perltidyrc [SortLines] select = .gitignore ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������SVG-2.84/xt/����������������������������������������������������������������������������������������0000755�0001750�0001750�00000000000�13242535444�012103� 5����������������������������������������������������������������������������������������������������ustar �manwar��������������������������manwar�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������SVG-2.84/xt/release/��������������������������������������������������������������������������������0000755�0001750�0001750�00000000000�13242535444�013523� 5����������������������������������������������������������������������������������������������������ustar �manwar��������������������������manwar�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������SVG-2.84/xt/release/meta-yml.t����������������������������������������������������������������������0000644�0001750�0001750�00000001150�13240335252�015423� 0����������������������������������������������������������������������������������������������������ustar �manwar��������������������������manwar�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use strict; use warnings; use Test::More; use Test::CPAN::Meta; use SVG; my $meta = meta_spec_ok('MYMETA.yml'); my $version = $SVG::VERSION; is( $meta->{version}, $version, 'MYMETA.yml distribution version matches' ); if ( $meta->{provides} ) { foreach my $mod ( keys %{ $meta->{provides} } ) { eval("use $mod;"); my $mod_version = eval( sprintf( "\$%s::VERSION", $mod ) ); is( $meta->{provides}{$mod}{version}, $version, "MYMETA.yml entry [$mod] version matches" ); is( $mod_version, $version, "Package $mod doesn't match version." ); } } done_testing(); ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������SVG-2.84/xt/release/meta-json.t���������������������������������������������������������������������0000644�0001750�0001750�00000001161�13242535211�015574� 0����������������������������������������������������������������������������������������������������ustar �manwar��������������������������manwar�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use strict; use warnings; use Test::More; use Test::CPAN::Meta::JSON; use SVG; my $meta = meta_spec_ok('MYMETA.json'); my $version = $SVG::VERSION; is( $meta->{version}, $version, 'MYMETA.json distribution version matches' ); if ( $meta->{provides} ) { foreach my $mod ( keys %{ $meta->{provides} } ) { eval("use $mod;"); my $mod_version = eval( sprintf( "\$%s::VERSION", $mod ) ); is( $meta->{provides}{$mod}{version}, $version, "MYMETA.json entry [$mod] version matches" ); is( $mod_version, $version, "Package $mod doesn't match version." ); } } done_testing(); ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������SVG-2.84/xt/author/���������������������������������������������������������������������������������0000755�0001750�0001750�00000000000�13242535444�013405� 5����������������������������������������������������������������������������������������������������ustar �manwar��������������������������manwar�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������SVG-2.84/xt/author/pod-syntax.t���������������������������������������������������������������������0000644�0001750�0001750�00000000202�13240335252�015663� 0����������������������������������������������������������������������������������������������������ustar �manwar��������������������������manwar�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use strict; use Test::More; use Test::Pod 1.00; my @poddirs = qw( blib blib/SVG); all_pod_files_ok( all_pod_files( @poddirs ) ); ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������SVG-2.84/xt/author/pod-coverage.t�������������������������������������������������������������������0000644�0001750�0001750�00000000123�13240335252�016132� 0����������������������������������������������������������������������������������������������������ustar �manwar��������������������������manwar�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test::More; use Test::Pod::Coverage; plan tests => 1; pod_coverage_ok("SVG"); ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������SVG-2.84/xt/author/perl-critic.t��������������������������������������������������������������������0000644�0001750�0001750�00000000057�13240335252�016002� 0����������������������������������������������������������������������������������������������������ustar �manwar��������������������������manwar�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test::Perl::Critic; all_critic_ok('lib'); ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������SVG-2.84/xt/author/tidyall.t������������������������������������������������������������������������0000644�0001750�0001750�00000000431�13240335252�015223� 0����������������������������������������������������������������������������������������������������ustar �manwar��������������������������manwar�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use strict; use warnings; use Test::More; use Perl::Tidy; use Test::Code::TidyAll; tidyall_ok( verbose => ( exists $ENV{TEST_TIDYALL_VERBOSE} ? $ENV{TEST_TIDYALL_VERBOSE} : 0 ), jobs => ( exists $ENV{TEST_TIDYALL_JOBS} ? $ENV{TEST_TIDYALL_JOBS} : 1 ), ); done_testing; ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������SVG-2.84/xt/author/perl-critic-tidy.t���������������������������������������������������������������0000644�0001750�0001750�00000001256�13240335252�016753� 0����������������������������������������������������������������������������������������������������ustar �manwar��������������������������manwar�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use strict; use warnings; use Test::More; plan skip_all => 'Set $ENV{TEST_AUTHOR} to enable this test.' unless $ENV{TEST_AUTHOR}; ## no critic #use Perl::Critic; use Perl::Tidy; use Test::Perl::Critic 1.02; # NOTE: New files will be tested automatically. # FIXME: Things should be removed (not added) to this list. # Temporarily skip any files that existed before adding the tests. # Eventually these should all be removed (once the files are cleaned up). my %skip = map { ( $_ => 1 ) } qw( ); my @files = grep { !$skip{$_} } ( Perl::Critic::Utils::all_perl_files(qw( bin lib )) ); # TODO t foreach my $file (@files) { critic_ok( $file, $file ); } done_testing(); ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������