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 |
||||||
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 |
||||||
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 | |
||||||
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 | |
||||||
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 | |
||||||
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 |
||||||
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/</g; | |||||
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, " |
|||||
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, " |
|||||
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, " |
|||||
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 |
||||||
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__ |