#!/usr/bin/perl -w
# Copyright © 2000-2009 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:  4-Nov-00.

require 5;
use diagnostics;
use strict;

BEGIN { push @INC, "utils/"; }
use Menuify;

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

my $verbose = 1;
my $debug_p = 0;  # this means "don't alter any files, print diffs instead"

my $latest_tag =
  q{^(Redirect 30\d\s+(.*?/backstage/log/)latest\.html\s+[^\s]+\2)([^\n]*)(.*)};

my $title = "DNA Sequencing";
my $columns = 3;
my $margin_left = 10;
my $margin_x = 60;
my $margin_y = 16;

my $xml_link_tag =
  "  <LINK REL=\"alternate\" TYPE=\"application/rss+xml\" TITLE=\"RSS\"" .
         " HREF=\"latest.rss\">\n";

my @all_day_files;
my @all_month_files;


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

  local *LDIR;
  opendir (LDIR, $dir) || error ("$dir: $!");

  my $prev_month;
  my $prev_day;
  foreach my $year (sort (readdir (LDIR))) {
    next unless ($year =~ m/^\d{4}$/s);
    local *YDIR;
    opendir(YDIR, "$dir/$year") || error ("$dir/$year: $!");

    foreach my $month (sort (readdir (YDIR))) {
      next unless ($month =~ m/^\d\d$/s);

      $month = "$year/$month";
      push @all_month_files, $month;
      $prev_month = $month;

      local *MDIR;
      opendir(MDIR, "$dir/$month") || error ("$dir/$month: $!");

      foreach my $day (sort (readdir (MDIR))) {
        next unless ($day =~ m/^\d\d\.html$/s);
        $day = "$month/$day";

        push @all_day_files, $day;
        $prev_day = $day;
      }
      closedir (MDIR);
    }
    closedir (YDIR);
  }
  closedir (LDIR);
}


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

  my @months = ("January", "February", "March", "April", "May", "June", "July",
                "August", "September", "October", "November", "December");

  my $output = ("<TITLE>DNA Lounge: $title</TITLE>\n" .
                $xml_link_tag .
                "  <LINK REL=\"top\"   HREF=\"../../\">\n" .
                "  <LINK REL=\"up\"    HREF=\"../\">\n" .
                "\n" .
                "<!-- %%RIGHT_START%% -->\n" .
                "<!-- %%BLOG_HEADER%% -->\n" .
                "<DIV>\n" .
                "</DIV>\n" .
                "\n" .
                "<P>\n" .
                "<DIV ALIGN=CENTER>\n" .
                " <TABLE BORDER=0 CELLPADDING=0 CELLSPACING=0>\n" .
                "  <TR>\n" .
                "   <TD NOWRAP ALIGN=RIGHT VALIGN=TOP>\n");

  my $first_year = $all_month_files[0];
  my $last_year  = $all_month_files[$#all_month_files];
  $first_year =~ s/^(\d+).*$/$1/s;
  $last_year  =~ s/^(\d+).*$/$1/s;
  my $nyears = $last_year - $first_year;

  my $col = 0;

  my $rows = int (($nyears + 1 + $columns) / $columns) * 12;

  print STDERR "$progname: $columns x $rows grid of $nyears.\n"
    if ($verbose > 1);

  unshift @all_month_files, "1998-1999.html";
  unshift @all_month_files, "1906-1998.html";

  my @all_months = ();
  my $x = 0;
  my $y = 0;
  foreach my $month (@all_month_files) {

    if ($y >= $rows) {
      $y = 0;
      $x++;
      $output .= ("   </TD>\n" .
                  "   <TD NOWRAP WIDTH=60></TD>\n" .
                  "   <TD NOWRAP ALIGN=RIGHT VALIGN=TOP>\n");
    } else {
      $output .= "    <BR>\n" if ($y > 0 && 0 == ($y % 12));
    }

    my ($yyyy, $mm) = ($month =~ m@\b(\d{4})/(\d\d)/?$@s);
    my $label;
    if ($mm) {
      $mm = $months[$mm - 1];
      $label = "$mm $yyyy";
      $month .= "/";
    } else {
      ($label) = ($month =~ m@^(.*)\.html$@);
    }
    $output .= "    <A HREF=\"$month\">$label</A><BR>\n";
    print STDERR "$progname:  $x,$y: ==> $label\n" if ($verbose > 1);
    $y++;
  }
  $output .= ("   </TD>\n" .
              "  </TR>\n" .
              " </TABLE>\n" .
              "</DIV>\n" .
              "<!-- %%RIGHT_END%% -->\n");


  my $file = "$dir/index.html";
  DNA::Menuify::write_file ($file, $output);
}


