[svg-spritemaker.git] / lib / SVG / SpriteMaker.pm

package SVG::SpriteMaker;

use 5.014000;
use strict;
use warnings;

our $VERSION = '0.002';
our @EXPORT = qw/make_sprite/;
our @EXPORT_OK = @EXPORT;

use parent qw/Exporter/;
use re '/s';

use Carp;
use File::Basename;

use SVG -indent => '', -elsep => '';
use SVG::Parser;

sub make_sprite {
	my ($prefix, @images) = @_;
	my $sub = ref $prefix eq 'CODE' ? $prefix : sub {
		my $base = scalar fileparse $_[0], qr/[.].*/;
		"$prefix-$base"
	};
	my $sprite = SVG->new(-inline => 1);
	my $parser = SVG::Parser->new;
	@images = map {[ $sub->($_) => $parser->parse_file($_) ]} @images;
	my ($x, $mh) = (0, 0);
	my %ids = map { $_->[0] => 1 } @images; # start with image names

	for (@images) {
		my ($img, $doc) = @$_;
		my $svg = $doc->getFirstChild;
		my ($w) = $svg->attr('width') =~ /([0-9.]*)/ or carp "Image $img has no width";
		my ($h) = $svg->attr('height') =~ /([0-9.]*)/ or carp "Image $img has no height";
		$mh = $h if $h > $mh;
		$svg->attr(x => $x);
		$svg->attr(version => undef);
		my $view = $sprite->view(id => $img, viewBox => "$x 0 $w $h");
		$x += $w + 5;

		my @all_elems = $svg->getElements;
		my @duplicate_ids;
		for my $elem (@all_elems) {
			my $id = $elem->attr('id');
			next unless $id;
			if ($ids{$id}) {
				push @duplicate_ids, $id;
			} else {
				$ids{$id} = 1;
			}
		}

		warn <<"EOF" if @duplicate_ids && !$ENV{SVG_SPRITEMAKER_NO_DUPLICATE_WARNINGS};
Some IDs (@duplicate_ids) in $img also exist in previous images.
Trying to fix automatically, but this might produce a broken SVG.
Fix IDs manually to avoid incorrect output.
EOF

		for my $oid (@duplicate_ids) {
			my $nid = $oid;
			$nid .= '_' while $ids{$nid};
			$svg->getElementByID($oid)->attr(id => $nid);
			for my $elem (@all_elems) {
				my %attribs = %{$elem->getAttributes};
				for my $key (keys %attribs) {
					if ($attribs{$key} =~ /#$oid\b/) {
						$attribs{$key} =~ s/#$oid\b/#$nid/g;
						$elem->attr($key => $attribs{$key});
					}
				}
				if ($elem->cdata =~ /#$oid\b/) {
					$elem->cdata($elem->cdata =~ s/#$oid\b/#$nid/gr);
				}
			}
		}

		$view->getParent->insertAfter($svg, $view);
	}

	# Keep a reference to the documents to prevent garbage collection
	$sprite->{'--images'} = \@images;
	$sprite->getFirstChild->attr(viewBox => "0 0 $x $mh");
	$sprite
}

1;
__END__

=encoding utf-8

=head1 NAME

SVG::SpriteMaker - Combine several SVG images into a single SVG sprite

=head1 SYNOPSIS

  use File::Slurp qw/write_file/;
  use SVG::SpriteMaker;
  my $sprite = make_sprite img => '1.svg', '2.svg', '3.svg';
  write_file 'sprite.svg', $sprite->xmlify;
  # You can now use <img src="sprite.svg#img-1" alt="...">

  my @images = <dir/*>; # dir/ImageA.svg dir/ImageB.svg
  $sprite = make_sprite sub {
    my ($name) = $_[0] =~ m,/([^/.]*),;
    uc $name
  }, @images; # Sprite will have identifiers #IMAGEA #IMAGEB

=head1 DESCRIPTION

A SVG sprite is a SVG image that contains several smaller images that
can be referred to using fragment identifiers. For example, this HTML
fragment:

  <img src="/img/cat.svg" alt="A cat">
  <img src="/img/dog.svg" alt="A dog">
  <img src="/img/horse.svg" alt="A horse">

Can be replaced with

  <img src="/img/sprite.svg#cat" alt="A cat">
  <img src="/img/sprite.svg#dog" alt="A dog">
  <img src="/img/sprite.svg#horse" alt="A horse">

This module exports a single function:

=head2 B<make_sprite>(I<$prefix>|I<$coderef>, I<@files>)

Takes a list of filenames, combines them and returns the resulting
sprite as a L<SVG> object. Each SVG must have width and height
attributes whose values are in pixels.

If the first argument is a coderef, it will be called with each
filename as a single argument and it should return the desired
fragment identifier.

If the first argument is not a coderef, the following coderef will be
used:

  sub {
    my $base = scalar fileparse $_[0], qr/\..*/s;
    "$prefix-$base"
  };

where I<$prefix> is the value of the first argument.

If an ID is shared between two or more input files, this module will
try to rename each occurence except for the first one. This operation
might have false positives (attributes/cdatas that are mistakenly
identified to contain the ID-to-be-renamed) and false negatives
(attributes/cdatas that actually contain the ID-to-be-renamed but this
is missed by the module), and as such SVG::SpriteMaker will warn if
duplicate IDs are detected. You can suppress this warning by setting
the C<SVG_SPRITEMAKER_NO_DUPLICATE_WARNINGS> environment variable to a
true value.

=head1 SEE ALSO

L<svg-spritemaker>, L<https://css-tricks.com/svg-fragment-identifiers-work/>

=head1 AUTHOR

Marius Gavrilescu, E<lt>marius@ieval.roE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2015-2017 by Marius Gavrilescu

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.20.2 or,
at your option, any later version of Perl 5 you may have available.


=cut
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
b1b509f4 MG	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