line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package SVG::SpriteMaker; |
2
|
|
|
|
|
|
|
|
3
|
1
|
|
|
1
|
|
14626
|
use 5.014000; |
|
1
|
|
|
|
|
5
|
|
4
|
1
|
|
|
1
|
|
6
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
21
|
|
5
|
1
|
|
|
1
|
|
4
|
use warnings; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
57
|
|
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
our $VERSION = '0.002'; |
8
|
|
|
|
|
|
|
our @EXPORT = qw/make_sprite/; |
9
|
|
|
|
|
|
|
our @EXPORT_OK = @EXPORT; |
10
|
|
|
|
|
|
|
|
11
|
1
|
|
|
1
|
|
442
|
use parent qw/Exporter/; |
|
1
|
|
|
|
|
228
|
|
|
1
|
|
|
|
|
4
|
|
12
|
1
|
|
|
1
|
|
43
|
use re '/s'; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
63
|
|
13
|
|
|
|
|
|
|
|
14
|
1
|
|
|
1
|
|
4
|
use Carp; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
66
|
|
15
|
1
|
|
|
1
|
|
4
|
use File::Basename; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
95
|
|
16
|
|
|
|
|
|
|
|
17
|
1
|
|
|
1
|
|
584
|
use SVG -indent => '', -elsep => ''; |
|
1
|
|
|
|
|
10895
|
|
|
1
|
|
|
|
|
9
|
|
18
|
1
|
|
|
1
|
|
1204
|
use SVG::Parser; |
|
1
|
|
|
|
|
1227
|
|
|
1
|
|
|
|
|
5
|
|
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
sub make_sprite { |
21
|
1
|
|
|
1
|
1
|
92
|
my ($prefix, @images) = @_; |
22
|
|
|
|
|
|
|
my $sub = ref $prefix eq 'CODE' ? $prefix : sub { |
23
|
2
|
|
|
2
|
|
96
|
my $base = scalar fileparse $_[0], qr/[.].*/; |
24
|
2
|
|
|
|
|
15
|
"$prefix-$base" |
25
|
1
|
50
|
|
|
|
8
|
}; |
26
|
1
|
|
|
|
|
11
|
my $sprite = SVG->new(-inline => 1); |
27
|
1
|
|
|
|
|
261
|
my $parser = SVG::Parser->new; |
28
|
1
|
|
|
|
|
39921
|
@images = map {[ $sub->($_) => $parser->parse_file($_) ]} @images; |
|
2
|
|
|
|
|
4176
|
|
29
|
1
|
|
|
|
|
2934
|
my ($x, $mh) = (0, 0); |
30
|
1
|
|
|
|
|
3
|
my %ids = map { $_->[0] => 1 } @images; # start with image names |
|
2
|
|
|
|
|
5
|
|
31
|
|
|
|
|
|
|
|
32
|
1
|
|
|
|
|
5
|
for (@images) { |
33
|
2
|
|
|
|
|
45
|
my ($img, $doc) = @$_; |
34
|
2
|
|
|
|
|
11
|
my $svg = $doc->getFirstChild; |
35
|
2
|
50
|
|
|
|
37
|
my ($w) = $svg->attr('width') =~ /([0-9.]*)/ or carp "Image $img has no width"; |
36
|
2
|
50
|
|
|
|
32
|
my ($h) = $svg->attr('height') =~ /([0-9.]*)/ or carp "Image $img has no height"; |
37
|
2
|
100
|
|
|
|
32
|
$mh = $h if $h > $mh; |
38
|
2
|
|
|
|
|
8
|
$svg->attr(x => $x); |
39
|
2
|
|
|
|
|
15
|
$svg->attr(version => undef); |
40
|
2
|
|
|
|
|
29
|
my $view = $sprite->view(id => $img, viewBox => "$x 0 $w $h"); |
41
|
2
|
|
|
|
|
89
|
$x += $w + 5; |
42
|
|
|
|
|
|
|
|
43
|
2
|
|
|
|
|
6
|
my @all_elems = $svg->getElements; |
44
|
2
|
|
|
|
|
33
|
my @duplicate_ids; |
45
|
2
|
|
|
|
|
3
|
for my $elem (@all_elems) { |
46
|
4
|
|
|
|
|
6
|
my $id = $elem->attr('id'); |
47
|
4
|
100
|
|
|
|
34
|
next unless $id; |
48
|
2
|
100
|
|
|
|
5
|
if ($ids{$id}) { |
49
|
1
|
|
|
|
|
2
|
push @duplicate_ids, $id; |
50
|
|
|
|
|
|
|
} else { |
51
|
1
|
|
|
|
|
17
|
$ids{$id} = 1; |
52
|
|
|
|
|
|
|
} |
53
|
|
|
|
|
|
|
} |
54
|
|
|
|
|
|
|
|
55
|
2
|
50
|
66
|
|
|
11
|
warn <<"EOF" if @duplicate_ids && !$ENV{SVG_SPRITEMAKER_NO_DUPLICATE_WARNINGS}; |
56
|
|
|
|
|
|
|
Some IDs (@duplicate_ids) in $img also exist in previous images. |
57
|
|
|
|
|
|
|
Trying to fix automatically, but this might produce a broken SVG. |
58
|
|
|
|
|
|
|
Fix IDs manually to avoid incorrect output. |
59
|
|
|
|
|
|
|
EOF |
60
|
|
|
|
|
|
|
|
61
|
2
|
|
|
|
|
3
|
for my $oid (@duplicate_ids) { |
62
|
1
|
|
|
|
|
3
|
my $nid = $oid; |
63
|
1
|
|
|
|
|
5
|
$nid .= '_' while $ids{$nid}; |
64
|
1
|
|
|
|
|
3
|
$svg->getElementByID($oid)->attr(id => $nid); |
65
|
1
|
|
|
|
|
14
|
for my $elem (@all_elems) { |
66
|
2
|
|
|
|
|
17
|
my %attribs = %{$elem->getAttributes}; |
|
2
|
|
|
|
|
5
|
|
67
|
2
|
|
|
|
|
61
|
for my $key (keys %attribs) { |
68
|
14
|
50
|
|
|
|
46
|
if ($attribs{$key} =~ /#$oid\b/) { |
69
|
0
|
|
|
|
|
0
|
$attribs{$key} =~ s/#$oid\b/#$nid/g; |
70
|
0
|
|
|
|
|
0
|
$elem->attr($key => $attribs{$key}); |
71
|
|
|
|
|
|
|
} |
72
|
|
|
|
|
|
|
} |
73
|
2
|
50
|
|
|
|
6
|
if ($elem->cdata =~ /#$oid\b/) { |
74
|
0
|
|
|
|
|
0
|
$elem->cdata($elem->cdata =~ s/#$oid\b/#$nid/gr); |
75
|
|
|
|
|
|
|
} |
76
|
|
|
|
|
|
|
} |
77
|
|
|
|
|
|
|
} |
78
|
|
|
|
|
|
|
|
79
|
2
|
|
|
|
|
11
|
$view->getParent->insertAfter($svg, $view); |
80
|
|
|
|
|
|
|
} |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
# Keep a reference to the documents to prevent garbage collection |
83
|
1
|
|
|
|
|
29
|
$sprite->{'--images'} = \@images; |
84
|
1
|
|
|
|
|
3
|
$sprite->getFirstChild->attr(viewBox => "0 0 $x $mh"); |
85
|
1
|
|
|
|
|
55
|
$sprite |
86
|
|
|
|
|
|
|
} |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
1; |
89
|
|
|
|
|
|
|
__END__ |