sub build_month_index($$$$@) {
  my ($dir, $month_file, $prev, $next, @day_files) = @_;

  # Construct YYYY/MM/index.html from the YYYY/MM/DD.html files.
  #
  my $output = '';
  foreach my $day (@day_files) {

    print STDERR "$progname: appending $dir/$day\n" if ($verbose > 1);
    local *IN;
    my $body = '';
    open (IN, "<$dir/$day") || error ("$dir/$day: $!");
    while (<IN>) { $body .= $_; }
    close IN;
    $body =~ s/^.*?(<!-- %%SUBHEADING%% -->)/$1/s;
    $body =~ s/<!-- %%BLOG_FOOTER%% -->.*?$//s;

    $day =~ s@^.*/@@s;
    my $com = "<DIV CLASS=\"comments\"><A HREF=\"$day\">" .
              "Comments &gt;&gt;</A></DIV>\n";
    $body =~ s@(<P>\s*)?(<DIV ID="fbcomments">.*?</DIV>\s*)@$com@si;

    $output .= "$body\n\n";
  }

  $output =~ s/\n\n\n+/\n\n/gs;

  my $xml = $xml_link_tag;
  $xml =~ s@HREF="@HREF="../../@s;

  $output = ("$xml\n" .
             "<!-- %%LEFT_START%% -->\n" .
             "<!-- %%BLOG_LEFT%% -->\n" .
             "<DIV>\n" .
             "</DIV>\n" .
             "\n" .
             "<!-- %%LEFT_END%% -->\n" .
             "\n" .
             "<!-- %%RIGHT_START%% -->\n" .
             "<!-- %%BLOG_HEADER%% -->\n" .
             "<DIV>\n" .
             "</DIV>\n" .
             "\n" .
             $output .
             "\n" .
             "<!-- %%BLOG_FOOTER%% -->\n" .
             "<DIV>\n" .
             "</DIV>\n" .
             "\n" .
             "<!-- %%RIGHT_END%% -->\n" .
             "\n");

  DNA::Menuify::write_file ("$dir/$month_file", $output);
}


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

  my $tag;
  my $redir = "$file";
  $redir =~ s@/(\d\d)\.html@/#$1@s;

  $file = "$dir/.htaccess";
  while ($file =~ m@/[^/.]+/\.\./@) {
    $file =~ s@/[^/.]+/\.\./@/@;
  }

  my $body = "";
  open (IN, "<$file") || error ("$file: $!");

  my $found = 0;
  my $changed = 0;
  while (<IN>) {
    my $line = $_;
    if (m@$latest_tag@s) {
      print STDERR "$progname:  matched: $1 * $3 * $4" if ($verbose > 2);
      $found = 1;
      $_ =~ s/$latest_tag/$1$redir$4/s;
      $changed = ($_ ne $line);
      print STDERR "$progname:  changed: $_" if ($verbose > 2 && $changed);
    }
    $body .= $_;
  }
  close IN;

  if (!$found) {
    print STDERR "$progname: didn't find redirector in $file!\n";
    exit 1;
  }

  if ($changed) {
    DNA::Menuify::write_file ("$file", $body);
  }
}


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

  scan_files ($dir);
  update_htaccess ($dir, $all_day_files[$#all_day_files]);

  my %month_days;

  foreach my $dfile (@all_day_files) {
    my ($yyyy, $mm, $dd) = ($dfile =~ m@^(\d{4})/(\d\d)/(\d\d)\.html@s);
    my $month_file = "$yyyy/$mm/index.html";
    my @o = (defined($month_days{$month_file})
             ? @{$month_days{$month_file}}
             : ());
    push @o, $dfile;
    $month_days{$month_file} = \@o;
  }

  my @month_files = sort (keys %month_days);
  for (my $i = $#month_files; $i >= 0; $i--) {
    my $file = $month_files[$i];
    build_month_index ($dir,
                       $file,
                       ($i == 0 ? undef : $month_files[$i-1]),
                       $month_files[$i+1],
                       @{$month_days{$file}});
  }

  build_year_index($dir);
}


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;

  error ("LANG is $ENV{LANG} -- UTF is no good, man!")
    if ($ENV{LANG} && $ENV{LANG} =~ m/utf/i);

  while ($_ = $ARGV[0]) {
    shift @ARGV;
    if    (m/^--?verbose$/s)           { $verbose++; }
    elsif (m/^-v+$/)                   { $verbose += length($_)-1; }
    elsif (m/^--?debug$/s)             { $debug_p++; }
    elsif (m/^-./)                     { usage; }
    elsif (!defined($dir))             { $dir = $_; }
    else                               { usage; }
  }

  usage unless $dir;
  $dir =~ s@/+$@@;

  $DNA::Menuify::verbose = $verbose;
  $DNA::Menuify::debug   = $debug_p;

  build_indexes ($dir);
}

main();
exit 0;