$page_title

#!/usr/bin/perl -w # Copyright © 2001-2007 Jamie Zawinski # # Permission to use, copy, modify, distribute, and sell this software and its # documentation for any purpose is hereby granted without fee, provided that # the above copyright notice appear in all copies and that both that # copyright notice and this permission notice appear in supporting # documentation. No representations are made about the suitability of this # software for any purpose. It is provided "as is" without express or # implied warranty. # # Created: 3-Jul-01. require 5; use diagnostics; use strict; use POSIX qw(mktime); my $progname = $0; $progname =~ s@.*/@@g; my $version = q{ $Revision: 1.57 $ }; $version =~ s/^[^0-9]+([0-9.]+).*$/$1/; my $verbose = 0; my $debug_p = 0; # this means "don't alter any files, print diffs instead" my $exec_dir = "utils"; my $template_file = "$exec_dir/template.html"; my @menuify_cmd = ("$exec_dir/menuify.pl", $template_file); my @months = ("January", "February", "March", "April", "May", "June", "July", "August", "September", "October", "November", "December"); my @days = ("Sunday", "Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday"); my $dim_fg = "#666"; my $body_template = undef; my %image_files = (); # keys are image file names (full and thumb) # Given a date, returns the day of the week on which it falls (0-6, sun-sat) # sub dotw($$$) { my ($dotm, $month, $year) = @_; # From the sci.math FAQ: # # The following formula, which is for the Gregorian calendar only, may be # more convenient for computer programming. Note that in some programming # languages the remainder operation can yield a negative result if given # a negative operand, so "mod 7" may not translate to a simple remainder. # # W == (k + [2.6m - 0.2] - 2C + Y + [Y/4] + [C/4]) mod 7 # where [] denotes the integer floor function (round down), # k is day (1 to 31) # m is month (1 = March, ..., 10 = December, 11 = Jan, 12 = Feb) # Treat Jan & Feb as months of the preceding year # C is century (1987 has C = 19) # Y is year (1987 has Y = 87 except Y = 86 for Jan & Feb) # W is week day (0 = Sunday, ..., 6 = Saturday) # # Here the century & 400 year corrections are built into the formula. # The [2.6m-0.2] term relates to the repetitive pattern that the 30-day # months show when March is taken as the first month. my $k = $dotm; my $m = 1 + (($month + 9) % 12); # (1-12) => (11, 12, 1-10) my $y = $year - ($m >= 11 ? 1 : 0); # subtract a year for jan/feb my $C = int ($y/100); my $Y = int ($y%100); my $W = (($k + int ((2.6 * $m) - 0.2) - (2 * $C) + $Y + int ($Y / 4) + int ($C / 4) + 7) % 7); return $W; } # Loads the template file and constructs our etc from it. # sub load_template() { local *IN; $body_template = ''; open (IN, "<$template_file") || error ("$template_file: $!"); print STDERR "$progname: reading $template_file\n" if ($verbose > 2); while () { $body_template .= $_; } close IN; # lose everything inside $body_template =~ s@(]*>).*(.*)$@$1\n $2@si; $body_template =~ s@^\s*\s*\n@@gmi; # insert more stuff into the 'body' element in the style sheet # my $margins = "margin: 0em 1em 0em 1em;"; $body_template =~ s@(body\s+{.*?)(})@$1 $margins $2@si; # Delete some classes we don't use here. # $body_template =~ s@ *\.(s|plink|[a-z]*box|maxright\d?) +{[^{}]*} *\n@@sgi; $body_template = "\n" . $body_template; # Swap DOCTYPE and NOWRAP, if there is one. $body_template =~ s@^()\n()@$2\n$1@si; } # returns a list of all flyer images under $dir, which is expected to # be the parent of the NNNN year directories. Thumbnail images are # excluded, but warnings about missing or extraneous thumbnails are # generated. Also populates %image_files with the flyers plus thumbs. # sub find_images($) { my ($dir) = @_; $dir .= "/" unless ($dir =~ m@/$@); local *FDIR; opendir (FDIR, "$dir") || error ("$dir: $!"); my @ffiles = readdir (FDIR); closedir FDIR; $dir = "" if $dir eq "./"; my %thumbs; my %images; foreach my $year (@ffiles) { next unless ($year =~ m/^\d{4}$/); local *YDIR; opendir(YDIR, "$dir$year") || error ("$dir$year: $!"); my @yfiles = readdir (YDIR); closedir YDIR; foreach my $month (@yfiles) { next unless ($month =~ m/^\d\d$/); next if ($month < 1 || $month > 12); local *MDIR; opendir(MDIR, "$dir$year/$month") || error ("$dir$year/$month: $!"); my @mfiles = readdir (MDIR); closedir MDIR; foreach my $img (@mfiles) { next unless ($img =~ m/\.(jpg|gif)$/i); if ($img =~ m/^(\d\d)-(.*)-(\d+)(-thumb)?\.(jpg|gif)$/) { next if ($1 < 1 || $1 > 31); $_ = "$year/$month/$img"; $image_files{$_} = 1; if ($img =~ m/-thumb/) { $thumbs{$_} = 1; } else { $images{$_} = 1; } } else { print STDERR "$progname: warning: unrecognised file: " . "$dir$year/$month/$img\n"; } } } } # Check for dangling thumbs... # foreach my $thumb (keys (%thumbs)) { my $img1 = $thumb; $img1 =~ s/-thumb//; my $img2 = $img1; $img1 =~ s/\.(jpg|gif)$/.jpg/; $img2 =~ s/\.(jpg|gif)$/.gif/; if (! ($images{$img1} || $images{$img2})) { print STDERR "$progname: warning: dangling thumb: $thumb\n"; } } # Check for missing thumbs... # foreach my $img (keys (%images)) { my $thumb1 = $img; my $thumb2 = $img; $thumb1 =~ s/(\.[^.]+)$/-thumb.jpg/; $thumb2 =~ s/(\.[^.]+)$/-thumb.gif/; if (! ($thumbs{$thumb1} || $thumbs{$thumb2})) { print STDERR "$progname: warning: no thumb: $img\n" unless ($img eq '2003/04/26-fetishball-3.jpg'); # kludge } } return sort { $b cmp $a } (keys (%images)); } sub cmp_files($$) { my ($file1, $file2) = @_; my @cmd = ("cmp", "-s", "$file1", "$file2"); print STDERR "$progname: executing \"" . join(" ", @cmd) . "\"\n" if ($verbose > 3); system (@cmd); my $exit_value = $? >> 8; my $signal_num = $? & 127; my $dumped_core = $? & 128; error ("$cmd[0]: core dumped!") if ($dumped_core); error ("$cmd[0]: signal $signal_num!") if ($signal_num); return $exit_value; } sub diff_files($$) { my ($file1, $file2) = @_; my @cmd = ("diff", "-NU2", "$file1", "$file2"); print "$progname: executing \"" . join(" ", @cmd) . "\"\n" if ($verbose > 1); system (@cmd); my $exit_value = $? >> 8; my $signal_num = $? & 127; my $dumped_core = $? & 128; error ("$cmd[0]: core dumped!") if ($dumped_core); error ("$cmd[0]: signal $signal_num!") if ($signal_num); return $exit_value; } # If the two files differ: # mv file2 file1 # else # rm file2 # sub rename_or_delete($$) { my ($file, $file_tmp) = @_; my $changed_p = cmp_files ($file, $file_tmp); if ($changed_p && $debug_p) { print STDOUT "\n" . ('#' x 79) . "\n"; diff_files ("$file", "$file_tmp"); $changed_p = 0; } if ($changed_p) { if (!rename ("$file_tmp", "$file")) { unlink "$file_tmp"; error ("mv $file_tmp $file: $!"); } print STDERR "$progname: wrote $file\n"; } else { unlink "$file_tmp" || error ("rm $file_tmp: $!\n"); print STDERR "$progname: $file unchanged\n" if ($verbose > 1); print STDERR "$progname: rm $file_tmp\n" if ($verbose > 2); } } my %event_prev_next_table = (); # For when the name of an event changed... # my %event_name_aliases = ( "poprocks" => "poproxx", "redsquare" => "qool", "bodymanipulations" => "flyingtigercircus", "kinkycircus" => "goodvibrations", ); sub sort_events_by_name(@) { my (@images) = @_; my %name_table = (); %event_prev_next_table = (); # first, divide the images by event name... # foreach my $image (@images) { error ("unparsable file name: $image") unless ($image =~ m@^(\d{4})/(\d\d)/(\d\d)-(.*)-(\d+)\.(jpg|gif)$@); my ($year, $month, $dotm, $event_name, $count) = ($1, $2, $3, $4, $5); $event_name = ($event_name_aliases{$event_name} || $event_name); next unless ($count == 1); # only want the first image in the set my $ref = $name_table{$event_name}; my @list = (defined($ref) ? @$ref : ()); push @list, $image; $name_table{$event_name} = \@list; } # next, for each event, find the prev and next for each image. # foreach my $event_name (keys (%name_table)) { my @list = @{$name_table{$event_name}}; @list = sort @list; my $i = 0; foreach my $img (@list) { my $prev = ($i == 0 ? undef : $list[$i-1]); my $next = $list[$i+1]; my @prevnext = ($prev, $next); $event_prev_next_table{$img} = \@prevnext; $i++; } $name_table{$event_name} = undef; } %name_table = (); } sub image_size($$) { my ($dir, $file) = @_; local *IN; error ("file not found: $file") unless ($image_files{$file}); $file = $dir . $file; my $cmd = ($file =~ m/\.gif$/i ? "giftopnm" : "djpeg"); open (IN, "$cmd '$file' 2>/dev/null |") || error ("$cmd $file: $!"); $_ = ''; while (defined($_) && m/^\s*(\#|$)/) { $_ = ; } # P6 $_ = ''; while (defined($_) && m/^\s*(\#|$)/) { $_ = ; } # w h close IN; (defined($_) && m/^(\d+) (\d+)$/) || error ("$file: no size?"); return ($1, $2); } # writes a file containing the inlined, large flyer images. # The @images arg contains the front and back images of all flyers # for this date. # # $prev and $next are of the form NNNN/MM/DD-xxx-N.jpg, and are the # nearest flyer images that come before/after this batch of images. # # $prev2 and $next2 are of the same form, but name the prev/next flyer # image of *this same event*, if there is one. # sub build_page($$$$$@) { my ($dir, $prev, $next, $prev2, $next2, @images) = @_; $dir .= "/" unless ($dir =~ m@/$@); $dir = "" if $dir eq "./"; error ("unparsable file name: $images[0]") unless ($images[0] =~ m@^(\d{4})/(\d\d)/(\d\d)-(.*)-(\d+)\.(jpg|gif)$@); my ($year, $month, $dotm, $event_name, $count) = ($1, $2, $3, $4, $5); my $this_name; my $dotw = $days[dotw ($dotm, $month, $year)]; my $month_name = $months[$month-1]; $dotw =~ s/^(...).*$/$1/; $month_name =~ s/^(...).*$/$1/; $this_name = "$dotw, $dotm $month_name $year"; my $links = ''; $links .= " \n"; $links .= " \n"; $links .= " \n"; if ($prev) { $_ = $prev; error ("unparsable prev: $prev") unless (m@^(\d{4})/(\d\d)/(\d\d)-@); my ($pyear, $pmonth, $pdotm) = ($1, $2, $3); $prev =~ s/\.(jpg|gif)$/.html/; $prev =~ s@^\d{4}/\d\d/@@; $prev =~ s@-\d+(\.[^.]+)$@$1@; if ($year != $pyear) { $prev = "../../$pyear/$pmonth/$prev"; } elsif ($month != $pmonth) { $prev = "../$pmonth/$prev"; } $pmonth = $months[$pmonth-1]; $pmonth =~ s/^(...).*$/$1/; my $pdate = "$pdotm $pmonth $pyear"; $links .= " \n"; } if ($next) { $_ = $next; error ("unparsable next: $next") unless (m@^(\d{4})/(\d\d)/(\d\d)-@); my ($nyear, $nmonth, $ndotm) = ($1, $2, $3); $next =~ s/\.(jpg|gif)$/.html/; $next =~ s@^\d{4}/\d\d/@@; $next =~ s@-\d+(\.[^.]+)$@$1@; if ($year != $nyear) { $next = "../../$nyear/$nmonth/$next"; } elsif ($month != $nmonth) { $next = "../$nmonth/$next"; } $nmonth = $months[$nmonth-1]; $nmonth =~ s/^(...).*$/$1/; my $ndate = "$ndotm $nmonth $nyear"; $links .= " \n"; } if ($prev2) { $_ = $prev2; error ("unparsable prev2: $prev2") unless (m@^(\d{4})/(\d\d)/(\d\d)-@); my ($pyear, $pmonth, $pdotm) = ($1, $2, $3); $prev2 =~ s/\.(jpg|gif)$/.html/; $prev2 =~ s@^\d{4}/\d\d/@@; $prev2 =~ s@-\d+(\.[^.]+)$@$1@; if ($year != $pyear) { $prev2 = "../../$pyear/$pmonth/$prev2"; } elsif ($month != $pmonth) { $prev2 = "../$pmonth/$prev2"; } } if ($next2) { $_ = $next2; error ("unparsable next2: $next2") unless (m@^(\d{4})/(\d\d)/(\d\d)-@); my ($nyear, $nmonth, $ndotm) = ($1, $2, $3); $next2 =~ s/\.(jpg|gif)$/.html/; $next2 =~ s@^\d{4}/\d\d/@@; $next2 =~ s@-\d+(\.[^.]+)$@$1@; if ($year != $nyear) { $next2 = "../../$nyear/$nmonth/$next2"; } elsif ($month != $nmonth) { $next2 = "../$nmonth/$next2"; } } my $title = "DNA Lounge: Flyer Archive: $dotm $month_name $year"; my $prev_href1 = ($prev ? "" : ""); my $next_href1 = ($next ? "" : ""); my $prev_href2 = ($prev ? "" : ""); my $next_href2 = ($next ? "" : ""); my $prev_href = "${prev_href1}<< prev${prev_href2}"; my $next_href = "${next_href1}next >>${next_href2}"; $prev_href .= "
<< prev $event_name" if ($prev2); $next_href .= "
next $event_name >>" if ($next2); my $photos = sprintf ("gallery/$year/%02d-%02d", $month, $dotm); if (-d $photos) { $photos = "photos"; } else { $photos = undef; } my $nav = " \n" . " \n" . " \n" . " \n" . " \n" . " \n" . "

