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 make_sprite_prefix/;
   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
  31         for (@images) {
  32                 my ($img, $doc) = @$_;
  33                 my $svg = $doc->getFirstChild;
  34                 my ($w) = $svg->attr('width') =~ /([0-9.]*)/ or carp "Image $img has no width";
  35                 my ($h) = $svg->attr('height') =~ /([0-9.]*)/ or carp "Image $img has no height";
  36                 $mh = $h if $h > $mh;
  37                 $svg->attr(x => $x);
  38                 $svg->attr(version => undef);
  39                 my $view = $sprite->view(id => $img, viewBox => "$x 0 $w $h");
  40                 $x += $w + 5;
  41                 $view->getParent->insertAfter($svg, $view);
  42         }
  43
  44         # Keep a reference to the documents to prevent garbage collection
  45         $sprite->{'--images'} = \@images;
  46         $sprite->getFirstChild->attr(viewBox => "0 0 $x $mh");
  47         $sprite
  48 }
  49
  50 1;
  51 __END__
  52
  53 =encoding utf-8
  54
  55 =head1 NAME
  56
  57 SVG::SpriteMaker - Combine several SVG images into a single SVG sprite
  58
  59 =head1 SYNOPSIS
  60
  61   use File::Slurp qw/write_file/;
  62   use SVG::SpriteMaker;
  63   my $sprite = make_sprite img => '1.svg', '2.svg', '3.svg';
  64   write_file 'sprite.svg', $sprite->xmlify;
  65   # You can now use <img src="sprite.svg#img-1" alt="...">
  66
  67   my @images = <dir/*>; # dir/ImageA.svg dir/ImageB.svg
  68   $sprite = make_sprite sub {
  69     my ($name) = $_[0] =~ m,/([^/.]*),;
  70     uc $name
  71   }, @images; # Sprite will have identifiers #IMAGEA #IMAGEB
  72
  73 =head1 DESCRIPTION
  74
  75 A SVG sprite is a SVG image that contains several smaller images that
  76 can be referred to using fragment identifiers. For example, this HTML
  77 fragment:
  78
  79   <img src="/img/cat.svg" alt="A cat">
  80   <img src="/img/dog.svg" alt="A dog">
  81   <img src="/img/horse.svg" alt="A horse">
  82
  83 Can be replaced with
  84
  85   <img src="/img/sprite.svg#cat" alt="A cat">
  86   <img src="/img/sprite.svg#dog" alt="A dog">
  87   <img src="/img/sprite.svg#horse" alt="A horse">
  88
  89 This module exports a single function:
  90
  91 =head2 B<make_sprite>(I<$prefix>|I<$coderef>, I<@files>)
  92
  93 Takes a list of filenames, combines them and returns the resulting
  94 sprite as a L<SVG> object. Each SVG must have width and height
  95 attributes whose values are in pixels.
  96
  97 If the first argument is a coderef, it will be called with each
  98 filename as a single argument and it should return the desired
  99 fragment identifier.
 100
 101 If the first argument is not a coderef, the following coderef will be
 102 used:
 103
 104   sub {
 105     my $base = scalar fileparse $_[0], qr/\..*/s;
 106     "$prefix-$base"
 107   };
 108
 109 where I<$prefix> is the value of the first argument.
 110
 111 =head1 SEE ALSO
 112
 113 L<svg-spritemaker>, L<https://css-tricks.com/svg-fragment-identifiers-work/>
 114
 115 =head1 AUTHOR
 116
 117 Marius Gavrilescu, E<lt>marius@ieval.roE<gt>
 118
 119 =head1 COPYRIGHT AND LICENSE
 120
 121 Copyright (C) 2015 by Marius Gavrilescu
 122
 123 This library is free software; you can redistribute it and/or modify
 124 it under the same terms as Perl itself, either Perl version 5.20.2 or,
 125 at your option, any later version of Perl 5 you may have available.
 126
 127
 128 =cut