#!/usr/bin/perl -w # Copyright © 2003-2008 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: 19-Aug-2003. require 5; use diagnostics; use strict; my $progname = $0; $progname =~ s@.*/@@g; my $version = q{ $Revision: 1.84 $ }; $version =~ s/^[^0-9]+([0-9.]+).*$/$1/; my $verbose = 0; my $debug = 0; my $exec_dir = "utils"; my $template_file = "$exec_dir/template.html"; my @menuify_cmd = ("$exec_dir/menuify.pl", $template_file); my @validate_cmd = (@menuify_cmd, "--validate"); 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; sub validate_html($) { my ($file) = @_; my @cmd = @validate_cmd; if ($verbose > 2) { push @cmd, ("-" .("v" x ($verbose - 2))); } push @cmd, $file; 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); } # This table maps each act in any gallery to the gallery pages on which # it occurs. Keys are downcased band names, values are list references # of "YYYY/MM-DD", ordered older to newer. # my %xrefs = (); # This table maps each gallery to the list of bands in that gallery # (omitting any aliases.) Keys are "YYYY/MM-DD", values are list references # of downcased band names. # my %xref_acts = (); # Table of how we abbeviate certain special case names. # (Exceptions to the normal abbreviation algorithm.) # my %abbreviations = ( 'all hallow\'s eve' => 'halloween', 'atomic jungle' => 'atomic jungle', 'beyond the pale' => 'pale', 'body manipulations' => 'circus', 'cabaret verdalet' => 'verdalet', 'cantankerous lollies' => 'lollies', 'castle spectacular' => 'spectacular', 'chris connelly' => 'connelly', 'control theory' => 'ctrl', 'cruxshadows' => 'cs', 'david j' => 'david j', 'death guild thunderdome' => 'thunderdome', 'extreme circus show' => 'circus', 'flying fox' => 'fox', 'flying tiger circus' => 'circus', 'genitorturers' => 'gt', 'hot pink feathers' => 'feathers', 'jill tracy' => 'jill', 'king\'s x' => 'king\'s x', 'meg lee chin' => 'meg', 'momentum dancers' => 'momentum', 'monochrome' => 'mc', 'naughty nursies' => 'nursies', 'nina hagen' => 'nina', 'psyclon nine' => 'p9', 'qool' => 'qoöl', 'red square' => 'red square', 'rosin coven' => 'rosin coven', 'san francisco fetish ball' => 'fetish ball', 'sf fetish ball' => 'fetish ball', 'sf fetish ball gallery show' => 'fetish ball', 'scar tissue' => 'scar tissue', 'see colin slash' => 'colon', 'simon stinger' => 'stinger', 'slick fetish ball' => 'slick', 'spectacular spectacular' => 'spectacular', 'storm and the balls' => 'storm', 'storm inc' => 'storm', 'tesseract7' => 't7', 'thunderdome' => 'thunderdome', 'creepshow peepshow' => 'creepshow', 'qbert' => 'qbert', 'staff christmas party' => 'staff', 'drag king contest' => 'drag kings', 'pop rocks' => 'poprocks', 'pop roxx' => 'poproxx', 'front 242' => 'f242', 'male or female' => 'morf', 'kitten on the keys' => 'kitten', 'jay walker' => 'jay', 'diamond daggers' => 'daggers', 'good vibrations' => 'goodvibes', 'catherine d\'lish' => 'c d\'l', 'smash-up derby' => 'sud', 'stromkern' => 'sk', 'scenic sisters' => 'scenics', 'hubba hubba revue' => 'hubba', 'mynx d\'meanor' => 'mynx', 'rj owens' => 'rj', 'deathline international' => 'dli', 'devil-ettes' => 'de', 'devilettes' => 'de', 'rock and roll adventure kids' => 'kids', 'phenomenauts' => 'pnauts', 'bawdy island beach party a go-go' => 'bawdy', 'bawdy island' => 'bawdy', 'groovie ghoulies' => 'ghoulies', 'meat vs. death guild' => 'meatguild', 'equilibrium' => 'eq', 'ignite sf' => 'ignite', ); # Given the body of a gallery page, extracts the bands mentioned in the # title or subheadings. Returns a downcased list of them all. # sub page_to_xrefs($) { my ($body) = @_; my ($title) = ($body =~ m@\s*(.*?)\s*@si); # also extract any subheadings in the body $body =~ s%([^<>\n]*?)% my $x = $1; if (! ($x =~ m@^(Photos|<|>)@i)) { $title .= " + $x"; } %xegsi; $title =~ s/^DNA Lounge:\s*//si; # lose heading $title =~ s/:\s+/ + /gsi; # split at ": " or at " + " my @xrefs = (); my %dups = (); foreach my $act (split (/\s*\+\s*/, $title)) { $act =~ s/,.*$//gsi; # truncate at comma $act =~ s/^.*@\s*//gsi; # "Groundscore @ d:CODE" $act =~ s/^[nd]:(C[oř0]DE)/CODE/gsi; # merge various CODEs $act =~ s/\s+20\d\d\b//gsi; # take off year $act =~ s/[^a-z\d]*$//gsi; # lose trailing non-alpha $act =~ s/^The\s*//gsi; $act =~ s/(.*)/\L$1/gsi; push @xrefs, $act unless ($dups{$act}); $dups{$act} = 1; } return @xrefs; } # Populate the %xrefs table with the contents of every gallery: # load each index and parse each title to construct the table. # sub load_xrefs($) { my ($dir) = @_; local *GDIR; opendir (GDIR, "$dir") || error ("$dir: $!"); my @gfiles = sort { $b cmp $a } (readdir (GDIR)); closedir GDIR; $dir .= "/" unless ($dir =~ m@/$@); $dir = "" if $dir eq "./"; print STDERR "$progname: scanning xrefs in $dir\n" if ($verbose > 2); foreach my $year (@gfiles) { next unless ($year =~ m/^\d{4}$/); local *YDIR; opendir(YDIR, "$dir$year") || error ("$dir$year: $!"); my @yfiles = sort { $b cmp $a } (readdir (YDIR)); closedir YDIR; foreach my $gallery (@yfiles) { next unless ($gallery =~ m/^(\d\d)-(\d\d)$/); my ($month, $dotm) = ($1, $2); my $date = "$year/$gallery"; my $file = "$dir$date/index.html"; local *IN; my $body = ''; open (IN, "<$file") || error ("$file: $!"); while () { $body .= $_; } close IN; my @acts = page_to_xrefs ($body); $xref_acts{$date} = \@acts; foreach my $key (@acts) { my $valP = $xrefs{$key}; my @val = (defined($valP) ? @$valP : ()); my %dups = (); foreach (@val) { $dups{$_} = 1; } unshift @val, $date unless ($dups{$date}); $xrefs{$key} = \@val; } } } if ($verbose > 3) { print STDERR "$progname: xrefs:\n"; foreach my $key (sort (keys (%xrefs))) { my $valP = $xrefs{$key}; my @val = @$valP; my $join = ",\n$progname: " . (' ' x 31); print STDERR "$progname: " . sprintf("%-30s ", $key) . join ($join, @val) . "\n"; } } } # Constructs a URL with minimal "../" action. # sub make_relative_link($$) { my ($self, $other) = @_; error ("no self") unless defined($self); error ("no other") unless defined($other); return $other if ($other =~ m!^(/|../)!); my ($self_year, $self_mon) = ($self =~ m!^(\d\d\d\d)/(.*)!); my ($other_year, $other_mon) = ($other =~ m!^(\d\d\d\d)/(.*)!); error ("unparsable: $self") unless ($self_year); error ("unparsable: $other") unless ($other_year); if ($self_year eq $other_year) { $other = "../$other_mon/"; } else { $other = "../../$other/"; } return $other; } # abbreviate a phrase, if there are multiple words in it. # sub abbreviate($) { my ($name) = @_; my $abbr = $abbreviations{$name}; return $abbr if defined($abbr); if ($name =~ m/\s/) { $name =~ s/([^\s])[^\s]+\b/$1/gs; $name =~ s/\s+//gs; } return $name; } # Given a list of names of acts on *this* page, and the date of a page we # intend this page to link to, returns a guess as to what name to use to # describe that link. That is, returns the first name that the two pages # have in common. # sub find_link_name($@) { my ($date, @names) = @_; $date =~ s@^(\.\./)+@@gs; $date =~ s@/$@@s; my $dnamesP = $xref_acts{$date}; error ("no xref_acts entry for $date") unless defined($dnamesP); my @dnames = @$dnamesP; my $result = undef; foreach my $name (@names) { foreach my $dname (@dnames) { if ($name eq $dname) { $result = $dname; last; } } last if ($result); } error ("no match in $date!\n" . "$progname: want: " . join(", ", @names) . "\n" . "$progname: in: " . join(", ", @dnames)) unless defined ($result); $result = abbreviate ($result); error ("WTF is this $1 doing here: $result") if ($result =~ m/(&;)/); return $result; } # Construct tags, and HTML for the "<< prev" and "next >>" parts # based on the body of this document and on the %xrefs table. # sub generate_links($$$$) { my ($file, $title, $body, $oheader_nav) = @_; my %links_table; # maps text to urls my %titles_table; # maps urls to anchor text my $prev_nav = ''; # html of the set of tags for the prev links my $next_nav = ''; # likewise # insert the default links. # $links_table{'shortcut icon'} = "/favicon.ico\" TYPE=\"image/x-icon"; $links_table{'top'} = "../../../"; $links_table{'up'} = "../"; my @acts = page_to_xrefs ($body); my ($date, $year) = ($file =~ m@\b((\d\d\d\d)/\d\d-\d\d)(/(index\.html)?)?$@); $titles_table{'../'} = "$year Photo Gallery"; my %already_done = (); # keys are: # YYYY/MM that have already been emitted, or # anchor-text that has already been emitted print STDERR "\n$date - $title\n" if ($debug > 1); foreach my $act (@acts) { my $xrefsP = $xrefs{$act}; my @xrefs = ($xrefsP ? @$xrefsP : ()); # list of the dates of $act my $first = $xrefs[0]; my $last = $xrefs[$#xrefs]; my $prev = undef; # date of $act before today my $next = undef; # date of $act after today $first = undef if ($date eq $first); $last = undef if ($date eq $last); while (@xrefs) { my $x = shift @xrefs; if ($x eq $date) { $next = shift @xrefs; last; } $prev = $x; } if ($debug > 1) { print STDERR ("\n" . " $act:\n" . " first: " . ($first ? $first : "-") . ($first && $already_done{$first} ? " [done]" : "") . "\n" . " prev: " . ($prev ? $prev : "-") . ($prev && $already_done{$prev} ? " [done]" : "") . "\n" . " next: " . ($next ? $next : "-") . ($next && $already_done{$next} ? " [done]" : "") . "\n" . " last: " . ($last ? $last : "-") . ($last && $already_done{$last} ? " [done]" : "") . "\n"); } my $fprev = $prev; my $fnext = $next; if (defined ($prev) && !$already_done{$prev}) { my $name = find_link_name ($fprev, @acts); $titles_table{$prev} = $name; if (!$already_done{"prev $name"}) { $prev_nav .= "<< prev $name
\n"; print STDERR "$progname: $date: emit \"prev $name\"\n" if ($verbose > 3); $already_done{$prev} = 1; $already_done{"prev $name"} = 1; } else { print STDERR "$progname: $date: already done \"prev $name\"\n" if ($verbose > 3); } } elsif (defined ($prev)) { print STDERR "$progname: $date: already done \"$prev\"\n" if ($verbose > 3); } if (defined ($next) && !$already_done{$next}) { my $name = find_link_name ($fnext, @acts); $titles_table{$next} = $name; if (!$already_done{"next $name"}) { $next_nav .= "next $name >>
\n"; print STDERR "$progname: $date: emit \"next $name\"\n" if ($verbose > 3); $already_done{$next} = 1; $already_done{"next $name"} = 1; } else { print STDERR "$progname: $date: already done \"next $name\"\n" if ($verbose > 3); } } elsif (defined ($next)) { print STDERR "$progname: $date: already done \"$next\"\n" if ($verbose > 3); } $titles_table{$first} = find_link_name ($first, @acts) if (defined ($first)); $titles_table{$last} = find_link_name ($last, @acts) if (defined ($last)); # For the tags, take the earliest "first" and "next" we've seen. # take the latest "last" and "prev" we've seen. my $ofirst = $links_table{'first'}; my $olast = $links_table{'last'}; my $oprev = $links_table{'prev'}; my $onext = $links_table{'next'}; $first = $ofirst if (!defined($first) || (defined($ofirst) && $ofirst lt $first)); $last = $olast if (!defined($last) || (defined($olast) && $olast gt $last)); $prev = $oprev if (!defined($prev) || (defined($oprev) && $oprev gt $prev)); $next = $onext if (!defined($next) || (defined($onext) && $onext lt $next)); $links_table{'first'} = $first; $links_table{'last'} = $last; $links_table{'prev'} = $prev; $links_table{'next'} = $next; } my $links = ''; foreach my $key ('shortcut icon', 'top', 'up', 'first', 'prev', 'next', 'last') { my $href = $links_table{$key}; next unless defined ($href); my $title = $titles_table{$href}; $title = "$key $title" if ($title && !($key =~ m/^up$/)); $href = make_relative_link ($date, $href); $links .= " 3); } sub navcmp($$) { my ($a, $b) = @_; $a =~ s@\"(\.\./)+@@gs; $b =~ s@\"(\.\./)+@@gs; return $a cmp $b; } $next_nav = join("\n", sort {navcmp($a,$b)} (split(/\n/, $next_nav))) . "\n"; $prev_nav = join("\n", sort {navcmp($b,$a)} (split(/\n/, $prev_nav))) . "\n"; my $header_nav = ("<< up
\n" . $prev_nav . $next_nav); if ($debug > 1) { print STDERR "\n Finally:\n"; my @lines = split (m/\n/, $header_nav); shift @lines if ($#lines >= 0); foreach (@lines) { my ($href, $name) = m/HREF=\"([^\"\s]+).*((prev|next)[^<>&]+)/si; $name =~ s/\s+$//s; print STDERR " $name: $href\n"; } print STDERR "\n"; } # Shrink all URLs to minimal relativism (after sorting!) $header_nav =~ s@(HREF=\")([^<>\"\s]+) @{$1 . make_relative_link ($date, $2) }@gxei; $header_nav =~ s/\n\n+/\n/gs; $header_nav =~ s@
\s*$@@si; # lose trailing BR $header_nav = "$header_nav"; $header_nav =~ s/^/ /gm; $header_nav =~ s/^\s*//gs; # put spaces after any << lines, if they aren't there already. # but only if there are any >> lines. if ($header_nav =~ m@>>@) { $header_nav =~ s@(<<\s[^<>]+)([ \t]*[<\n]) @$1     $2@xgs; } return ($links, $header_nav); } # 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; } # Make sure the date in the HTML is the right one for the file name # and has a correct link into the calendar around it. # sub fix_dates($$) { my ($file, $html) = @_; my ($head, $dhref, $date, $tail) = ($html =~ m@^(.*?) (]*>) \s* ([a-z][a-z][a-z],\s\d\d?\s[a-z][a-z][a-z]+\s\d\d\d\d)\b (.*)$@xsi); error ("$file: unparsable date") unless defined ($date); my ($yyyy, $mm, $dd) = ($file =~ m@(\d\d\d\d)/(\d\d)-(\d\d)/index\.html$@); error ("$file: unparsable filename") unless defined ($dd); # regenerate the date and splice it back in. my $mmm = $months[$mm-1]; my $ddd = $days[dotw($dd, $mm, $yyyy)]; $mmm =~ s/^(...).*$/$1/; $ddd =~ s/^(...).*$/$1/; $date = sprintf ("%s, %02d %s %d", $ddd, $dd, $mmm, $yyyy); $dhref = ""; $html = $head . $dhref . $date . $tail; # Sanity-check the flyer link, if any # my ($full_flyer, $rel_flyer, $flyer_d1, $flyer_d2) = ($html =~ m@HREF=\"(.*?\bflyers/(((\d\d\d\d/\d\d)/\d\d)-[^\"]+))\"@); if (defined ($rel_flyer)) { my $ffile = $file; $ffile =~ s@/[^/]*$@/@; $ffile .= $full_flyer; 1 while ($ffile =~ s@[^/]+/\.\./@@); print STDERR "$progname: $file: no such flyer: $ffile\n" unless (-f $ffile); my $test_dotm = 0; #### if ($test_dotm ? $flyer_d1 ne "$yyyy/$mm/$dd" : $flyer_d2 ne "$yyyy/$mm") { print STDERR "$progname: $yyyy/$mm/$dd/: wrong flyer: $rel_flyer\n"; } } return $html; } # 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; } # Clean up the HTML in the head/tail of the given gallery index file. # Returns the title of the gallery. # sub wrap_gallery_1($$$) { my ($file, $wrap_images_p, $check_thumbs_p) = @_; local *IN; my $ocontents = ''; open (IN, "<$file") || error ("$file: $!"); print STDERR "$progname: reading $file\n" if ($verbose > 2); while () { $ocontents .= $_; } close IN; my $contents = $ocontents; $_ = $contents; ####################################### # Sectionize the whole document ####################################### my ($title) = m@\s*(.*?)\s*@; error ("$file: no title?") unless (defined($title)); error ("$file: title doesn't begin with DNA Lounge?") unless ($title =~ m/^DNA Lounge: /); my ($body) = m@]*>(.*).*$@xis; error ("$file: unparsable ") unless (defined ($body)); my ($header, $post_header) = ($body =~ m@^\s*? ([ \t]*\n) (.*)$@xsi); error ("$file: no top TABLE?") unless (defined($header)); my ($main_body, $footer) = ($post_header =~ m@^(.*?)([ \t]*]*>.*?)$@si); error ("$file: no footer?") unless (defined($footer)); ####################################### # Sectionize the header table ####################################### my ($header_start, $header_attrib, $header_mid, $header_nav, $header_end) = ($header =~ m@^(\s* ]*>\s* ]*>\s* ]*>\s* .*? \s* # logo cell ]*>\s*) (.*?) (\s* # attrib cell ]*>\s*) (.*?) (\s* # nav cell \s* \s*)$@xsi); error ("$file: no header nav?") unless (defined($header_nav)); ####################################### # Reconstruct the static parts. ####################################### $header_start = ("\n" . " \n" . " \n" . " \n" . " \n" . " \n" . "
"); $header_mid = ("\n" . " "); $header_end = ("
\n"); ####################################### # Clean up the changing parts ####################################### my $links; ($links, $header_nav) = generate_links ($file, $title, $ocontents, $header_nav); $header_attrib = fix_dates ($file, $header_attrib); # Just clone the $header_nav html into the footer. # If it's multi-line, wrap it in a table. if ($header_nav =~ m@<(BR|P)\b@) { $_ = $header_nav; s/\n/\n /gs; $footer = ("