" . $prev_href . "

" . "$this_name
\n" . " << flyers \n" . ($photos ? "$photos \n" : "") . " " . "calendar >>
\n" . "

" . $next_href . "

\n"; my $nav2= " \n" . " \n" . " \n" . " \n" . " \n" . "

" . $prev_href . "

" . $next_href . "

\n"; my $body = "$nav

\n"; my $i = 0; my $last_w; my $last_h; foreach my $image (@images) { my ($w, $h) = image_size ($dir, $image); my $himage = $image; $himage =~ s@^.*?([^/]+)$@$1@; my $cell = "

\n"; # If the height of this image differs from the previous image by # more than 10px, then force a line break between them. # if ($i > 0 && ($last_h < $h - 10 || $last_h > $h + 10)) { $cell = "
" . $cell; } $body .= $cell; $last_w = $w; $last_h = $h; $i++; } $body =~ s/[ \t]*\n
/
\n/gsi; $body .= "

\n" . $nav2 . "

\n"; { my $body2 = $body_template; $body2 =~ s@(]*>).*()@$1$title$2@s; $body2 =~ s@([ \t]*]*>\n)+@$links@s; $body2 =~ s@(]*>).*()@$1\n\n$body $2@s; $body = $body2; } my $file = "$dir$images[0]"; $file =~ s/-\d+\.[^.]+$/.html/; local *OUT; my $file_tmp = "$file.tmp"; open (OUT, ">$file_tmp") || error ("$file_tmp: $!"); print OUT $body || error ("$file_tmp: $!"); close OUT; rename_or_delete ("$file", "$file_tmp"); } # generates all HTML pages for flyers under $dir, which is expected to # be the parent of the NNNN year directories. # sub wrap_images($) { my ($dir) = @_; load_template (); my @images = find_images($dir); sort_events_by_name (@images); my $body = ""; my $prev; my $next; my $oyear; my $omonth; my $year_one; my $nlines = 0; while (@images) { my @imgs = (); my $img = $images[0]; error ("unparsable image? $img") unless ($img =~ m@^((\d{4})/(\d\d)/\d\d-.*-)\d+\.(jpg|gif)@); my $head = $1; my $year = $2; my $month = $3; my $head_re = qr/$head/; $year_one = $year unless defined($year_one); if ($oyear && ($year ne $oyear || $month ne $omonth)) { write_month_index ($dir, $oyear, $omonth, $body, $nlines); $body = ""; $nlines = 0; } if ($oyear && $year ne $oyear) { write_year_index ($dir, $oyear); } $oyear = $year; $omonth = $month; while ($#images >= 0 && $images[0] =~ m/^$head_re/) { $img = shift @images; unshift @imgs, $img; } # look up the next/prev event with the same name my ($next2, $prev2); { my $key = $img; $key =~ s/(-\d+)(\.[^.]+)$/-1$2/; my $ref = $event_prev_next_table{$key}; ($next2, $prev2) = ($ref ? @$ref : ()); } $next = $images[0]; build_page ($dir, $next, $prev, $next2, $prev2, @imgs); my $thtml = thumb_html ($dir, @imgs); $body = $thtml . $body; $prev = $img; # Figure out how many lines of flyers were just written by counting TRs. my @L = split(/ 12) { $omonth -= 12; $oyear++; } my $oname = $months[$omonth-1]; my $oname2 = "$oname $oyear"; $oname =~ s/^(...).*$/$1/; my $odir = ($oyear == $year ? sprintf("../%02d/", $omonth) : sprintf("../../%04d/%02d/", $oyear, $omonth)); return ($oname, $oname2, $odir); } # Find the prev/next month that has flyers; if there isn't one within # three months of here, return the prev/next month with no directory name. # sub other_month($$$$) { my ($base, $month, $year, $next_p) = @_; my $sign = ($next_p ? 1 : -1); my ($oname, $oname2, $odir) = shift_month ($month, $year, $sign * 1); my $ooname = $oname; my $ooname2 = $oname2; return ($oname, $oname2, $odir) if (-d "$base/$odir"); ($oname, $oname2, $odir) = shift_month ($month, $year, $sign * 2); return ($oname, $oname2, $odir) if (-d "$base/$odir"); ($oname, $oname2, $odir) = shift_month ($month, $year, $sign * 3); return ($oname, $oname2, $odir) if (-d "$base/$odir"); return ($ooname, $ooname2, undef); } # Writes the HTML for the page listing all flyers in a given month: # the page that contains the thumbnail images (YYYY/MM/index.html). # sub write_month_index($$$$$) { my ($dir, $year, $month, $body, $nlines) = @_; $dir .= "/" unless ($dir =~ m@/$@); $dir = "" if $dir eq "./"; my $output = ""; my $month_name = $months[$month-1]; my $page_title = "DNA Lounge: Flyer Archive: $month_name $year"; $output .= "$page_title\n\n"; my ($prev_name, $prev_name2, $prev) = other_month ("$dir$year/$month", $month, $year, 0); my ($next_name, $next_name2, $next) = other_month ("$dir$year/$month", $month, $year, 1); $prev_name = "<< $prev_name"; $next_name = "$next_name >>"; $prev_name2 .= " Flyers"; $next_name2 .= " Flyers"; my $prev_href1 = ($prev ? "" : ""); my $next_href1 = ($next ? "" : ""); my $prev_href2 = ($prev ? "" : ""); my $next_href2 = ($next ? "" : ""); my $links = ''; $links .= " \n"; $links .= " \n"; $links .= " \n" if ($prev); $links .= " \n" if ($next); $output .= $links; my $nav = ""; $nav .= "

