#!/usr/bin/perl -w
# Copyright © 2002-2012 Jamie Zawinski <jwz@dnalounge.com>
#
# 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.
#
# Splice /calendar/thumbs.html and /gallery/snapshots.html into /index.html.
# Created: 13-Feb-2002.

require 5;
use diagnostics;
use strict;

# Utter foulness!  Without this, [:upper:] doesn't work on Latin1 characters.
use locale;
use POSIX qw(locale_h mktime);
setlocale(LC_ALL, "en_US");


my $progname = $0; $progname =~ s@.*/@@g;
my $version = q{ $Revision: 1.28 $ }; $version =~ s/^[^0-9]+([0-9.]+).*$/$1/;

my $verbose = 0;
my $debug_p = 0;

my $thumbs_file    = "calendar/thumbs.html";
my $snapshots_file = "gallery/snapshots.html";


sub read_component($$) {
  my ($file, $name) = @_;

  open (my $in, '<', $file) || error ("$file: $!");
  local $/ = undef;  # read entire file
  my $body = <$in>;
  close $in;

  print STDERR "$progname: read $file\n" if ($verbose > 2);

  if (! ($body =~ s@^.*
                   <!--\s*%%$name _START%%\s*-->
                   \s*(.*?)\s*
                   <!--\s*%%$name _END%%\s*-->
                   .*$
                   @$1@xs)) {
    error ("$file: no %%${name}_START/END%% markers?");
  }

  $body =~ s/^\n+//s;
  $body =~ s/\s*$/\n/s;

  # Correct relative HREFs by inserting "$dir/" at the front.
  #
  my $dir = $file;
  $dir =~ s@/[^/]*$@/@;
  $dir =~ s@^\./@@;
  $body =~ s@\b((SRC|HREF)\s*=\s*\")([^\"<>:]+\")@$1$dir$3@g;

  # Clean up URLs by short-circuiting "foo/../" to ""
  #
  $body =~ s@\b((SRC|HREF)\s*=\s*\")([^\"<>/:]+/\.\./)@$1@g;

  return $body;
}


sub splice_component($$$$) {
  my ($component, $into, $into_file, $name) = @_;

  if (! ($into =~ s/\s*
                    (<!--\s*%% $name _START%%\s*-->)
                    [ \t]*\n
                    (.*)
                    (<!--\s*%% $name _END%%\s*-->)
                    [ \t]*\n
                    /\n$1\n$component$3\n/xs)) {
    error ("$into_file: no %%${name}_START/END%% namewords\n");
  } elsif ($verbose > 2) {
    print STDERR "$progname: $into_file: patched %%$name%%\n";
  }

  return $into;
}


sub splice_all($$) {
  my ($from_file, $into_file) = @_;

  my $thumbs = read_component ($thumbs_file,    "THUMBS");
  my $snaps  = read_component ($snapshots_file, "SNAPSHOTS");

  open (my $in, '<', $from_file) || error ("$from_file: $!");
  local $/ = undef;  # read entire file
  my $body = <$in>;
  close $in;

  print STDERR "$progname: read $from_file\n" if ($verbose > 2);

  $body = splice_component ($thumbs, $body, $from_file, "THUMBS");
  $body = splice_component ($snaps,  $body, $from_file, "SNAPSHOTS");

  if ($debug_p) {
    print STDERR "$progname: not writing $into_file\n";
  } else {
    open (my $out, '>', $into_file) || error ("$into_file: $!");
    (print $out $body) || error ("$into_file: $!");
    close $out;
    print STDERR "$progname: wrote $into_file\n" if ($verbose);
  }
}


sub error($) {
  my ($err) = @_;
  print STDERR "$progname: $err\n";
  exit 1;
}

sub usage() {
  print STDERR "usage: $progname [--verbose] template-file into-file\n";
  exit 1;
}

sub main() {
  my ($from, $into);

  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 (m/^-v+$/) { $verbose += length($_)-1; }
    elsif ($_ eq "--debug") { $debug_p++; }
    elsif (m/^-./) { usage; }
    elsif (!defined ($from)) { $from = $_; }
    elsif (!defined ($into)) { $into = $_; }
    else { usage; }
  }

  # When writing files, make permissions match the parent directory
  # by computing a umask from the directory's permissions.
  #
  umask (~((stat("."))[2] & 0666) & 0666);

  usage() unless ($from && $into);
  error ("to and from are the same?") if ($from eq $into);

  splice_all ($from, $into);
}

main();
exit 0;