lib/SVG/SpriteMaker.pm

   1 package SVG::SpriteMaker;
   2
   3 use 5.014000;
   4 use strict;
   5 use warnings;
   6
   7 our $VERSION = '0.001';
   8 our @EXPORT = qw/make_sprite/;
   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);
  30         my %ids = map { $_->[0] => 1 } @images; # start with image names
  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;
  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
  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
 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
 159 =head1 SEE ALSO
 160
 161 L<svg-spritemaker>, L<https://css-tricks.com/svg-fragment-identifiers-work/>
 162
 163 =head1 AUTHOR
 164
 165 Marius Gavrilescu, E<lt>marius@ieval.roE<gt>
 166
 167 =head1 COPYRIGHT AND LICENSE
 168
 169 Copyright (C) 2015 by Marius Gavrilescu
 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