#!/usr/bin/perl -w
# Copyright © 2001-2007 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.
#
# Created: 20-Jul-01.
#
# This updates the .htaccess file to change the redirects for the various
# "latest.html" pseudo-files for calendar-like things.

require 5;
use diagnostics;
use strict;

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

my $verbose = 0;

my $base_head_1 = "";
my $base_url_1  = "http://www.dnalounge.com";

my $base_head_2 = "/dna";
my $base_url_2  = "http://traitor.jwz.org$base_head_2";


sub calendar_latest($$$$$) {
  my ($dotm, $month, $year, $base_head, $base_url) = @_;
  return (         "$base_head/calendar/latest.html",
          sprintf ("$base_url/calendar/%04d/%02d.html", $year, $month+1));
}

sub flyer_latest($$$$$) {
  my ($dotm, $month, $year, $base_head, $base_url) = @_;
  return (         "$base_head/flyers/latest.html",
          sprintf ("$base_url/flyers/%04d/%02d/", $year, $month+1));
}

sub gallery_latest($$$$$) {
  my ($dotm, $month, $year, $base_head, $base_url) = @_;
  my $gdir = "gallery";

  my @files;
  local *DIR;

  opendir(DIR, "$gdir") || error ("$gdir: $!");
  @files = readdir (DIR);
  closedir DIR;
  my $yyyy;
  foreach (sort { $b cmp $a } @files) {
    if (m/^\d{4}$/) {
      $yyyy = $_;
      last;
    }
  }
  return () unless $yyyy;

#  opendir(DIR, "$gdir/$yyyy") || error ("$gdir/$yyyy: $!");
#  @files = readdir (DIR);
#  closedir DIR;
#  my $mm_dd;
#  foreach (sort { $b cmp $a } @files) {
#
#    if (m/^\d{2}-\d{2}$/) {
#      $mm_dd = $_;
#      last;
#    }
#  }
#  return () unless $mm_dd;

  return ("$base_head/gallery/latest.html",
#         "$base_url/gallery/$yyyy/$mm_dd/"
          "$base_url/gallery/$yyyy/"
         );
}


sub update_htaccess($) {
  my ($dir) = @_;

  local *IN;

  my ($sec,$min,$hour,$dotm,$mon,$year,$wday,$yday,$isdst) = localtime;
  $year += 1900;

  my @redirects = ();

  my $u1 = $base_url_1;
  my $u2 = $base_url_2;
  my $h1 = $base_head_1;
  my $h2 = $base_head_2;

  push @redirects, calendar_latest ($dotm, $mon, $year, $h1, $u1);
  push @redirects, calendar_latest ($dotm, $mon, $year, $h2, $u2);
  push @redirects, flyer_latest    ($dotm, $mon, $year, $h1, $u1);
  push @redirects, flyer_latest    ($dotm, $mon, $year, $h2, $u2);
  push @redirects, gallery_latest  ($dotm, $mon, $year, $h1, $u1);
  push @redirects, gallery_latest  ($dotm, $mon, $year, $h2, $u2);

  my $file = "$dir/.htaccess";

  my $body = "";
  open (IN, "<$file") || error ("$file: $!");
  while (<IN>) { $body .= $_; }
  close IN;

  my $changed = 0;

  while (my $from = shift @redirects) {
    my $to = shift @redirects;
    my $from_re = qr/$from/;
#    if ($body =~ s@^(Redirect\s+\d\d\d\s+$from_re\s+)(.*)$@$1$to@img) {
    if ($body =~ m@^(Redirect\s+\d\d\d\s+$from_re\s+)(.*)$@im) {
      $body   =~ s@^(Redirect\s+\d\d\d\s+$from_re\s+)(.*)$@$1$to@im;
      my $old = $2;
      if ($to eq $old) {
        print STDERR "$progname: $from -> $to (unchanged)\n" if ($verbose > 3);
      } else {
        $changed++;
        print STDERR "$progname: $from -> $to (was $old)\n" if ($verbose > 2);
      }
    } else {
      error ("didn't find \"$from\" redirector in $file");
    }
  }

  if ($changed) {
    local *OUT;
    open (OUT, ">$file") || error ("$file: $!");
    print OUT $body || error ("$file: $!");
    close OUT;
    print STDERR "$progname: wrote $file\n" if ($verbose);
  } else {
    print STDERR "$progname: $file unchanged\n" if ($verbose > 1);
  }
}


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

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

sub main() {
  my $dir;
  while ($_ = $ARGV[0]) {
    shift @ARGV;
    if ($_ eq "--verbose") { $verbose++; }
    elsif (m/^-v+$/) { $verbose += length($_)-1; }
    elsif (m/^-./) { usage; }
    elsif (!defined($dir)) { $dir = $_; }
    else { usage; }
  }

  usage unless defined($dir);
  update_htaccess ($dir);
}

main();
exit 0;