#!/usr/bin/perl -w # Copyright © 2000-2012 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; BEGIN { push @INC, "utils/"; } use Menuify; my $progname = $0; $progname =~ s@.*/@@g; my $version = q{ $Revision: 1.55 $ }; $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 @months = ("January", "February", "March", "April", "May", "June", "July", "August", "September", "October", "November", "December"); my $body_template = undef; my $dim_fg = "#666"; sub safe_system(@) { my @cmd = @_; 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); } sub image_size($) { my ($file) = @_; error ("$file does not exist") unless -f $file; return (0, 0) unless -f $file; my $cmd = ("identify -define jpeg:size=1x1 -format '%[width]x%[height]'" . " '$file'"); print STDERR "$progname: executing: $cmd\n" if ($verbose > 7); my $result = `$cmd`; print STDERR "$progname: ==> $result\n" if ($verbose > 7); my ($w, $h) = ($result =~ m/^(\d+)x(\d+)$/); error ("no size: $file") unless ($w && $h); return ($w, $h); } # Loads the template file and constructs our etc from it. # sub load_template() { $body_template = ''; my $template_file = $DNA::Menuify::template_file; open (my $in, '<', $template_file) || error ("$template_file: $!"); print STDERR "$progname: reading $template_file\n" if ($verbose > 2); local $/ = undef; # read entire file $body_template = <$in>; close $in; # lose everything inside $body_template =~ s@(]*>).*(.*)$@$1\n $2@si; $body_template =~ s@^\s*\s*\n@@gmi; $body_template =~ s@%%ROOT%%@../../../../@gs; $body_template = "\n" . $body_template; # We generate our own version of these. $body_template =~ s@^\s*]*>\n@@gmi; $body_template =~ s@^\s*]*>\n@@gmi; # Swap DOCTYPE and NOWRAP, if there is one. $body_template =~ s@^()\n()@$2\n$1@si; } sub find_images($) { my ($dir) = @_; my @images = (); my @thumbs = (); opendir (my $ldir, $dir) || error ("$dir: $!"); $dir .= "/" unless ($dir =~ m@/$@); $dir = "" if $dir eq "./"; foreach my $year (sort (readdir ($ldir))) { next unless ($year =~ m/^\d{4}$/); opendir (my $ydir, "$dir$year") || error ("$dir$year: $!"); foreach my $month (sort (readdir ($ydir))) { next unless ($month =~ m/^\d{2}$/); opendir (my $mdir, "$dir$year/$month") || error ("$dir$year$month: $!"); foreach my $day (sort (readdir ($mdir))) { next unless ($day =~ m/^\d{2}\.html$/); my $file = "$dir$year/$month/$day"; my $body = ""; open (my $in, '<', $file) || error ("$file: $!"); local $/ = undef; # read entire file $body = <$in>; close $in; $body =~ s/\n/ /g; $body =~ s/]+)\"@) { my $thumb = $1; next if ($thumb =~ m@^http://img.youtube.com/vi/@s); error ("$file: absolute URL in IMG: $thumb") if ($thumb =~ m/^http:/); next unless ($thumb =~ m@^([^./]*)-thumb\.(jpg|gif)$@); my $img = "$1.$2"; # Kludge: these exist as thumbs only. my $ff = $back; $ff =~ s@/\d\d\.[^/.]+$@/$img@s; next if ($ff eq '2003/08/dulcinea1.jpg'); next if ($ff eq '2005/04/195231.jpg'); next if ($ff eq '2005/04/195515.jpg'); next if ($ff eq '2005/04/195539.jpg'); push @images, "$img\t$back"; push @thumbs, "$thumb\t$back"; } } } closedir $mdir; } closedir $ydir; } closedir $ldir; print STDERR "$progname: found " . ($#images+1) . " images\n" if ($verbose); if ($verbose > 3) { print STDERR "$progname: all images:\n"; foreach(@images) { print STDERR " $_\n" } print STDERR "\n"; } return ( \@images, \@thumbs ); } sub build_page($$$$) { my ($dir, $img, $prev, $next) = @_; $dir .= "/" unless ($dir =~ m@/$@); $dir = "" if $dir eq "./"; my ($file, $year, $month, $day) = ($img =~ m@^(.*)\t(\d+)/(\d+)/(\d+)\.html$@); $img = $file; $file =~ s@\.[^./]+$@.html@s; if ($prev) { my ($file2, $year2, $month2, $day2) = ($prev =~ m@^(.*)\t(\d+)/(\d+)/(\d+)\.html$@); if ($year != $year2) { $prev = "../../$year2/$month2/$file2"; } elsif ($month != $month2) { $prev = "../$month2/$file2"; } else { $prev = $file2; } $prev =~ s/\.(jpg|gif)$/.html/; } if ($next) { my ($file2, $year2, $month2, $day2) = ($next =~ m@^(.*)\t(\d+)/(\d+)/(\d+)\.html$@); if ($year != $year2) { $next = "../../$year2/$month2/$file2"; } elsif ($month != $month2) { $next = "../$month2/$file2"; } else { $next = $file2; } $next =~ s/\.(jpg|gif)$/.html/; } my $title; { my $tmon = $months[$month-1]; $tmon =~ s/^(...).*/$1/; $_ = $img; s/\.[^.]+$//; s/\b(.)/\u$1/gs; s/(\d+)$/ $1/s; s/[-_\s]+/ /gs; $title = "DNA Lounge: $day $tmon $year: $_"; } my ($img_width, $img_height) = image_size ("$dir$year/$month/$img"); error ("unable to get dimensions: $img") unless $img_width; # Hints for Facebook and iPhone. # my $links = (" \n" . " \n" . " \n" . " \n"); { my $bmon = $months[$month-1]; $bmon =~ s/^(...).*/$1/; my $btitle = "$day $bmon $year"; $links .= " \n"; $links .= " \n"; $links .= " \n" if ($prev); $links .= " \n" if ($next); $links .= " \n"; } my $u = $next ? $next : "$day.html"; $prev = ($prev ? "<<" : "<<"); $next = ($next ? ">>" : ">>"); my $output = $body_template; $output =~ s/([ \t]*)/$links$1$title/g; my $body = (" <DIV ALIGN=CENTER>\n" . " $prev\n" . " <A HREF=\"$day.html\" CLASS=\"navC\">back</A>\n" . " $next\n" . " <A HREF=\"$u\">" . "<IMG SRC=\"$img\" CLASS=\"photo\"" . " STYLE=\"max-width:${img_width}px;" . " max-height:${img_height}px\">" . "</A>\n" . #" $prev\n" . #" $next\n" . " </DIV>\n"); $output =~ s@(<BODY>\n)@$1$body@si; DNA::Menuify::write_file ("$dir$year/$month/$file", $output); } # For the -thumb.jpg images in the file, make sure the files exist # (creating them from the non-thumb version if necessary) and make # sure the IMG tags have the proper width/height for the thumbs. # sub update_thumbs($$) { my ($file, $target_size) = @_; my $dir = $file; $dir =~ s@/[^/]*$@@s; my $body = ""; open (my $in, '<', $file) || error ("$file: $!"); local $/ = undef; # read entire file $body = <$in>; close $in; $body =~ s%(<IMG\b.*?>)%{ my $tag = $1; my ($src) = ($tag =~ m/\bSRC="(.*?)"/si); if ($src =~ m@^([^./]*)-thumb\.(jpg|gif)$@s) { my ($ow) = ($tag =~ m/ \b WIDTH = \"? (\d+) /six); ($ow) = ($tag =~ m/ \b width: \s* (\d+) \s* px \b/six) unless $ow; my ($oh) = ($tag =~ m/ \b HEIGHT = \"? (\d+) /six); ($oh) = ($tag =~ m/ \b height: \s* (\d+) \s* px \b/six) unless $oh; $ow = 0 unless $ow; $oh = 0 unless $oh; my $tfile = "$dir/$src"; my ($w, $h) = (-f $tfile ? image_size ($tfile) : (0,0)); if (!$h) { my $ofile = $tfile; $ofile =~ s/-thumb\././s; # If there is no thumb, but the html specifies a size, aim for that. if ($ow && $oh) { $target_size = "${ow}x$oh"; } elsif ($ow) { $target_size = "${ow}x"; } elsif ($oh) { $target_size = "x${oh}"; } # Make sure original file is rotated properly safe_system ("rotimg", $ofile) if ($ofile =~ m@\.jpg$@si); my @cmd = ("convert", $ofile, "-resize", $target_size, "-strip", $tfile); print STDERR "$progname: creating $tfile\n"; if (! $debug_p) { safe_system (@cmd); ($w, $h) = image_size ($tfile); error ("$progname: $tfile: failed") unless ($w); } } if ($w != $ow || $h != $oh) { print STDERR "$progname: $file: $src: ${ow}x$oh -> ${w}x$h\n"; my $otag = $tag; # Replace the old width/height, or add if it doesn't exist. ($tag =~ s/\b ( WIDTH = "? ) (\d+) /$1$w/six) || ($tag =~ s/\b ( width: \s* ) (\d+) (\s* px)\b/$1${w}$3/six) || ($tag =~ s/>/ WIDTH=$w>/si); ($tag =~ s/\b ( HEIGHT = "? ) (\d+) /$1$h/six) || ($tag =~ s/\b ( height: \s* ) (\d+) (\s* px)\b/$1${h}$3/six) || ($tag =~ s/>/ HEIGHT=$h>/si); error ("unable to update tag: $otag") if ($otag eq $tag); $tag =~s/>/ BORDER=1>/s unless ($tag =~ m/(BORDER=|border:)/s); } } $tag; }%gesxi; DNA::Menuify::write_file ($file, $body); } sub build_image_pages($$) { my ($dir, $target_size) = @_; load_template (); my ($images, $thumbs) = find_images ($dir); my @images = @$images; my @thumbs = @$thumbs; my %files; foreach my $tt (@thumbs) { my ($thumb, $file) = split(/\t/, $tt); $files{$file} = 1; } foreach my $file (sort (keys %files)) { update_thumbs ("$dir/$file", $target_size); } my $i = 0; for ($i = $#images; $i >= 0; $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]" . " [--target-size 180x180] directory\n"; exit 1; } sub main() { my $dir = undef; my $target_size = '180x180'; while ($_ = $ARGV[0]) { shift @ARGV; if (m/^--?verbose$/s) { $verbose++; } elsif (m/^-v+$/) { $verbose += length($_)-1; } elsif (m/^--?debug$/s) { $debug_p++; } elsif (m/^--?target(-size)?$/s) { $target_size = shift @ARGV; } elsif (m/^-./) { usage; } elsif (!defined($dir)) { $dir = $_; } else { usage; } } usage unless $dir; $dir =~ s@/+$@@; # When writing files, make permissions match the parent directory # by computing a umask from the directory's permissions. # umask (~((stat($dir))[2] & 0666) & 0666); $DNA::Menuify::verbose = $verbose; $DNA::Menuify::debug = $debug_p; build_image_pages ($dir, $target_size); } main(); exit 0;