File Coverage

blib/lib/HTML/KhatGallery/Core.pm
Criterion Covered Total %
statement 39 692 5.6
branch 0 200 0.0
condition 0 71 0.0
subroutine 13 58 22.4
pod 44 44 100.0
total 96 1065 9.0


line stmt bran cond sub pod time code
1             package HTML::KhatGallery::Core;
2             our $VERSION = '0.24'; # VERSION
3 3     3   15384 use strict;
  3         5  
  3         75  
4 3     3   13 use warnings;
  3         4  
  3         83  
5              
6             =head1 NAME
7              
8             HTML::KhatGallery::Core - the core methods for HTML::KhatGallery
9              
10             =head1 VERSION
11              
12             version 0.24
13              
14             =head1 SYNOPSIS
15              
16             # implicitly
17             use HTML::KhatGallery qw(HTML::KhatGallery::Core HTML::KhatGallery::Plugin::MyPlugin ...);
18              
19             # or explicitly
20             require HTML::KhatGallery;
21              
22             @plugins = qw(HTML::KhatGallery::Core HTML::KhatGallery::Plugin::MyPlugin ...);
23             HTML::KhatGallery->import(@plugins);
24             HTML::KhatGallery->run(%args);
25              
26              
27             =head1 DESCRIPTION
28              
29             HTML::KhatGallery is a photo-gallery generator.
30              
31             HTML::KhatGallery::Core provides the core functionality of the system.
32             Other functions can be added or overridden by plugin modules.
33              
34             =cut
35              
36 3     3   1278 use POSIX qw(ceil);
  3         16034  
  3         12  
37 3     3   3606 use File::Basename;
  3         6  
  3         187  
38 3     3   15 use File::Spec;
  3         5  
  3         69  
39 3     3   13 use Cwd;
  3         5  
  3         133  
40 3     3   1206 use File::stat;
  3         18611  
  3         9  
41 3     3   1296 use YAML qw(Dump LoadFile);
  3         17593  
  3         147  
42 3     3   4667 use Image::ExifTool;
  3         149894  
  3         1716  
