#!/usr/bin/perl -w # Copyright © 2000-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-Dec-00. require 5; use diagnostics; use strict; my $progname = $0; $progname =~ s@.*/@@g; my $version = q{ $Revision: 1.31 $ }; $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 @months = ("January", "February", "March", "April", "May", "June", "July", "August", "September", "October", "November", "December"); my $body_template = undef; sub cmp_files($$) { my ($file1, $file2) = @_; my @cmd = ("cmp", "-s", "$file1", "$file2"); print "$progname: executing \"" . join(" ", @cmd) . "\"\n" if ($verbose > 2); 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 > 2); print STDERR "$progname: rm $file_tmp\n" if ($verbose > 3); } } # 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; } sub find_images($) { my ($dir) = @_; my @images = (); local *LDIR; opendir (LDIR, "$dir") || error ("$dir: $!"); $dir .= "/" unless ($dir =~ m@/$@); $dir = "" if $dir eq "./"; foreach my $year (sort (readdir (LDIR))) { next unless ($year =~ m/^\d{4}$/); local *YDIR; opendir(YDIR, "$dir$year") || error ("$dir$year: $!"); foreach my $month (sort (readdir (YDIR))) { next unless ($month =~ m/^\d{2}\.html$/); local *IN; my $file = "$dir$year/$month"; my $body = ""; open (IN, "<$file") || error ("$file: $!"); while () { $body .= $_; } close IN; $body =~ s/\n/ /g; $body =~ s/]+)\"@) { my $thumb = $1; error ("$file: absolute URL in IMG: $thumb") if ($thumb =~ m/^http:/); next unless ($thumb =~ m/^((\d{2})-.*)-thumb\.(jpe?g|gif)$/); next unless ($mm eq $2); # this thumb is from this month. error ("no back? $thumb") unless $back; push @images, "$year\t$1.$3\t$back"; } elsif (m@]+)\"@) { my $anchor = $1; if ($anchor =~ m/^(\d\d?)-[a-z]+-\d{4}$/) { # convert "3-mar-2000" to "03" (both anchors point here.) $anchor = sprintf ("%02d", $1); } $back = "$month\#$anchor"; } } } closedir YDIR; } closedir LDIR; if ($verbose > 4) { print STDERR "$progname: all pictures:\n"; foreach(@images) { print STDERR " $_\n" } print STDERR "\n"; } return @images; } sub build_page($$$$) { my ($dir, $image, $prev, $next) = @_; $dir .= "/" unless ($dir =~ m@/$@); $dir = "" if $dir eq "./"; $_ = $image; my ($year, $file, $back) = m/^(.*)\t(.*)\t(.*)$/; if ($prev) { my $y; $_ = $prev; ($y, $prev) = m/^(.*)\t(.*)\t(.*)$/; $prev =~ s/\.(jpg|gif)$/.html/ if $prev; $prev = "../$y/$prev" if ($y ne $year); } if ($next) { my $y; $_ = $next; ($y, $next) = m/^(.*)\t(.*)\t(.*)$/; $next =~ s/\.(jpg|gif)$/.html/ if $next; $next = "../$y/$next" if ($y ne $year); } $image =~ s/^(.*)\t(.*)\t(.*)$/$2/; $file =~ s/\.(jpg|gif)$/.html/; $file = "$dir$year/$file"; my $prev_href1 = ($prev ? "" : ""); my $next_href1 = ($next ? "" : ""); my $prev_href2 = ($prev ? "" : ""); my $next_href2 = ($next ? "" : ""); $_ = $image; s/^\d+-\d+-//; my $title = "DNA Lounge: $_"; my $links = ''; { my $btitle; my ($bmon, $bdotm) = ($back =~ m/(\d\d)\.html\#(\d+)/); if ($bmon) { $bmon = $months[$bmon-1]; $bmon =~ s/^(...).*/$1/; $btitle = "$bdotm $bmon $year"; } $links .= " \n"; $links .= " \n"; $links .= " \n"; $links .= " \n" if ($prev); $links .= " \n" if ($next); # $links .= " \n"; } my $nav = " " . "\n" . " \n" . " \n" . " \n" . " " . "

" . "" . $prev_href1 . "<< prev" . $prev_href2 . "" . "

" . "" . "" . "back" . "" . "" . "

" . "" . $next_href1 . "next >>" . $next_href2 . "" . "

\n"; my $border = 1; $border = 0 if ("$year/$image" eq "2000/11-lift.jpg"); # KLUDGE! my $cmd = ($image =~ m/\.gif$/ ? "giftopnm" : "djpeg"); $_ = `$cmd < $dir$year/$image 2>/dev/null | head -2`; my ($w, $h) = m@P\d\n(\d+) (\d+)\n@s; error ("unable to get size of image: $image") unless ($w && $h); my $body2 = $nav . "

" . "

\n" . $nav . "

\n"; my $body = $body_template; $body =~ s@(]*>).*()@$1$title$2@s; $body =~ s@([ \t]*]*>\n)+@$links@s; $body =~ s@(]*>).*()@$1\n$body2 $2@s; local *OUT; my $file_tmp = "$file.tmp"; open (OUT, ">$file_tmp") || error ("$file_tmp: $!"); print OUT $body || error ("$file_tmp: $!"); close OUT; if ($verbose > 3) { print STDERR "$progname: $file: $image\n"; print STDERR "$progname: prev: " . ($prev ? $prev : "") . "\n"; print STDERR "$progname: next: " . ($next ? $next : "") . "\n"; } rename_or_delete ("$file", "$file_tmp"); } sub build_image_pages($) { my ($dir) = @_; load_template (); my @images = find_images ($dir); my $i = 0; for ($i = 0; $i <= $#images; $i++) { build_page ($dir, $images[$i], $i == 0 ? undef : $images[$i-1], $images[$i+1]); } } 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; 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@/$@@; build_image_pages ($dir); } main(); exit 0;