]>
Commit | Line | Data |
---|---|---|
b1b509f4 MG |
1 | package SVG::SpriteMaker; |
2 | ||
3 | use 5.014000; | |
4 | use strict; | |
5 | use warnings; | |
6 | ||
5c7da44c | 7 | our $VERSION = '0.002'; |
566ccd6a | 8 | our @EXPORT = qw/make_sprite/; |
b1b509f4 MG |
9 | our @EXPORT_OK = @EXPORT; |
10 | ||
11 | use parent qw/Exporter/; | |
12 | use re '/s'; | |
13 | ||
14 | use Carp; | |
15 | use File::Basename; | |
16 | ||
17 | use SVG -indent => '', -elsep => ''; | |
18 | use SVG::Parser; | |
19 | ||
20 | sub make_sprite { | |
21 | my ($prefix, @images) = @_; | |
22 | my $sub = ref $prefix eq 'CODE' ? $prefix : sub { | |
23 | my $base = scalar fileparse $_[0], qr/[.].*/; | |
24 | "$prefix-$base" | |
25 | }; | |
26 | my $sprite = SVG->new(-inline => 1); | |
27 | my $parser = SVG::Parser->new; | |
28 | @images = map {[ $sub->($_) => $parser->parse_file($_) ]} @images; | |
29 | my ($x, $mh) = (0, 0); | |
014f8c27 | 30 | my %ids = map { $_->[0] => 1 } @images; # start with image names |
b1b509f4 MG |
31 | |
32 | for (@images) { | |
33 | my ($img, $doc) = @$_; | |
34 | my $svg = $doc->getFirstChild; | |
35 | my ($w) = $svg->attr('width') =~ /([0-9.]*)/ or carp "Image $img has no width"; | |
36 | my ($h) = $svg->attr('height') =~ /([0-9.]*)/ or carp "Image $img has no height"; | |
37 | $mh = $h if $h > $mh; | |
38 | $svg->attr(x => $x); | |
39 | $svg->attr(version => undef); | |
40 | my $view = $sprite->view(id => $img, viewBox => "$x 0 $w $h"); | |
41 | $x += $w + 5; | |
014f8c27 MG |
42 | |
43 | my @all_elems = $svg->getElements; | |
44 | my @duplicate_ids; | |
45 | for my $elem (@all_elems) { | |
46 | my $id = $elem->attr('id'); | |
47 | next unless $id; | |
48 | if ($ids{$id}) { | |
49 | push @duplicate_ids, $id; | |
50 | } else { | |
51 | $ids{$id} = 1; | |
52 | } | |
53 | } | |
54 | ||
55 | 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 | for my $oid (@duplicate_ids) { | |
62 | my $nid = $oid; | |
63 | $nid .= '_' while $ids{$nid}; | |
64 | $svg->getElementByID($oid)->attr(id => $nid); | |
65 | for my $elem (@all_elems) { | |
66 | my %attribs = %{$elem->getAttributes}; | |
67 | for my $key (keys %attribs) { | |
68 | if ($attribs{$key} =~ /#$oid\b/) { | |
69 | $attribs{$key} =~ s/#$oid\b/#$nid/g; | |
70 | $elem->attr($key => $attribs{$key}); | |
71 | } | |
72 | } | |
73 | if ($elem->cdata =~ /#$oid\b/) { | |
74 | $elem->cdata($elem->cdata =~ s/#$oid\b/#$nid/gr); | |
75 | } | |
76 | } | |
77 | } | |
78 | ||
b1b509f4 MG |
79 | $view->getParent->insertAfter($svg, $view); |
80 | } | |
81 | ||
82 | # Keep a reference to the documents to prevent garbage collection | |
83 | $sprite->{'--images'} = \@images; | |
84 | $sprite->getFirstChild->attr(viewBox => "0 0 $x $mh"); | |
85 | $sprite | |
86 | } | |
87 | ||
88 | 1; | |
89 | __END__ | |
90 | ||
91 | =encoding utf-8 | |
92 | ||
93 | =head1 NAME | |
94 | ||
95 | SVG::SpriteMaker - Combine several SVG images into a single SVG sprite | |
96 | ||
97 | =head1 SYNOPSIS | |
98 | ||
99 | use File::Slurp qw/write_file/; | |
100 | use SVG::SpriteMaker; | |
101 | my $sprite = make_sprite img => '1.svg', '2.svg', '3.svg'; | |
102 | write_file 'sprite.svg', $sprite->xmlify; | |
103 | # You can now use <img src="sprite.svg#img-1" alt="..."> | |
104 | ||
105 | my @images = <dir/*>; # dir/ImageA.svg dir/ImageB.svg | |
106 | $sprite = make_sprite sub { | |
107 | my ($name) = $_[0] =~ m,/([^/.]*),; | |
108 | uc $name | |
109 | }, @images; # Sprite will have identifiers #IMAGEA #IMAGEB | |
110 | ||
111 | =head1 DESCRIPTION | |
112 | ||
113 | A SVG sprite is a SVG image that contains several smaller images that | |
114 | can be referred to using fragment identifiers. For example, this HTML | |
115 | fragment: | |
116 | ||
117 | <img src="/img/cat.svg" alt="A cat"> | |
118 | <img src="/img/dog.svg" alt="A dog"> | |
119 | <img src="/img/horse.svg" alt="A horse"> | |
120 | ||
121 | Can be replaced with | |
122 | ||
123 | <img src="/img/sprite.svg#cat" alt="A cat"> | |
124 | <img src="/img/sprite.svg#dog" alt="A dog"> | |
125 | <img src="/img/sprite.svg#horse" alt="A horse"> | |
126 | ||
127 | This module exports a single function: | |
128 | ||
129 | =head2 B<make_sprite>(I<$prefix>|I<$coderef>, I<@files>) | |
130 | ||
131 | Takes a list of filenames, combines them and returns the resulting | |
132 | sprite as a L<SVG> object. Each SVG must have width and height | |
133 | attributes whose values are in pixels. | |
134 | ||
135 | If the first argument is a coderef, it will be called with each | |
136 | filename as a single argument and it should return the desired | |
137 | fragment identifier. | |
138 | ||
139 | If the first argument is not a coderef, the following coderef will be | |
140 | used: | |
141 | ||
142 | sub { | |
143 | my $base = scalar fileparse $_[0], qr/\..*/s; | |
144 | "$prefix-$base" | |
145 | }; | |
146 | ||
147 | where I<$prefix> is the value of the first argument. | |
148 | ||
014f8c27 MG |
149 | If an ID is shared between two or more input files, this module will |
150 | try to rename each occurence except for the first one. This operation | |
151 | might have false positives (attributes/cdatas that are mistakenly | |
152 | identified to contain the ID-to-be-renamed) and false negatives | |
153 | (attributes/cdatas that actually contain the ID-to-be-renamed but this | |
154 | is missed by the module), and as such SVG::SpriteMaker will warn if | |
155 | duplicate IDs are detected. You can suppress this warning by setting | |
156 | the C<SVG_SPRITEMAKER_NO_DUPLICATE_WARNINGS> environment variable to a | |
157 | true value. | |
158 | ||
b1b509f4 MG |
159 | =head1 SEE ALSO |
160 | ||
39589141 | 161 | L<svg-spritemaker>, L<https://css-tricks.com/svg-fragment-identifiers-work/> |
b1b509f4 MG |
162 | |
163 | =head1 AUTHOR | |
164 | ||
165 | Marius Gavrilescu, E<lt>marius@ieval.roE<gt> | |
166 | ||
167 | =head1 COPYRIGHT AND LICENSE | |
168 | ||
5c7da44c | 169 | Copyright (C) 2015-2017 by Marius Gavrilescu |
b1b509f4 MG |
170 | |
171 | This library is free software; you can redistribute it and/or modify | |
172 | it under the same terms as Perl itself, either Perl version 5.20.2 or, | |
173 | at your option, any later version of Perl 5 you may have available. | |
174 | ||
175 | ||
176 | =cut |