File Coverage

blib/lib/CSS/SpriteMaker.pm
Criterion Covered Total %
statement 10 12 83.3
branch n/a
condition n/a
subroutine 4 4 100.0
pod n/a
total 14 16 87.5


line stmt bran cond sub pod time code
1             package CSS::SpriteMaker;
2              
3 1     1   59151 use strict;
  1         4  
  1         45  
4 1     1   6 use warnings;
  1         3  
  1         34  
5              
6 1     1   6 use File::Find;
  1         8  
  1         78  
7 1     1   478 use Image::Magick;
  0            
  0            
8             use List::Util qw(max);
9              
10             use Module::Pluggable
11             search_path => ['CSS::SpriteMaker::Layout'],
12             except => qr/CSS::SpriteMaker::Layout::Utils::.*/,
13             require => 1,
14             inner => 0;
15              
16             use POSIX qw(ceil);
17              
18              
19             =head1 NAME
20              
21             CSS::SpriteMaker - Combine several images into a single CSS sprite
22              
23             =head1 VERSION
24              
25             Version 0.14
26              
27             =cut
28              
29             our $VERSION = '0.14';
30              
31              
32             =head1 SYNOPSIS
33              
34             use CSS::SpriteMaker;
35              
36             my $SpriteMaker = CSS::SpriteMaker->new(
37             verbose => 1, # optional
38              
39             #
40             # Options that impact the lifecycle of css class name generation
41             #
42             # if provided will replace the default logic for creating css classnames
43             # out of image filenames. This filename-to-classname is the FIRST step
44             # of css classnames creation. It's safe to return invalid css characters
45             # in this subroutine. They will be cleaned up internally.
46             #
47             rc_filename_to_classname => sub { my $filename = shift; ... } # optional
48              
49             # ... cleaning stage happens (all non css safe characters are removed)
50              
51             # This adds a prefix to all the css class names. This is called after
52             # the cleaning stage internally. Don't mess with invalid CSS characters!
53             #
54             css_class_prefix => 'myicon-',
55              
56             # This is the last step. Change here whatever part of the final css
57             # class name.
58             #
59             rc_override_classname => sub { my $css_class = shift; ... } # optional
60             );
61              
62             $SpriteMaker->make_sprite(
63             source_images => ['/path/to/imagedir', '/images/img1.png', '/img2.png'];
64             target_file => '/tmp/test/mysprite.png',
65             layout_name => 'Packed', # optional
66             remove_source_padding => 1, # optional
67             add_extra_padding => 31, # optional +31px padding around all images
68             format => 'png8', # optional
69             );
70              
71             $SpriteMaker->print_css();
72              
73             $SpriteMaker->print_html();
74              
75             OR
76              
77             my $SpriteMaker = CSS::SpriteMaker->new();
78              
79             $SpriteMaker->make_sprite(
80             source_dir => '/tmp/test/images',
81             target_file => '/tmp/test/mysprite.png',
82             );
83              
84             $SpriteMaker->print_css();
85              
86             $SpriteMaker->print_html();
87              
88             OR
89              
90             my $SpriteMaker = CSS::SpriteMaker->new();
91              
92             $SpriteMaker->compose_sprite(
93             parts => [
94             { source_dir => 'sample_icons',
95             layout_name => 'Packed',
96             add_extra_padding => 32 # just add extra padding in one part
97             },
98             { source_dir => 'more_icons',
99             layout => {
100             name => 'FixedDimension',
101             options => {
102             'dimension' => 'horizontal',
103             'n' => 4,
104             }
105             }
106             },
107             ],
108             # the composing layout
109             layout => {
110             name => 'FixedDimension',
111             options => {
112             n => 2,
113             }
114             },
115             target_file => 'composite.png',
116             );
117              
118             $SpriteMaker->print_css();
119              
120             $SpriteMaker->print_html();
121              
122             ALTERNATIVELY
123              
124             you can generate a fake CSS only containing the original images...
125              
126             my $SpriteMakerOnlyCss = CSS::SpriteMaker->new();
127              
128             $SpriteMakerOnlyCss->print_fake_css(
129             filename => 'some/fake_style.css',
130             source_dir => 'sample_icons'
131             );
132              
133              
134             =head1 DESCRIPTION
135              
136             A CSS Sprite is an image obtained by arranging many smaller images on a 2D
137             canvas, according to a certain layout.
138              
139             Transferring one larger image is generally faster than transferring multiple
140             images separately as it greatly reduces the number of HTTP requests (and
141             overhead) necessary to render the original images on the browser.
142              
143             =head1 PUBLIC METHODS
144              
145             =head2 new
146              
147             Create and configure a new CSS::SpriteMaker object.
148              
149             The object can be initialised as follows:
150            
151             my $SpriteMaker = CSS::SpriteMaker->new({
152             rc_filename_to_classname => sub { my $filename = shift; ... }, # optional
153             css_class_prefix => 'myicon-', # optional
154             rc_override_classname => sub { my $css_class = shift; ... } # optional
155             source_dir => '/tmp/test/images', # optional
156             target_file => '/tmp/test/mysprite.png' # optional
157             remove_source_padding => 1, # optional
158             add_extra_padding => 1, # optional
159             verbose => 1, # optional
160             });
161            
162             Default values are set to:
163              
164             =over 4
165              
166             =item remove_source_padding : false,
167              
168             =item verbose : false,
169              
170             =item format : png,
171              
172             =item css_class_prefix : ''
173              
174             =back
175              
176             The parameter rc_filename_to_classname is a code reference to a function that
177             allow to customize the way class names are generated. This function should take
178             one parameter as input and return a class name
179              
180             =cut
181              
182             sub new {
183             my $class = shift;
184             my %opts = @_;
185              
186             # defaults
187             $opts{remove_source_padding} //= 0;
188             $opts{add_extra_padding} //= 0;
189             $opts{verbose} //= 0;
190             $opts{format} //= 'png';
191             $opts{layout_name} //= 'Packed';
192             $opts{css_class_prefix} //= '';
193            
194             my $self = {
195             css_class_prefix => $opts{css_class_prefix},
196             source_images => $opts{source_images},
197             source_dir => $opts{source_dir},
198             target_file => $opts{target_file},
199             is_verbose => $opts{verbose},
200             format => $opts{format},
201             remove_source_padding => $opts{remove_source_padding},
202             add_extra_padding => $opts{add_extra_padding},
203             output_css_file => $opts{output_css_file},
204             output_html_file => $opts{output_html_file},
205              
206             # layout_name is used as default
207             layout => {
208             name => $opts{layout_name},
209             # no options by default
210             options => {}
211             },
212             rc_filename_to_classname => $opts{rc_filename_to_classname},
213             rc_override_classname => $opts{rc_override_classname},
214              
215             # the maximum color value
216             color_max => 2 ** Image::Magick->QuantumDepth - 1,
217             };
218              
219             return bless $self, $class;
220             }
221              
222             =head2 compose_sprite
223              
224             Compose many sprite layouts into one sprite. This is done by applying
225             individual layout separately, then merging the final result together using a
226             glue layout.
227              
228             my $is_error = $SpriteMaker->compose_sprite (
229             parts => [
230             { source_images => ['some/file.png', 'path/to/some_directory'],
231             layout_name => 'Packed',
232             },
233             { source_images => ['path/to/some_directory'],
234             layout => {
235             name => 'DirectoryBased',
236             }
237             include_in_css => 0, # optional
238             remove_source_padding => 1, # optional (defaults to 0)
239             add_extra_padding => 40, # optional, px (defaults to 0px)
240             },
241             ],
242             # arrange the previous two layout using a glue layout
243             layout => {
244             name => 'FixedDimension',
245             dimension => 'horizontal',
246             n => 2
247             }
248             target_file => 'sample_sprite.png',
249             format => 'png8', # optional, default is png
250             );
251              
252             Note the optional include_in_css option, which allows to exclude a group of
253             images from the CSS (still including them in the resulting image).
254              
255             =cut
256              
257             sub compose_sprite {
258             my $self = shift;
259             my %options = @_;
260              
261             if (exists $options{layout}) {
262             return $self->_compose_sprite_with_glue(%options);
263             }
264             else {
265             return $self->_compose_sprite_without_glue(%options);
266             }
267             }
268              
269             =head2 make_sprite
270              
271             Creates the sprite file out of the specifed image files or directories, and
272             according to the given layout name.
273              
274             my $is_error = $SpriteMaker->make_sprite(
275             source_images => ['some/file.png', path/to/some_directory],
276             target_file => 'sample_sprite.png',
277             layout_name => 'Packed',
278              
279             # all imagemagick supported formats
280             format => 'png8', # optional, default is png
281             );
282              
283             returns true if an error occurred during the procedure.
284              
285             Available layouts are:
286              
287             =over 4
288              
289             =item * Packed: try to pack together the images as much as possible to reduce the
290             image size.
291              
292             =item * DirectoryBased: put images under the same directory on the same horizontal
293             row. Order alphabetically within each row.
294              
295             =item * FixedDimension: arrange a maximum of B images on the same row (or
296             column).
297              
298             =back
299              
300             =cut
301              
302             sub make_sprite {
303             my $self = shift;
304             my %options = @_;
305              
306             my $rh_sources_info = $self->_ensure_sources_info(%options);
307             my $Layout = $self->_ensure_layout(%options,
308             rh_sources_info => $rh_sources_info
309             );
310              
311             return $self->_write_image(%options,
312             Layout => $Layout,
313             rh_sources_info => $rh_sources_info
314             );
315             }
316              
317             =head2 print_css
318              
319             Creates and prints the css stylesheet for the sprite that was previously
320             produced.
321              
322             You can specify the filename or the filehandle where the output CSS should be
323             written:
324              
325             $SpriteMaker->print_css(
326             filehandle => $fh,
327             );
328              
329             OR
330              
331             $SpriteMaker->print_css(
332             filename => 'relative/path/to/style.css',
333             );
334              
335             Optionally you can provide the name of the image file that should be included in
336             the CSS file instead of the default one:
337              
338             # within the style.css file, override the default path to the sprite image
339             # with "custom/path/to/sprite.png".
340             #
341             $SpriteMaker->print_css(
342             filename => 'relative/path/to/style.css',
343             sprite_filename => 'custom/path/to/sprite.png', # optional
344             );
345              
346              
347             NOTE: make_sprite() must be called before this method is called.
348              
349             =cut
350              
351             sub print_css {
352             my $self = shift;
353             my %options = @_;
354            
355             my $rh_sources_info = $self->_ensure_sources_info(%options);
356             my $Layout = $self->_ensure_layout(%options,
357             rh_sources_info => $rh_sources_info
358             );
359              
360             my $fh = $self->_ensure_filehandle_write(%options);
361              
362             $self->_verbose(" * writing css file");
363              
364             my $target_image_filename;
365             if (exists $options{sprite_filename} && $options{sprite_filename}) {
366             $target_image_filename = $options{sprite_filename};
367             }
368              
369             my $stylesheet = $self->_get_stylesheet_string({
370             target_image_filename => $target_image_filename,
371             use_full_images => 0
372             },
373             %options
374             );
375              
376             print $fh $stylesheet;
377              
378             return 0;
379             }
380              
381             =head2 print_fake_css
382              
383             Fake a css spritesheet by generating a stylesheet containing just the original
384             images (not the ones coming from the sprite!)
385              
386             $SpriteMaker->print_fake_css(
387             filename => 'relative/path/to/style.css',
388             fix_image_path => {
389             find: '/some/absolute/path', # a Perl regexp
390             replace: 'some/relative/path'
391             }
392             );
393              
394             NOTE: unlike print_css you don't need to call this method after make_sprite.
395              
396             =cut
397              
398             sub print_fake_css {
399             my $self = shift;
400             my %options = @_;
401            
402             my $rh_sources_info = $self->_ensure_sources_info(%options);
403              
404             my $fh = $self->_ensure_filehandle_write(%options);
405              
406             $self->_verbose(" * writing fake css file");
407              
408             if (exists $options{sprite_filename}) {
409             die "the sprite_filename option is incompatible with fake_css. In this mode the original images are used in the spritesheet";
410             }
411              
412             my $stylesheet = $self->_get_stylesheet_string({
413             use_full_images => 1
414             },
415             %options
416             );
417              
418             print $fh $stylesheet;
419              
420             return 0;
421             }
422              
423             =head2 print_html
424              
425             Creates and prints an html sample page containing informations about each sprite produced.
426              
427             $SpriteMaker->print_html(
428             filehandle => $fh,
429             );
430              
431             OR
432              
433             $SpriteMaker->print_html(
434             filename => 'relative/path/to/index.html',
435             );
436              
437             NOTE: make_sprite() must be called before this method is called.
438              
439             =cut
440             sub print_html {
441             my $self = shift;
442             my %options = @_;
443            
444             my $rh_sources_info = $self->_ensure_sources_info(%options);
445             my $Layout = $self->_ensure_layout(%options,
446             rh_sources_info => $rh_sources_info
447             );
448             my $fh = $self->_ensure_filehandle_write(%options);
449            
450             $self->_verbose(" * writing html sample page");
451              
452             my $stylesheet = $self->_get_stylesheet_string({}, %options);
453              
454             print $fh '

CSS::SpriteMaker Image Information

';
489              
490             # html
491             for my $id (keys %$rh_sources_info) {
492             my $rh_source_info = $rh_sources_info->{$id};
493            
494             my $css_class = $self->_generate_css_class_name($rh_source_info->{name});
495             $self->_verbose(
496             sprintf("%s -> %s", $rh_source_info->{name}, $css_class)
497             );
498              
499             $css_class =~ s/[.]//;
500              
501             my $is_included = $rh_source_info->{include_in_css};
502             my $width = $rh_source_info->{original_width};
503             my $height = $rh_source_info->{original_height};
504              
505             my $onclick = <
506             if (typeof current !== 'undefined' && current !== this) {
507             current.style.width = current.w;
508             current.style.height = current.h;
509             current.style.position = '';
510             delete current.w;
511             delete current.h;
512             }
513             if (typeof this.h === 'undefined') {
514             this.h = this.style.height;
515             this.w = this.style.width;
516             this.style.width = '';
517             this.style.height = '';
518             this.style.position = 'fixed';
519             current = this;
520             }
521             else {
522             this.style.width = this.w;
523             this.style.height = this.h;
524             this.style.position = '';
525             delete this.w;
526             delete this.h;
527             current = undefined;
528             }
529             EONCLICK
530              
531              
532             print $fh sprintf(
533             '
',
534             $is_included ? ' included' : ' not-included',
535             $onclick,
536             $width, $height
537             );
538              
539            
540             if ($is_included) {
541             print $fh "
";
542             }
543             else {
544             print $fh "
";
545             }
546             print $fh "
";
547             for my $key (keys %$rh_source_info) {
548             next if $key eq "colors";
549             print $fh "" . $key . ": " . ($rh_source_info->{$key} // 'none') . "
";
550             }
551             print $fh '

Colors

';
552             print $fh "total: " . $rh_source_info->{colors}{total} . '
';
553             for my $colors (keys %{$rh_source_info->{colors}{map}}) {
554             my ($r, $g, $b, $a) = split /,/, $colors;
555             my $rrgb = $r * 255 / $self->{color_max};
556             my $grgb = $g * 255 / $self->{color_max};
557             my $brgb = $b * 255 / $self->{color_max};
558             my $argb = 255 - ($a * 255 / $self->{color_max});
559             print $fh '
";
560             }
561             print $fh " ";
562             print $fh '';
563             }
564              
565             print $fh "";
566              
567             return 0;
568             }
569              
570             =head2 get_css_info_structure
571              
572             Returns an arrayref of hashrefs like:
573              
574             [
575             {
576             full_path => 'relative/path/to/file.png',
577             css_class => 'file',
578             width => 16, # pixels
579             height => 16,
580             x => 173, # offset within the layout
581             y => 234,
582             },
583             ...more
584             ]
585              
586             This structure can be used to build your own html or css stylesheet for
587             example.
588              
589             NOTE: the x y offsets within the layout, will be always positive numbers.
590              
591             =cut
592              
593             sub get_css_info_structure {
594             my $self = shift;
595             my %options = @_;
596              
597             my $rh_sources_info = $self->_ensure_sources_info(%options);
598             my $Layout = $self->_ensure_layout(%options,
599             rh_sources_info => $rh_sources_info
600             );
601              
602             my $rh_id_to_class = $self->_generate_css_class_names($rh_sources_info);
603              
604             my @css_info;
605              
606             for my $id (keys %$rh_sources_info) {
607             my $rh_source_info = $rh_sources_info->{$id};
608             my $css_class = $rh_id_to_class->{$id};
609              
610             my ($x, $y) = $Layout->get_item_coord($id);
611              
612             push @css_info, {
613             full_path => $rh_source_info->{pathname},
614             x => $x + $rh_source_info->{add_extra_padding},
615             y => $y + $rh_source_info->{add_extra_padding},
616             css_class => $css_class,
617             width => $rh_source_info->{original_width},
618             height => $rh_source_info->{original_height},
619             };
620             }
621              
622             return \@css_info;
623             }
624              
625             =head1 PRIVATE METHODS
626              
627             =head2 _generate_css_class_names
628              
629             Returns a mapping id -> class_name out of the current information structure.
630              
631             It guarantees unique class_name for each id.
632              
633             =cut
634              
635             sub _generate_css_class_names {
636             my $self = shift;
637             my $rh_source_info = shift;;
638              
639             my %existing_classnames_lookup;
640             my %id_to_class_mapping;
641              
642             PROCESS_SOURCEINFO:
643             for my $id (keys %$rh_source_info) {
644            
645             next PROCESS_SOURCEINFO if !$rh_source_info->{$id}{include_in_css};
646              
647             my $css_class = $self->_generate_css_class_name(
648             $rh_source_info->{$id}{name}
649             );
650            
651             # keep modifying the css_class name until it doesn't exist in the hash
652             my $i = 0;
653             while (exists $existing_classnames_lookup{$css_class}) {
654             # ... we want to add an incremental suffix like "-2"
655             if (!$i) {
656             # the first time, we want to add the prefix only, but leave the class name intact
657             if ($css_class =~ m/-\Z/) {
658             # class already ends with a dash
659             $css_class .= '1';
660             }
661             else {
662             $css_class .= '-1';
663             }
664             }
665             elsif ($css_class =~ m/-(\d+)\Z/) { # that's our dash added before!
666             my $current_number = $1;
667             $current_number++;
668             $css_class =~ s/-\d+\Z/-$current_number/;
669             }
670             $i++;
671             }
672              
673             $existing_classnames_lookup{$css_class} = 1;
674             $id_to_class_mapping{$id} = $css_class;
675             }
676              
677             return \%id_to_class_mapping;
678             }
679              
680              
681             =head2 _image_locations_to_source_info
682              
683             Identify informations from the location of each input image, and assign
684             numerical ids to each input image.
685              
686             We use a global image identifier for composite layouts. Each identified image
687             must have a unique id in the scope of the same CSS::SpriteMaker instance!
688              
689             =cut
690              
691             sub _image_locations_to_source_info {
692             my $self = shift;
693             my $ra_locations = shift;
694             my $remove_source_padding = shift;
695             my $add_extra_padding = shift;
696             my $include_in_css = shift // 1;
697              
698             my %source_info;
699            
700             # collect properties of each input image.
701             IMAGE:
702             for my $rh_location (@$ra_locations) {
703              
704             my $id = $self->_get_image_id;
705              
706             my %properties = %{$self->_get_image_properties(
707             $rh_location->{pathname},
708             $remove_source_padding,
709             $add_extra_padding,
710             )};
711              
712             # add whether to include this item in the css or not
713             $properties{include_in_css} = $include_in_css;
714              
715             # this is really for write_image, it should add padding as necessary
716             $properties{add_extra_padding} = $add_extra_padding;
717              
718             # skip invalid images
719             next IMAGE if !%properties;
720              
721             for my $key (keys %$rh_location) {
722             $source_info{$id}{$key} = $rh_location->{$key};
723             }
724             for my $key (keys %properties) {
725             $source_info{$id}{$key} = $properties{$key};
726             }
727             }
728              
729             return \%source_info;
730             }
731              
732             =head2 _get_image_id
733              
734             Returns a global numeric identifier.
735              
736             =cut
737              
738             sub _get_image_id {
739             my $self = shift;
740             $self->{_unique_id} //= 0;
741             return $self->{_unique_id}++;
742             }
743              
744             =head2 _locate_image_files
745              
746             Finds the location of image files within the given directory. Returns an
747             arrayref of hashrefs containing information about the names and pathnames of
748             each image file.
749              
750             The returned arrayref looks like:
751              
752             [ # pathnames of the first image to follow
753             {
754             name => 'image.png',
755             pathname => '/complete/path/to/image.png',
756             parentdir => '/complete/path/to',
757             },
758             ...
759             ]
760              
761             Dies if the given directory is empty or doesn't exist.
762              
763             =cut
764              
765             sub _locate_image_files {
766             my $self = shift;
767             my $source_directory = shift;
768              
769             if (!defined $source_directory) {
770             die "you have called _locate_image_files but \$source_directory was undefined";
771             }
772              
773             $self->_verbose(" * gathering files and directories of source images");
774              
775             my @locations;
776             find(sub {
777             my $filename = $_;
778             my $fullpath = $File::Find::name;
779             my $parentdir = $File::Find::dir;
780            
781             return if $filename eq '.';
782              
783             if (-f $filename) {
784             push @locations, {
785             # only the name of the file
786             name => $filename,
787              
788             # the full relative pathname
789             pathname => $fullpath,
790              
791             # the full relative path to the parent directory
792             parentdir => $parentdir
793             };
794             }
795              
796             }, $source_directory);
797              
798             return \@locations;
799             }
800              
801             =head2 _get_stylesheet_string
802              
803             Returns the stylesheet in a string.
804              
805             =cut
806              
807             sub _get_stylesheet_string {
808             my $self = shift;
809             my $rh_opts = shift // {};
810             my %options = @_;
811              
812             # defaults
813             my $target_image_filename = $self->{_cache_target_image_file};
814             if (exists $rh_opts->{target_image_filename} && defined $rh_opts->{target_image_filename}) {
815             $target_image_filename = $rh_opts->{target_image_filename};
816             }
817              
818             my $use_full_images = 0;
819             if (exists $rh_opts->{use_full_images} && defined $rh_opts->{use_full_images}) {
820             $use_full_images = $rh_opts->{use_full_images};
821             }
822              
823             my $rah_cssinfo = $self->get_css_info_structure(%options);
824              
825             my @classes = map { "." . $_->{css_class} }
826             grep { defined $_->{css_class} }
827             @$rah_cssinfo;
828              
829             my @stylesheet;
830              
831             if ($use_full_images) {
832             my ($f, $r);
833             my $is_path_to_be_fixed = 0;
834             if (exists $options{fix_image_path} &&
835             exists $options{fix_image_path}{find} &&
836             exists $options{fix_image_path}{replace}) {
837              
838             $is_path_to_be_fixed = 1;
839             $f = qr/$options{fix_image_path}{find}/;
840             $r = $options{fix_image_path}{replace};
841             }
842              
843             ##
844             ## use full images instead of the ones from the sprite
845             ##
846             for my $rh_info (@$rah_cssinfo) {
847              
848             # fix the path (maybe)
849             my $path = $rh_info->{full_path};
850             if ($is_path_to_be_fixed) {
851             $path =~ s/$f/$r/;
852             }
853              
854             if (defined $rh_info->{css_class}) {
855             push @stylesheet, sprintf(
856             ".%s { background-image: url('%s'); width: %spx; height: %spx; }",
857             $rh_info->{css_class},
858             $path,
859             $rh_info->{width},
860             $rh_info->{height},
861             );
862             }
863             }
864             }
865             else {
866             # write header
867             # header associates the sprite image to each class
868             push @stylesheet, sprintf(
869             "%s { background-image: url('%s'); background-repeat: no-repeat; }",
870             join(",", @classes),
871             $target_image_filename
872             );
873              
874             for my $rh_info (@$rah_cssinfo) {
875             if (defined $rh_info->{css_class}) {
876             push @stylesheet, sprintf(
877             ".%s { background-position: %spx %spx; width: %spx; height: %spx; }",
878             $rh_info->{css_class},
879             -1 * $rh_info->{x},
880             -1 * $rh_info->{y},
881             $rh_info->{width},
882             $rh_info->{height},
883             );
884             }
885             }
886             }
887              
888             return join "\n", @stylesheet;
889             }
890              
891              
892             =head2 _generate_css_class_name
893              
894             This method generates the name of the CSS class for a certain image file. Takes
895             the image filename as input and produces a css class name (excluding the
896             prepended ".").
897              
898             =cut
899              
900             sub _generate_css_class_name {
901             my $self = shift;
902             my $filename = shift;
903              
904             my $rc_filename_to_classname = $self->{rc_filename_to_classname};
905             my $rc_override_classname = $self->{rc_override_classname};
906              
907             if (defined $rc_filename_to_classname) {
908             my $classname = $rc_filename_to_classname->($filename);
909             if (!$classname) {
910             warn "custom sub to generate class names out of file names returned empty class for file name $filename";
911             }
912             if ($classname =~ m/^[.]/) {
913             warn sprintf('your custom sub should not include \'.\' at the beginning of the class name. (%s was generated from %s)',
914             $classname,
915             $filename
916             );
917             }
918            
919             if (defined $rc_override_classname) {
920             $classname = $rc_override_classname->($classname);
921             }
922              
923             return $classname;
924             }
925              
926             # prepare (lowercase)
927             my $css_class = lc($filename);
928              
929             # remove image extensions if any
930             $css_class =~ s/[.](tif|tiff|gif|jpeg|jpg|jif|jfif|jp2|jpx|j2k|j2c|fpx|pcd|png|pdf)\Z//;
931              
932             # remove @ [] +
933             $css_class =~ s/[+@\]\[]//g;
934              
935             # turn certain characters into dashes
936             $css_class =~ s/[\s_.]/-/g;
937              
938             # remove dashes if they appear at the end
939             $css_class =~ s/-\Z//g;
940              
941             # remove initial dashes if any
942             $css_class =~ s/\A-+//g;
943              
944             # add prefix if it was requested
945             if (defined $self->{css_class_prefix}) {
946             $css_class = $self->{css_class_prefix} . $css_class;
947             }
948              
949             # allow change (e.g., add prefix)
950             if (defined $rc_override_classname) {
951             $css_class = $rc_override_classname->($css_class);
952             }
953              
954             return $css_class;
955             }
956              
957              
958             =head2 _ensure_filehandle_write
959              
960             Inspects the input %options hash and returns a filehandle according to the
961             parameters passed in there.
962              
963             The filehandle is where something (css stylesheet for example) is going to be
964             printed.
965              
966             =cut
967              
968             sub _ensure_filehandle_write {
969             my $self = shift;
970             my %options = @_;
971              
972             return $options{filehandle} if defined $options{filehandle};
973              
974             if (defined $options{filename}) {
975             open my ($fh), '>', $options{filename};
976             return $fh;
977             }
978              
979             return \*STDOUT;
980             }
981              
982             =head2 _ensure_sources_info
983              
984             Makes sure the user of this module has provided a valid input parameter for
985             sources_info and return the sources_info structure accordingly. Dies in case
986             something goes wrong with the user input.
987              
988             Parameters that allow us to obtain a $rh_sources_info structure are:
989              
990             - source_images: an arrayref of files or directories, directories will be
991             visited recursively and any image file in it becomes the input.
992              
993             If none of the above parameters have been found in input options, the cache is
994             checked before giving up - i.e., the user has previously provided the layout
995             parameter, and was able to generate a sprite.
996              
997             =cut
998              
999             sub _ensure_sources_info {
1000             my $self = shift;
1001             my %options = @_;
1002              
1003             ##
1004             ## Shall we remove source padding?
1005             ## - first check if an option is provided
1006             ## - otherwise default to the option in $self
1007             my $remove_source_padding = $self->{remove_source_padding};
1008             my $add_extra_padding = $self->{add_extra_padding};
1009             if (exists $options{remove_source_padding}
1010             && defined $options{remove_source_padding}) {
1011              
1012             $remove_source_padding = $options{remove_source_padding};
1013             }
1014             if (exists $options{add_extra_padding}
1015             && defined $options{add_extra_padding}) {
1016              
1017             $add_extra_padding = $options{add_extra_padding};
1018             }
1019              
1020              
1021             my $rh_source_info;
1022              
1023             return $options{source_info} if exists $options{source_info};
1024              
1025             my @source_images;
1026              
1027             if (exists $options{source_dir} && defined $options{source_dir}) {
1028             push @source_images, $options{source_dir};
1029             }
1030              
1031             if (exists $options{source_images} && defined $options{source_images}) {
1032             die 'source_images parameter must be an ARRAY REF' if ref $options{source_images} ne 'ARRAY';
1033             push @source_images, @{$options{source_images}};
1034             }
1035              
1036             if (@source_images) {
1037             # locate each file within each directory and then identify all...
1038             my @locations;
1039             for my $file_or_dir (@source_images) {
1040             my $ra_locations = $self->_locate_image_files($file_or_dir);
1041             push @locations, @$ra_locations;
1042             }
1043              
1044             my $include_in_css = exists $options{include_in_css}
1045             ? $options{include_in_css}
1046             : 1;
1047              
1048             $rh_source_info = $self->_image_locations_to_source_info(
1049             \@locations,
1050             $remove_source_padding,
1051             $add_extra_padding,
1052             $include_in_css
1053             );
1054             }
1055            
1056             if (!$rh_source_info) {
1057             if (exists $self->{_cache_rh_source_info}
1058             && defined $self->{_cache_rh_source_info}) {
1059              
1060             $rh_source_info = $self->{_cache_rh_source_info};
1061             }
1062             else {
1063             die "Unable to create the source_info_structure!";
1064             }
1065             }
1066              
1067             return $rh_source_info;
1068             }
1069              
1070              
1071              
1072             =head2 _ensure_layout
1073              
1074             Makes sure the user of this module has provided valid layout options and
1075             returns a $Layout object accordingly. Dies in case something goes wrong with
1076             the user input. A Layout actually runs over the specified items on instantiation.
1077              
1078             Parameters in %options (see code) that allow us to obtain a $Layout object are:
1079              
1080             - layout: a CSS::SpriteMaker::Layout object already;
1081             - layout: can also be a hashref like
1082              
1083             {
1084             name => 'LayoutName',
1085             options => {
1086             'Layout-Specific option' => 'value',
1087             ...
1088             }
1089             }
1090              
1091             - layout_name: the name of a CSS::SpriteMaker::Layout object.
1092              
1093             If none of the above parameters have been found in input options, the cache is
1094             checked before giving up - i.e., the user has previously provided the layout
1095             parameter...
1096              
1097             =cut
1098              
1099             sub _ensure_layout {
1100             my $self = shift;
1101             my %options = @_;
1102              
1103             die 'rh_sources_info parameter is required' if !exists $options{rh_sources_info};
1104              
1105             # Get the layout from the layout parameter in case it is a $Layout object
1106             my $Layout;
1107             if (exists $options{layout} && $options{layout} && ref $options{layout} ne 'HASH') {
1108             if (exists $options{layout}{_layout_ran}) {
1109             $Layout = $options{layout};
1110             }
1111             else {
1112             warn 'a Layout object was specified but strangely was not executed on the specified items. NOTE: if a layout is instantiated it\'s always ran over the items!';
1113             }
1114             }
1115              
1116             if (defined $Layout) {
1117             if (exists $options{layout_name} && defined $options{layout_name}) {
1118             warn 'the parameter layout_name was ignored as the layout parameter was specified. These two parameters are mutually exclusive.';
1119             }
1120             }
1121             else {
1122             ##
1123             ## We were unable to get the layout object directly, so we need to
1124             ## create the layout from a name if possible...
1125             ##
1126              
1127             $self->_verbose(" * creating layout");
1128              
1129             # the layout name can be specified in the options as layout_name
1130             my $layout_name = '';
1131             my $layout_options;
1132             if (exists $options{layout_name}) {
1133             $layout_name = $options{layout_name};
1134             # if this is the case this layout must support no options
1135             $layout_options = {};
1136             }
1137              
1138             # maybe a layout => { name => 'something' was specified }
1139             if (exists $options{layout} && exists $options{layout}{name}) {
1140             $layout_name = $options{layout}{name};
1141             $layout_options = $options{layout}{options} // {};
1142             }
1143              
1144             LOAD_LAYOUT_PLUGIN:
1145             for my $plugin ($self->plugins()) {
1146             my ($plugin_name) = reverse split "::", $plugin;
1147             if ($plugin eq $layout_name || $plugin_name eq $layout_name) {
1148             $self->_verbose(" * using layout $plugin");
1149             $Layout = $plugin->new($options{rh_sources_info}, $layout_options);
1150             last LOAD_LAYOUT_PLUGIN;
1151             }
1152             }
1153              
1154             if (!defined $Layout && $layout_name ne '') {
1155             die sprintf(
1156             "The layout you've specified (%s) couldn't be found. Valid layouts are:\n%s",
1157             $layout_name,
1158             join "\n", $self->plugins()
1159             );
1160             }
1161             }
1162              
1163             #
1164             # Still no layout, check the cache!
1165             #
1166             if (!defined $Layout) {
1167             # try checking in the cache before giving up...
1168             if (exists $self->{_cache_layout}
1169             && defined $self->{_cache_layout}) {
1170            
1171             $Layout = $self->{_cache_layout};
1172             }
1173             }
1174              
1175             #
1176             # Still nothing, then use default layout
1177             #
1178             if (!defined $Layout) {
1179             my $layout_name = $self->{layout}{name};
1180             my $layout_options = {};
1181             LOAD_DEFAULT_LAYOUT_PLUGIN:
1182             for my $plugin ($self->plugins()) {
1183             my ($plugin_name) = reverse split "::", $plugin;
1184             if ($plugin eq $layout_name || $plugin_name eq $layout_name) {
1185             $self->_verbose(" * using DEFAULT layout $plugin");
1186             $Layout = $plugin->new($options{rh_sources_info}, $layout_options);
1187             last LOAD_DEFAULT_LAYOUT_PLUGIN;
1188             }
1189             }
1190             }
1191              
1192             return $Layout;
1193             }
1194              
1195             sub _write_image {
1196             my $self = shift;
1197             my %options = @_;
1198              
1199             my $target_file = $options{target_file} // $self->{target_file};
1200             my $output_format = $options{format} // $self->{format};
1201             my $Layout = $options{Layout} // 0;
1202             my $rh_sources_info = $options{rh_sources_info} // 0;
1203              
1204             if (!$target_file) {
1205             die "the ``target_file'' parameter is required for this subroutine or you must instantiate Css::SpriteMaker with the target_file parameter";
1206             }
1207              
1208             if (!$rh_sources_info) {
1209             die "The 'rh_sources_info' parameter must be passed to _write_image";
1210             }
1211              
1212             if (!$Layout) {
1213             die "The 'layout' parameter needs to be specified for _write_image, and must be a CSS::SpriteMaker::Layout object";
1214             }
1215              
1216             $self->_verbose(" * writing sprite image");
1217              
1218             $self->_verbose(sprintf("Target image size: %s, %s",
1219             $Layout->width(),
1220             $Layout->height())
1221             );
1222              
1223             my $Target = Image::Magick->new();
1224              
1225             $Target->Set(size => sprintf("%sx%s",
1226             $Layout->width(),
1227             $Layout->height()
1228             ));
1229              
1230             # prepare the target image
1231             if (my $err = $Target->ReadImage('xc:white')) {
1232             warn $err;
1233             }
1234             $Target->Set(type => 'TruecolorMatte');
1235            
1236             # make it transparent
1237             $self->_verbose(" - clearing canvas");
1238             $Target->Draw(
1239             fill => 'transparent',
1240             primitive => 'rectangle',
1241             points => sprintf("0,0 %s,%s", $Layout->width(), $Layout->height())
1242             );
1243             $Target->Transparent('color' => 'white');
1244              
1245             # place each image according to the layout
1246             ITEM_ID:
1247             for my $source_id (sort { $a <=> $b } $Layout->get_item_ids) {
1248             my $rh_source_info = $rh_sources_info->{$source_id};
1249             my ($layout_x, $layout_y) = $Layout->get_item_coord($source_id);
1250              
1251             $self->_verbose(sprintf(" - placing %s (format: %s size: %sx%s position: [%s,%s])",
1252             $rh_source_info->{pathname},
1253             $rh_source_info->{format},
1254             $rh_source_info->{width},
1255             $rh_source_info->{height},
1256             $layout_y,
1257             $layout_x
1258             ));
1259             my $I = Image::Magick->new();
1260             my $err = $I->Read($rh_source_info->{pathname});
1261             if ($err) {
1262             warn $err;
1263             next ITEM_ID;
1264             }
1265              
1266             my $padding = $rh_source_info->{add_extra_padding};
1267              
1268             # place soure image in the target image according to the layout
1269             my $transparent_p = $I->Get('transparent-color');
1270              
1271             # the first pixel of the source image (maybe inner)
1272              
1273             my $endx = $rh_source_info->{first_pixel_x} + $rh_source_info->{original_width};
1274             my $endy = $rh_source_info->{first_pixel_y} + $rh_source_info->{original_height};
1275              
1276             my $srcx = $rh_source_info->{first_pixel_x};
1277              
1278             my $destx = $layout_x;
1279              
1280             while ($srcx < $endx) {
1281              
1282             my $srcy = $rh_source_info->{first_pixel_y};
1283             my $desty = $layout_y;
1284              
1285             while ($srcy < $endy) {
1286              
1287             my $p = $I->Get(
1288             sprintf('pixel[%s,%s]', $srcx, $srcy),
1289             );
1290              
1291             $Target->Set(
1292             sprintf('pixel[%s,%s]', $destx + $padding, $desty + $padding), $p
1293             );
1294              
1295             $srcy++;
1296             $desty++;
1297             }
1298              
1299             $destx++;
1300             $srcx++;
1301             }
1302              
1303             }
1304              
1305             # write target image
1306             my $err = $Target->Write("$output_format:".$target_file);
1307             if ($err) {
1308             warn "unable to obtain $target_file for writing it as $output_format. Perhaps you have specified an invalid format. Check http://www.imagemagick.org/script/formats.php for a list of supported formats. Error: $err";
1309              
1310             $self->_verbose("Wrote $target_file");
1311              
1312             return 1;
1313             }
1314              
1315             # cache the layout and the rh_info structure so that it hasn't to be passed
1316             # as a parameter next times.
1317             $self->{_cache_layout} = $Layout;
1318              
1319             # cache the target image file, as making the stylesheet can't be done
1320             # without this information.
1321             $self->{_cache_target_image_file} = $target_file;
1322              
1323             # cache sources info
1324             $self->{_cache_rh_source_info} = $rh_sources_info;
1325              
1326             return 0;
1327            
1328             }
1329              
1330             =head2 _get_image_properties
1331              
1332             Return an hashref of information about the image at the given pathname.
1333              
1334             =cut
1335              
1336             sub _get_image_properties {
1337             my $self = shift;
1338             my $image_path = shift;
1339             my $remove_source_padding = shift;
1340             my $add_extra_padding = shift;
1341              
1342             my $Image = Image::Magick->new();
1343              
1344             my $err = $Image->Read($image_path);
1345             if ($err) {
1346             warn $err;
1347             return {};
1348             }
1349              
1350             my $rh_info = {};
1351             $rh_info->{first_pixel_x} = 0,
1352             $rh_info->{first_pixel_y} = 0,
1353             $rh_info->{width} = $Image->Get('columns');
1354             $rh_info->{height} = $Image->Get('rows');
1355             $rh_info->{comment} = $Image->Get('comment');
1356             $rh_info->{colors}{total} = $Image->Get('colors');
1357             $rh_info->{format} = $Image->Get('magick');
1358              
1359             if ($remove_source_padding) {
1360             #
1361             # Find borders for this image.
1362             #
1363             # (RE-)SET:
1364             # - first_pixel(x/y) as the true point the image starts
1365             # - width/height as the true dimensions of the image
1366             #
1367             my $w = $rh_info->{width};
1368             my $h = $rh_info->{height};
1369              
1370             # seek for left/right borders
1371             my $first_left = 0;
1372             my $first_right = $w-1;
1373             my $left_found = 0;
1374             my $right_found = 0;
1375              
1376             BORDER_HORIZONTAL:
1377             for my $x (0 .. ceil(($w-1)/2)) {
1378             my $xr = $w-$x-1;
1379             for my $y (0..$h-1) {
1380             my $al = $Image->Get(sprintf('pixel[%s,%s]', $x, $y));
1381             my $ar = $Image->Get(sprintf('pixel[%s,%s]', $xr, $y));
1382            
1383             # remove rgb info and only get alpha value
1384             $al =~ s/^.+,//;
1385             $ar =~ s/^.+,//;
1386              
1387             if ($al != $self->{color_max} && !$left_found) {
1388             $first_left = $x;
1389             $left_found = 1;
1390             }
1391             if ($ar != $self->{color_max} && !$right_found) {
1392             $first_right = $xr;
1393             $right_found = 1;
1394             }
1395             last BORDER_HORIZONTAL if $left_found && $right_found;
1396             }
1397             }
1398             $rh_info->{first_pixel_x} = $first_left;
1399             $rh_info->{width} = $first_right - $first_left + 1;
1400              
1401             # seek for top/bottom borders
1402             my $first_top = 0;
1403             my $first_bottom = $h-1;
1404             my $top_found = 0;
1405             my $bottom_found = 0;
1406              
1407             BORDER_VERTICAL:
1408             for my $y (0 .. ceil(($h-1)/2)) {
1409             my $yb = $h-$y-1;
1410             for my $x (0 .. $w-1) {
1411             my $at = $Image->Get(sprintf('pixel[%s,%s]', $x, $y));
1412             my $ab = $Image->Get(sprintf('pixel[%s,%s]', $x, $yb));
1413            
1414             # remove rgb info and only get alpha value
1415             $at =~ s/^.+,//;
1416             $ab =~ s/^.+,//;
1417              
1418             if ($at != $self->{color_max} && !$top_found) {
1419             $first_top = $y;
1420             $top_found = 1;
1421             }
1422             if ($ab != $self->{color_max} && !$bottom_found) {
1423             $first_bottom = $yb;
1424             $bottom_found = 1;
1425             }
1426             last BORDER_VERTICAL if $top_found && $bottom_found;
1427             }
1428             }
1429             $rh_info->{first_pixel_y} = $first_top;
1430             $rh_info->{height} = $first_bottom - $first_top + 1;
1431             }
1432              
1433             # save the original width as it may change later
1434             $rh_info->{original_width} = $rh_info->{width};
1435             $rh_info->{original_height} = $rh_info->{height};
1436              
1437             # Store information about the color of each pixel
1438             $rh_info->{colors}{map} = {};
1439             my $x = 0;
1440             for my $fake_x ($rh_info->{first_pixel_x} .. $rh_info->{width}) {
1441              
1442             my $y = 0;
1443             for my $fake_y ($rh_info->{first_pixel_y} .. $rh_info->{height}) {
1444              
1445             my $color = $Image->Get(
1446             sprintf('pixel[%s,%s]', $fake_x, $fake_y),
1447             );
1448              
1449             push @{$rh_info->{colors}{map}{$color}}, {
1450             x => $x,
1451             y => $y,
1452             };
1453              
1454             $y++;
1455             }
1456             }
1457              
1458             if ($add_extra_padding) {
1459             # fix the width of the image if a padding was added, as if the image
1460             # was actually wider
1461             $rh_info->{width} += 2 * $add_extra_padding;
1462             $rh_info->{height} += 2 * $add_extra_padding;
1463             }
1464              
1465             return $rh_info;
1466             }
1467              
1468             =head2 _compose_sprite_with_glue
1469              
1470             Compose a layout though a glue layout: first each image set is layouted, then
1471             it is composed using the specified glue layout.
1472              
1473             =cut
1474              
1475             sub _compose_sprite_with_glue {
1476             my $self = shift;
1477             my %options = @_;
1478              
1479             my @parts = @{$options{parts}};
1480              
1481             my $i = 0;
1482              
1483             # compose the following rh_source_info of Layout objects
1484             my $rh_layout_source_info = {};
1485              
1486             # also join each rh_sources_info_from the parts...
1487             my %global_sources_info;
1488              
1489             # keep all the layouts
1490             my @layouts;
1491              
1492             # layout each part
1493             for my $rh_part (@parts) {
1494              
1495             my $rh_sources_info = $self->_ensure_sources_info(%$rh_part);
1496             for my $key (keys %$rh_sources_info) {
1497             $global_sources_info{$key} = $rh_sources_info->{$key};
1498             }
1499              
1500             my $Layout = $self->_ensure_layout(%$rh_part,
1501             rh_sources_info => $rh_sources_info
1502             );
1503              
1504             # we now do as if we were having images, but actually we have layouts
1505             # to do this we re-build a typical rh_sources_info.
1506             $rh_layout_source_info->{$i++} = {
1507             name => sprintf("%sLayout%s", $options{layout_name} // $options{layout}{name}, $i),
1508             pathname => "/fake/path_$i",
1509             parentdir => "/fake",
1510             width => $Layout->width,
1511             height => $Layout->height,
1512             first_pixel_x => 0,
1513             first_pixel_y => 0,
1514             };
1515              
1516             # save this layout
1517             push @layouts, $Layout;
1518             }
1519              
1520             # now that we have the $rh_source_info **about layouts**, we layout the
1521             # layouts...
1522             my $LayoutOfLayouts = $self->_ensure_layout(
1523             layout => $options{layout},
1524             rh_sources_info => $rh_layout_source_info,
1525             );
1526              
1527             # we need to adjust the position of each element of the layout according to
1528             # the positions of the elements in $LayoutOfLayouts
1529             my $FinalLayout;
1530             for my $layout_id (sort { $a <=> $b } $LayoutOfLayouts->get_item_ids()) {
1531             my $Layout = $layouts[$layout_id];
1532             my ($dx, $dy) = $LayoutOfLayouts->get_item_coord($layout_id);
1533             $Layout->move_items($dx, $dy);
1534             if (!$FinalLayout) {
1535             $FinalLayout = $Layout;
1536             }
1537             else {
1538             # merge $FinalLayout <- $Layout
1539             $FinalLayout->merge_with($Layout);
1540             }
1541             }
1542              
1543             # fix width and height
1544             $FinalLayout->{width} = $LayoutOfLayouts->width();
1545             $FinalLayout->{height} = $LayoutOfLayouts->height();
1546              
1547             # now simply draw the FinalLayout
1548             return $self->_write_image(%options,
1549             Layout => $FinalLayout,
1550             rh_sources_info => \%global_sources_info,
1551             );
1552             }
1553              
1554             =head2 _compose_sprite_without_glue
1555              
1556             Compose a layout without glue layout: the previously lay-outed image set
1557             becomes part of the next image set.
1558              
1559             =cut
1560              
1561             sub _compose_sprite_without_glue {
1562             my $self = shift;
1563             my %options = @_;
1564              
1565             my %global_sources_info;
1566              
1567             my @parts = @{$options{parts}};
1568              
1569             my $LayoutOfLayouts;
1570              
1571             my $i = 0;
1572              
1573             for my $rh_part (@parts) {
1574             $i++;
1575            
1576             # gather information about images in the current part
1577             my $rh_sources_info = $self->_ensure_sources_info(%$rh_part);
1578              
1579             # keep composing the global sources_info structure
1580             # as we find new images... we will need this later
1581             # when we actually write the image.
1582             for my $key (keys %$rh_sources_info) {
1583             $global_sources_info{$key} = $rh_sources_info->{$key};
1584             }
1585              
1586             if (!defined $LayoutOfLayouts) {
1587             # we keep the first layout
1588             $LayoutOfLayouts = $self->_ensure_layout(%$rh_part,
1589             rh_sources_info => $rh_sources_info
1590             );
1591             }
1592             else {
1593             # tweak the $rh_sources_info to include a new
1594             # fake image (the previously created layout)
1595             my $max_id = max keys %$rh_sources_info;
1596             my $fake_img_id = $self->_get_image_id();
1597             $rh_sources_info->{$fake_img_id} = {
1598             name => 'FakeImage' . $i,
1599             pathname => "/fake/path_$i",
1600             parentdir => "/fake",
1601             width => $LayoutOfLayouts->width,
1602             height => $LayoutOfLayouts->height,
1603             first_pixel_x => 0,
1604             first_pixel_y => 0,
1605             };
1606              
1607             # we merge down this layout with the first
1608             # one, but first we must fix it, as it may
1609             # have been moved during this second
1610             # iteration.
1611             my $Layout = $self->_ensure_layout(%$rh_part,
1612             rh_sources_info => $rh_sources_info
1613             );
1614              
1615             # where was LayoutOfLayout positioned?
1616             my ($lol_x, $lol_y) = $Layout->get_item_coord($fake_img_id);
1617              
1618             # fix previous layout
1619             $LayoutOfLayouts->move_items($lol_x, $lol_y);
1620              
1621             # now remove it from $Layout and merge down!
1622             $Layout->delete_item($fake_img_id);
1623             $LayoutOfLayouts->merge_with($Layout);
1624              
1625             # fix the width that doesn't get updated with
1626             # the new layout...
1627             $LayoutOfLayouts->{width} = $Layout->width();
1628             $LayoutOfLayouts->{height} = $Layout->height();
1629             }
1630             }
1631              
1632             # draw it all!
1633             return $self->_write_image(%options,
1634             Layout => $LayoutOfLayouts,
1635             rh_sources_info => \%global_sources_info
1636             );
1637             }
1638              
1639              
1640             =head2 _generate_color_histogram
1641              
1642             Generate color histogram out of the information structure of all the images.
1643              
1644             =cut
1645              
1646             sub _generate_color_histogram {
1647             my $self = shift;
1648             my $rh_source_info = shift;
1649              
1650             my %histogram;
1651             for my $id (keys %$rh_source_info) {
1652             for my $color (keys %{ $rh_source_info->{$id}{colors}{map} }) {
1653             my $rah_colors_info = $rh_source_info->{$id}{colors}{map}{$color};
1654              
1655             $histogram{$color} = scalar @$rah_colors_info;
1656             }
1657             }
1658              
1659             return \%histogram;
1660             }
1661              
1662             =head2 _verbose
1663              
1664             Print verbose output only if the verbose option was passed as input.
1665              
1666             =cut
1667              
1668             sub _verbose {
1669             my $self = shift;
1670             my $msg = shift;
1671              
1672             if ($self->{is_verbose}) {
1673             print "${msg}\n";
1674             }
1675             }
1676              
1677             =head1 LICENSE AND COPYRIGHT
1678              
1679             Copyright 2013 Savio Dimatteo.
1680              
1681             This program is free software; you can redistribute it and/or modify it
1682             under the terms of either: the GNU General Public License as published
1683             by the Free Software Foundation; or the Artistic License.
1684              
1685             See http://dev.perl.org/licenses/ for more information.
1686              
1687              
1688             =cut
1689              
1690             1; # End of CSS::SpriteMaker