43              
44             =head1 CLASS METHODS
45              
46             =head2 run
47              
48             HTML::KhatGallery->run(%args);
49              
50             C is the only method you should need to use from outside
51             this module; other methods are called internally by this one.
52              
53             This method orchestrates all the work; it creates a new object,
54             and applies all the actions.
55              
56             Arguments:
57              
58             =over
59              
60             =item B
61              
62             The name of the captions file; which is in the same directory
63             as the images which it describes. This file is in L format.
64             For example:
65              
66             ---
67             index.html: this is the caption for the album as a whole
68             image1.png: this is the caption for image1.png
69             image2.jpg: I like the second image
70              
71             (default: captions.yml)
72              
73             =item B
74              
75             Instead of generating files, clean up the thumbnail directories to
76             remove thumbnails and image HTML pages for images which are no
77             longer there.
78              
79             =item B
80              
81             Set the level of debugging output. The higher the level, the more verbose.
82             (developer only)
83             (default: 0)
84              
85             =item B
86              
87             Regular expression to match the directories we are interested in.
88             Hidden directories and the thumbnail directory will never be included.
89              
90             =item B
91              
92             Force the re-generation of all the HTML files even if they already
93             exist. If false (the default) then a given HTML file will only be
94             created if there is a change in that particular directory.
95              
96             =item B
97              
98             Force the re-generation of the thumbnail images even if they already
99             exist. If false (the default) then a given (thumbnail) image file will
100             only be created if it doesn't already exist.
101              
102             =item B
103              
104             Regular expression determining what filenames should be interpreted
105             as images.
106              
107             =item B
108              
109             Array reference containing formats for meta-data from the images.
110             Field names are surrounded by % characters. For example:
111              
112             meta => ['Date: %DateTime%', '%Comment%'],
113              
114             If an image doesn't have that particular field, the data for that field is not
115             shown. All the meta-data is placed after any caption the image has.
116              
117             =item B
118              
119             Template for HTML pages. The default template is this:
120              
121            
122             "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
123            
124            
125             <!--kg_title-->
126            
127            
128            
129            
130            
131            
132              
133             This can be a string or a filename.
134              
135             =item B
136              
137             The number of images to display per index page.
138              
139             =item B
140              
141             The name of the directory where thumbnails and image-pages are put.
142             It is a subdirectory below the directory where its images are.
143             (default: tn)
144              
145             =item B
146              
147             The size of the thumbnails. This doesn't actually define the dimensions
148             of the thumbnails, but their area. This gives better-quality thumbnails.
149             (default:100x100)
150              
151             =item B
152              
153             The directory to look for images in; this will be searched for images and
154             sub-directories. If this is not given, the current directory is used.
155              
156             =item B
157              
158             The directory to create galleries in; HTML and thumbnails will be created
159             there. If this is not given, it is the same as B.
160              
161             =item B
162              
163             The URL of the top images directory; if the top_out_dir isn't the
164             same as the top_dir, then we need to know this in order
165             to link to the images in the images directory.
166              
167             =item B
168              
169             Print informational messages.
170              
171             =back
172              
173             =cut
174             sub run {
175 0     0 1   my $class = shift;
176 0           my %args = (
177             parent=>'',
178             @_
179             );
180              
181 0           my $self = $class->new(%args);
182 0           $self->init();
183             print "Processing directory $self->{top_dir}\n"
184 0 0         if $self->{verbose};
185              
186 0           $self->do_dir_actions('');
187             } # run
188              
189             =head1 OBJECT METHODS
190              
191             Only of interest to developers and those wishing to write plugins.
192              
193             =head2 new
194              
195             Make a new object. See L for the arguments.
196             This method should not be overridden by plugin writers; use L
197             instead.
198              
199             =cut
200              
201             sub new {
202 0     0 1   my $class = shift;
203 0   0       my $self = bless ({@_}, ref ($class) || $class);
204              
205 0           return ($self);
206             } # new
207              
208             =head2 init
209              
210             Do some initialization of the object after it's created.
211             See L for the arguments.
212             Set up defaults for things which haven't been defined.
213              
214             Plugin writers should override this method rather than L
215             if they want to do some initialization for their plugin.
216              
217             =cut
218              
219             sub init {
220 0     0 1   my $self = shift;
221              
222             # some defaults
223 0   0       $self->{per_page} ||= 16;
224 0   0       $self->{thumbdir} ||= 'tn';
225 0   0       $self->{captions_file} ||= 'captions.yml';
226 0   0       $self->{thumb_geom} ||= '100x100';
227 0   0       $self->{force_html} ||= 0;
228 0   0       $self->{force_images} ||= 0;
229              
230 0   0       $self->{debug_level} ||= 0;
231             # if there's no top dir, make it the current one
232 0 0         if (!defined $self->{top_dir})
233             {
234 0           $self->{top_dir} = '.';
235             }
236 0           $self->{top_dir} = File::Spec->rel2abs($self->{top_dir});
237 0           $self->{top_base} = basename($self->{top_dir});
238              
239             # top_out_dir
240 0 0         if (!defined $self->{top_out_dir})
241             {
242 0           $self->{top_out_dir} = $self->{top_dir};
243             }
244 0           $self->{top_out_dir} = File::Spec->rel2abs($self->{top_out_dir});
245 0           $self->{top_out_base} = basename($self->{top_out_dir});
246              
247             # trim top_url if it has a trailing slash
248 0 0         if (defined $self->{top_url})
249             {
250 0           $self->{top_url} =~ s!/$!!;
251             }
252             else
253             {
254 0           $self->{top_url} = '';
255             }
256              
257             # calculate width and height of thumbnail display
258 0           $self->{thumb_geom} =~ /(\d+)x(\d+)/;
259 0           $self->{thumb_width} = $1;
260 0           $self->{thumb_height} = $2;
261 0           $self->{pixelcount} = $self->{thumb_width} * $self->{thumb_height};
262              
263 0 0         if (!defined $self->{dir_actions})
264             {
265 0           $self->{dir_actions} = [qw(init_settings
266             read_captions
267             read_dir
268             read_out_dir
269             filter_images
270             sort_images
271             filter_dirs
272             sort_dirs
273             make_index_page
274             process_images
275             process_subdirs
276             tidy_up
277             )];
278             }
279 0 0         if (!defined $self->{clean_actions})
280             {
281 0           $self->{clean_actions} = [qw(init_settings
282             read_dir
283             filter_images
284             filter_dirs
285             clean_thumb_dir
286             process_subdirs
287             tidy_up
288             )];
289             }
290              
291 0 0         if (!defined $self->{image_actions})
292             {
293 0           $self->{image_actions} = [qw(init_image_settings
294             make_thumbnail
295             make_image_page
296             image_tidy_up
297             )];
298             }
299              
300 0 0         if (!defined $self->{image_match})
301             {
302 0           my @img_ext = map {"\.$_\$"}
  0            
303             qw(jpg jpeg png gif tif tiff pcx xwd xpm xbm);
304 0           my $img_re = join('|', @img_ext);
305 0           $self->{image_match} = qr/$img_re/i;
306             }
307              
308 0 0         if (!defined $self->{page_template})
309             {
310 0           $self->{page_template} = <
311            
312             "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
313            
314            
315             <!--kg_title-->
316            
317            
318            
319            
320            
321            
322             EOT
323             }
324              
325 0           return ($self);
326             } # init
327              
328             =head2 do_dir_actions
329              
330             $self->do_dir_actions($dir);
331              
332             Do all the actions in the $self->{dir_actions} list, for the
333             given directory. If cleaning, do the actions in the 'clean_actions'
334             list instead.
335             If the dir is empty, this is taken to be the directory given in
336             $self->{top_dir}, the top-level directory.
337              
338             =cut
339             sub do_dir_actions {
340 0     0 1   my $self = shift;
341 0           my $dir = shift;
342              
343 0           my %state = ();
344 0           $state{stop} = 0;
345 0           $state{dir} = $dir;
346              
347 3     3   25 no strict qw(subs refs);
  3         5  
  3         346  
348             my @actions = ($self->{clean}
349 0           ? @{$self->{clean_actions}}
350 0 0         : @{$self->{dir_actions}});
  0            
351 0           while (@actions)
352             {
353 0           my $action = shift @actions;
354 0 0         last if $state{stop};
355 0           $state{action} = $action;
356 0           $self->debug(1, "action: $action");
357 0           $self->$action(\%state);
358             }
359 3     3   17 use strict qw(subs refs);
  3         6  
  3         353  
360 0           1;
361             } # do_dir_actions
362              
363             =head2 do_image_actions
364              
365             $self->do_image_actions(\%dir_state, @images);
366              
367             Do all the actions in the $self->{image_actions} list, for the
368             given images.
369              
370             =cut
371             sub do_image_actions {
372 0     0 1   my $self = shift;
373 0           my $dir_state = shift;
374 0           my @images = @_;
375              
376 0           my %images_state = ();
377              
378 3     3   19 no strict qw(subs refs);
  3         6  
  3         385  
379 0           for (my $i = 0; $i < @images; $i++)
380             {
381 0           %images_state = ();
382 0           $images_state{stop} = 0;
383 0           $images_state{images} = \@images;
384 0           $images_state{num} = $i;
385 0           $images_state{cur_img} = $images[$i];
386             # pop off each action as we go;
387             # that way it's possible for an action to
388             # manipulate the actions array
389 0           @{$images_state{image_actions}} = @{$self->{image_actions}};
  0            
  0            
390 0           while (@{$images_state{image_actions}})
  0            
391             {
392 0           my $action = shift @{$images_state{image_actions}};
  0            
393 0 0         last if $images_state{stop};
394 0           $images_state{action} = $action;
395 0           $self->debug(1, "image_action: $action");
396 0           $self->$action($dir_state,
397             \%images_state);
398             }
399             }
400 3     3   27 use strict qw(subs refs);
  3         6  
  3         16707  
401 0           1;
402             } # do_image_actions
403              
404             =head1 Dir Action Methods
405              
406             Methods implementing directory-related actions. All such actions
407             expect a reference to a state hash, and generally will update either
408             that hash or the object itself, or both, in the course of their
409             running.
410              
411             =head2 init_settings
412              
413             Initialize various settings that need to be set before everything
414             else.
415              
416             This is not the same as "init", because this is the start of
417             the dir_actions sequence; we do it for each directory (or sub-directory)
418             we traverse.
419              
420             =cut
421             sub init_settings {
422 0     0 1   my $self = shift;
423 0           my $dir_state = shift;
424              
425 0           $dir_state->{abs_dir} = File::Spec->catdir($self->{top_dir}, $dir_state->{dir});
426 0           $dir_state->{abs_out_dir} = File::Spec->catdir($self->{top_out_dir}, $dir_state->{dir});
427 0           my @path = File::Spec->splitdir($dir_state->{abs_dir});
428 0 0         if ($dir_state->{dir})
429             {
430 0           $dir_state->{dirbase} = pop @path;
431 0           $dir_state->{parent} = pop @path;
432 0           $dir_state->{dir_url} = $self->{top_url} . '/' . $dir_state->{dir};
433             }
434             else # first dir
435             {
436 0           $dir_state->{dirbase} = pop @path;
437 0           $dir_state->{parent} = '';
438 0           $dir_state->{dir_url} = $self->{top_url};
439             }
440             # thumbnail dir for this directory
441             $dir_state->{abs_thumbdir} = File::Spec->catdir($dir_state->{abs_out_dir},
442 0           $self->{thumbdir});
443              
444             # reset the per-directory redo_html flag
445 0           $dir_state->{redo_html} = 0;
446              
447             } # init_settings
448              
449             =head2 read_captions
450              
451             Set the $dir_state->{captions} hash to contain all the
452             captions for this directory (if they exist)
453              
454             =cut
455             sub read_captions {
456 0     0 1   my $self = shift;
457 0           my $dir_state = shift;
458              
459             my $captions_file = File::Spec->catfile($dir_state->{abs_dir},
460 0           $self->{captions_file});
461 0 0         if (!-f $captions_file)
462             {
463             $captions_file = File::Spec->catfile($dir_state->{abs_out_dir},
464 0           $self->{captions_file});
465             }
466 0 0         if (-f $captions_file)
467             {
468 0           $dir_state->{captions} = {};
469 0           $dir_state->{captions} = LoadFile($captions_file);
470             }
471             } # read_captions
472              
473             =head2 read_dir
474              
475             Read the $dir_state->{dir} directory. Sets $dir_state->{subdirs}, and
476             $dir_state->{files} with the relative subdirs, and other files.
477              
478             =cut
479             sub read_dir {
480 0     0 1   my $self = shift;
481 0           my $dir_state = shift;
482              
483 0           my $dh;
484 0 0         opendir($dh, $dir_state->{abs_dir}) or die "Can't opendir $dir_state->{abs_dir}: $!";
485 0           my @subdirs = ();
486 0           my @files = ();
487 0           while (my $fn = readdir($dh))
488             {
489 0           my $abs_fn = File::Spec->catfile($dir_state->{abs_dir}, $fn);
490 0 0 0       if ($fn =~ /^\./ or $fn eq $self->{thumbdir})
    0          
    0          
491             {
492             # skip
493             }
494             elsif (-d $abs_fn)
495             {
496 0           push @subdirs, $fn;
497             }
498             # ignore any html files
499             elsif ($fn =~ /\.html$/)
500             {
501             }
502             else
503             {
504 0           push @files, $fn;
505             }
506             }
507 0           closedir($dh);
508              
509 0           $dir_state->{subdirs} = \@subdirs;
510 0           $dir_state->{files} = \@files;
511             } # read_dir
512              
513             =head2 read_out_dir
514              
515             Read the $dir_state->{dir} directory in the output tree.
516             Sets $dir_state->{index_files} with the index*.html files.
517              
518             =cut
519             sub read_out_dir {
520 0     0 1   my $self = shift;
521 0           my $dir_state = shift;
522              
523 0           my @index_files = ();
524 0 0         if (-d $dir_state->{abs_out_dir})
525             {
526 0           my $dh;
527 0 0         opendir($dh, $dir_state->{abs_out_dir}) or die "Can't opendir $dir_state->{abs_out_dir}: $!";
528 0           while (my $fn = readdir($dh))
529             {
530 0           my $abs_fn = File::Spec->catfile($dir_state->{abs_out_dir}, $fn);
531 0 0 0       if ($fn =~ /^\./ or $fn eq $self->{thumbdir})
    0          
532             {
533             # skip
534             }
535             # remember the index files
536             elsif ($fn =~ /index.*\.html$/)
537             {
538 0           push @index_files, $fn;
539             }
540             }
541 0           closedir($dh);
542             }
543              
544 0           $dir_state->{index_files} = \@index_files;
545             } # read_out_dir
546              
547             =head2 filter_images
548              
549             Sets $dir_state->{files} to contain only image files that
550             we are interested in.
551              
552             =cut
553             sub filter_images {
554 0     0 1   my $self = shift;
555 0           my $dir_state = shift;
556              
557 0 0 0       if ($self->{image_match}
558 0           and @{$dir_state->{files}})
559             {
560 0           my $img_match = $self->{image_match};
561             my @images = grep {
562 0           /$img_match/
563 0           } @{$dir_state->{files}};
  0            
564 0           $dir_state->{files} = \@images;
565             }
566             } # filter_images
567              
568             =head2 sort_images
569              
570             Sorts the $dir_state->{files} array.
571              
572             =cut
573             sub sort_images {
574 0     0 1   my $self = shift;
575 0           my $dir_state = shift;
576              
577 0 0         if (@{$dir_state->{files}})
  0            
578             {
579 0           my @images = sort @{$dir_state->{files}};
  0            
580 0           $dir_state->{files} = \@images;
581             }
582             } # sort_images
583              
584             =head2 filter_dirs
585              
586             Sets $dir_state->{subdirs} to contain only directories that
587             we are interested in.
588              
589             =cut
590             sub filter_dirs {
591 0     0 1   my $self = shift;
592 0           my $dir_state = shift;
593              
594 0 0 0       if ($self->{dir_match}
595 0           and @{$dir_state->{subdirs}})
596             {
597 0           my $dir_match = $self->{dir_match};
598             my @dirs = grep {
599 0           /$dir_match/
600 0           } @{$dir_state->{subdirs}};
  0            
601 0           $dir_state->{subdirs} = \@dirs;
602             }
603             } # filter_dirs
604              
605             =head2 sort_dirs
606              
607             Sorts the $dir_state->{subdirs} array.
608              
609             =cut
610             sub sort_dirs {
611 0     0 1   my $self = shift;
612 0           my $dir_state = shift;
613              
614 0 0         if (@{$dir_state->{subdirs}})
  0            
615             {
616 0           my @dirs = sort @{$dir_state->{subdirs}};
  0            
617 0           $dir_state->{subdirs} = \@dirs;
618             }
619             } # sort_dirs
620              
621             =head2 make_index_page
622              
623             Make the index page(s) for this directory.
624              
625             =cut
626             sub make_index_page {
627 0     0 1   my $self = shift;
628 0           my $dir_state = shift;
629              
630             # determine the number of pages
631             # To make things easier, always put the subdirs on each index page
632 0           my $num_files = @{$dir_state->{files}};
  0            
633 0           my $pages = ceil($num_files / $self->{per_page});
634             # if there are only subdirs make sure you still make an index
635 0 0 0       if ($pages == 0 and @{$dir_state->{subdirs}})
  0            
636             {
637 0           $pages = 1;
638             }
639 0           $dir_state->{pages} = $pages;
640              
641             # make the output dir if it doesn't exist
642 0 0         if (!-d $dir_state->{abs_out_dir})
643             {
644 0           mkdir $dir_state->{abs_out_dir};
645             }
646              
647             # if we have any new images in this directory, we need to re-make the index
648             # files because we don't know which index file it will appear in,
649             # and we need to re-make the other HTML files because
650             # we need to re-generate the prev/next links
651 0           $dir_state->{redo_html} = $self->index_needs_rebuilding($dir_state);
652              
653             # if forcing HTML, delete the old index pages
654             # just in case we are going to have fewer pages
655             # this time around
656 0 0 0       if ($self->{force_html} or $dir_state->{redo_html})
657             {
658 0           foreach my $if (@{$dir_state->{index_files}})
  0            
659             {
660 0           my $ff = File::Spec->catfile($dir_state->{abs_out_dir}, $if);
661 0           unlink $ff;
662             }
663             }
664              
665 0 0         if ($self->{verbose})
666             {
667             # if the first index is gone, we're rebuilding all of them
668 0           my $first_index
669             = $self->get_index_pagename(dir_state=>$dir_state,
670             page=>1, get_filename=>1);
671 0 0         if (!-f $first_index)
672             {
673 0           print "making $pages indexes\n";
674             }
675             }
676              
677             # for each page
678 0           for (my $page = 1; $page <= $pages; $page++)
679             {
680             # calculate the filename
681 0           my $ifile = $self->get_index_pagename(dir_state=>$dir_state,
682             page=>$page, get_filename=>1);
683 0 0         if (-f $ifile)
684             {
685 0           next;
686             }
687              
688             # figure which files are in this page
689             # Determine number of images to skip
690 0           my @images = ();
691 0 0         if (@{$dir_state->{files}})
  0            
692             {
693 0           my $skip = $self->{per_page} * ($page-1);
694             # index of last entry to include
695 0           my $last = $skip + $self->{per_page};
696 0 0         $last = $num_files if ($last > $num_files);
697 0           $last--; # need the index, not the count
698 0           @images = @{$dir_state->{files}}[$skip .. $last];
  0            
699             }
700              
701 0           my @content = ();
702 0           push @content, $self->start_index_page($dir_state, $page);
703             # add the subdirs
704 0           push @content, $self->make_index_subdirs($dir_state, $page);
705             # add the images
706 0           push @content, $self->make_image_index(dir_state=>$dir_state,
707             page=>$page, images=>\@images);
708 0           push @content, $self->end_index_page($dir_state, $page);
709 0           my $content = join('', @content);
710              
711             # make the head stuff
712 0           my $title = $self->make_index_title($dir_state, $page);
713 0           my $style = $self->make_index_style($dir_state, $page);
714              
715             # put the page content in the template
716 0           my $out = $self->get_template($self->{page_template});
717             # save the content of the template in case we read it
718             # from a file
719 0           $self->{page_template} = $out;
720 0           $out =~ s//$title/;
721 0           $out =~ s//$style/;
722 0           $out =~ s//$content/;
723              
724             # write the page to the file
725 0           my $fh = undef;
726 0 0         open($fh, ">", $ifile) or die "Could not open $ifile for writing: $!";
727 0           print $fh $out;
728 0           close($fh);
729             } # for each page
730             } # make_index_page
731              
732             =head2 clean_thumb_dir
733              
734             Clean unused thumbnails and image-pages from
735             the thumbnail directory of this directory
736              
737             =cut
738             sub clean_thumb_dir {
739 0     0 1   my $self = shift;
740 0           my $dir_state = shift;
741              
742 0           my $dir = File::Spec->catdir($dir_state->{abs_out_dir}, $self->{thumbdir});
743 0           my @pics = @{$dir_state->{files}};
  0            
744 0           $self->debug(2, "dir: $dir");
745              
746 0 0         return unless -d $dir;
747              
748             # store the pics as a hash to make checking easier
749 0           my %pics_hash = ();
750 0           foreach my $pic ( @pics )
751             {
752 0           $pics_hash{$pic} = 1;
753             }
754              
755             # Read the thumbnail directory
756 0           my $dirh;
757 0           opendir($dirh,$dir);
758 0           my @files = grep(!/^\.{1,2}$/, readdir($dirh));
759 0           closedir($dirh);
760              
761             # Check each file to make sure it's a currently used thumbnail or image_page
762 0           foreach my $file ( @files )
763             {
764 0           my $remove = '';
765 0           my $name = $file;
766 0 0         if ($name =~ s/\.html$//)
    0          
767             {
768             # change the last underscore to a dot
769 0           $name =~ s/_([a-zA-Z0-9]+)$/.$1/;
770             $remove = "unused image page"
771 0 0         unless (exists $pics_hash{$name});
772             }
773             elsif ($name =~ /(.+)\.jpg$/i) {
774             # Thumbnail?
775 0           $name = $1;
776             # change the last underscore to a dot
777 0           $name =~ s/_([a-zA-Z0-9]+)$/.$1/;
778 0           $self->debug(2, "thumb: $name");
779             $remove = "unused thumbnail"
780 0 0         unless (exists $pics_hash{$name});
781             } else {
782 0           $remove = "unknown file";
783             }
784 0 0         if ($remove) {
785 0 0         print "Remove $remove: $file\n" if $self->{verbose};
786 0           my $fullname = File::Spec->catfile($dir, $file);
787 0 0         warn "Couldn't erase [$file]"
788             unless unlink $fullname;
789             }
790             } # for each file
791             } # clean_thumb_dir
792              
793             =head2 process_images
794              
795             Process the images from this directory.
796              
797             =cut
798             sub process_images {
799 0     0 1   my $self = shift;
800 0           my $dir_state = shift;
801              
802 0           $self->do_image_actions($dir_state, @{$dir_state->{files}});
  0            
803             } # process_images
804              
805             =head2 process_subdirs
806              
807             Process the sub-directories of this directory.
808              
809             =cut
810             sub process_subdirs {
811 0     0 1   my $self = shift;
812 0           my $dir_state = shift;
813              
814 0           my @image_dirs = @{$dir_state->{subdirs}};
  0            
815              
816 0           foreach my $subdir (@image_dirs)
817             {
818 0           my $dir = $subdir;
819 0 0         if ($dir_state->{dir})
820             {
821 0           $dir = File::Spec->catdir($dir_state->{dir}, $subdir);
822             }
823 0 0         print "=== $dir ===\n" if $self->{verbose};
824 0           $self->do_dir_actions($dir);
825             }
826             } # process_subdirs
827              
828             =head2 tidy_up
829              
830             Cleanup after processing this directory.
831              
832             =cut
833             sub tidy_up {
834 0     0 1   my $self = shift;
835 0           my $dir_state = shift;
836              
837             } # tidy_up
838              
839             =head1 Image Action Methods
840              
841             Methods implementing per-image actions.
842              
843             =head2 init_image_settings
844              
845             Initialize settings for the current image.
846              
847             =cut
848             sub init_image_settings {
849 0     0 1   my $self = shift;
850 0           my $dir_state = shift;
851 0           my $img_state = shift;
852              
853             $img_state->{abs_img} = File::Spec->catfile($dir_state->{abs_dir},
854 0           $img_state->{cur_img});
855 0           $img_state->{info} = $self->get_image_info($img_state->{abs_img});
856              
857             } # init_image_settings
858              
859             =head2 make_thumbnail
860              
861             Make a thumbnail of the current image.
862             Constant pixel count among generated images based on
863             http://www.chaosreigns.com/code/thumbnail/
864              
865             =cut
866             sub make_thumbnail {
867 0     0 1   my $self = shift;
868 0           my $dir_state = shift;
869 0           my $img_state = shift;
870              
871             my $thumb_file = $self->get_thumbnail_name(
872             dir_state=>$dir_state, image=>$img_state->{cur_img},
873 0           type=>'file');
874 0 0         if (!$self->need_to_generate_image($dir_state, $img_state,
875             check_image=>$thumb_file))
876             {
877 0           return;
878             }
879             # make the thumbnail dir if it doesn't exist
880 0 0         if (!-d $dir_state->{abs_thumbdir})
881             {
882 0           mkdir $dir_state->{abs_thumbdir};
883             }
884              
885 0           my $x = $img_state->{info}->{ImageWidth};
886 0           my $y = $img_state->{info}->{ImageHeight};
887 0 0 0       if (!$x or !$y)
888             {
889 0           warn "dimensions of " . $img_state->{abs_img} . " undefined -- faking it";
890 0           print STDERR Dump($img_state);
891 0           print STDERR "========================\n";
892 0           $x = 1024;
893 0           $y = 1024;
894             }
895            
896 0           my $pixels = $x * $y;
897 0           my $newx = int($x / (sqrt($x * $y) / sqrt($self->{pixelcount})));
898 0           my $newy = int($y / (sqrt($x * $y) / sqrt($self->{pixelcount})));
899 0           my $newpix = $newx * $newy;
900 0           my $command = '';
901 0 0         if ($img_state->{cur_img} =~ /\.gif$/)
902             {
903             # in case this is an animated gif, get the first frame only
904 0           $command = "convert -geometry \"${newx}x${newy}\>\" \"$img_state->{abs_img}\[0\]\" \"$thumb_file\"";
905             }
906             else
907             {
908 0           $command = "convert -geometry \"${newx}x${newy}\>\" \"$img_state->{abs_img}\" \"$thumb_file\"";
909             }
910 0 0         system($command) == 0
911             or die "$command failed";
912            
913             } # make_thumbnail
914              
915             =head2 make_image_page
916              
917             Make HTML page for current image.
918              
919             =cut
920             sub make_image_page {
921 0     0 1   my $self = shift;
922 0           my $dir_state = shift;
923 0           my $img_state = shift;
924              
925 0           my $img_name = $img_state->{cur_img};
926             my $img_page_file = $self->get_image_pagename(dir_state=>$dir_state,
927             image=>$img_state->{cur_img},
928 0           type=>'file');
929 0 0 0       if (-f $img_page_file
      0        
930             and !$self->{force_html}
931             and !$dir_state->{redo_html})
932             {
933 0           return;
934             }
935             # make the thumbnail dir if it doesn't exist
936 0 0         if (!-d $dir_state->{abs_thumbdir})
937             {
938 0           mkdir $dir_state->{abs_thumbdir};
939             }
940 0           my @content = ();
941 0           push @content, $self->start_image_page($dir_state, $img_state);
942             # add the image itself
943 0           push @content, $self->make_image_content($dir_state, $img_state);
944 0           push @content, $self->end_image_page($dir_state, $img_state);
945 0           my $content = join('', @content);
946              
947             # make the head stuff
948 0           my $title = $self->make_image_title($dir_state, $img_state);
949 0           my $style = $self->make_image_style($dir_state, $img_state);
950              
951             # put the page content in the template
952 0           my $out = $self->get_template($self->{page_template});
953             # save the content of the template in case we read it
954             # from a file
955 0           $self->{page_template} = $out;
956 0           $out =~ s//$title/;
957 0           $out =~ s//$style/;
958 0           $out =~ s//$content/;
959              
960             # write the page to the file
961 0           my $fh = undef;
962 0 0         open($fh, ">", $img_page_file) or die "Could not open $img_page_file for writing: $!";
963 0           print $fh $out;
964 0           close($fh);
965             } # make_image_page
966              
967             =head2 image_tidy_up
968              
969             Clean up after the current image.
970              
971             =cut
972             sub image_tidy_up {
973 0     0 1   my $self = shift;
974 0           my $dir_state = shift;
975 0           my $img_state = shift;
976              
977             } # image_tidy_up
978              
979             =head1 Helper Methods
980              
981             Methods which can be called from within other methods.
982              
983             =head2 start_index_page
984              
985             push @content, $self->start_index_page($dir_state, $page);
986              
987             Create the start-of-page for an index page.
988             This contains page content, not full etc (that's expected
989             to be in the full-page template).
990             It contains the header, link to parent dirs and links to
991             previous and next index-pages, and the album caption.
992              
993             =cut
994             sub start_index_page {
995 0     0 1   my $self = shift;
996 0           my $dir_state = shift;
997 0           my $page = shift;
998              
999 0           my @out = ();
1000 0           push @out, "
\n";
1001              
1002             # Path array contains basenames from the top dir down to the current dir.
1003 0           my @path = split(/[\/\\]/, $dir_state->{dir});
1004              
1005             # Note that what we want is the top_out_base and not the top_base
1006             # because if they are not the same (because top_out_dir was set)
1007             # the salient info is the output directory and not the source directory.
1008 0           unshift @path, $self->{top_out_base};
1009              
1010             # we want to create relative links to all the dirs
1011             # above the current one, so work backwards
1012 0           my %uplinks = ();
1013 0           my $uplink = '';
1014 0           foreach my $dn (reverse @path)
1015             {
1016 0           $uplinks{$dn} = $uplink;
1017 0 0 0       if (!$uplink and $page > 1)
1018             {
1019 0           $uplinks{$dn} = "index.html";
1020             }
1021             else
1022             {
1023 0           $uplink .= '../';
1024             }
1025             }
1026 0           my @header = ();
1027 0           foreach my $dn (@path)
1028             {
1029 0           my $pretty = $dn;
1030 0           $pretty =~ s/_/ /g;
1031 0 0         if ($uplinks{$dn})
1032             {
1033 0           push @header, "$pretty";
1034             }
1035             else
1036             {
1037 0           push @header, $pretty;
1038             }
1039             }
1040 0           push @out, '

';

1041 0           push @out, join(' :: ', @header);
1042 0           push @out, "\n";
1043              
1044             # now for the prev, next links
1045 0           push @out, $self->make_index_prev_next($dir_state, $page);
1046              
1047             # and now for the album caption
1048 0 0         if (exists $dir_state->{captions})
1049             {
1050 0           my $index_caption = 'index.html';
1051 0 0 0       if (exists $dir_state->{captions}->{$index_caption}
1052             and defined $dir_state->{captions}->{$index_caption})
1053             {
1054 0           push @out, '
';
1055 0           push @out, $dir_state->{captions}->{$index_caption};
1056 0           push @out, "\n";
1057             }
1058             }
1059              
1060 0           return join('', @out);
1061             } # start_index_page
1062              
1063             =head2 make_index_prev_next
1064              
1065             my $links = $self->start_index_page($dir_state, $page);
1066              
1067             Make the previous next other-index-pages links for the
1068             given index-page. Generally called for the top and bottom
1069             of the index page.
1070              
1071             =cut
1072             sub make_index_prev_next {
1073 0     0 1   my $self = shift;
1074 0           my $dir_state = shift;
1075 0           my $page = shift;
1076              
1077 0           my @out = ();
1078 0 0         if ($dir_state->{pages} > 1)
1079             {
1080 0           push @out, '

';

1081             # prev
1082 0           my $label = '< - prev';
1083 0 0         if ($page > 1)
1084             {
1085 0           my $iurl = $self->get_index_pagename(dir_state=>$dir_state,
1086             page=>$page - 1, get_filename=>0);
1087 0           push @out, "$label ";
1088             }
1089              
1090             # pages, but only if more than two
1091 0 0         if ($dir_state->{pages} > 2)
1092             {
1093 0           for (my $i = 1; $i <= $dir_state->{pages}; $i++)
1094             {
1095 0 0         if ($page == $i)
1096             {
1097 0           push @out, " [$i] ";
1098             }
1099             else
1100             {
1101 0           my $iurl = $self->get_index_pagename(dir_state=>$dir_state,
1102             page=>$i, get_filename=>0);
1103 0           push @out, " $i ";
1104             }
1105             }
1106             }
1107 0           $label = 'next ->';
1108 0 0         if (($page+1) <= $dir_state->{pages})
1109             {
1110 0           my $iurl = $self->get_index_pagename(dir_state=>$dir_state,
1111             page=>$page + 1, get_filename=>0);
1112 0           push @out, " $label";
1113             }
1114 0           push @out, "

\n";
1115             }
1116              
1117 0           return join('', @out);
1118             } # make_index_prev_next
1119              
1120             =head2 end_index_page
1121              
1122             push @content, $self->end_index_page($dir_state, $page);
1123              
1124             Create the end-of-page for an index page.
1125             This contains page content, not full etc (that's expected
1126             to be in the full-page template).
1127              
1128             =cut
1129             sub end_index_page {
1130 0     0 1   my $self = shift;
1131 0           my $dir_state = shift;
1132 0           my $page = shift;
1133              
1134 0           my @out = ();
1135 0           push @out, "\n
\n";
1136 0           push @out, $self->make_index_prev_next($dir_state, $page);
1137 0           push @out, "\n";
1138 0           return join('', @out);
1139             } # end_index_page
1140              
1141             =head2 make_index_subdirs
1142              
1143             push @content, $self->make_index_subdirs($dir_state, $page);
1144              
1145             Create the subdirs section; this contains links to subdirs.
1146              
1147             =cut
1148             sub make_index_subdirs {
1149 0     0 1   my $self = shift;
1150 0           my $dir_state = shift;
1151 0           my $page = shift;
1152              
1153 0           my @out = ();
1154              
1155 0 0         if (@{$dir_state->{subdirs}})
  0            
1156             {
1157 0           push @out, "\n
\n";
1158 0           push @out, "
\n";
1159             # subdirs
1160 0           foreach my $subdir (@{$dir_state->{subdirs}})
  0            
1161             {
1162 0           push @out, <
1163            
1164             $subdir
1165            
1166             EOT
1167             }
1168 0           push @out, "\n";
1169             }
1170 0           return join('', @out);
1171             } # make_index_subdirs
1172              
1173             =head2 make_image_index
1174              
1175             push @content, $self->make_image_index(dir_state=>$dir_state,
1176             page=>$page, images=>\@images);
1177              
1178             Create the images section; this contains links to image-pages, with thumbnails.
1179              
1180             =cut
1181             sub make_image_index {
1182 0     0 1   my $self = shift;
1183 0           my %args = (
1184             @_
1185             );
1186 0           my $dir_state = $args{dir_state};
1187              
1188 0           my @out = ();
1189              
1190 0 0         if (@{$args{images}})
  0            
1191             {
1192 0           push @out, "\n
\n";
1193 0           push @out, "
\n";
1194             # subdirs
1195 0           foreach my $image (@{$args{images}})
  0            
1196             {
1197 0           my $image_link = $self->get_image_pagename(dir_state=>$dir_state,
1198             image=>$image, type=>'parent');
1199 0           my $thumbnail_link = $self->get_thumbnail_name(
1200             dir_state=>$dir_state,
1201             image=>$image, type=>'parent');
1202 0           my $image_name = $self->get_image_pagename(dir_state=>$dir_state,
1203             image=>$image, type=>'pretty');
1204 0           push @out, <
1205            
1206            
1207             $image
1208             $image_name
1209            
1210            
1211             EOT
1212             }
1213 0           push @out, "\n";
1214             }
1215 0           return join('', @out);
1216             } # make_image_index
1217              
1218             =head2 make_index_title
1219              
1220             Make the title for the index page.
1221             This is expected to go inside a <!--kg_title-->
1222             in the page template.
1223              
1224             =cut
1225             sub make_index_title {
1226 0     0 1   my $self = shift;
1227 0           my $dir_state = shift;
1228 0           my $page = shift;
1229              
1230 0           my @out = ();
1231             # title
1232 0           push @out, $dir_state->{dirbase};
1233 0 0         push @out, " ($page)" if $page > 1;
1234 0           return join('', @out);
1235             } # make_index_title
1236              
1237             =head2 make_index_style
1238              
1239             Make the style tags for the index page. This will be put in the
1240             part of the template.
1241              
1242             =cut
1243             sub make_index_style {
1244 0     0 1   my $self = shift;
1245 0           my $dir_state = shift;
1246 0           my $page = shift;
1247              
1248 0           my @out = ();
1249             # style
1250 0           my $thumb_area_width = $self->{thumb_width} * 1.5;
1251             # 1.5 times the thumbnail, plus a fudge-factor for the words underneath
1252 0           my $thumb_area_height = ($self->{thumb_height} * 1.5) + 20;
1253 0           push @out, <
1254            
1280             EOT
1281 0           return join('', @out);
1282             } # make_index_style
1283              
1284             =head2 get_index_pagename
1285              
1286             my $name = self->get_index_pagename(
1287             dir_state=>$dir_state,
1288             page=>$page,
1289             get_filename=>0);
1290              
1291             Get the name of the given index page; either the file name
1292             or the relative URL.
1293              
1294             =cut
1295             sub get_index_pagename {
1296 0     0 1   my $self = shift;
1297 0           my %args = (
1298             get_filename=>0,
1299             @_
1300             );
1301 0           my $dir_state = $args{dir_state};
1302 0           my $page = $args{page};
1303              
1304 0           my $pagename;
1305 0 0         if ($page == 1)
    0          
1306             {
1307 0           $pagename = 'index.html';
1308             }
1309             elsif ($dir_state->{pages} > 9)
1310             {
1311 0           $pagename = sprintf("index%02d.html", $page);
1312             }
1313             else
1314             {
1315 0           $pagename = "index${page}.html";
1316             }
1317            
1318 0 0         if ($args{get_filename})
1319             {
1320 0           return File::Spec->catfile($dir_state->{abs_out_dir}, $pagename);
1321             }
1322             else # get URL
1323             {
1324 0           return $pagename;
1325             }
1326             } # get_index_pagename
1327              
1328             =head2 get_image_pagename
1329              
1330             my $name = self->get_image_pagename(
1331             dir_state=>$dir_state,
1332             image=>$image,
1333             type=>'file');
1334              
1335             Get the name of the image page; either the file name
1336             or the relative URL from above, or the relative URL
1337             from the sibling, or a 'pretty' name suitable for a title.
1338              
1339             The 'type' can be 'file', 'parent', 'sibling' or 'pretty'.
1340              
1341             =cut
1342             sub get_image_pagename {
1343 0     0 1   my $self = shift;
1344 0           my %args = (
1345             type=>'parent',
1346             @_
1347             );
1348 0           my $dir_state = $args{dir_state};
1349 0           my $image = $args{image};
1350            
1351 0           my $thumbdir = $self->{thumbdir};
1352 0           my $img_page = $image;
1353             # change the last dot to underscore
1354 0           $img_page =~ s/\.(\w+)$/_$1/;
1355 0           $img_page .= ".html";
1356 0 0         if ($args{type} eq 'file')
    0          
    0          
    0          
1357             {
1358 0           return File::Spec->catfile($dir_state->{abs_out_dir}, $thumbdir, $img_page);
1359             }
1360             elsif ($args{type} eq 'parent')
1361             {
1362 0           return "${thumbdir}/${img_page}";
1363             }
1364             elsif ($args{type} eq 'sibling')
1365             {
1366 0           return ${img_page};
1367             }
1368             elsif ($args{type} eq 'pretty')
1369             {
1370 0           my $pretty = ${image};
1371 0           $pretty =~ s/\.(\w+)$//;
1372 0           $pretty =~ s/_/ /g;
1373 0           return $pretty;
1374             }
1375 0           return '';
1376             } # get_image_pagename
1377              
1378             =head2 get_thumbnail_name
1379              
1380             my $name = self->get_thumbnail_name(
1381             dir_state=>$dir_state,
1382             image=>$image,
1383             type=>'file');
1384              
1385             Get the name of the image thumbnail file; either the file name
1386             or the relative URL from above, or the relative URL
1387             from the sibling.
1388              
1389             The 'type' can be 'file', 'parent', 'sibling'.
1390              
1391             =cut
1392             sub get_thumbnail_name {
1393 0     0 1   my $self = shift;
1394 0           my %args = (
1395             type=>'parent',
1396             @_
1397             );
1398 0           my $dir_state = $args{dir_state};
1399 0           my $image = $args{image};
1400            
1401 0           my $thumbdir = $self->{thumbdir};
1402 0           my $thumb = $image;
1403             # change the last dot to underscore
1404 0           $thumb =~ s/\.([\w]+)$/_$1/;
1405 0           $thumb .= ".jpg";
1406 0 0         if ($args{type} eq 'file')
    0          
    0          
1407             {
1408 0           return File::Spec->catfile($dir_state->{abs_out_dir}, $thumbdir, $thumb);
1409             }
1410             elsif ($args{type} eq 'parent')
1411             {
1412 0           return "${thumbdir}/${thumb}";
1413             }
1414             elsif ($args{type} eq 'sibling')
1415             {
1416 0           return ${thumb};
1417             }
1418 0           return '';
1419             } # get_thumbnail_name
1420              
1421             =head2 get_caption
1422              
1423             my $name = self->get_caption(
1424             dir_state=>$dir_state,
1425             img_state->$img_state,
1426             image=>$image)
1427              
1428             Get the caption for this image.
1429             This also gets the meta-data if any is required.
1430              
1431             =cut
1432             sub get_caption {
1433 0     0 1   my $self = shift;
1434 0           my %args = (
1435             @_
1436             );
1437 0           my $dir_state = $args{dir_state};
1438 0           my $img_state = $args{img_state};
1439 0           my $image = $args{image};
1440            
1441 0           my @out = ();
1442 0 0         if (exists $dir_state->{captions})
1443             {
1444 0 0 0       if (exists $dir_state->{captions}->{$image}
1445             and defined $dir_state->{captions}->{$image})
1446             {
1447 0           push @out, $dir_state->{captions}->{$image};
1448             }
1449             }
1450 0 0 0       if ($img_state and defined $self->{meta} and @{$self->{meta}})
  0   0        
1451             {
1452             # only add the meta data if it's there
1453 0           foreach my $fieldspec (@{$self->{meta}})
  0            
1454             {
1455 0           $fieldspec =~ /%([\w\s]+)%/;
1456 0           my $field = $1;
1457 0 0 0       if (exists $img_state->{info}->{$field}
      0        
1458             and defined $img_state->{info}->{$field}
1459             and $img_state->{info}->{$field})
1460             {
1461 0           my $val = $fieldspec;
1462 0           my $fieldval = $img_state->{info}->{$field};
1463             # make the fieldval HTML-safe
1464 0           $fieldval =~ s/&/&/g;
1465 0           $fieldval =~ s/
1466 0           $fieldval =~ s/>/>/g;
1467 0           $val =~ s/%${field}%/$fieldval/g;
1468 0           push @out, $val;
1469             }
1470             }
1471             }
1472 0           return join("\n", @out);
1473             } # get_caption
1474              
1475             =head2 get_template
1476              
1477             my $templ = $self->get_template($template);
1478              
1479             Get the given template (read if it's from a file)
1480              
1481             =cut
1482             sub get_template {
1483 0     0 1   my $self = shift;
1484 0           my $template = shift;
1485              
1486 0 0 0       if ($template !~ /\n/
1487             && -r $template)
1488             {
1489 0           local $/ = undef;
1490 0           my $fh;
1491 0 0         open($fh, $template)
1492             or die "Could not open ", $template;
1493 0           $template = <$fh>;
1494 0           close($fh);
1495             }
1496 0           return $template;
1497             } # get_template
1498              
1499             =head2 start_image_page
1500              
1501             push @content, $self->start_image_page($dir_state, $img_state);
1502              
1503             Create the start-of-page for an image page.
1504             This contains page content, not full etc (that's expected
1505             to be in the full-page template).
1506             It contains the header, link to parent dirs and links to
1507             previous and next image-pages.
1508              
1509             =cut
1510             sub start_image_page {
1511 0     0 1   my $self = shift;
1512 0           my $dir_state = shift;
1513 0           my $img_state = shift;
1514              
1515 0           my @out = ();
1516 0           push @out, "
\n";
1517              
1518             # Path array contains basenames from the top dir
1519             # down to the current dir.
1520 0           my @path = split(/[\/\\]/, $dir_state->{dir});
1521 0           unshift @path, $self->{top_out_base};
1522             # we want to create relative links to all the dirs
1523             # including the current one, so work backwards
1524 0           my %uplinks = ();
1525 0           my $uplink = '';
1526 0           foreach my $dn (reverse @path)
1527             {
1528 0           $uplink .= '../';
1529 0           $uplinks{$dn} = $uplink;
1530             }
1531 0           my @breadcrumb = ();
1532 0           foreach my $dn (@path)
1533             {
1534 0 0         if ($uplinks{$dn})
1535             {
1536 0           push @breadcrumb, "$dn";
1537             }
1538             else
1539             {
1540 0           push @breadcrumb, $dn;
1541             }
1542             }
1543 0           push @out, '

';

1544 0           push @out, $img_state->{cur_img};
1545 0           push @out, "\n";
1546 0           push @out, '
1547 0           push @out, join(' > ', @breadcrumb);
1548 0           push @out, "

\n";
1549              
1550             # now for the prev, next links
1551 0           push @out, $self->make_image_prev_next(dir_state=>$dir_state,
1552             img_state=>$img_state);
1553              
1554 0           return join('', @out);
1555             } # start_image_page
1556              
1557             =head2 end_image_page
1558              
1559             push @content, $self->end_image_page($dir_state, $img_state);
1560              
1561             Create the end-of-page for an image page.
1562             This contains page content, not full etc (that's expected
1563             to be in the full-page template).
1564              
1565             =cut
1566             sub end_image_page {
1567 0     0 1   my $self = shift;
1568 0           my $dir_state = shift;
1569 0           my $img_state = shift;
1570              
1571 0           my @out = ();
1572              
1573             # now for the prev, next links
1574 0           push @out, $self->make_image_prev_next(dir_state=>$dir_state,
1575             img_state=>$img_state,
1576             use_thumb=>1);
1577 0           push @out, "\n\n";
1578              
1579 0           return join('', @out);
1580             } # end_image_page
1581              
1582             =head2 make_image_prev_next
1583              
1584             my $links = $self->make_image_prev_next(
1585             dir_state=>$dir_state,
1586             img_state=>$img_state);
1587              
1588             Make the previous next other-image-pages links for the
1589             given image-page. Generally called for the top and bottom
1590             of the image page.
1591              
1592             =cut
1593             sub make_image_prev_next {
1594 0     0 1   my $self = shift;
1595 0           my %args = (
1596             use_thumb=>0,
1597             @_
1598             );
1599 0           my $dir_state = $args{dir_state};
1600 0           my $img_state = $args{img_state};
1601              
1602 0           my $img_num = $img_state->{num};
1603 0           my @out = ();
1604 0 0         if ($dir_state->{files} > 1)
1605             {
1606 0           push @out, '
';
1607             # prev
1608 0           push @out, "";
1609 0           my $label = '< - prev';
1610 0           my $iurl;
1611             my $turl;
1612 0 0         if ($img_num > 0)
1613             {
1614             $iurl = $self->get_image_pagename(dir_state=>$dir_state,
1615 0           image=>$img_state->{images}->[$img_num - 1],
1616             type=>'sibling');
1617             $turl = $self->get_thumbnail_name(dir_state=>$dir_state,
1618 0           image=>$img_state->{images}->[$img_num - 1],
1619             type=>'sibling');
1620             }
1621             else
1622             {
1623             # loop to the last image
1624             $iurl = $self->get_image_pagename(dir_state=>$dir_state,
1625 0           image=>$img_state->{images}->[$#{$img_state->{images}}],
  0            
1626             type=>'sibling');
1627             $turl = $self->get_thumbnail_name(dir_state=>$dir_state,
1628 0           image=>$img_state->{images}->[$#{$img_state->{images}}],
  0            
1629             type=>'sibling');
1630             }
1631 0           push @out, "$label ";
1632 0 0         if ($args{use_thumb})
1633             {
1634 0           push @out, "\"$label\"/ ";
1635             }
1636 0           push @out, "";
1637              
1638 0           push @out, "";
1639 0           $label = 'next ->';
1640 0 0         if (($img_num+1) < @{$img_state->{images}})
  0            
1641             {
1642             $iurl = $self->get_image_pagename(dir_state=>$dir_state,
1643 0           image=>$img_state->{images}->[$img_num + 1],
1644             type=>'sibling');
1645             $turl = $self->get_thumbnail_name(dir_state=>$dir_state,
1646 0           image=>$img_state->{images}->[$img_num + 1],
1647             type=>'sibling');
1648             }
1649             else
1650             {
1651             # loop to the first image
1652             $iurl = $self->get_image_pagename(dir_state=>$dir_state,
1653 0           image=>$img_state->{images}->[0],
1654             type=>'sibling');
1655             $turl = $self->get_thumbnail_name(dir_state=>$dir_state,
1656 0           image=>$img_state->{images}->[0],
1657             type=>'sibling');
1658             }
1659 0 0         if ($args{use_thumb})
1660             {
1661 0           push @out, "\"$label\"/ ";
1662             }
1663 0           push @out, " $label";
1664 0           push @out, "";
1665 0           push @out, "\n";
1666             }
1667              
1668 0           return join('', @out);
1669             } # make_image_prev_next
1670              
1671             =head2 make_image_content
1672              
1673             Make the content of the image page, the image itself.
1674              
1675             =cut
1676             sub make_image_content {
1677 0     0 1   my $self = shift;
1678 0           my $dir_state = shift;
1679 0           my $img_state = shift;
1680              
1681 0           my $img_name = $img_state->{cur_img};
1682 0           my $caption = $self->get_caption(dir_state=>$dir_state,
1683             img_state=>$img_state,
1684             image=>$img_name);
1685 0           my $img_url = "../$img_name";
1686 0 0         if ($self->{top_dir} ne $self->{top_out_dir})
1687             {
1688 0           $img_url = $dir_state->{dir_url} . '/' . $img_name;
1689             }
1690 0           my @out = ();
1691 0           push @out, "
\n";
1692 0           my $width = $img_state->{info}->{ImageWidth};
1693 0           my $height = $img_state->{info}->{ImageHeight};
1694 0           push @out, "\"$img_name\"\n";
1695 0           push @out, "

$caption

\n";
1696 0           push @out, "\n";
1697 0           return join('', @out);
1698             } # make_image_content
1699              
1700             =head2 make_image_title
1701              
1702             Make the title for the image page.
1703             This is expected to go inside a <!--kg_title-->
1704             in the page template.
1705              
1706             =cut
1707             sub make_image_title {
1708 0     0 1   my $self = shift;
1709 0           my $dir_state = shift;
1710 0           my $img_state = shift;
1711              
1712 0           my @out = ();
1713             # title
1714 0           push @out, $img_state->{cur_img};
1715 0           return join('', @out);
1716             } # make_image_title
1717              
1718             =head2 make_image_style
1719              
1720             Make the style tags for the image page. This will be put in the
1721             part of the template.
1722              
1723             =cut
1724             sub make_image_style {
1725 0     0 1   my $self = shift;
1726 0           my $dir_state = shift;
1727 0           my $img_state = shift;
1728              
1729 0           my @out = ();
1730             # style
1731 0           push @out, <
1732            
1747             EOT
1748 0           return join('', @out);
1749             } # make_image_style
1750              
1751             =head2 need_to_generate_image
1752              
1753             Check if a thumbnail needs to be made (or rebuilt).
1754              
1755             =cut
1756             sub need_to_generate_image {
1757 0     0 1   my $self = shift;
1758 0           my $dir_state = shift;
1759 0           my $img_state = shift;
1760 0           my %args = @_;
1761              
1762 0 0 0       if (!-f $args{check_image} or $self->{force_images})
1763             {
1764 0           return 1;
1765             }
1766 0           return 0;
1767             } # need_to_generate_image
1768              
1769             =head2 index_needs_rebuilding
1770              
1771             Check to see if there are any new (or deleted) images in this
1772             directory.
1773              
1774             =cut
1775             sub index_needs_rebuilding {
1776 0     0 1   my $self = shift;
1777 0           my $dir_state = shift;
1778              
1779 0           my $dir = File::Spec->catdir($dir_state->{abs_out_dir}, $self->{thumbdir});
1780 0           my @pics = @{$dir_state->{files}};
  0            
1781 0           $self->debug(2, "dir: $dir");
1782              
1783             # if the thumbnail directory doesn't exist, then either all images
1784             # are new, or we don't have any images in this directory
1785 0 0         if (!-d $dir)
1786             {
1787 0 0         return (@pics ? 1 : 0);
1788             }
1789              
1790             # Read the thumbnail directory
1791 0           my $dirh;
1792 0           opendir($dirh,$dir);
1793 0           my @files = grep(!/^\.{1,2}$/, readdir($dirh));
1794 0           closedir($dirh);
1795              
1796             # check whether a picture has a thumbnail, and a thumbnail has a picture
1797 0           my %pic_has_tn = ();
1798 0           my %tn_has_pic = ();
1799              
1800             # initialize to false
1801 0           foreach my $pic ( @pics )
1802             {
1803 0           $pic_has_tn{$pic} = 0;
1804             }
1805              
1806             # Check each file to make sure it's a currently used thumbnail or image_page
1807 0           foreach my $file ( @files )
1808             {
1809 0           my $name = $file;
1810 0 0         if ($name =~ s/\.html$//)
    0          
1811             {
1812             # change the last underscore to a dot
1813 0           $name =~ s/_([a-zA-Z0-9]+)$/.$1/;
1814 0 0         if (exists $pic_has_tn{$name})
1815             {
1816 0           $pic_has_tn{$name} = 1;
1817 0           $tn_has_pic{$name} = 1;
1818             }
1819             else
1820             {
1821 0           $tn_has_pic{$name} = 0;
1822 0 0         print "$dir has unused image pages; needs cleaning\n" if $self->{verbose};
1823 0           return 1;
1824             }
1825             }
1826             elsif ($name =~ /(.+)\.jpg$/i) {
1827             # Thumbnail?
1828 0           $name = $1;
1829             # change the last underscore to a dot
1830 0           $name =~ s/_([a-zA-Z0-9]+)$/.$1/;
1831 0           $self->debug(2, "thumb: $name");
1832 0 0         if (exists $pic_has_tn{$name})
1833             {
1834 0           $pic_has_tn{$name} = 1;
1835 0           $tn_has_pic{$name} = 1;
1836             }
1837             else
1838             {
1839 0           $tn_has_pic{$name} = 0;
1840 0 0         print "$dir has unused thumbnails; needs cleaning\n" if $self->{verbose};
1841 0           return 1;
1842             }
1843             }
1844             } # for each file
1845              
1846             # now check if there are pics without thumbnails
1847 0           while (my ($key, $tn_exists) = each(%pic_has_tn))
1848             {
1849 0 0         if (!$tn_exists)
1850             {
1851 0           return 1;
1852             }
1853             }
1854              
1855 0           return 0;
1856             } # index_needs_rebuilding
1857              
1858             =head2 get_image_info
1859              
1860             Get the image information for an image. Returns a hash of
1861             information.
1862              
1863             %info = $self->get_image_info($image_file);
1864              
1865             =cut
1866             sub get_image_info {
1867 0     0 1   my $self = shift;
1868 0           my $img_file = shift;
1869              
1870 0           my $info = Image::ExifTool::ImageInfo($img_file);
1871             # add the basename
1872 0           my ($basename, $path, $suffix) = fileparse($img_file, qr/\.[^.]*/);
1873 0           $info->{file_basename} = $basename;
1874 0           return $info;
1875             } # get_image_info
1876              
1877             =head2 debug
1878              
1879             $self->debug($level, $message);
1880              
1881             Print a debug message (for debugging).
1882             Checks $self->{'debug_level'} to see if the message should be printed or
1883             not.
1884              
1885             =cut
1886             sub debug {
1887 0     0 1   my $self = shift;
1888 0           my $level = shift;
1889 0           my $message = shift;
1890              
1891 0 0         if ($level <= $self->{'debug_level'})
1892             {
1893 0           my $oh = \*STDERR;
1894 0           print $oh $message, "\n";
1895             }
1896             } # debug
1897              
1898             =head1 Private Methods
1899              
1900             Methods which may or may not be here in future.
1901              
1902             =head2 _whowasi
1903              
1904             For debugging: say who called this
1905              
1906             =cut
1907 0     0     sub _whowasi { (caller(1))[3] . '()' }
1908              
1909             =head1 REQUIRES
1910              
1911             Test::More
1912              
1913             =head1 INSTALLATION
1914              
1915             To install this module, run the following commands:
1916              
1917             perl Build.PL
1918             ./Build
1919             ./Build test
1920             ./Build install
1921              
1922             Or, if you're on a platform (like DOS or Windows) that doesn't like the
1923             "./" notation, you can do this:
1924              
1925             perl Build.PL
1926             perl Build
1927             perl Build test
1928             perl Build install
1929              
1930             In order to install somewhere other than the default, such as
1931             in a directory under your home directory, like "/home/fred/perl"
1932             go
1933              
1934             perl Build.PL --install_base /home/fred/perl
1935              
1936             as the first step instead.
1937              
1938             This will install the files underneath /home/fred/perl.
1939              
1940             You will then need to make sure that you alter the PERL5LIB variable to
1941             find the modules, and the PATH variable to find the script.
1942              
1943             Therefore you will need to change:
1944             your path, to include /home/fred/perl/script (where the script will be)
1945              
1946             PATH=/home/fred/perl/script:${PATH}
1947              
1948             the PERL5LIB variable to add /home/fred/perl/lib
1949              
1950             PERL5LIB=/home/fred/perl/lib:${PERL5LIB}
1951              
1952              
1953             =head1 SEE ALSO
1954              
1955             perl(1).
1956              
1957             =head1 BUGS
1958              
1959             Please report any bugs or feature requests to the author.
1960              
1961             =head1 AUTHOR
1962              
1963             Kathryn Andersen (RUBYKAT)
1964             perlkat AT katspace dot com
1965             http://www.katspace.org/tools
1966              
1967             =head1 COPYRIGHT AND LICENCE
1968              
1969             Copyright (c) 2006 by Kathryn Andersen
1970              
1971             This program is free software; you can redistribute it and/or modify it
1972             under the same terms as Perl itself.
1973              
1974              
1975             =cut
1976              
1977             1; # End of HTML::KhatGallery::Core
1978             __END__