\n" . " \n" . " \n" . " \n" . " \n" . "
\n" . " $_
\n"); } else { $footer = ("

\n" . " $header_nav
\n"); } ####################################### # Put the sections back together ####################################### $header = ($header_start . $header_attrib . $header_mid . $header_nav . $header_end); $contents = $body_template; $contents =~ s@(]*>).*()@$1$title$2@s; $contents =~ s@([ \t]*]*>\n)+@$links@s; $contents =~ s@(]*>).*() @$1\n\n$header$main_body$footer

\n $2@xs; $contents =~ s/([^\s])[ \t]+($file_tmp") || error ("$file_tmp: $!"); print OUT $contents || error ("$file_tmp: $!"); close OUT; validate_html ($file_tmp); if ($debug) { print STDERR "$progname: diffing $file\n"; system ("diff -u $file $file_tmp"); unlink "$file_tmp"; } else { if (!rename ("$file_tmp", "$file")) { unlink "$file_tmp"; error ("mv $file_tmp $file: $!"); } print STDERR "$progname: wrote $file\n"; } } check_thumb_sizes ($file, $contents) if ($check_thumbs_p); if ($wrap_images_p) { my $dir = $file; $dir =~ s@/[^/]*$@@; local *IDIR; opendir (IDIR, "$dir") || error ("$dir: $!"); my @ifiles = sort { $b cmp $a } (readdir (IDIR)); closedir IDIR; foreach my $img (@ifiles) { next unless ($img =~ m/^(\d+)\.html$/); wrap_gallery_image_1 ("$dir/$img", $contents); } } return $title; } # Clean up the HTML in the head/tail of the given NNN.html image wrapper file. # The 'template' arg is the contents of the index.html file in this dir. # sub wrap_gallery_image_1($$) { my ($file, $template) = @_; local *IN; my $ocontents = ''; open (IN, "<$file") || error ("$file: $!"); print STDERR "$progname: reading $file\n" if ($verbose > 2); while () { $ocontents .= $_; } close IN; my $contents = $ocontents; $_ = $contents; ####################################### # Sectionize the whole document ####################################### my ($title) = m@\s*(.*?)\s*@; error ("$file: no title?") unless (defined($title)); error ("$file: title doesn't begin with DNA Lounge?") unless ($title =~ m/^DNA Lounge: /); my ($links) = m@(([ \t]*]*>[ \t]*\n)+)@is; error ("$file: no tags?") unless (defined ($links)); my ($body) = m@]*>(.*).*$@xis; error ("$file: unparsable ") unless (defined ($body)); ####################################### # Put the sections back together ####################################### $contents = $template; $contents =~ s@(]*>).*()@$1$title$2@s; $contents =~ s@([ \t]*]*>\n)+@$links@s; $contents =~ s@(]*>).*()@$1$body$2@s; if ($contents eq $ocontents) { print STDERR "$file unchanged\n" if ($verbose); # validate_html ($file); } else { local *OUT; my $file_tmp = "$file.tmp"; open (OUT, ">$file_tmp") || error ("$file_tmp: $!"); print OUT $contents || error ("$file_tmp: $!"); close OUT; validate_html ($file_tmp); if ($debug) { print STDERR "$progname: diffing $file\n"; system ("diff -u $file $file_tmp"); unlink "$file_tmp"; } else { if (!rename ("$file_tmp", "$file")) { unlink "$file_tmp"; error ("mv $file_tmp $file: $!"); } print STDERR "$progname: wrote $file\n"; } } } # Print a warning if any of the IMG tags have sizes that don't match # the sizes of the inlined files themselves. # sub check_thumb_sizes($$) { my ($filename, $body) = @_; my $dir = $filename; $dir =~ s@/[^/]*$@/@; foreach (split (//dev/null | head -2"; open (IN, "$cmd |") || error ("$cmd: $!"); $_ = || error ("$thumb unreadable"); $_ = || error ("$thumb unreadable"); my ($file_w, $file_h) = m/^(\d+)\s+(\d+)$/; close IN; error ("$thumb file unparsable") unless ($file_w && $file_h); if ($tag_w != $file_w || $tag_h != $file_h) { print STDERR "$progname: WARNING: $thumb is " . "${file_w}x$file_h, not ${tag_w}x$tag_h\n"; } } } # Iterate over all of the gallery files and call wrap_gallery_1 on # each of the DIR/YYYY/MM-DD/index.html files. # sub wrap_gallery($$$) { my ($dir, $wrap_images_p, $check_thumbs_p) = @_; load_xrefs ($dir); load_template (); local *GDIR; opendir (GDIR, "$dir") || error ("$dir: $!"); my @gfiles = sort { $b cmp $a } (readdir (GDIR)); closedir GDIR; $dir .= "/" unless ($dir =~ m@/$@); $dir = "" if $dir eq "./"; my $first_year = 99999; my $last_year = 0; foreach my $year (@gfiles) { next unless ($year =~ m/^\d{4}$/); $first_year = $year if ($year < $first_year); $last_year = $year if ($year > $last_year); } foreach my $year (@gfiles) { next unless ($year =~ m/^\d{4}$/); local *YDIR; opendir(YDIR, "$dir$year") || error ("$dir$year: $!"); my @yfiles = sort { $b cmp $a } (readdir (YDIR)); closedir YDIR; my $year_html = ""; foreach my $gallery (@yfiles) { next unless ($gallery =~ m/^(\d\d)-(\d\d)$/); my ($month, $dotm) = ($1, $2); my $file = "$dir$year/$gallery/index.html"; my $mmm = $months[$month-1]; my $ddd = $days[dotw($dotm, $month, $year)]; $mmm =~ s/^(...).*$/$1/; $ddd =~ s/^(...).*$/$1/; my $date = sprintf ("%s, %02d %s %d", $ddd, $dotm, $mmm, $year); my $title = wrap_gallery_1 ($file, $wrap_images_p, $check_thumbs_p); $title =~ s/^DNA Lounge:\s*//si; if ($title =~ s@(\s*[-+:]|\s+vs\.)\s@$1 @gsi) { $title = "$title"; } $year_html = (" \n" . " \n" . " " . "$date:   " . "" . "\n" . " " . "$title" . "\n" . " \n" . $year_html); } my $prev_year = $year-1; my $next_year = $year+1; my $first_p = ($year != $first_year); my $last_p = ($year != $last_year); my $prev_p = (-d "$dir$prev_year"); my $next_p = (-d "$dir$next_year"); my ($prev_a, $prev_b) = ($prev_p ? ("", "") : ("", "")); my ($next_a, $next_b) = ($next_p ? ("", "") : ("", "")); $year_html = ("DNA Lounge: Photo Gallery: $year\n" . " \n" . " \n" . ($prev_p ? " \n" : "") . ($next_p ? " \n" : "") . ($first_p ? " \n" : "") . ($last_p ? " \n" : "") . "\n" . "\n" . "\n" . "\n" . "

\n" . "\n" . " \n" . " \n" . " \n" . " \n" . "
\n" . " $prev_a<< $prev_year$prev_b\n" . " $next_a$next_year >>$next_b
\n" . "\n" . "\n" . "

\n" . "\n" . "$year Photo Gallery\n" . "\n" . "

\n" . "\n" . $year_html . "
\n" . "

\n" . "\n"); write_file_if_changed ("$dir$year/index.html", $year_html, 1); } } ############################################################################## # # Writing files # lifted from calendar/generate-calendar.pl; # only used for the gallery/YYYY/index.html files, # not for the gallery/YYYY/MM-DD/index.html files. # ############################################################################## # Returns true if the two files differ (by running "cmp") # sub cmp_files($$) { my ($file1, $file2) = @_; my @cmd = ("cmp", "-s", "$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; } sub diff_files($$) { my ($file1, $file2) = @_; my @cmd = ("diff", "-U2", "$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) { 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); print STDERR "$progname: rm $file_tmp\n" if ($verbose > 1); } } # Write the given body to the file, but don't alter the file's # date if the new content is the same as the existing content. # If $menuify_p is true, runs @menuify_cmd on the file as well. # sub write_file_if_changed($$$) { my ($outfile, $body, $menuify_p) = @_; local *OUT; my $file_tmp = "$outfile.tmp"; open(OUT, ">$file_tmp") || error ("$file_tmp: $!"); print OUT $body || error ("$file_tmp: $!"); close OUT || error ("$file_tmp: $!"); if ($menuify_p) { my @cmd = @menuify_cmd; if ($verbose > 1) { push @cmd, ("-" .("v" x ($verbose - 1))); } push @cmd, $file_tmp; 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); error ("$cmd[0]: exited with $exit_value!") if ($exit_value); } rename_or_delete ("$outfile", "$file_tmp"); } sub error($) { my ($err) = @_; print STDERR "$progname: $err\n"; exit 1; } sub usage() { print STDERR "usage: $progname [--verbose] [--debug] [--all] [--check] " . "directory\n"; exit 1; } sub main() { my $dir = undef; my $wrap_images_p = 0; my $check_thumbs_p = 0; while ($_ = $ARGV[0]) { shift @ARGV; if ($_ eq "--verbose") { $verbose++; } elsif (m/^-v+$/) { $verbose += length($_)-1; } elsif ($_ eq "--debug") { $debug++; } elsif ($_ eq "--all") { $wrap_images_p++; } elsif ($_ eq "--check") { $check_thumbs_p++; } elsif (m/^-./) { usage; } elsif (!defined($dir)) { $dir = $_; } else { usage; } } usage unless defined($dir); $dir =~ s@/+$@@; wrap_gallery ($dir, $wrap_images_p, $check_thumbs_p); } main(); exit 0;