\n"; $nav .= "\n"; $nav .= " \n"; $nav .= " \n"; $nav .= " \n"; $nav .= " \n"; $nav .= " \n"; $nav .= "
\n"; $nav .= " $prev_href1$prev_name$prev_href2"; $nav .= " \n"; $nav .= " $year"; $nav .= " \n"; $nav .= " $next_href1$next_name$next_href2"; $nav .= "
\n"; $output .= "\n"; $output .= $nav; $output .= "\n"; $output .= "\n"; $output .= "$nav

" if ($nlines >= 6); $output .= "\n"; $output .= ("\n" . "\n" . "\n" . "\n" . "\n" . $body . "
\n" . "\n" . "$month_name $year Flyers\n\n" . "
\n" . "\n"); my $outfile = "$dir$year/$month/index.html"; local *OUT; my $file_tmp = "$outfile.tmp"; open(OUT, ">$file_tmp") || error ("$file_tmp: $!"); print OUT $output; close OUT; my @cmd = @menuify_cmd; if ($verbose > 2) { push @cmd, ("-" .("v" x ($verbose - 2))); } push @cmd, $file_tmp; print "$progname: executing \"" . join(" ", @cmd) . "\"\n" if ($verbose > 3); system (@cmd); my $exit_value = $? >> 8; my $signal_num = $? & 127; my $dumped_core = $? & 128; error ("$cmd[0]: core dumped!") if ($dumped_core); error ("$cmd[0]: signal $signal_num!") if ($signal_num); error ("$cmd[0]: exited with $exit_value!") if ($exit_value); rename_or_delete ("$outfile", "$file_tmp"); } # Writes the HTML for the page listing all months in a given year # the page that contains the month name links (YYYY/index.html). # sub write_year_index($$) { my ($dir, $year) = @_; $dir .= "/" unless ($dir =~ m@/$@); $dir = "" if $dir eq "./"; my $output = ""; my $page_title = "DNA Lounge: Flyer Archive: $year"; $output .= "$page_title\n\n"; my $prev_name = $year-1; my $next_name = $year+1; my $prev = "../$prev_name/"; my $next = "../$next_name/"; $prev = undef unless (-d "$dir$year/$prev"); $next = undef unless (-d "$dir$year/$next"); my $prev_href1 = ($prev ? "" : ""); my $next_href1 = ($next ? "" : ""); my $prev_href2 = ($prev ? "" : ""); my $next_href2 = ($next ? "" : ""); my $links = ''; $links .= " \n"; $links .= " \n"; $links .= " \n" if ($prev); $links .= " \n" if ($next); $output .= $links; $prev_name = "<< $prev_name"; $next_name = "$next_name >>"; $output .= "\n"; $output .= "

