File Coverage

blib/lib/HTML/KhatGallery/Core.pm
Criterion Covered Total %
statement 39 712 5.4
branch 0 204 0.0
condition 0 74 0.0
subroutine 13 58 22.4
pod 44 44 100.0
total 96 1092 8.7


line stmt bran cond sub pod time code
1             package HTML::KhatGallery::Core;
2             our $VERSION = '0.2402'; # VERSION
3 3     3   14505 use strict;
  3         5  
  3         75  
4 3     3   11 use warnings;
  3         5  
  3         77  
5              
6             =head1 NAME
7              
8             HTML::KhatGallery::Core - the core methods for HTML::KhatGallery
9              
10             =head1 VERSION
11              
12             version 0.2402
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   1190 use POSIX qw(ceil);
  3         15696  
  3         13  
37 3     3   3528 use File::Basename;
  3         5  
  3         189  
38 3     3   17 use File::Spec;
  3         4  
  3         71  
39 3     3   12 use Cwd qw(realpath);
  3         4  
  3         119  
40 3     3   1180 use File::stat;
  3         18484  
  3         11  
41 3     3   1222 use YAML qw(Dump LoadFile);
  3         16974  
  3         141  
42 3     3   4470 use Image::ExifTool;
  3         146417  
  3         1682  
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   26 no strict qw(subs refs);
  3         5  
  3         342  
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   19 use strict qw(subs refs);
  3         4  
  3         293  
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   17 no strict qw(subs refs);
  3         5  
  3         375  
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   26 use strict qw(subs refs);
  3         6  
  3         16902  
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             $dir_state->{abs_dir} = File::Spec->catdir(
426 0           realpath($self->{top_dir}), $dir_state->{dir});
427             $dir_state->{abs_out_dir} = File::Spec->catdir(
428 0           realpath($self->{top_out_dir}), $dir_state->{dir});
429 0           my @path = File::Spec->splitdir($dir_state->{abs_dir});
430 0 0         if ($dir_state->{dir})
431             {
432 0           $dir_state->{dirbase} = pop @path;
433 0           $dir_state->{parent} = pop @path;
434 0           $dir_state->{dir_url} = $self->{top_url} . '/' . $dir_state->{dir};
435             }
436             else # first dir
437             {
438 0           $dir_state->{dirbase} = pop @path;
439 0           $dir_state->{parent} = '';
440 0           $dir_state->{dir_url} = $self->{top_url};
441             }
442             # thumbnail dir for this directory
443             $dir_state->{abs_thumbdir} = File::Spec->catdir($dir_state->{abs_out_dir},
444 0           $self->{thumbdir});
445              
446             # reset the per-directory redo_html flag
447 0           $dir_state->{redo_html} = 0;
448              
449             } # init_settings
450              
451             =head2 read_captions
452              
453             Set the $dir_state->{captions} hash to contain all the
454             captions for this directory (if they exist)
455              
456             =cut
457             sub read_captions {
458 0     0 1   my $self = shift;
459 0           my $dir_state = shift;
460              
461             my $captions_file = File::Spec->catfile($dir_state->{abs_dir},
462 0           $self->{captions_file});
463 0 0         if (!-f $captions_file)
464             {
465             $captions_file = File::Spec->catfile($dir_state->{abs_out_dir},
466 0           $self->{captions_file});
467             }
468 0 0         if (-f $captions_file)
469             {
470 0           $dir_state->{captions} = {};
471 0           $dir_state->{captions} = LoadFile($captions_file);
472             }
473             } # read_captions
474              
475             =head2 read_dir
476              
477             Read the $dir_state->{dir} directory. Sets $dir_state->{subdirs}, and
478             $dir_state->{files} with the relative subdirs, and other files.
479              
480             =cut
481             sub read_dir {
482 0     0 1   my $self = shift;
483 0           my $dir_state = shift;
484              
485 0           my $dh;
486 0 0         opendir($dh, $dir_state->{abs_dir}) or die "Can't opendir $dir_state->{abs_dir}: $!";
487 0           my @subdirs = ();
488 0           my @files = ();
489 0           while (my $fn = readdir($dh))
490             {
491 0           my $abs_fn = File::Spec->catfile($dir_state->{abs_dir}, $fn);
492 0 0 0       if ($fn =~ /^\./ or $fn eq $self->{thumbdir})
    0          
    0          
493             {
494             # skip
495             }
496             elsif (-d $abs_fn)
497             {
498 0           push @subdirs, $fn;
499             }
500             # ignore any html files
501             elsif ($fn =~ /\.html$/)
502             {
503             }
504             else
505             {
506 0           push @files, $fn;
507             }
508             }
509 0           closedir($dh);
510              
511 0           $dir_state->{subdirs} = \@subdirs;
512 0           $dir_state->{files} = \@files;
513             } # read_dir
514              
515             =head2 read_out_dir
516              
517             Read the $dir_state->{dir} directory in the output tree.
518             Sets $dir_state->{index_files} with the index*.html files.
519              
520             =cut
521             sub read_out_dir {
522 0     0 1   my $self = shift;
523 0           my $dir_state = shift;
524              
525 0           my @index_files = ();
526 0 0         if (-d $dir_state->{abs_out_dir})
527             {
528 0           my $dh;
529 0 0         opendir($dh, $dir_state->{abs_out_dir}) or die "Can't opendir $dir_state->{abs_out_dir}: $!";
530 0           while (my $fn = readdir($dh))
531             {
532 0           my $abs_fn = File::Spec->catfile($dir_state->{abs_out_dir}, $fn);
533 0 0 0       if ($fn =~ /^\./ or $fn eq $self->{thumbdir})
    0          
534             {
535             # skip
536             }
537             # remember the index files
538             elsif ($fn =~ /index.*\.html$/)
539             {
540 0           push @index_files, $fn;
541             }
542             }
543 0           closedir($dh);
544             }
545              
546 0           $dir_state->{index_files} = \@index_files;
547             } # read_out_dir
548              
549             =head2 filter_images
550              
551             Sets $dir_state->{files} to contain only image files that
552             we are interested in.
553              
554             =cut
555             sub filter_images {
556 0     0 1   my $self = shift;
557 0           my $dir_state = shift;
558              
559 0 0 0       if ($self->{image_match}
560 0           and @{$dir_state->{files}})
561             {
562 0           my $img_match = $self->{image_match};
563             my @images = grep {
564 0           /$img_match/
565 0           } @{$dir_state->{files}};
  0            
566 0           $dir_state->{files} = \@images;
567             }
568             } # filter_images
569              
570             =head2 sort_images
571              
572             Sorts the $dir_state->{files} array.
573              
574             =cut
575             sub sort_images {
576 0     0 1   my $self = shift;
577 0           my $dir_state = shift;
578              
579 0 0         if (@{$dir_state->{files}})
  0            
580             {
581 0           my @images = sort @{$dir_state->{files}};
  0            
582 0           $dir_state->{files} = \@images;
583             }
584             } # sort_images
585              
586             =head2 filter_dirs
587              
588             Sets $dir_state->{subdirs} to contain only directories that
589             we are interested in.
590              
591             =cut
592             sub filter_dirs {
593 0     0 1   my $self = shift;
594 0           my $dir_state = shift;
595              
596 0 0 0       if ($self->{dir_match}
597 0           and @{$dir_state->{subdirs}})
598             {
599 0           my $dir_match = $self->{dir_match};
600             my @dirs = grep {
601 0           /$dir_match/
602 0           } @{$dir_state->{subdirs}};
  0            
603 0           $dir_state->{subdirs} = \@dirs;
604             }
605             } # filter_dirs
606              
607             =head2 sort_dirs
608              
609             Sorts the $dir_state->{subdirs} array.
610              
611             =cut
612             sub sort_dirs {
613 0     0 1   my $self = shift;
614 0           my $dir_state = shift;
615              
616 0 0         if (@{$dir_state->{subdirs}})
  0            
617             {
618 0           my @dirs = sort @{$dir_state->{subdirs}};
  0            
619 0           $dir_state->{subdirs} = \@dirs;
620             }
621             } # sort_dirs
622              
623             =head2 make_index_page
624              
625             Make the index page(s) for this directory.
626              
627             =cut
628             sub make_index_page {
629 0     0 1   my $self = shift;
630 0           my $dir_state = shift;
631              
632             # determine the number of pages
633             # To make things easier, always put the subdirs on each index page
634 0           my $num_files = @{$dir_state->{files}};
  0            
635 0           my $pages = ceil($num_files / $self->{per_page});
636             # if there are only subdirs make sure you still make an index
637 0 0 0       if ($pages == 0 and @{$dir_state->{subdirs}})
  0            
638             {
639 0           $pages = 1;
640             }
641 0           $dir_state->{pages} = $pages;
642              
643             # make the output dir if it doesn't exist
644 0 0         if (!-d $dir_state->{abs_out_dir})
645             {
646 0           mkdir $dir_state->{abs_out_dir};
647             }
648              
649             # if we have any new images in this directory, we need to re-make the index
650             # files because we don't know which index file it will appear in,
651             # and we need to re-make the other HTML files because
652             # we need to re-generate the prev/next links
653 0           $dir_state->{redo_html} = $self->index_needs_rebuilding($dir_state);
654              
655             # if forcing HTML, delete the old index pages
656             # just in case we are going to have fewer pages
657             # this time around
658 0 0 0       if ($self->{force_html} or $dir_state->{redo_html})
659             {
660 0           foreach my $if (@{$dir_state->{index_files}})
  0            
661             {
662 0           my $ff = File::Spec->catfile($dir_state->{abs_out_dir}, $if);
663 0           unlink $ff;
664             }
665             }
666              
667 0 0         if ($self->{verbose})
668             {
669             # if the first index is gone, we're rebuilding all of them
670 0           my $first_index
671             = $self->get_index_pagename(dir_state=>$dir_state,
672             page=>1, get_filename=>1);
673 0 0         if (!-f $first_index)
674             {
675 0           print "making $pages indexes\n";
676             }
677             }
678              
679             # for each page
680 0           for (my $page = 1; $page <= $pages; $page++)
681             {
682             # calculate the filename
683 0           my $ifile = $self->get_index_pagename(dir_state=>$dir_state,
684             page=>$page, get_filename=>1);
685 0 0         if (-f $ifile)
686             {
687 0           next;
688             }
689              
690             # figure which files are in this page
691             # Determine number of images to skip
692 0           my @images = ();
693 0 0         if (@{$dir_state->{files}})
  0            
694             {
695 0           my $skip = $self->{per_page} * ($page-1);
696             # index of last entry to include
697 0           my $last = $skip + $self->{per_page};
698 0 0         $last = $num_files if ($last > $num_files);
699 0           $last--; # need the index, not the count
700 0           @images = @{$dir_state->{files}}[$skip .. $last];
  0            
701             }
702              
703 0           my @content = ();
704 0           push @content, $self->start_index_page($dir_state, $page);
705             # add the subdirs
706 0           push @content, $self->make_index_subdirs($dir_state, $page);
707             # add the images
708 0           push @content, $self->make_image_index(dir_state=>$dir_state,
709             page=>$page, images=>\@images);
710 0           push @content, $self->end_index_page($dir_state, $page);
711 0           my $content = join('', @content);
712              
713             # make the head stuff
714 0           my $title = $self->make_index_title($dir_state, $page);
715 0           my $style = $self->make_index_style($dir_state, $page);
716              
717             # put the page content in the template
718 0           my $out = $self->get_template($self->{page_template});
719             # save the content of the template in case we read it
720             # from a file
721 0           $self->{page_template} = $out;
722 0           $out =~ s//$title/;
723 0           $out =~ s//$style/;
724 0           $out =~ s//$content/;
725              
726             # write the page to the file
727 0           my $fh = undef;
728 0 0         open($fh, ">", $ifile) or die "Could not open $ifile for writing: $!";
729 0           print $fh $out;
730 0           close($fh);
731             } # for each page
732             } # make_index_page
733              
734             =head2 clean_thumb_dir
735              
736             Clean unused thumbnails and image-pages from
737             the thumbnail directory of this directory
738              
739             =cut
740             sub clean_thumb_dir {
741 0     0 1   my $self = shift;
742 0           my $dir_state = shift;
743              
744 0           my $dir = File::Spec->catdir($dir_state->{abs_out_dir}, $self->{thumbdir});
745 0           my @pics = @{$dir_state->{files}};
  0            
746 0           $self->debug(2, "dir: $dir");
747              
748 0 0         return unless -d $dir;
749              
750             # store the pics as a hash to make checking easier
751 0           my %pics_hash = ();
752 0           foreach my $pic ( @pics )
753             {
754 0           $pics_hash{$pic} = 1;
755             }
756              
757             # Read the thumbnail directory
758 0           my $dirh;
759 0           opendir($dirh,$dir);
760 0           my @files = grep(!/^\.{1,2}$/, readdir($dirh));
761 0           closedir($dirh);
762              
763             # Check each file to make sure it's a currently used thumbnail or image_page
764 0           foreach my $file ( @files )
765             {
766 0           my $remove = '';
767 0           my $name = $file;
768 0 0         if ($name =~ s/\.html$//)
    0          
769             {
770             # change the last underscore to a dot
771 0           $name =~ s/_([a-zA-Z0-9]+)$/.$1/;
772             $remove = "unused image page"
773 0 0         unless (exists $pics_hash{$name});
774             }
775             elsif ($name =~ /(.+)\.jpg$/i) {
776             # Thumbnail?
777 0           $name = $1;
778             # change the last underscore to a dot
779 0           $name =~ s/_([a-zA-Z0-9]+)$/.$1/;
780 0           $self->debug(2, "thumb: $name");
781             $remove = "unused thumbnail"
782 0 0         unless (exists $pics_hash{$name});
783             } else {
784 0           $remove = "unknown file";
785             }
786 0 0         if ($remove) {
787 0 0         print "Remove $remove: $file\n" if $self->{verbose};
788 0           my $fullname = File::Spec->catfile($dir, $file);
789 0 0         warn "Couldn't erase [$file]"
790             unless unlink $fullname;
791             }
792             } # for each file
793             } # clean_thumb_dir
794              
795             =head2 process_images
796              
797             Process the images from this directory.
798              
799             =cut
800             sub process_images {
801 0     0 1   my $self = shift;
802 0           my $dir_state = shift;
803              
804 0           $self->do_image_actions($dir_state, @{$dir_state->{files}});
  0            
805             } # process_images
806              
807             =head2 process_subdirs
808              
809             Process the sub-directories of this directory.
810              
811             =cut
812             sub process_subdirs {
813 0     0 1   my $self = shift;
814 0           my $dir_state = shift;
815              
816 0           my @image_dirs = @{$dir_state->{subdirs}};
  0            
817              
818 0           foreach my $subdir (@image_dirs)
819             {
820 0           my $dir = $subdir;
821 0 0         if ($dir_state->{dir})
822             {
823 0           $dir = File::Spec->catdir($dir_state->{dir}, $subdir);
824             }
825 0 0         print "=== $dir ===\n" if $self->{verbose};
826 0           $self->do_dir_actions($dir);
827             }
828             } # process_subdirs
829              
830             =head2 tidy_up
831              
832             Cleanup after processing this directory.
833              
834             =cut
835             sub tidy_up {
836 0     0 1   my $self = shift;
837 0           my $dir_state = shift;
838              
839             } # tidy_up
840              
841             =head1 Image Action Methods
842              
843             Methods implementing per-image actions.
844              
845             =head2 init_image_settings
846              
847             Initialize settings for the current image.
848              
849             =cut
850             sub init_image_settings {
851 0     0 1   my $self = shift;
852 0           my $dir_state = shift;
853 0           my $img_state = shift;
854              
855             $img_state->{abs_img} = File::Spec->catfile($dir_state->{abs_dir},
856 0           $img_state->{cur_img});
857 0           $img_state->{info} = $self->get_image_info($img_state->{abs_img});
858              
859             } # init_image_settings
860              
861             =head2 make_thumbnail
862              
863             Make a thumbnail of the current image.
864             Constant pixel count among generated images based on
865             http://www.chaosreigns.com/code/thumbnail/
866              
867             =cut
868             sub make_thumbnail {
869 0     0 1   my $self = shift;
870 0           my $dir_state = shift;
871 0           my $img_state = shift;
872              
873             my $thumb_file = $self->get_thumbnail_name(
874             dir_state=>$dir_state, image=>$img_state->{cur_img},
875 0           type=>'file');
876 0 0         if (!$self->need_to_generate_image($dir_state, $img_state,
877             check_image=>$thumb_file))
878             {
879 0           return;
880             }
881             # make the thumbnail dir if it doesn't exist
882 0 0         if (!-d $dir_state->{abs_thumbdir})
883             {
884 0           mkdir $dir_state->{abs_thumbdir};
885             }
886              
887 0           my $x = $img_state->{info}->{ImageWidth};
888 0           my $y = $img_state->{info}->{ImageHeight};
889 0 0 0       if (!$x or !$y)
890             {
891 0           warn "dimensions of " . $img_state->{abs_img} . " undefined -- faking it";
892 0           print STDERR Dump($img_state);
893 0           print STDERR "========================\n";
894 0           $x = 1024;
895 0           $y = 1024;
896             }
897            
898 0           my $pixels = $x * $y;
899 0           my $newx = int($x / (sqrt($x * $y) / sqrt($self->{pixelcount})));
900 0           my $newy = int($y / (sqrt($x * $y) / sqrt($self->{pixelcount})));
901 0           my $newpix = $newx * $newy;
902 0           my $command = '';
903 0 0         if ($img_state->{cur_img} =~ /\.gif$/)
904             {
905             # in case this is an animated gif, get the first frame only
906 0           $command = "convert -geometry \"${newx}x${newy}\>\" \"$img_state->{abs_img}\[0\]\" \"$thumb_file\"";
907             }
908             else
909             {
910 0           $command = "convert -geometry \"${newx}x${newy}\>\" \"$img_state->{abs_img}\" \"$thumb_file\"";
911             }
912 0 0         system($command) == 0
913             or die "$command failed";
914            
915             } # make_thumbnail
916              
917             =head2 make_image_page
918              
919             Make HTML page for current image.
920              
921             =cut
922             sub make_image_page {
923 0     0 1   my $self = shift;
924 0           my $dir_state = shift;
925 0           my $img_state = shift;
926              
927 0           my $img_name = $img_state->{cur_img};
928             my $img_page_file = $self->get_image_pagename(dir_state=>$dir_state,
929             image=>$img_state->{cur_img},
930 0           type=>'file');
931 0 0 0       if (-f $img_page_file
      0        
932             and !$self->{force_html}
933             and !$dir_state->{redo_html})
934             {
935 0           return;
936             }
937             # make the thumbnail dir if it doesn't exist
938 0 0         if (!-d $dir_state->{abs_thumbdir})
939             {
940 0           mkdir $dir_state->{abs_thumbdir};
941             }
942 0           my @content = ();
943 0           push @content, $self->start_image_page($dir_state, $img_state);
944             # add the image itself
945 0           push @content, $self->make_image_content($dir_state, $img_state);
946 0           push @content, $self->end_image_page($dir_state, $img_state);
947 0           my $content = join('', @content);
948              
949             # make the head stuff
950 0           my $title = $self->make_image_title($dir_state, $img_state);
951 0           my $style = $self->make_image_style($dir_state, $img_state);
952              
953             # put the page content in the template
954 0           my $out = $self->get_template($self->{page_template});
955             # save the content of the template in case we read it
956             # from a file
957 0           $self->{page_template} = $out;
958 0           $out =~ s//$title/;
959 0           $out =~ s//$style/;
960 0           $out =~ s//$content/;
961              
962             # write the page to the file
963 0           my $fh = undef;
964 0 0         open($fh, ">", $img_page_file) or die "Could not open $img_page_file for writing: $!";
965 0           print $fh $out;
966 0           close($fh);
967             } # make_image_page
968              
969             =head2 image_tidy_up
970              
971             Clean up after the current image.
972              
973             =cut
974             sub image_tidy_up {
975 0     0 1   my $self = shift;
976 0           my $dir_state = shift;
977 0           my $img_state = shift;
978              
979             } # image_tidy_up
980              
981             =head1 Helper Methods
982              
983             Methods which can be called from within other methods.
984              
985             =head2 start_index_page
986              
987             push @content, $self->start_index_page($dir_state, $page);
988              
989             Create the start-of-page for an index page.
990             This contains page content, not full etc (that's expected
991             to be in the full-page template).
992             It contains the header, link to parent dirs and links to
993             previous and next index-pages, and the album caption.
994              
995             =cut
996             sub start_index_page {
997 0     0 1   my $self = shift;
998 0           my $dir_state = shift;
999 0           my $page = shift;
1000              
1001 0           my @out = ();
1002 0           push @out, "
\n";
1003              
1004             # Path array contains basenames from the top dir down to the current dir.
1005 0           my @path = split(/[\/\\]/, $dir_state->{dir});
1006              
1007             # Note that what we want is the top_out_base and not the top_base
1008             # because if they are not the same (because top_out_dir was set)
1009             # the salient info is the output directory and not the source directory.
1010 0           unshift @path, $self->{top_out_base};
1011              
1012             # we want to create relative links to all the dirs
1013             # above the current one, so work backwards
1014 0           my %uplinks = ();
1015 0           my $uplink = '';
1016 0           foreach my $dn (reverse @path)
1017             {
1018 0           $uplinks{$dn} = $uplink;
1019 0 0 0       if (!$uplink and $page > 1)
1020             {
1021 0           $uplinks{$dn} = "index.html";
1022             }
1023             else
1024             {
1025 0           $uplink .= '../';
1026             }
1027             }
1028 0           my @header = ();
1029 0           foreach my $dn (@path)
1030             {
1031 0           my $pretty = $dn;
1032 0           $pretty =~ s/_/ /g;
1033 0 0         if ($uplinks{$dn})
1034             {
1035 0           push @header, "$pretty";
1036             }
1037             else
1038             {
1039 0           push @header, $pretty;
1040             }
1041             }
1042 0           push @out, '

';

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

';

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

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

';

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

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

$caption

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