SVG-2.84/ 0000755 0001750 0001750 00000000000 13242535444 011450 5 ustar manwar manwar SVG-2.84/t/ 0000755 0001750 0001750 00000000000 13242535444 011713 5 ustar manwar manwar SVG-2.84/t/05-processinginstruction.t 0000644 0001750 0001750 00000003220 13057520366 016776 0 ustar manwar manwar use 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.t 0000644 0001750 0001750 00000001100 13057520366 014127 0 ustar manwar manwar use 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.t 0000644 0001750 0001750 00000000626 13057520366 014515 0 ustar manwar manwar use 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.t 0000644 0001750 0001750 00000003206 13057520366 014305 0 ustar manwar manwar use 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.t 0000644 0001750 0001750 00000001237 13057520366 014013 0 ustar manwar manwar use 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.t 0000644 0001750 0001750 00000000450 13057520366 014340 0 ustar manwar manwar use 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.t 0000644 0001750 0001750 00000000520 13057520366 014506 0 ustar manwar manwar use 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.t 0000644 0001750 0001750 00000002720 13057520366 013605 0 ustar manwar manwar use 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.t 0000644 0001750 0001750 00000000620 13101532353 013220 0 ustar manwar manwar #!/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.t 0000644 0001750 0001750 00000001202 13057520366 013607 0 ustar manwar manwar use 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.t 0000644 0001750 0001750 00000000313 13210233610 015545 0 ustar manwar manwar use 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.t 0000644 0001750 0001750 00000001172 13057520366 014167 0 ustar manwar manwar use 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.t 0000644 0001750 0001750 00000000544 13057520366 013473 0 ustar manwar manwar use 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.t 0000644 0001750 0001750 00000000535 13057520366 014307 0 ustar manwar manwar use 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.t 0000644 0001750 0001750 00000001725 13102112140 013557 0 ustar manwar manwar use 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{