\n"; $output .= "\n"; $output .= " \n"; $output .= " \n"; $output .= " \n"; $output .= " \n"; $output .= "
\n"; $output .= " $prev_href1$prev_name$prev_href2"; $output .= " \n"; $output .= " $next_href1$next_name$next_href2"; $output .= "
\n"; $output .= "\n"; $output .= "\n"; $output .= "\n"; $output .= "$year Flyers\n\n"; $output .= "

\n"; $output .= "\n"; for (my $y = 0; $y < 4; $y++) { $output .= " \n"; for (my $x = 0; $x < 3; $x++) { my $month = sprintf("%02d", (($x * 4) + $y) + 1); my $month_name = $months[$month-1]; my $align = ($x == 0 ? "RIGHT" : $x == 1 ? "CENTER" : "LEFT"); my $ok = (-d "$dir$year/$month"); my $href1 = ($ok ? "" : ""); my $href2 = ($ok ? "" : ""); $output .= " \n"; } $output .= " \n"; } $output .= "
$href1"; $output .= "$month_name$href2
\n"; $output .= "\n"; my $outfile = "$dir$year/index.html"; local *OUT; my $file_tmp = "$outfile.tmp"; open(OUT, ">$file_tmp") || error ("$file_tmp: $!"); print OUT $output; close OUT; my @cmd = @menuify_cmd; if ($verbose > 2) { push @cmd, ("-" .("v" x ($verbose - 2))); } push @cmd, $file_tmp; print "$progname: executing \"" . join(" ", @cmd) . "\"\n" if ($verbose > 3); system (@cmd); my $exit_value = $? >> 8; my $signal_num = $? & 127; my $dumped_core = $? & 128; error ("$cmd[0]: core dumped!") if ($dumped_core); error ("$cmd[0]: signal $signal_num!") if ($signal_num); error ("$cmd[0]: exited with $exit_value!") if ($exit_value); rename_or_delete ("$outfile", "$file_tmp"); } # Returns the HTML that renders the inlined thumbs of the given flyer images. # The @images arg names the front and back images of all flyers for this date. # (They are converted to -thumb versions.) # sub thumb_html($$) { my ($dir, @images) = @_; $dir .= "/" unless ($dir =~ m@/$@); $dir = "" if $dir eq "./"; error ("unparsable image? $images[0]") unless ($images[0] =~ m@^(\d{4})/(\d\d)/(\d\d)-(.*)-(\d+)\.(jpg|gif)$@); my ($year, $month, $dotm, $name, $count) = ($1, $2, $3, $4, $5); my $dotw = $days[dotw ($dotm, $month, $year)]; my $month_name = $months[$month-1]; $month_name =~ s/^(...).*$/$1/; my $body = ""; $body .= " \n"; $body .= " \n"; $body .= " $dotw
$dotm $month_name $year"; $body .= "\n"; # pad the images: if the sequence is "1, 3, 4", change it to "1, '', 3, 4". { my @im2 = (); my $last = 0; foreach (@images) { my ($n) = m/-(\d+)\.[a-z]+$/; while ($last < ($n-1)) { push @im2, undef; $last++; } $last = $n; push @im2, $_; } @images = @im2; } my $L = $#images; my $fcount = 0; foreach my $image (@images) { if (!defined ($image)) { # spacer image $fcount++; next; } my $thumb = $image; $thumb =~ s/(\.[^.]+)$/-thumb.jpg/; $thumb =~ s/\.jpg$/.gif/ unless ($image_files{$thumb}); if ($fcount && !($fcount & 1)) { $body .= " \n"; $body .= " \n"; $body .= " \n"; } my $next_image = $images[$fcount+1]; my $just_one = (!($fcount & 1) && !defined($next_image)); my $align = ($just_one ? "CENTER" : (($fcount & 1) == 0 ? "RIGHT" : "LEFT")); my $html = "$dotm-$name.html"; if ($image_files{$thumb}) { my ($w, $h) = image_size ($dir, $thumb); $w = "WIDTH=$w"; $h = "HEIGHT=$h"; my $hthumb = $thumb; $hthumb =~ s@^.*?([^/]+)$@$1@; $body .= " \n"; $body .= " \n"; $body .= " "; $body .= ""; $body .= "\n"; } $fcount++; } $body .= " \n"; $body =~ s@\n[ \t]*\s*\s*\s*@@gsi; # lose blank rows return $body; } sub error($) { my ($err) = @_; print STDERR "$progname: $err\n"; exit 1; } sub usage() { print STDERR "usage: $progname [--verbose] [--debug] directory\n"; exit 1; } sub main() { my $dir = undef; error ("LANG is $ENV{LANG} -- UTF is no good, man!") if ($ENV{LANG} && $ENV{LANG} =~ m/utf/i); while ($_ = $ARGV[0]) { shift @ARGV; if ($_ eq "--verbose") { $verbose++; } elsif ($_ eq "--debug") { $debug_p++; } elsif (m/^-v+$/) { $verbose += length($_)-1; } elsif (m/^-./) { usage; } elsif (!defined($dir)) { $dir = $_; } else { usage; } } usage unless defined($dir); $dir =~ s@/+$@@; wrap_images ($dir); } main(); exit 0;