blib/lib/HTML/KhatGallery/Core.pm | |||
---|---|---|---|
Criterion | Covered | Total | % |
statement | 39 | 692 | 5.6 |
branch | 0 | 200 | 0.0 |
condition | 0 | 71 | 0.0 |
subroutine | 13 | 58 | 22.4 |
pod | 44 | 44 | 100.0 |
total | 96 | 1065 | 9.0 |
line | stmt | bran | cond | sub | pod | time | code |
---|---|---|---|---|---|---|---|
1 | package HTML::KhatGallery::Core; | ||||||
2 | our $VERSION = '0.24'; # VERSION | ||||||
3 | 3 | 3 | 15384 | use strict; | |||
3 | 5 | ||||||
3 | 75 | ||||||
4 | 3 | 3 | 13 | use warnings; | |||
3 | 4 | ||||||
3 | 83 | ||||||
5 | |||||||
6 | =head1 NAME | ||||||
7 | |||||||
8 | HTML::KhatGallery::Core - the core methods for HTML::KhatGallery | ||||||
9 | |||||||
10 | =head1 VERSION | ||||||
11 | |||||||
12 | version 0.24 | ||||||
13 | |||||||
14 | =head1 SYNOPSIS | ||||||
15 | |||||||
16 | # implicitly | ||||||
17 | use HTML::KhatGallery qw(HTML::KhatGallery::Core HTML::KhatGallery::Plugin::MyPlugin ...); | ||||||
18 | |||||||
19 | # or explicitly | ||||||
20 | require HTML::KhatGallery; | ||||||
21 | |||||||
22 | @plugins = qw(HTML::KhatGallery::Core HTML::KhatGallery::Plugin::MyPlugin ...); | ||||||
23 | HTML::KhatGallery->import(@plugins); | ||||||
24 | HTML::KhatGallery->run(%args); | ||||||
25 | |||||||
26 | |||||||
27 | =head1 DESCRIPTION | ||||||
28 | |||||||
29 | HTML::KhatGallery is a photo-gallery generator. | ||||||
30 | |||||||
31 | HTML::KhatGallery::Core provides the core functionality of the system. | ||||||
32 | Other functions can be added or overridden by plugin modules. | ||||||
33 | |||||||
34 | =cut | ||||||
35 | |||||||
36 | 3 | 3 | 1278 | use POSIX qw(ceil); | |||
3 | 16034 | ||||||
3 | 12 | ||||||
37 | 3 | 3 | 3606 | use File::Basename; | |||
3 | 6 | ||||||
3 | 187 | ||||||
38 | 3 | 3 | 15 | use File::Spec; | |||
3 | 5 | ||||||
3 | 69 | ||||||
39 | 3 | 3 | 13 | use Cwd; | |||
3 | 5 | ||||||
3 | 133 | ||||||
40 | 3 | 3 | 1206 | use File::stat; | |||
3 | 18611 | ||||||
3 | 9 | ||||||
41 | 3 | 3 | 1296 | use YAML qw(Dump LoadFile); | |||
3 | 17593 | ||||||
3 | 147 | ||||||
42 | 3 | 3 | 4667 | use Image::ExifTool; | |||
3 | 149894 | ||||||
3 | 1716 | ||||||
43 | |||||||
44 | =head1 CLASS METHODS | ||||||
45 | |||||||
46 | =head2 run | ||||||
47 | |||||||
48 | HTML::KhatGallery->run(%args); | ||||||
49 | |||||||
50 | C |
||||||
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 | 25 | no strict qw(subs refs); | |||
3 | 5 | ||||||
3 | 346 | ||||||
348 | my @actions = ($self->{clean} | ||||||
349 | 0 | ? @{$self->{clean_actions}} | |||||
350 | 0 | 0 | : @{$self->{dir_actions}}); | ||||
0 | |||||||
351 | 0 | while (@actions) | |||||
352 | { | ||||||
353 | 0 | my $action = shift @actions; | |||||
354 | 0 | 0 | last if $state{stop}; | ||||
355 | 0 | $state{action} = $action; | |||||
356 | 0 | $self->debug(1, "action: $action"); | |||||
357 | 0 | $self->$action(\%state); | |||||
358 | } | ||||||
359 | 3 | 3 | 17 | use strict qw(subs refs); | |||
3 | 6 | ||||||
3 | 353 | ||||||
360 | 0 | 1; | |||||
361 | } # do_dir_actions | ||||||
362 | |||||||
363 | =head2 do_image_actions | ||||||
364 | |||||||
365 | $self->do_image_actions(\%dir_state, @images); | ||||||
366 | |||||||
367 | Do all the actions in the $self->{image_actions} list, for the | ||||||
368 | given images. | ||||||
369 | |||||||
370 | =cut | ||||||
371 | sub do_image_actions { | ||||||
372 | 0 | 0 | 1 | my $self = shift; | |||
373 | 0 | my $dir_state = shift; | |||||
374 | 0 | my @images = @_; | |||||
375 | |||||||
376 | 0 | my %images_state = (); | |||||
377 | |||||||
378 | 3 | 3 | 19 | no strict qw(subs refs); | |||
3 | 6 | ||||||
3 | 385 | ||||||
379 | 0 | for (my $i = 0; $i < @images; $i++) | |||||
380 | { | ||||||
381 | 0 | %images_state = (); | |||||
382 | 0 | $images_state{stop} = 0; | |||||
383 | 0 | $images_state{images} = \@images; | |||||
384 | 0 | $images_state{num} = $i; | |||||
385 | 0 | $images_state{cur_img} = $images[$i]; | |||||
386 | # pop off each action as we go; | ||||||
387 | # that way it's possible for an action to | ||||||
388 | # manipulate the actions array | ||||||
389 | 0 | @{$images_state{image_actions}} = @{$self->{image_actions}}; | |||||
0 | |||||||
0 | |||||||
390 | 0 | while (@{$images_state{image_actions}}) | |||||
0 | |||||||
391 | { | ||||||
392 | 0 | my $action = shift @{$images_state{image_actions}}; | |||||
0 | |||||||
393 | 0 | 0 | last if $images_state{stop}; | ||||
394 | 0 | $images_state{action} = $action; | |||||
395 | 0 | $self->debug(1, "image_action: $action"); | |||||
396 | 0 | $self->$action($dir_state, | |||||
397 | \%images_state); | ||||||
398 | } | ||||||
399 | } | ||||||
400 | 3 | 3 | 27 | use strict qw(subs refs); | |||
3 | 6 | ||||||
3 | 16707 | ||||||
401 | 0 | 1; | |||||
402 | } # do_image_actions | ||||||
403 | |||||||
404 | =head1 Dir Action Methods | ||||||
405 | |||||||
406 | Methods implementing directory-related actions. All such actions | ||||||
407 | expect a reference to a state hash, and generally will update either | ||||||
408 | that hash or the object itself, or both, in the course of their | ||||||
409 | running. | ||||||
410 | |||||||
411 | =head2 init_settings | ||||||
412 | |||||||
413 | Initialize various settings that need to be set before everything | ||||||
414 | else. | ||||||
415 | |||||||
416 | This is not the same as "init", because this is the start of | ||||||
417 | the dir_actions sequence; we do it for each directory (or sub-directory) | ||||||
418 | we traverse. | ||||||
419 | |||||||
420 | =cut | ||||||
421 | sub init_settings { | ||||||
422 | 0 | 0 | 1 | my $self = shift; | |||
423 | 0 | my $dir_state = shift; | |||||
424 | |||||||
425 | 0 | $dir_state->{abs_dir} = File::Spec->catdir($self->{top_dir}, $dir_state->{dir}); | |||||
426 | 0 | $dir_state->{abs_out_dir} = File::Spec->catdir($self->{top_out_dir}, $dir_state->{dir}); | |||||
427 | 0 | my @path = File::Spec->splitdir($dir_state->{abs_dir}); | |||||
428 | 0 | 0 | if ($dir_state->{dir}) | ||||
429 | { | ||||||
430 | 0 | $dir_state->{dirbase} = pop @path; | |||||
431 | 0 | $dir_state->{parent} = pop @path; | |||||
432 | 0 | $dir_state->{dir_url} = $self->{top_url} . '/' . $dir_state->{dir}; | |||||
433 | } | ||||||
434 | else # first dir | ||||||
435 | { | ||||||
436 | 0 | $dir_state->{dirbase} = pop @path; | |||||
437 | 0 | $dir_state->{parent} = ''; | |||||
438 | 0 | $dir_state->{dir_url} = $self->{top_url}; | |||||
439 | } | ||||||
440 | # thumbnail dir for this directory | ||||||
441 | $dir_state->{abs_thumbdir} = File::Spec->catdir($dir_state->{abs_out_dir}, | ||||||
442 | 0 | $self->{thumbdir}); | |||||
443 | |||||||
444 | # reset the per-directory redo_html flag | ||||||
445 | 0 | $dir_state->{redo_html} = 0; | |||||
446 | |||||||
447 | } # init_settings | ||||||
448 | |||||||
449 | =head2 read_captions | ||||||
450 | |||||||
451 | Set the $dir_state->{captions} hash to contain all the | ||||||
452 | captions for this directory (if they exist) | ||||||
453 | |||||||
454 | =cut | ||||||
455 | sub read_captions { | ||||||
456 | 0 | 0 | 1 | my $self = shift; | |||
457 | 0 | my $dir_state = shift; | |||||
458 | |||||||
459 | my $captions_file = File::Spec->catfile($dir_state->{abs_dir}, | ||||||
460 | 0 | $self->{captions_file}); | |||||
461 | 0 | 0 | if (!-f $captions_file) | ||||
462 | { | ||||||
463 | $captions_file = File::Spec->catfile($dir_state->{abs_out_dir}, | ||||||
464 | 0 | $self->{captions_file}); | |||||
465 | } | ||||||
466 | 0 | 0 | if (-f $captions_file) | ||||
467 | { | ||||||
468 | 0 | $dir_state->{captions} = {}; | |||||
469 | 0 | $dir_state->{captions} = LoadFile($captions_file); | |||||
470 | } | ||||||
471 | } # read_captions | ||||||
472 | |||||||
473 | =head2 read_dir | ||||||
474 | |||||||
475 | Read the $dir_state->{dir} directory. Sets $dir_state->{subdirs}, and | ||||||
476 | $dir_state->{files} with the relative subdirs, and other files. | ||||||
477 | |||||||
478 | =cut | ||||||
479 | sub read_dir { | ||||||
480 | 0 | 0 | 1 | my $self = shift; | |||
481 | 0 | my $dir_state = shift; | |||||
482 | |||||||
483 | 0 | my $dh; | |||||
484 | 0 | 0 | opendir($dh, $dir_state->{abs_dir}) or die "Can't opendir $dir_state->{abs_dir}: $!"; | ||||
485 | 0 | my @subdirs = (); | |||||
486 | 0 | my @files = (); | |||||
487 | 0 | while (my $fn = readdir($dh)) | |||||
488 | { | ||||||
489 | 0 | my $abs_fn = File::Spec->catfile($dir_state->{abs_dir}, $fn); | |||||
490 | 0 | 0 | 0 | if ($fn =~ /^\./ or $fn eq $self->{thumbdir}) | |||
0 | |||||||
0 | |||||||
491 | { | ||||||
492 | # skip | ||||||
493 | } | ||||||
494 | elsif (-d $abs_fn) | ||||||
495 | { | ||||||
496 | 0 | push @subdirs, $fn; | |||||
497 | } | ||||||
498 | # ignore any html files | ||||||
499 | elsif ($fn =~ /\.html$/) | ||||||
500 | { | ||||||
501 | } | ||||||
502 | else | ||||||
503 | { | ||||||
504 | 0 | push @files, $fn; | |||||
505 | } | ||||||
506 | } | ||||||
507 | 0 | closedir($dh); | |||||
508 | |||||||
509 | 0 | $dir_state->{subdirs} = \@subdirs; | |||||
510 | 0 | $dir_state->{files} = \@files; | |||||
511 | } # read_dir | ||||||
512 | |||||||
513 | =head2 read_out_dir | ||||||
514 | |||||||
515 | Read the $dir_state->{dir} directory in the output tree. | ||||||
516 | Sets $dir_state->{index_files} with the index*.html files. | ||||||
517 | |||||||
518 | =cut | ||||||
519 | sub read_out_dir { | ||||||
520 | 0 | 0 | 1 | my $self = shift; | |||
521 | 0 | my $dir_state = shift; | |||||
522 | |||||||
523 | 0 | my @index_files = (); | |||||
524 | 0 | 0 | if (-d $dir_state->{abs_out_dir}) | ||||
525 | { | ||||||
526 | 0 | my $dh; | |||||
527 | 0 | 0 | opendir($dh, $dir_state->{abs_out_dir}) or die "Can't opendir $dir_state->{abs_out_dir}: $!"; | ||||
528 | 0 | while (my $fn = readdir($dh)) | |||||
529 | { | ||||||
530 | 0 | my $abs_fn = File::Spec->catfile($dir_state->{abs_out_dir}, $fn); | |||||
531 | 0 | 0 | 0 | if ($fn =~ /^\./ or $fn eq $self->{thumbdir}) | |||
0 | |||||||
532 | { | ||||||
533 | # skip | ||||||
534 | } | ||||||
535 | # remember the index files | ||||||
536 | elsif ($fn =~ /index.*\.html$/) | ||||||
537 | { | ||||||
538 | 0 | push @index_files, $fn; | |||||
539 | } | ||||||
540 | } | ||||||
541 | 0 | closedir($dh); | |||||
542 | } | ||||||
543 | |||||||
544 | 0 | $dir_state->{index_files} = \@index_files; | |||||
545 | } # read_out_dir | ||||||
546 | |||||||
547 | =head2 filter_images | ||||||
548 | |||||||
549 | Sets $dir_state->{files} to contain only image files that | ||||||
550 | we are interested in. | ||||||
551 | |||||||
552 | =cut | ||||||
553 | sub filter_images { | ||||||
554 | 0 | 0 | 1 | my $self = shift; | |||
555 | 0 | my $dir_state = shift; | |||||
556 | |||||||
557 | 0 | 0 | 0 | if ($self->{image_match} | |||
558 | 0 | and @{$dir_state->{files}}) | |||||
559 | { | ||||||
560 | 0 | my $img_match = $self->{image_match}; | |||||
561 | my @images = grep { | ||||||
562 | 0 | /$img_match/ | |||||
563 | 0 | } @{$dir_state->{files}}; | |||||
0 | |||||||
564 | 0 | $dir_state->{files} = \@images; | |||||
565 | } | ||||||
566 | } # filter_images | ||||||
567 | |||||||
568 | =head2 sort_images | ||||||
569 | |||||||
570 | Sorts the $dir_state->{files} array. | ||||||
571 | |||||||
572 | =cut | ||||||
573 | sub sort_images { | ||||||
574 | 0 | 0 | 1 | my $self = shift; | |||
575 | 0 | my $dir_state = shift; | |||||
576 | |||||||
577 | 0 | 0 | if (@{$dir_state->{files}}) | ||||
0 | |||||||
578 | { | ||||||
579 | 0 | my @images = sort @{$dir_state->{files}}; | |||||
0 | |||||||
580 | 0 | $dir_state->{files} = \@images; | |||||
581 | } | ||||||
582 | } # sort_images | ||||||
583 | |||||||
584 | =head2 filter_dirs | ||||||
585 | |||||||
586 | Sets $dir_state->{subdirs} to contain only directories that | ||||||
587 | we are interested in. | ||||||
588 | |||||||
589 | =cut | ||||||
590 | sub filter_dirs { | ||||||
591 | 0 | 0 | 1 | my $self = shift; | |||
592 | 0 | my $dir_state = shift; | |||||
593 | |||||||
594 | 0 | 0 | 0 | if ($self->{dir_match} | |||
595 | 0 | and @{$dir_state->{subdirs}}) | |||||
596 | { | ||||||
597 | 0 | my $dir_match = $self->{dir_match}; | |||||
598 | my @dirs = grep { | ||||||
599 | 0 | /$dir_match/ | |||||
600 | 0 | } @{$dir_state->{subdirs}}; | |||||
0 | |||||||
601 | 0 | $dir_state->{subdirs} = \@dirs; | |||||
602 | } | ||||||
603 | } # filter_dirs | ||||||
604 | |||||||
605 | =head2 sort_dirs | ||||||
606 | |||||||
607 | Sorts the $dir_state->{subdirs} array. | ||||||
608 | |||||||
609 | =cut | ||||||
610 | sub sort_dirs { | ||||||
611 | 0 | 0 | 1 | my $self = shift; | |||
612 | 0 | my $dir_state = shift; | |||||
613 | |||||||
614 | 0 | 0 | if (@{$dir_state->{subdirs}}) | ||||
0 | |||||||
615 | { | ||||||
616 | 0 | my @dirs = sort @{$dir_state->{subdirs}}; | |||||
0 | |||||||
617 | 0 | $dir_state->{subdirs} = \@dirs; | |||||
618 | } | ||||||
619 | } # sort_dirs | ||||||
620 | |||||||
621 | =head2 make_index_page | ||||||
622 | |||||||
623 | Make the index page(s) for this directory. | ||||||
624 | |||||||
625 | =cut | ||||||
626 | sub make_index_page { | ||||||
627 | 0 | 0 | 1 | my $self = shift; | |||
628 | 0 | my $dir_state = shift; | |||||
629 | |||||||
630 | # determine the number of pages | ||||||
631 | # To make things easier, always put the subdirs on each index page | ||||||
632 | 0 | my $num_files = @{$dir_state->{files}}; | |||||
0 | |||||||
633 | 0 | my $pages = ceil($num_files / $self->{per_page}); | |||||
634 | # if there are only subdirs make sure you still make an index | ||||||
635 | 0 | 0 | 0 | if ($pages == 0 and @{$dir_state->{subdirs}}) | |||
0 | |||||||
636 | { | ||||||
637 | 0 | $pages = 1; | |||||
638 | } | ||||||
639 | 0 | $dir_state->{pages} = $pages; | |||||
640 | |||||||
641 | # make the output dir if it doesn't exist | ||||||
642 | 0 | 0 | if (!-d $dir_state->{abs_out_dir}) | ||||
643 | { | ||||||
644 | 0 | mkdir $dir_state->{abs_out_dir}; | |||||
645 | } | ||||||
646 | |||||||
647 | # if we have any new images in this directory, we need to re-make the index | ||||||
648 | # files because we don't know which index file it will appear in, | ||||||
649 | # and we need to re-make the other HTML files because | ||||||
650 | # we need to re-generate the prev/next links | ||||||
651 | 0 | $dir_state->{redo_html} = $self->index_needs_rebuilding($dir_state); | |||||
652 | |||||||
653 | # if forcing HTML, delete the old index pages | ||||||
654 | # just in case we are going to have fewer pages | ||||||
655 | # this time around | ||||||
656 | 0 | 0 | 0 | if ($self->{force_html} or $dir_state->{redo_html}) | |||
657 | { | ||||||
658 | 0 | foreach my $if (@{$dir_state->{index_files}}) | |||||
0 | |||||||
659 | { | ||||||
660 | 0 | my $ff = File::Spec->catfile($dir_state->{abs_out_dir}, $if); | |||||
661 | 0 | unlink $ff; | |||||
662 | } | ||||||
663 | } | ||||||
664 | |||||||
665 | 0 | 0 | if ($self->{verbose}) | ||||
666 | { | ||||||
667 | # if the first index is gone, we're rebuilding all of them | ||||||
668 | 0 | my $first_index | |||||
669 | = $self->get_index_pagename(dir_state=>$dir_state, | ||||||
670 | page=>1, get_filename=>1); | ||||||
671 | 0 | 0 | if (!-f $first_index) | ||||
672 | { | ||||||
673 | 0 | print "making $pages indexes\n"; | |||||
674 | } | ||||||
675 | } | ||||||
676 | |||||||
677 | # for each page | ||||||
678 | 0 | for (my $page = 1; $page <= $pages; $page++) | |||||
679 | { | ||||||
680 | # calculate the filename | ||||||
681 | 0 | my $ifile = $self->get_index_pagename(dir_state=>$dir_state, | |||||
682 | page=>$page, get_filename=>1); | ||||||
683 | 0 | 0 | if (-f $ifile) | ||||
684 | { | ||||||
685 | 0 | next; | |||||
686 | } | ||||||
687 | |||||||
688 | # figure which files are in this page | ||||||
689 | # Determine number of images to skip | ||||||
690 | 0 | my @images = (); | |||||
691 | 0 | 0 | if (@{$dir_state->{files}}) | ||||
0 | |||||||
692 | { | ||||||
693 | 0 | my $skip = $self->{per_page} * ($page-1); | |||||
694 | # index of last entry to include | ||||||
695 | 0 | my $last = $skip + $self->{per_page}; | |||||
696 | 0 | 0 | $last = $num_files if ($last > $num_files); | ||||
697 | 0 | $last--; # need the index, not the count | |||||
698 | 0 | @images = @{$dir_state->{files}}[$skip .. $last]; | |||||
0 | |||||||
699 | } | ||||||
700 | |||||||
701 | 0 | my @content = (); | |||||
702 | 0 | push @content, $self->start_index_page($dir_state, $page); | |||||
703 | # add the subdirs | ||||||
704 | 0 | push @content, $self->make_index_subdirs($dir_state, $page); | |||||
705 | # add the images | ||||||
706 | 0 | push @content, $self->make_image_index(dir_state=>$dir_state, | |||||
707 | page=>$page, images=>\@images); | ||||||
708 | 0 | push @content, $self->end_index_page($dir_state, $page); | |||||
709 | 0 | my $content = join('', @content); | |||||
710 | |||||||
711 | # make the head stuff | ||||||
712 | 0 | my $title = $self->make_index_title($dir_state, $page); | |||||
713 | 0 | my $style = $self->make_index_style($dir_state, $page); | |||||
714 | |||||||
715 | # put the page content in the template | ||||||
716 | 0 | my $out = $self->get_template($self->{page_template}); | |||||
717 | # save the content of the template in case we read it | ||||||
718 | # from a file | ||||||
719 | 0 | $self->{page_template} = $out; | |||||
720 | 0 | $out =~ s//$title/; | |||||
721 | 0 | $out =~ s//$style/; | |||||
722 | 0 | $out =~ s//$content/; | |||||
723 | |||||||
724 | # write the page to the file | ||||||
725 | 0 | my $fh = undef; | |||||
726 | 0 | 0 | open($fh, ">", $ifile) or die "Could not open $ifile for writing: $!"; | ||||
727 | 0 | print $fh $out; | |||||
728 | 0 | close($fh); | |||||
729 | } # for each page | ||||||
730 | } # make_index_page | ||||||
731 | |||||||
732 | =head2 clean_thumb_dir | ||||||
733 | |||||||
734 | Clean unused thumbnails and image-pages from | ||||||
735 | the thumbnail directory of this directory | ||||||
736 | |||||||
737 | =cut | ||||||
738 | sub clean_thumb_dir { | ||||||
739 | 0 | 0 | 1 | my $self = shift; | |||
740 | 0 | my $dir_state = shift; | |||||
741 | |||||||
742 | 0 | my $dir = File::Spec->catdir($dir_state->{abs_out_dir}, $self->{thumbdir}); | |||||
743 | 0 | my @pics = @{$dir_state->{files}}; | |||||
0 | |||||||
744 | 0 | $self->debug(2, "dir: $dir"); | |||||
745 | |||||||
746 | 0 | 0 | return unless -d $dir; | ||||
747 | |||||||
748 | # store the pics as a hash to make checking easier | ||||||
749 | 0 | my %pics_hash = (); | |||||
750 | 0 | foreach my $pic ( @pics ) | |||||
751 | { | ||||||
752 | 0 | $pics_hash{$pic} = 1; | |||||
753 | } | ||||||
754 | |||||||
755 | # Read the thumbnail directory | ||||||
756 | 0 | my $dirh; | |||||
757 | 0 | opendir($dirh,$dir); | |||||
758 | 0 | my @files = grep(!/^\.{1,2}$/, readdir($dirh)); | |||||
759 | 0 | closedir($dirh); | |||||
760 | |||||||
761 | # Check each file to make sure it's a currently used thumbnail or image_page | ||||||
762 | 0 | foreach my $file ( @files ) | |||||
763 | { | ||||||
764 | 0 | my $remove = ''; | |||||
765 | 0 | my $name = $file; | |||||
766 | 0 | 0 | if ($name =~ s/\.html$//) | ||||
0 | |||||||
767 | { | ||||||
768 | # change the last underscore to a dot | ||||||
769 | 0 | $name =~ s/_([a-zA-Z0-9]+)$/.$1/; | |||||
770 | $remove = "unused image page" | ||||||
771 | 0 | 0 | unless (exists $pics_hash{$name}); | ||||
772 | } | ||||||
773 | elsif ($name =~ /(.+)\.jpg$/i) { | ||||||
774 | # Thumbnail? | ||||||
775 | 0 | $name = $1; | |||||
776 | # change the last underscore to a dot | ||||||
777 | 0 | $name =~ s/_([a-zA-Z0-9]+)$/.$1/; | |||||
778 | 0 | $self->debug(2, "thumb: $name"); | |||||
779 | $remove = "unused thumbnail" | ||||||
780 | 0 | 0 | unless (exists $pics_hash{$name}); | ||||
781 | } else { | ||||||
782 | 0 | $remove = "unknown file"; | |||||
783 | } | ||||||
784 | 0 | 0 | if ($remove) { | ||||
785 | 0 | 0 | print "Remove $remove: $file\n" if $self->{verbose}; | ||||
786 | 0 | my $fullname = File::Spec->catfile($dir, $file); | |||||
787 | 0 | 0 | warn "Couldn't erase [$file]" | ||||
788 | unless unlink $fullname; | ||||||
789 | } | ||||||
790 | } # for each file | ||||||
791 | } # clean_thumb_dir | ||||||
792 | |||||||
793 | =head2 process_images | ||||||
794 | |||||||
795 | Process the images from this directory. | ||||||
796 | |||||||
797 | =cut | ||||||
798 | sub process_images { | ||||||
799 | 0 | 0 | 1 | my $self = shift; | |||
800 | 0 | my $dir_state = shift; | |||||
801 | |||||||
802 | 0 | $self->do_image_actions($dir_state, @{$dir_state->{files}}); | |||||
0 | |||||||
803 | } # process_images | ||||||
804 | |||||||
805 | =head2 process_subdirs | ||||||
806 | |||||||
807 | Process the sub-directories of this directory. | ||||||
808 | |||||||
809 | =cut | ||||||
810 | sub process_subdirs { | ||||||
811 | 0 | 0 | 1 | my $self = shift; | |||
812 | 0 | my $dir_state = shift; | |||||
813 | |||||||
814 | 0 | my @image_dirs = @{$dir_state->{subdirs}}; | |||||
0 | |||||||
815 | |||||||
816 | 0 | foreach my $subdir (@image_dirs) | |||||
817 | { | ||||||
818 | 0 | my $dir = $subdir; | |||||
819 | 0 | 0 | if ($dir_state->{dir}) | ||||
820 | { | ||||||
821 | 0 | $dir = File::Spec->catdir($dir_state->{dir}, $subdir); | |||||
822 | } | ||||||
823 | 0 | 0 | print "=== $dir ===\n" if $self->{verbose}; | ||||
824 | 0 | $self->do_dir_actions($dir); | |||||
825 | } | ||||||
826 | } # process_subdirs | ||||||
827 | |||||||
828 | =head2 tidy_up | ||||||
829 | |||||||
830 | Cleanup after processing this directory. | ||||||
831 | |||||||
832 | =cut | ||||||
833 | sub tidy_up { | ||||||
834 | 0 | 0 | 1 | my $self = shift; | |||
835 | 0 | my $dir_state = shift; | |||||
836 | |||||||
837 | } # tidy_up | ||||||
838 | |||||||
839 | =head1 Image Action Methods | ||||||
840 | |||||||
841 | Methods implementing per-image actions. | ||||||
842 | |||||||
843 | =head2 init_image_settings | ||||||
844 | |||||||
845 | Initialize settings for the current image. | ||||||
846 | |||||||
847 | =cut | ||||||
848 | sub init_image_settings { | ||||||
849 | 0 | 0 | 1 | my $self = shift; | |||
850 | 0 | my $dir_state = shift; | |||||
851 | 0 | my $img_state = shift; | |||||
852 | |||||||
853 | $img_state->{abs_img} = File::Spec->catfile($dir_state->{abs_dir}, | ||||||
854 | 0 | $img_state->{cur_img}); | |||||
855 | 0 | $img_state->{info} = $self->get_image_info($img_state->{abs_img}); | |||||
856 | |||||||
857 | } # init_image_settings | ||||||
858 | |||||||
859 | =head2 make_thumbnail | ||||||
860 | |||||||
861 | Make a thumbnail of the current image. | ||||||
862 | Constant pixel count among generated images based on | ||||||
863 | http://www.chaosreigns.com/code/thumbnail/ | ||||||
864 | |||||||
865 | =cut | ||||||
866 | sub make_thumbnail { | ||||||
867 | 0 | 0 | 1 | my $self = shift; | |||
868 | 0 | my $dir_state = shift; | |||||
869 | 0 | my $img_state = shift; | |||||
870 | |||||||
871 | my $thumb_file = $self->get_thumbnail_name( | ||||||
872 | dir_state=>$dir_state, image=>$img_state->{cur_img}, | ||||||
873 | 0 | type=>'file'); | |||||
874 | 0 | 0 | if (!$self->need_to_generate_image($dir_state, $img_state, | ||||
875 | check_image=>$thumb_file)) | ||||||
876 | { | ||||||
877 | 0 | return; | |||||
878 | } | ||||||
879 | # make the thumbnail dir if it doesn't exist | ||||||
880 | 0 | 0 | if (!-d $dir_state->{abs_thumbdir}) | ||||
881 | { | ||||||
882 | 0 | mkdir $dir_state->{abs_thumbdir}; | |||||
883 | } | ||||||
884 | |||||||
885 | 0 | my $x = $img_state->{info}->{ImageWidth}; | |||||
886 | 0 | my $y = $img_state->{info}->{ImageHeight}; | |||||
887 | 0 | 0 | 0 | if (!$x or !$y) | |||
888 | { | ||||||
889 | 0 | warn "dimensions of " . $img_state->{abs_img} . " undefined -- faking it"; | |||||
890 | 0 | print STDERR Dump($img_state); | |||||
891 | 0 | print STDERR "========================\n"; | |||||
892 | 0 | $x = 1024; | |||||
893 | 0 | $y = 1024; | |||||
894 | } | ||||||
895 | |||||||
896 | 0 | my $pixels = $x * $y; | |||||
897 | 0 | my $newx = int($x / (sqrt($x * $y) / sqrt($self->{pixelcount}))); | |||||
898 | 0 | my $newy = int($y / (sqrt($x * $y) / sqrt($self->{pixelcount}))); | |||||
899 | 0 | my $newpix = $newx * $newy; | |||||
900 | 0 | my $command = ''; | |||||
901 | 0 | 0 | if ($img_state->{cur_img} =~ /\.gif$/) | ||||
902 | { | ||||||
903 | # in case this is an animated gif, get the first frame only | ||||||
904 | 0 | $command = "convert -geometry \"${newx}x${newy}\>\" \"$img_state->{abs_img}\[0\]\" \"$thumb_file\""; | |||||
905 | } | ||||||
906 | else | ||||||
907 | { | ||||||
908 | 0 | $command = "convert -geometry \"${newx}x${newy}\>\" \"$img_state->{abs_img}\" \"$thumb_file\""; | |||||
909 | } | ||||||
910 | 0 | 0 | system($command) == 0 | ||||
911 | or die "$command failed"; | ||||||
912 | |||||||
913 | } # make_thumbnail | ||||||
914 | |||||||
915 | =head2 make_image_page | ||||||
916 | |||||||
917 | Make HTML page for current image. | ||||||
918 | |||||||
919 | =cut | ||||||
920 | sub make_image_page { | ||||||
921 | 0 | 0 | 1 | my $self = shift; | |||
922 | 0 | my $dir_state = shift; | |||||
923 | 0 | my $img_state = shift; | |||||
924 | |||||||
925 | 0 | my $img_name = $img_state->{cur_img}; | |||||
926 | my $img_page_file = $self->get_image_pagename(dir_state=>$dir_state, | ||||||
927 | image=>$img_state->{cur_img}, | ||||||
928 | 0 | type=>'file'); | |||||
929 | 0 | 0 | 0 | if (-f $img_page_file | |||
0 | |||||||
930 | and !$self->{force_html} | ||||||
931 | and !$dir_state->{redo_html}) | ||||||
932 | { | ||||||
933 | 0 | return; | |||||
934 | } | ||||||
935 | # make the thumbnail dir if it doesn't exist | ||||||
936 | 0 | 0 | if (!-d $dir_state->{abs_thumbdir}) | ||||
937 | { | ||||||
938 | 0 | mkdir $dir_state->{abs_thumbdir}; | |||||
939 | } | ||||||
940 | 0 | my @content = (); | |||||
941 | 0 | push @content, $self->start_image_page($dir_state, $img_state); | |||||
942 | # add the image itself | ||||||
943 | 0 | push @content, $self->make_image_content($dir_state, $img_state); | |||||
944 | 0 | push @content, $self->end_image_page($dir_state, $img_state); | |||||
945 | 0 | my $content = join('', @content); | |||||
946 | |||||||
947 | # make the head stuff | ||||||
948 | 0 | my $title = $self->make_image_title($dir_state, $img_state); | |||||
949 | 0 | my $style = $self->make_image_style($dir_state, $img_state); | |||||
950 | |||||||
951 | # put the page content in the template | ||||||
952 | 0 | my $out = $self->get_template($self->{page_template}); | |||||
953 | # save the content of the template in case we read it | ||||||
954 | # from a file | ||||||
955 | 0 | $self->{page_template} = $out; | |||||
956 | 0 | $out =~ s//$title/; | |||||
957 | 0 | $out =~ s//$style/; | |||||
958 | 0 | $out =~ s//$content/; | |||||
959 | |||||||
960 | # write the page to the file | ||||||
961 | 0 | my $fh = undef; | |||||
962 | 0 | 0 | open($fh, ">", $img_page_file) or die "Could not open $img_page_file for writing: $!"; | ||||
963 | 0 | print $fh $out; | |||||
964 | 0 | close($fh); | |||||
965 | } # make_image_page | ||||||
966 | |||||||
967 | =head2 image_tidy_up | ||||||
968 | |||||||
969 | Clean up after the current image. | ||||||
970 | |||||||
971 | =cut | ||||||
972 | sub image_tidy_up { | ||||||
973 | 0 | 0 | 1 | my $self = shift; | |||
974 | 0 | my $dir_state = shift; | |||||
975 | 0 | my $img_state = shift; | |||||
976 | |||||||
977 | } # image_tidy_up | ||||||
978 | |||||||
979 | =head1 Helper Methods | ||||||
980 | |||||||
981 | Methods which can be called from within other methods. | ||||||
982 | |||||||
983 | =head2 start_index_page | ||||||
984 | |||||||
985 | push @content, $self->start_index_page($dir_state, $page); | ||||||
986 | |||||||
987 | Create the start-of-page for an index page. | ||||||
988 | This contains page content, not full etc (that's expected | ||||||
989 | to be in the full-page template). | ||||||
990 | It contains the header, link to parent dirs and links to | ||||||
991 | previous and next index-pages, and the album caption. | ||||||
992 | |||||||
993 | =cut | ||||||
994 | sub start_index_page { | ||||||
995 | 0 | 0 | 1 | my $self = shift; | |||
996 | 0 | my $dir_state = shift; | |||||
997 | 0 | my $page = shift; | |||||
998 | |||||||
999 | 0 | my @out = (); | |||||
1000 | 0 | push @out, " \n"; |
|||||
1001 | |||||||
1002 | # Path array contains basenames from the top dir down to the current dir. | ||||||
1003 | 0 | my @path = split(/[\/\\]/, $dir_state->{dir}); | |||||
1004 | |||||||
1005 | # Note that what we want is the top_out_base and not the top_base | ||||||
1006 | # because if they are not the same (because top_out_dir was set) | ||||||
1007 | # the salient info is the output directory and not the source directory. | ||||||
1008 | 0 | unshift @path, $self->{top_out_base}; | |||||
1009 | |||||||
1010 | # we want to create relative links to all the dirs | ||||||
1011 | # above the current one, so work backwards | ||||||
1012 | 0 | my %uplinks = (); | |||||
1013 | 0 | my $uplink = ''; | |||||
1014 | 0 | foreach my $dn (reverse @path) | |||||
1015 | { | ||||||
1016 | 0 | $uplinks{$dn} = $uplink; | |||||
1017 | 0 | 0 | 0 | if (!$uplink and $page > 1) | |||
1018 | { | ||||||
1019 | 0 | $uplinks{$dn} = "index.html"; | |||||
1020 | } | ||||||
1021 | else | ||||||
1022 | { | ||||||
1023 | 0 | $uplink .= '../'; | |||||
1024 | } | ||||||
1025 | } | ||||||
1026 | 0 | my @header = (); | |||||
1027 | 0 | foreach my $dn (@path) | |||||
1028 | { | ||||||
1029 | 0 | my $pretty = $dn; | |||||
1030 | 0 | $pretty =~ s/_/ /g; | |||||
1031 | 0 | 0 | if ($uplinks{$dn}) | ||||
1032 | { | ||||||
1033 | 0 | push @header, "$pretty"; | |||||
1034 | } | ||||||
1035 | else | ||||||
1036 | { | ||||||
1037 | 0 | push @header, $pretty; | |||||
1038 | } | ||||||
1039 | } | ||||||
1040 | 0 | push @out, ''; |
|||||
1041 | 0 | push @out, join(' :: ', @header); | |||||
1042 | 0 | push @out, "\n"; | |||||
1043 | |||||||
1044 | # now for the prev, next links | ||||||
1045 | 0 | push @out, $self->make_index_prev_next($dir_state, $page); | |||||
1046 | |||||||
1047 | # and now for the album caption | ||||||
1048 | 0 | 0 | if (exists $dir_state->{captions}) | ||||
1049 | { | ||||||
1050 | 0 | my $index_caption = 'index.html'; | |||||
1051 | 0 | 0 | 0 | if (exists $dir_state->{captions}->{$index_caption} | |||
1052 | and defined $dir_state->{captions}->{$index_caption}) | ||||||
1053 | { | ||||||
1054 | 0 | push @out, ' '; |
|||||
1055 | 0 | push @out, $dir_state->{captions}->{$index_caption}; | |||||
1056 | 0 | push @out, "\n"; | |||||
1057 | } | ||||||
1058 | } | ||||||
1059 | |||||||
1060 | 0 | return join('', @out); | |||||
1061 | } # start_index_page | ||||||
1062 | |||||||
1063 | =head2 make_index_prev_next | ||||||
1064 | |||||||
1065 | my $links = $self->start_index_page($dir_state, $page); | ||||||
1066 | |||||||
1067 | Make the previous next other-index-pages links for the | ||||||
1068 | given index-page. Generally called for the top and bottom | ||||||
1069 | of the index page. | ||||||
1070 | |||||||
1071 | =cut | ||||||
1072 | sub make_index_prev_next { | ||||||
1073 | 0 | 0 | 1 | my $self = shift; | |||
1074 | 0 | my $dir_state = shift; | |||||
1075 | 0 | my $page = shift; | |||||
1076 | |||||||
1077 | 0 | my @out = (); | |||||
1078 | 0 | 0 | if ($dir_state->{pages} > 1) | ||||
1079 | { | ||||||
1080 | 0 | push @out, ' '; |
|||||
1081 | # prev | ||||||
1082 | 0 | my $label = '< - prev'; | |||||
1083 | 0 | 0 | if ($page > 1) | ||||
1084 | { | ||||||
1085 | 0 | my $iurl = $self->get_index_pagename(dir_state=>$dir_state, | |||||
1086 | page=>$page - 1, get_filename=>0); | ||||||
1087 | 0 | push @out, "$label "; | |||||
1088 | } | ||||||
1089 | |||||||
1090 | # pages, but only if more than two | ||||||
1091 | 0 | 0 | if ($dir_state->{pages} > 2) | ||||
1092 | { | ||||||
1093 | 0 | for (my $i = 1; $i <= $dir_state->{pages}; $i++) | |||||
1094 | { | ||||||
1095 | 0 | 0 | if ($page == $i) | ||||
1096 | { | ||||||
1097 | 0 | push @out, " [$i] "; | |||||
1098 | } | ||||||
1099 | else | ||||||
1100 | { | ||||||
1101 | 0 | my $iurl = $self->get_index_pagename(dir_state=>$dir_state, | |||||
1102 | page=>$i, get_filename=>0); | ||||||
1103 | 0 | push @out, " $i "; | |||||
1104 | } | ||||||
1105 | } | ||||||
1106 | } | ||||||
1107 | 0 | $label = 'next ->'; | |||||
1108 | 0 | 0 | if (($page+1) <= $dir_state->{pages}) | ||||
1109 | { | ||||||
1110 | 0 | my $iurl = $self->get_index_pagename(dir_state=>$dir_state, | |||||
1111 | page=>$page + 1, get_filename=>0); | ||||||
1112 | 0 | push @out, " $label"; | |||||
1113 | } | ||||||
1114 | 0 | push @out, "\n"; | |||||
1115 | } | ||||||
1116 | |||||||
1117 | 0 | return join('', @out); | |||||
1118 | } # make_index_prev_next | ||||||
1119 | |||||||
1120 | =head2 end_index_page | ||||||
1121 | |||||||
1122 | push @content, $self->end_index_page($dir_state, $page); | ||||||
1123 | |||||||
1124 | Create the end-of-page for an index page. | ||||||
1125 | This contains page content, not full etc (that's expected | ||||||
1126 | to be in the full-page template). | ||||||
1127 | |||||||
1128 | =cut | ||||||
1129 | sub end_index_page { | ||||||
1130 | 0 | 0 | 1 | my $self = shift; | |||
1131 | 0 | my $dir_state = shift; | |||||
1132 | 0 | my $page = shift; | |||||
1133 | |||||||
1134 | 0 | my @out = (); | |||||
1135 | 0 | push @out, "\n \n"; |
|||||
1136 | 0 | push @out, $self->make_index_prev_next($dir_state, $page); | |||||
1137 | 0 | push @out, "\n"; | |||||
1138 | 0 | return join('', @out); | |||||
1139 | } # end_index_page | ||||||
1140 | |||||||
1141 | =head2 make_index_subdirs | ||||||
1142 | |||||||
1143 | push @content, $self->make_index_subdirs($dir_state, $page); | ||||||
1144 | |||||||
1145 | Create the subdirs section; this contains links to subdirs. | ||||||
1146 | |||||||
1147 | =cut | ||||||
1148 | sub make_index_subdirs { | ||||||
1149 | 0 | 0 | 1 | my $self = shift; | |||
1150 | 0 | my $dir_state = shift; | |||||
1151 | 0 | my $page = shift; | |||||
1152 | |||||||
1153 | 0 | my @out = (); | |||||
1154 | |||||||
1155 | 0 | 0 | if (@{$dir_state->{subdirs}}) | ||||
0 | |||||||
1156 | { | ||||||
1157 | 0 | push @out, "\n \n"; |
|||||
1158 | 0 | push @out, " \n"; |
|||||
1159 | # subdirs | ||||||
1160 | 0 | foreach my $subdir (@{$dir_state->{subdirs}}) | |||||
0 | |||||||
1161 | { | ||||||
1162 | 0 | push @out, < | |||||
1163 | |
||||||
1164 | $subdir | ||||||
1165 | |||||||
1166 | EOT | ||||||
1167 | } | ||||||
1168 | 0 | push @out, "\n"; | |||||
1169 | } | ||||||
1170 | 0 | return join('', @out); | |||||
1171 | } # make_index_subdirs | ||||||
1172 | |||||||
1173 | =head2 make_image_index | ||||||
1174 | |||||||
1175 | push @content, $self->make_image_index(dir_state=>$dir_state, | ||||||
1176 | page=>$page, images=>\@images); | ||||||
1177 | |||||||
1178 | Create the images section; this contains links to image-pages, with thumbnails. | ||||||
1179 | |||||||
1180 | =cut | ||||||
1181 | sub make_image_index { | ||||||
1182 | 0 | 0 | 1 | my $self = shift; | |||
1183 | 0 | my %args = ( | |||||
1184 | @_ | ||||||
1185 | ); | ||||||
1186 | 0 | my $dir_state = $args{dir_state}; | |||||
1187 | |||||||
1188 | 0 | my @out = (); | |||||
1189 | |||||||
1190 | 0 | 0 | if (@{$args{images}}) | ||||
0 | |||||||
1191 | { | ||||||
1192 | 0 | push @out, "\n \n"; |
|||||
1193 | 0 | push @out, " \n"; |
|||||
1194 | # subdirs | ||||||
1195 | 0 | foreach my $image (@{$args{images}}) | |||||
0 | |||||||
1196 | { | ||||||
1197 | 0 | my $image_link = $self->get_image_pagename(dir_state=>$dir_state, | |||||
1198 | image=>$image, type=>'parent'); | ||||||
1199 | 0 | my $thumbnail_link = $self->get_thumbnail_name( | |||||
1200 | dir_state=>$dir_state, | ||||||
1201 | image=>$image, type=>'parent'); | ||||||
1202 | 0 | my $image_name = $self->get_image_pagename(dir_state=>$dir_state, | |||||
1203 | image=>$image, type=>'pretty'); | ||||||
1204 | 0 | push @out, < | |||||
1205 | |
||||||
1206 | |
||||||
1207 | |
||||||
1208 | $image_name | ||||||
1209 | |||||||
1210 | |||||||
1211 | EOT | ||||||
1212 | } | ||||||
1213 | 0 | push @out, "\n"; | |||||
1214 | } | ||||||
1215 | 0 | return join('', @out); | |||||
1216 | } # make_image_index | ||||||
1217 | |||||||
1218 | =head2 make_index_title | ||||||
1219 | |||||||
1220 | Make the title for the index page. | ||||||
1221 | This is expected to go inside a |
||||||
1222 | in the page template. | ||||||
1223 | |||||||
1224 | =cut | ||||||
1225 | sub make_index_title { | ||||||
1226 | 0 | 0 | 1 | my $self = shift; | |||
1227 | 0 | my $dir_state = shift; | |||||
1228 | 0 | my $page = shift; | |||||
1229 | |||||||
1230 | 0 | my @out = (); | |||||
1231 | # title | ||||||
1232 | 0 | push @out, $dir_state->{dirbase}; | |||||
1233 | 0 | 0 | push @out, " ($page)" if $page > 1; | ||||
1234 | 0 | return join('', @out); | |||||
1235 | } # make_index_title | ||||||
1236 | |||||||
1237 | =head2 make_index_style | ||||||
1238 | |||||||
1239 | Make the style tags for the index page. This will be put in the | ||||||
1240 | part of the template. | ||||||
1241 | |||||||
1242 | =cut | ||||||
1243 | sub make_index_style { | ||||||
1244 | 0 | 0 | 1 | my $self = shift; | |||
1245 | 0 | my $dir_state = shift; | |||||
1246 | 0 | my $page = shift; | |||||
1247 | |||||||
1248 | 0 | my @out = (); | |||||
1249 | # style | ||||||
1250 | 0 | my $thumb_area_width = $self->{thumb_width} * 1.5; | |||||
1251 | # 1.5 times the thumbnail, plus a fudge-factor for the words underneath | ||||||
1252 | 0 | my $thumb_area_height = ($self->{thumb_height} * 1.5) + 20; | |||||
1253 | 0 | push @out, < | |||||
1254 | |||||||
1280 | EOT | ||||||
1281 | 0 | return join('', @out); | |||||
1282 | } # make_index_style | ||||||
1283 | |||||||
1284 | =head2 get_index_pagename | ||||||
1285 | |||||||
1286 | my $name = self->get_index_pagename( | ||||||
1287 | dir_state=>$dir_state, | ||||||
1288 | page=>$page, | ||||||
1289 | get_filename=>0); | ||||||
1290 | |||||||
1291 | Get the name of the given index page; either the file name | ||||||
1292 | or the relative URL. | ||||||
1293 | |||||||
1294 | =cut | ||||||
1295 | sub get_index_pagename { | ||||||
1296 | 0 | 0 | 1 | my $self = shift; | |||
1297 | 0 | my %args = ( | |||||
1298 | get_filename=>0, | ||||||
1299 | @_ | ||||||
1300 | ); | ||||||
1301 | 0 | my $dir_state = $args{dir_state}; | |||||
1302 | 0 | my $page = $args{page}; | |||||
1303 | |||||||
1304 | 0 | my $pagename; | |||||
1305 | 0 | 0 | if ($page == 1) | ||||
0 | |||||||
1306 | { | ||||||
1307 | 0 | $pagename = 'index.html'; | |||||
1308 | } | ||||||
1309 | elsif ($dir_state->{pages} > 9) | ||||||
1310 | { | ||||||
1311 | 0 | $pagename = sprintf("index%02d.html", $page); | |||||
1312 | } | ||||||
1313 | else | ||||||
1314 | { | ||||||
1315 | 0 | $pagename = "index${page}.html"; | |||||
1316 | } | ||||||
1317 | |||||||
1318 | 0 | 0 | if ($args{get_filename}) | ||||
1319 | { | ||||||
1320 | 0 | return File::Spec->catfile($dir_state->{abs_out_dir}, $pagename); | |||||
1321 | } | ||||||
1322 | else # get URL | ||||||
1323 | { | ||||||
1324 | 0 | return $pagename; | |||||
1325 | } | ||||||
1326 | } # get_index_pagename | ||||||
1327 | |||||||
1328 | =head2 get_image_pagename | ||||||
1329 | |||||||
1330 | my $name = self->get_image_pagename( | ||||||
1331 | dir_state=>$dir_state, | ||||||
1332 | image=>$image, | ||||||
1333 | type=>'file'); | ||||||
1334 | |||||||
1335 | Get the name of the image page; either the file name | ||||||
1336 | or the relative URL from above, or the relative URL | ||||||
1337 | from the sibling, or a 'pretty' name suitable for a title. | ||||||
1338 | |||||||
1339 | The 'type' can be 'file', 'parent', 'sibling' or 'pretty'. | ||||||
1340 | |||||||
1341 | =cut | ||||||
1342 | sub get_image_pagename { | ||||||
1343 | 0 | 0 | 1 | my $self = shift; | |||
1344 | 0 | my %args = ( | |||||
1345 | type=>'parent', | ||||||
1346 | @_ | ||||||
1347 | ); | ||||||
1348 | 0 | my $dir_state = $args{dir_state}; | |||||
1349 | 0 | my $image = $args{image}; | |||||
1350 | |||||||
1351 | 0 | my $thumbdir = $self->{thumbdir}; | |||||
1352 | 0 | my $img_page = $image; | |||||
1353 | # change the last dot to underscore | ||||||
1354 | 0 | $img_page =~ s/\.(\w+)$/_$1/; | |||||
1355 | 0 | $img_page .= ".html"; | |||||
1356 | 0 | 0 | if ($args{type} eq 'file') | ||||
0 | |||||||
0 | |||||||
0 | |||||||
1357 | { | ||||||
1358 | 0 | return File::Spec->catfile($dir_state->{abs_out_dir}, $thumbdir, $img_page); | |||||
1359 | } | ||||||
1360 | elsif ($args{type} eq 'parent') | ||||||
1361 | { | ||||||
1362 | 0 | return "${thumbdir}/${img_page}"; | |||||
1363 | } | ||||||
1364 | elsif ($args{type} eq 'sibling') | ||||||
1365 | { | ||||||
1366 | 0 | return ${img_page}; | |||||
1367 | } | ||||||
1368 | elsif ($args{type} eq 'pretty') | ||||||
1369 | { | ||||||
1370 | 0 | my $pretty = ${image}; | |||||
1371 | 0 | $pretty =~ s/\.(\w+)$//; | |||||
1372 | 0 | $pretty =~ s/_/ /g; | |||||
1373 | 0 | return $pretty; | |||||
1374 | } | ||||||
1375 | 0 | return ''; | |||||
1376 | } # get_image_pagename | ||||||
1377 | |||||||
1378 | =head2 get_thumbnail_name | ||||||
1379 | |||||||
1380 | my $name = self->get_thumbnail_name( | ||||||
1381 | dir_state=>$dir_state, | ||||||
1382 | image=>$image, | ||||||
1383 | type=>'file'); | ||||||
1384 | |||||||
1385 | Get the name of the image thumbnail file; either the file name | ||||||
1386 | or the relative URL from above, or the relative URL | ||||||
1387 | from the sibling. | ||||||
1388 | |||||||
1389 | The 'type' can be 'file', 'parent', 'sibling'. | ||||||
1390 | |||||||
1391 | =cut | ||||||
1392 | sub get_thumbnail_name { | ||||||
1393 | 0 | 0 | 1 | my $self = shift; | |||
1394 | 0 | my %args = ( | |||||
1395 | type=>'parent', | ||||||
1396 | @_ | ||||||
1397 | ); | ||||||
1398 | 0 | my $dir_state = $args{dir_state}; | |||||
1399 | 0 | my $image = $args{image}; | |||||
1400 | |||||||
1401 | 0 | my $thumbdir = $self->{thumbdir}; | |||||
1402 | 0 | my $thumb = $image; | |||||
1403 | # change the last dot to underscore | ||||||
1404 | 0 | $thumb =~ s/\.([\w]+)$/_$1/; | |||||
1405 | 0 | $thumb .= ".jpg"; | |||||
1406 | 0 | 0 | if ($args{type} eq 'file') | ||||
0 | |||||||
0 | |||||||
1407 | { | ||||||
1408 | 0 | return File::Spec->catfile($dir_state->{abs_out_dir}, $thumbdir, $thumb); | |||||
1409 | } | ||||||
1410 | elsif ($args{type} eq 'parent') | ||||||
1411 | { | ||||||
1412 | 0 | return "${thumbdir}/${thumb}"; | |||||
1413 | } | ||||||
1414 | elsif ($args{type} eq 'sibling') | ||||||
1415 | { | ||||||
1416 | 0 | return ${thumb}; | |||||
1417 | } | ||||||
1418 | 0 | return ''; | |||||
1419 | } # get_thumbnail_name | ||||||
1420 | |||||||
1421 | =head2 get_caption | ||||||
1422 | |||||||
1423 | my $name = self->get_caption( | ||||||
1424 | dir_state=>$dir_state, | ||||||
1425 | img_state->$img_state, | ||||||
1426 | image=>$image) | ||||||
1427 | |||||||
1428 | Get the caption for this image. | ||||||
1429 | This also gets the meta-data if any is required. | ||||||
1430 | |||||||
1431 | =cut | ||||||
1432 | sub get_caption { | ||||||
1433 | 0 | 0 | 1 | my $self = shift; | |||
1434 | 0 | my %args = ( | |||||
1435 | @_ | ||||||
1436 | ); | ||||||
1437 | 0 | my $dir_state = $args{dir_state}; | |||||
1438 | 0 | my $img_state = $args{img_state}; | |||||
1439 | 0 | my $image = $args{image}; | |||||
1440 | |||||||
1441 | 0 | my @out = (); | |||||
1442 | 0 | 0 | if (exists $dir_state->{captions}) | ||||
1443 | { | ||||||
1444 | 0 | 0 | 0 | if (exists $dir_state->{captions}->{$image} | |||
1445 | and defined $dir_state->{captions}->{$image}) | ||||||
1446 | { | ||||||
1447 | 0 | push @out, $dir_state->{captions}->{$image}; | |||||
1448 | } | ||||||
1449 | } | ||||||
1450 | 0 | 0 | 0 | if ($img_state and defined $self->{meta} and @{$self->{meta}}) | |||
0 | 0 | ||||||
1451 | { | ||||||
1452 | # only add the meta data if it's there | ||||||
1453 | 0 | foreach my $fieldspec (@{$self->{meta}}) | |||||
0 | |||||||
1454 | { | ||||||
1455 | 0 | $fieldspec =~ /%([\w\s]+)%/; | |||||
1456 | 0 | my $field = $1; | |||||
1457 | 0 | 0 | 0 | if (exists $img_state->{info}->{$field} | |||
0 | |||||||
1458 | and defined $img_state->{info}->{$field} | ||||||
1459 | and $img_state->{info}->{$field}) | ||||||
1460 | { | ||||||
1461 | 0 | my $val = $fieldspec; | |||||
1462 | 0 | my $fieldval = $img_state->{info}->{$field}; | |||||
1463 | # make the fieldval HTML-safe | ||||||
1464 | 0 | $fieldval =~ s/&/&/g; | |||||
1465 | 0 | $fieldval =~ s/</g; | |||||
1466 | 0 | $fieldval =~ s/>/>/g; | |||||
1467 | 0 | $val =~ s/%${field}%/$fieldval/g; | |||||
1468 | 0 | push @out, $val; | |||||
1469 | } | ||||||
1470 | } | ||||||
1471 | } | ||||||
1472 | 0 | return join("\n", @out); | |||||
1473 | } # get_caption | ||||||
1474 | |||||||
1475 | =head2 get_template | ||||||
1476 | |||||||
1477 | my $templ = $self->get_template($template); | ||||||
1478 | |||||||
1479 | Get the given template (read if it's from a file) | ||||||
1480 | |||||||
1481 | =cut | ||||||
1482 | sub get_template { | ||||||
1483 | 0 | 0 | 1 | my $self = shift; | |||
1484 | 0 | my $template = shift; | |||||
1485 | |||||||
1486 | 0 | 0 | 0 | if ($template !~ /\n/ | |||
1487 | && -r $template) | ||||||
1488 | { | ||||||
1489 | 0 | local $/ = undef; | |||||
1490 | 0 | my $fh; | |||||
1491 | 0 | 0 | open($fh, $template) | ||||
1492 | or die "Could not open ", $template; | ||||||
1493 | 0 | $template = <$fh>; | |||||
1494 | 0 | close($fh); | |||||
1495 | } | ||||||
1496 | 0 | return $template; | |||||
1497 | } # get_template | ||||||
1498 | |||||||
1499 | =head2 start_image_page | ||||||
1500 | |||||||
1501 | push @content, $self->start_image_page($dir_state, $img_state); | ||||||
1502 | |||||||
1503 | Create the start-of-page for an image page. | ||||||
1504 | This contains page content, not full etc (that's expected | ||||||
1505 | to be in the full-page template). | ||||||
1506 | It contains the header, link to parent dirs and links to | ||||||
1507 | previous and next image-pages. | ||||||
1508 | |||||||
1509 | =cut | ||||||
1510 | sub start_image_page { | ||||||
1511 | 0 | 0 | 1 | my $self = shift; | |||
1512 | 0 | my $dir_state = shift; | |||||
1513 | 0 | my $img_state = shift; | |||||
1514 | |||||||
1515 | 0 | my @out = (); | |||||
1516 | 0 | push @out, " \n"; |
|||||
1517 | |||||||
1518 | # Path array contains basenames from the top dir | ||||||
1519 | # down to the current dir. | ||||||
1520 | 0 | my @path = split(/[\/\\]/, $dir_state->{dir}); | |||||
1521 | 0 | unshift @path, $self->{top_out_base}; | |||||
1522 | # we want to create relative links to all the dirs | ||||||
1523 | # including the current one, so work backwards | ||||||
1524 | 0 | my %uplinks = (); | |||||
1525 | 0 | my $uplink = ''; | |||||
1526 | 0 | foreach my $dn (reverse @path) | |||||
1527 | { | ||||||
1528 | 0 | $uplink .= '../'; | |||||
1529 | 0 | $uplinks{$dn} = $uplink; | |||||
1530 | } | ||||||
1531 | 0 | my @breadcrumb = (); | |||||
1532 | 0 | foreach my $dn (@path) | |||||
1533 | { | ||||||
1534 | 0 | 0 | if ($uplinks{$dn}) | ||||
1535 | { | ||||||
1536 | 0 | push @breadcrumb, "$dn"; | |||||
1537 | } | ||||||
1538 | else | ||||||
1539 | { | ||||||
1540 | 0 | push @breadcrumb, $dn; | |||||
1541 | } | ||||||
1542 | } | ||||||
1543 | 0 | push @out, ''; |
|||||
1544 | 0 | push @out, $img_state->{cur_img}; | |||||
1545 | 0 | push @out, "\n"; | |||||
1546 | 0 | push @out, ' | |||||
1547 | 0 | push @out, join(' > ', @breadcrumb); | |||||
1548 | 0 | push @out, "\n"; | |||||
1549 | |||||||
1550 | # now for the prev, next links | ||||||
1551 | 0 | push @out, $self->make_image_prev_next(dir_state=>$dir_state, | |||||
1552 | img_state=>$img_state); | ||||||
1553 | |||||||
1554 | 0 | return join('', @out); | |||||
1555 | } # start_image_page | ||||||
1556 | |||||||
1557 | =head2 end_image_page | ||||||
1558 | |||||||
1559 | push @content, $self->end_image_page($dir_state, $img_state); | ||||||
1560 | |||||||
1561 | Create the end-of-page for an image page. | ||||||
1562 | This contains page content, not full etc (that's expected | ||||||
1563 | to be in the full-page template). | ||||||
1564 | |||||||
1565 | =cut | ||||||
1566 | sub end_image_page { | ||||||
1567 | 0 | 0 | 1 | my $self = shift; | |||
1568 | 0 | my $dir_state = shift; | |||||
1569 | 0 | my $img_state = shift; | |||||
1570 | |||||||
1571 | 0 | my @out = (); | |||||
1572 | |||||||
1573 | # now for the prev, next links | ||||||
1574 | 0 | push @out, $self->make_image_prev_next(dir_state=>$dir_state, | |||||
1575 | img_state=>$img_state, | ||||||
1576 | use_thumb=>1); | ||||||
1577 | 0 | push @out, "\n\n"; | |||||
1578 | |||||||
1579 | 0 | return join('', @out); | |||||
1580 | } # end_image_page | ||||||
1581 | |||||||
1582 | =head2 make_image_prev_next | ||||||
1583 | |||||||
1584 | my $links = $self->make_image_prev_next( | ||||||
1585 | dir_state=>$dir_state, | ||||||
1586 | img_state=>$img_state); | ||||||
1587 | |||||||
1588 | Make the previous next other-image-pages links for the | ||||||
1589 | given image-page. Generally called for the top and bottom | ||||||
1590 | of the image page. | ||||||
1591 | |||||||
1592 | =cut | ||||||
1593 | sub make_image_prev_next { | ||||||
1594 | 0 | 0 | 1 | my $self = shift; | |||
1595 | 0 | my %args = ( | |||||
1596 | use_thumb=>0, | ||||||
1597 | @_ | ||||||
1598 | ); | ||||||
1599 | 0 | my $dir_state = $args{dir_state}; | |||||
1600 | 0 | my $img_state = $args{img_state}; | |||||
1601 | |||||||
1602 | 0 | my $img_num = $img_state->{num}; | |||||
1603 | 0 | my @out = (); | |||||
1604 | 0 | 0 | if ($dir_state->{files} > 1) | ||||
1605 | { | ||||||
1606 | 0 | push @out, ' '; |
|||||
1607 | # prev | ||||||
1608 | 0 | push @out, ""; | |||||
1609 | 0 | my $label = '< - prev'; | |||||
1610 | 0 | my $iurl; | |||||
1611 | my $turl; | ||||||
1612 | 0 | 0 | if ($img_num > 0) | ||||
1613 | { | ||||||
1614 | $iurl = $self->get_image_pagename(dir_state=>$dir_state, | ||||||
1615 | 0 | image=>$img_state->{images}->[$img_num - 1], | |||||
1616 | type=>'sibling'); | ||||||
1617 | $turl = $self->get_thumbnail_name(dir_state=>$dir_state, | ||||||
1618 | 0 | image=>$img_state->{images}->[$img_num - 1], | |||||
1619 | type=>'sibling'); | ||||||
1620 | } | ||||||
1621 | else | ||||||
1622 | { | ||||||
1623 | # loop to the last image | ||||||
1624 | $iurl = $self->get_image_pagename(dir_state=>$dir_state, | ||||||
1625 | 0 | image=>$img_state->{images}->[$#{$img_state->{images}}], | |||||
0 | |||||||
1626 | type=>'sibling'); | ||||||
1627 | $turl = $self->get_thumbnail_name(dir_state=>$dir_state, | ||||||
1628 | 0 | image=>$img_state->{images}->[$#{$img_state->{images}}], | |||||
0 | |||||||
1629 | type=>'sibling'); | ||||||
1630 | } | ||||||
1631 | 0 | push @out, "$label "; | |||||
1632 | 0 | 0 | if ($args{use_thumb}) | ||||
1633 | { | ||||||
1634 | 0 | push @out, " |
|||||
1635 | } | ||||||
1636 | 0 | push @out, ""; | |||||
1637 | |||||||
1638 | 0 | push @out, ""; | |||||
1639 | 0 | $label = 'next ->'; | |||||
1640 | 0 | 0 | if (($img_num+1) < @{$img_state->{images}}) | ||||
0 | |||||||
1641 | { | ||||||
1642 | $iurl = $self->get_image_pagename(dir_state=>$dir_state, | ||||||
1643 | 0 | image=>$img_state->{images}->[$img_num + 1], | |||||
1644 | type=>'sibling'); | ||||||
1645 | $turl = $self->get_thumbnail_name(dir_state=>$dir_state, | ||||||
1646 | 0 | image=>$img_state->{images}->[$img_num + 1], | |||||
1647 | type=>'sibling'); | ||||||
1648 | } | ||||||
1649 | else | ||||||
1650 | { | ||||||
1651 | # loop to the first image | ||||||
1652 | $iurl = $self->get_image_pagename(dir_state=>$dir_state, | ||||||
1653 | 0 | image=>$img_state->{images}->[0], | |||||
1654 | type=>'sibling'); | ||||||
1655 | $turl = $self->get_thumbnail_name(dir_state=>$dir_state, | ||||||
1656 | 0 | image=>$img_state->{images}->[0], | |||||
1657 | type=>'sibling'); | ||||||
1658 | } | ||||||
1659 | 0 | 0 | if ($args{use_thumb}) | ||||
1660 | { | ||||||
1661 | 0 | push @out, " |
|||||
1662 | } | ||||||
1663 | 0 | push @out, " $label"; | |||||
1664 | 0 | push @out, ""; | |||||
1665 | 0 | push @out, "\n"; | |||||
1666 | } | ||||||
1667 | |||||||
1668 | 0 | return join('', @out); | |||||
1669 | } # make_image_prev_next | ||||||
1670 | |||||||
1671 | =head2 make_image_content | ||||||
1672 | |||||||
1673 | Make the content of the image page, the image itself. | ||||||
1674 | |||||||
1675 | =cut | ||||||
1676 | sub make_image_content { | ||||||
1677 | 0 | 0 | 1 | my $self = shift; | |||
1678 | 0 | my $dir_state = shift; | |||||
1679 | 0 | my $img_state = shift; | |||||
1680 | |||||||
1681 | 0 | my $img_name = $img_state->{cur_img}; | |||||
1682 | 0 | my $caption = $self->get_caption(dir_state=>$dir_state, | |||||
1683 | img_state=>$img_state, | ||||||
1684 | image=>$img_name); | ||||||
1685 | 0 | my $img_url = "../$img_name"; | |||||
1686 | 0 | 0 | if ($self->{top_dir} ne $self->{top_out_dir}) | ||||
1687 | { | ||||||
1688 | 0 | $img_url = $dir_state->{dir_url} . '/' . $img_name; | |||||
1689 | } | ||||||
1690 | 0 | my @out = (); | |||||
1691 | 0 | push @out, " \n"; |
|||||
1692 | 0 | my $width = $img_state->{info}->{ImageWidth}; | |||||
1693 | 0 | my $height = $img_state->{info}->{ImageHeight}; | |||||
1694 | 0 | push @out, " |
|||||
1695 | 0 | push @out, " $caption \n"; |
|||||
1696 | 0 | push @out, "\n"; | |||||
1697 | 0 | return join('', @out); | |||||
1698 | } # make_image_content | ||||||
1699 | |||||||
1700 | =head2 make_image_title | ||||||
1701 | |||||||
1702 | Make the title for the image page. | ||||||
1703 | This is expected to go inside a |
||||||
1704 | in the page template. | ||||||
1705 | |||||||
1706 | =cut | ||||||
1707 | sub make_image_title { | ||||||
1708 | 0 | 0 | 1 | my $self = shift; | |||
1709 | 0 | my $dir_state = shift; | |||||
1710 | 0 | my $img_state = shift; | |||||
1711 | |||||||
1712 | 0 | my @out = (); | |||||
1713 | # title | ||||||
1714 | 0 | push @out, $img_state->{cur_img}; | |||||
1715 | 0 | return join('', @out); | |||||
1716 | } # make_image_title | ||||||
1717 | |||||||
1718 | =head2 make_image_style | ||||||
1719 | |||||||
1720 | Make the style tags for the image page. This will be put in the | ||||||
1721 | part of the template. | ||||||
1722 | |||||||
1723 | =cut | ||||||
1724 | sub make_image_style { | ||||||
1725 | 0 | 0 | 1 | my $self = shift; | |||
1726 | 0 | my $dir_state = shift; | |||||
1727 | 0 | my $img_state = shift; | |||||
1728 | |||||||
1729 | 0 | my @out = (); | |||||
1730 | # style | ||||||
1731 | 0 | push @out, < | |||||
1732 | |||||||
1747 | EOT | ||||||
1748 | 0 | return join('', @out); | |||||
1749 | } # make_image_style | ||||||
1750 | |||||||
1751 | =head2 need_to_generate_image | ||||||
1752 | |||||||
1753 | Check if a thumbnail needs to be made (or rebuilt). | ||||||
1754 | |||||||
1755 | =cut | ||||||
1756 | sub need_to_generate_image { | ||||||
1757 | 0 | 0 | 1 | my $self = shift; | |||
1758 | 0 | my $dir_state = shift; | |||||
1759 | 0 | my $img_state = shift; | |||||
1760 | 0 | my %args = @_; | |||||
1761 | |||||||
1762 | 0 | 0 | 0 | if (!-f $args{check_image} or $self->{force_images}) | |||
1763 | { | ||||||
1764 | 0 | return 1; | |||||
1765 | } | ||||||
1766 | 0 | return 0; | |||||
1767 | } # need_to_generate_image | ||||||
1768 | |||||||
1769 | =head2 index_needs_rebuilding | ||||||
1770 | |||||||
1771 | Check to see if there are any new (or deleted) images in this | ||||||
1772 | directory. | ||||||
1773 | |||||||
1774 | =cut | ||||||
1775 | sub index_needs_rebuilding { | ||||||
1776 | 0 | 0 | 1 | my $self = shift; | |||
1777 | 0 | my $dir_state = shift; | |||||
1778 | |||||||
1779 | 0 | my $dir = File::Spec->catdir($dir_state->{abs_out_dir}, $self->{thumbdir}); | |||||
1780 | 0 | my @pics = @{$dir_state->{files}}; | |||||
0 | |||||||
1781 | 0 | $self->debug(2, "dir: $dir"); | |||||
1782 | |||||||
1783 | # if the thumbnail directory doesn't exist, then either all images | ||||||
1784 | # are new, or we don't have any images in this directory | ||||||
1785 | 0 | 0 | if (!-d $dir) | ||||
1786 | { | ||||||
1787 | 0 | 0 | return (@pics ? 1 : 0); | ||||
1788 | } | ||||||
1789 | |||||||
1790 | # Read the thumbnail directory | ||||||
1791 | 0 | my $dirh; | |||||
1792 | 0 | opendir($dirh,$dir); | |||||
1793 | 0 | my @files = grep(!/^\.{1,2}$/, readdir($dirh)); | |||||
1794 | 0 | closedir($dirh); | |||||
1795 | |||||||
1796 | # check whether a picture has a thumbnail, and a thumbnail has a picture | ||||||
1797 | 0 | my %pic_has_tn = (); | |||||
1798 | 0 | my %tn_has_pic = (); | |||||
1799 | |||||||
1800 | # initialize to false | ||||||
1801 | 0 | foreach my $pic ( @pics ) | |||||
1802 | { | ||||||
1803 | 0 | $pic_has_tn{$pic} = 0; | |||||
1804 | } | ||||||
1805 | |||||||
1806 | # Check each file to make sure it's a currently used thumbnail or image_page | ||||||
1807 | 0 | foreach my $file ( @files ) | |||||
1808 | { | ||||||
1809 | 0 | my $name = $file; | |||||
1810 | 0 | 0 | if ($name =~ s/\.html$//) | ||||
0 | |||||||
1811 | { | ||||||
1812 | # change the last underscore to a dot | ||||||
1813 | 0 | $name =~ s/_([a-zA-Z0-9]+)$/.$1/; | |||||
1814 | 0 | 0 | if (exists $pic_has_tn{$name}) | ||||
1815 | { | ||||||
1816 | 0 | $pic_has_tn{$name} = 1; | |||||
1817 | 0 | $tn_has_pic{$name} = 1; | |||||
1818 | } | ||||||
1819 | else | ||||||
1820 | { | ||||||
1821 | 0 | $tn_has_pic{$name} = 0; | |||||
1822 | 0 | 0 | print "$dir has unused image pages; needs cleaning\n" if $self->{verbose}; | ||||
1823 | 0 | return 1; | |||||
1824 | } | ||||||
1825 | } | ||||||
1826 | elsif ($name =~ /(.+)\.jpg$/i) { | ||||||
1827 | # Thumbnail? | ||||||
1828 | 0 | $name = $1; | |||||
1829 | # change the last underscore to a dot | ||||||
1830 | 0 | $name =~ s/_([a-zA-Z0-9]+)$/.$1/; | |||||
1831 | 0 | $self->debug(2, "thumb: $name"); | |||||
1832 | 0 | 0 | if (exists $pic_has_tn{$name}) | ||||
1833 | { | ||||||
1834 | 0 | $pic_has_tn{$name} = 1; | |||||
1835 | 0 | $tn_has_pic{$name} = 1; | |||||
1836 | } | ||||||
1837 | else | ||||||
1838 | { | ||||||
1839 | 0 | $tn_has_pic{$name} = 0; | |||||
1840 | 0 | 0 | print "$dir has unused thumbnails; needs cleaning\n" if $self->{verbose}; | ||||
1841 | 0 | return 1; | |||||
1842 | } | ||||||
1843 | } | ||||||
1844 | } # for each file | ||||||
1845 | |||||||
1846 | # now check if there are pics without thumbnails | ||||||
1847 | 0 | while (my ($key, $tn_exists) = each(%pic_has_tn)) | |||||
1848 | { | ||||||
1849 | 0 | 0 | if (!$tn_exists) | ||||
1850 | { | ||||||
1851 | 0 | return 1; | |||||
1852 | } | ||||||
1853 | } | ||||||
1854 | |||||||
1855 | 0 | return 0; | |||||
1856 | } # index_needs_rebuilding | ||||||
1857 | |||||||
1858 | =head2 get_image_info | ||||||
1859 | |||||||
1860 | Get the image information for an image. Returns a hash of | ||||||
1861 | information. | ||||||
1862 | |||||||
1863 | %info = $self->get_image_info($image_file); | ||||||
1864 | |||||||
1865 | =cut | ||||||
1866 | sub get_image_info { | ||||||
1867 | 0 | 0 | 1 | my $self = shift; | |||
1868 | 0 | my $img_file = shift; | |||||
1869 | |||||||
1870 | 0 | my $info = Image::ExifTool::ImageInfo($img_file); | |||||
1871 | # add the basename | ||||||
1872 | 0 | my ($basename, $path, $suffix) = fileparse($img_file, qr/\.[^.]*/); | |||||
1873 | 0 | $info->{file_basename} = $basename; | |||||
1874 | 0 | return $info; | |||||
1875 | } # get_image_info | ||||||
1876 | |||||||
1877 | =head2 debug | ||||||
1878 | |||||||
1879 | $self->debug($level, $message); | ||||||
1880 | |||||||
1881 | Print a debug message (for debugging). | ||||||
1882 | Checks $self->{'debug_level'} to see if the message should be printed or | ||||||
1883 | not. | ||||||
1884 | |||||||
1885 | =cut | ||||||
1886 | sub debug { | ||||||
1887 | 0 | 0 | 1 | my $self = shift; | |||
1888 | 0 | my $level = shift; | |||||
1889 | 0 | my $message = shift; | |||||
1890 | |||||||
1891 | 0 | 0 | if ($level <= $self->{'debug_level'}) | ||||
1892 | { | ||||||
1893 | 0 | my $oh = \*STDERR; | |||||
1894 | 0 | print $oh $message, "\n"; | |||||
1895 | } | ||||||
1896 | } # debug | ||||||
1897 | |||||||
1898 | =head1 Private Methods | ||||||
1899 | |||||||
1900 | Methods which may or may not be here in future. | ||||||
1901 | |||||||
1902 | =head2 _whowasi | ||||||
1903 | |||||||
1904 | For debugging: say who called this | ||||||
1905 | |||||||
1906 | =cut | ||||||
1907 | 0 | 0 | sub _whowasi { (caller(1))[3] . '()' } | ||||
1908 | |||||||
1909 | =head1 REQUIRES | ||||||
1910 | |||||||
1911 | Test::More | ||||||
1912 | |||||||
1913 | =head1 INSTALLATION | ||||||
1914 | |||||||
1915 | To install this module, run the following commands: | ||||||
1916 | |||||||
1917 | perl Build.PL | ||||||
1918 | ./Build | ||||||
1919 | ./Build test | ||||||
1920 | ./Build install | ||||||
1921 | |||||||
1922 | Or, if you're on a platform (like DOS or Windows) that doesn't like the | ||||||
1923 | "./" notation, you can do this: | ||||||
1924 | |||||||
1925 | perl Build.PL | ||||||
1926 | perl Build | ||||||
1927 | perl Build test | ||||||
1928 | perl Build install | ||||||
1929 | |||||||
1930 | In order to install somewhere other than the default, such as | ||||||
1931 | in a directory under your home directory, like "/home/fred/perl" | ||||||
1932 | go | ||||||
1933 | |||||||
1934 | perl Build.PL --install_base /home/fred/perl | ||||||
1935 | |||||||
1936 | as the first step instead. | ||||||
1937 | |||||||
1938 | This will install the files underneath /home/fred/perl. | ||||||
1939 | |||||||
1940 | You will then need to make sure that you alter the PERL5LIB variable to | ||||||
1941 | find the modules, and the PATH variable to find the script. | ||||||
1942 | |||||||
1943 | Therefore you will need to change: | ||||||
1944 | your path, to include /home/fred/perl/script (where the script will be) | ||||||
1945 | |||||||
1946 | PATH=/home/fred/perl/script:${PATH} | ||||||
1947 | |||||||
1948 | the PERL5LIB variable to add /home/fred/perl/lib | ||||||
1949 | |||||||
1950 | PERL5LIB=/home/fred/perl/lib:${PERL5LIB} | ||||||
1951 | |||||||
1952 | |||||||
1953 | =head1 SEE ALSO | ||||||
1954 | |||||||
1955 | perl(1). | ||||||
1956 | |||||||
1957 | =head1 BUGS | ||||||
1958 | |||||||
1959 | Please report any bugs or feature requests to the author. | ||||||
1960 | |||||||
1961 | =head1 AUTHOR | ||||||
1962 | |||||||
1963 | Kathryn Andersen (RUBYKAT) | ||||||
1964 | perlkat AT katspace dot com | ||||||
1965 | http://www.katspace.org/tools | ||||||
1966 | |||||||
1967 | =head1 COPYRIGHT AND LICENCE | ||||||
1968 | |||||||
1969 | Copyright (c) 2006 by Kathryn Andersen | ||||||
1970 | |||||||
1971 | This program is free software; you can redistribute it and/or modify it | ||||||
1972 | under the same terms as Perl itself. | ||||||
1973 | |||||||
1974 | |||||||
1975 | =cut | ||||||
1976 | |||||||
1977 | 1; # End of HTML::KhatGallery::Core | ||||||
1978 | __END__ |