#!/usr/bin/perl -w
# Copyright © 2001-2013 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: 16-Jun-01.
#
# Given a set of MP3 file names, creates an HTML page that indexes into
# them.

require 5;
use diagnostics;
use strict;
use LWP::Simple qw($ua);

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

use POSIX qw(strftime);

BEGIN { my $exec_dir = $0; $exec_dir =~ s@/[^/]*$@@;
        push @INC, "$exec_dir/utils/"; 
      }
use Menuify;

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

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

my $audio_url_base = "http://cerebrum.dnalounge.com:8001/audio";

my $file_ext = "m3u";
my $file_bytes_per_second = 16000;   # the magic number for 128k mp3 files...


my $data_dir = $0; $data_dir =~ s@/[^/]*$@@;

my $intro_file    = "$data_dir/intro.html";
my $template_file = "$data_dir/utils/template.html";
my $html_base     = "http://www.dnalounge.com/";
my $names_file    = "calendar/names.txt";

my $max_age = 16;	# ignore any files older than this many days


my $rss_header = 
'<?xml version="1.0" encoding="UTF-8"?>
<rss version="2.0"
 xmlns:blogChannel="http://backend.userland.com/blogChannelModule"
 xmlns:content="http://purl.org/rss/1.0/modules/content/"
 xmlns:atom="http://www.w3.org/2005/Atom"
>
 <channel>
  <title>DNA Lounge Audio Archive</title>
  <link>http://www.dnalounge.com/webcast/archive/</link>
  <description>DNA Lounge Audio Archive</description>
  <language>en</language>
  <managingEditor>webmaster@dnalounge.com (DNA Lounge)</managingEditor>
  <webMaster>webmaster@dnalounge.com (DNA Lounge)</webMaster>
  <atom:link href="http://cerebrum.dnalounge.com/archive/archive.rss"
   rel="self" type="application/rss+xml" />
  <image>
   <title>DNA Lounge Audio Archive</title>
   <url>http://www.dnalounge.com/logo2.gif</url>
   <link>http://www.dnalounge.com/webcast/archive/</link>
   <width>144</width>
   <height>76</height>
   <description>DNA Lounge Audio Archive</description>
  </image>
';

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


my %start_times = ();

sub sort_files(@) {
  my (@files) = @_;
  my @files2 = ();
  foreach my $f (@files) {

    if (-l $f) {
      print STDERR "$progname: skipping symlink $f\n"
        if ($verbose > 1);
      next;
    }

    push @files2, $f;

    my $tf = $f;
    $tf =~ s@\.[^./]+$@.time@;

    # If we have a .time file, use its write date.
    #
    my $tt = (stat($tf))[9];

    # Otherwise, use the write date of the mp3 file, *minus* the length
    # in seconds of that file (that is, assume the write date is the date
    # at which the last data was written.)
    #
    if (!$tt) {
      my @st = stat($f);
      error "$f does not exist\n" unless ($st[9]);
      $tt = $st[9] - (int($st[7] / $file_bytes_per_second));
    }

    $start_times{$f} = $tt;
  }

  return sort { $start_times{$b} <=> $start_times{$a} } @files2;
}


my %event_names;

sub pull_names() {

  $ua->agent("$progname/$version");  # set user agent for all LWP::Simple calls

  my $body = '';
  my $nf = $names_file;
  my $www = "/var/www/dnalounge/";
  $nf = "${www}$nf" if (-f "${www}$nf");
  if (-f $nf) {
    print STDERR "$progname: reading $nf...\n" if ($verbose);
    open (my $in, '<', $nf) || error ("$nf: $!");
    local $/ = undef;  # read entire file
    $body = <$in>;
    close $in;
  } else {
    $nf = "${html_base}$nf";
    print STDERR "$progname: reading $nf...\n" if ($verbose);
    $body = LWP::Simple::get($nf) || '';
    error ("$nf: null response") unless $body;
  }

  my $count = 0;
  foreach my $line (split(/\n/, $body)) {
    my ($date, $pres, $name, $flyer) = split(m/\t/, $line);
    error ("$nf: unparsable: $line") unless ($name);
    $name =~ s/^\*//s;
    $event_names{$date} = [ $name, $flyer ];
    $count++;
  }
  error ("$nf: no names") unless $count;
  print STDERR "$progname: $count names\n" if ($verbose > 2);
}


sub load_event_description($) {
  my ($audio_file) = @_;

  my $time = $start_times{$audio_file};
  error ("$audio_file: no start time") unless $time;

  my $year = (localtime($time))[5] + 1900;
  my ($mm, $dd) = ($audio_file =~ m@\b(\d\d)-(\d\d[a-z]?)\.[a-z\d]*$@si);
  error ("unparsable file name: $audio_file") unless $dd;

  # Believe year in file name if it's there.
  $year = $1 if ($audio_file =~ m@\b(\d{4})/(\d\d)-(\d\d[a-z]?)\.[a-z\d]*$@si);

  my $key = "$year-$mm-$dd";
  my $N = $event_names{$key};

  if (! $N) {
#    error ("no names for $key: $audio_file");
    print STDERR "$progname: no names for $key: $audio_file\n"
      if ($verbose || $year >= 2010);
    return ($key, '');
  }
  my ($name, $flyer) = @$N;
  return ($name, $flyer);
}


sub make_listen_links($$$$$$) {
  my ($url_base, $interval, $start_time,
      $duration, $real_duration, $clickable) = @_;

  return "<B CLASS=\"l noclick\">Listen</B>"
    if (! $clickable);

  $duration -= $interval/2;
  $real_duration -= $interval/2;

  my $output = "";

  my $url = "$url_base.$file_ext";
  $output .= "<A HREF=\"$url\"><B CLASS=\"l\">Listen</B></A>";

  if ($real_duration <= $interval) {
    return $output;
  }

  $output .= "<P>\n";
  $output .= "<DIV CLASS=\"lbox\">";

  my @tt = localtime($start_time);
  my $start_h = $tt[2];
  my $start_m = $tt[1];
  my $start_s = $tt[0];

  my $midnight = ($start_time
                  - ($start_h * 60 * 60)
                  - ($start_m * 60)
                  - $start_s);
  my $off_from_hour = (($start_m > 30
                        ? (($start_m - 30) * 60)
                        : ($start_m * 60))
                       + $start_s);

  my $last_timestr = '';
  my $first_off = undef;
  my $end = $start_time + $real_duration;

  $output .= ("<SPAN CLASS=\"start_time\">" .
              strftime ("%l:%M:%S %p", localtime ($start_time)) .
              "</SPAN>" .
              "<SPAN CLASS=\"end_time\">" .
              strftime ("%l:%M:%S %p", localtime ($end)) .
              "</SPAN>");

  for (my $wall_clock = $start_time - $off_from_hour;
       $wall_clock < $end + $interval;
       $wall_clock += $interval) {

    $clickable = 0 if ($wall_clock >= $end);

    my $wc2 = ($wall_clock < $start_time ? $start_time :
               $clickable ? $wall_clock : $end);

    my $file_off = $wc2 - $start_time;

    # fudge "0:00:40" down to "0:00:00".
    $file_off = 0 if ($file_off < 59);

    my $offstr = ($file_off > 0
                  ? sprintf("-%d%02d%02d",
                            int($file_off / (60 * 60)),
                            int($file_off / 60) % 60,
                            ($file_off % 60))
                  : '');

    my $t2 = $wc2 - $midnight;
    my $hh = int($t2 / (60 * 60));
    my $mm = int($t2 / 60) % 60;
    my $ap = (($hh % 24) <= 12) ? 'a' : 'p';
    $ap = '';
    $hh = $hh % 12;
    $hh = 12 if ($hh == 0);
    my $timestr = sprintf("%d:%02d%s", $hh, $mm, $ap);

    next if ($timestr eq $last_timestr);  # no dups...
    $last_timestr = $timestr;

    my $html = $timestr;

    if ($clickable) {
      $html = "<A HREF=\"$url_base$offstr.$file_ext\">$html</A>";
    } else {
      $html = "<SPAN CLASS=\"noclick\">$html</SPAN>";
    }

    $html = "<SPAN CLASS=\"l2\">$html</SPAN>";

    $output .= $html;
  }

  $output .= "<BR CLEAR=BOTH></DIV>\n";

  return $output;
}


sub make_index($@) {
  my ($rawp, @names) = @_;

  @names = sort_files(@names);

  my $output = "";
  my $rss    = "";

  my $last_mon;
  my $last_year;
  my $count = 0;

  $output .= "<TABLE BORDER=0>\n" if ($rawp);

  foreach my $f (@names) {
    my @st = stat($f);
    error "$f does not exist\n" unless ($st[9]);

    my $start = $start_times{$f};
    my $end   = $st[9];
    my $zerop = $st[7] < 512;  # empty file

    # $len is the difference between the first write, and the last write.
    # $real_len is the actual duration of the data in the file.

    my $real_len = int($st[7] / $file_bytes_per_second);
    my $len = $real_len;

    if (abs (($start + $len) - $end) > 60 * 5) {  # more than 5 min

      if ($verbose > 1) {
        print STDERR "$progname: warning: start/end times were out " .
                     "of whack on $f:\n";
        print STDERR "$progname:    length: " . 
                     sprintf("%d:%02d:%02d\n",
                             int($len / (60 * 60)),
                             int($len / 60) % 60,
                             ($len % 60));
        print STDERR "$progname:     start: " . localtime($start) . "\n";
        print STDERR "$progname:       end: " . localtime($end)   . "\n";
        print STDERR "$progname: start+len: " . localtime($start+$len) .
          " (" . int (abs (($start + $len) - $end) / 60) . " min)" .
          "\n";
      }

      $end = $start + $len;
    } else {
      $len = $end - $start;
    }

    next if ($f =~ m@\.time$@);
    if (! ($f =~ m@((\d\d\d\d)/(\d\d)-(\d\d)([a-z]?))\.mp3$@)) {
      print STDERR "$progname: WARNING: " .
        "skipping $f (unrecognised name format)\n";
      next;
    }
    my ($f2, $year, $mon, $dotm, $suf) = ($1, $2, $3, $4, $5);

    my $url_base = "$audio_url_base/$f2";

    my $age_days = (time - $start) / (60 * 60 * 24);
    if (!$rawp &&
        $age_days > $max_age) {
      if ($verbose > 1) {
        $age_days = int($age_days);
        print STDERR "$progname: skipping $f ($age_days days old)...\n";
      }
      next;
    }

    print STDERR "$progname: indexing $f...\n" if ($verbose > 1);

    my ($title, $flyer_url) = load_event_description ($f);
    my $utitle = $title;

    my $cal_url = "../../calendar/$year/$mon-$dotm$suf.html";

    $title =~ s@&@&amp;@gs;
    $title =~ s@<@&lt;@gs;
    $title =~ s@>@&gt;@gs;

    $utitle =~ s@&@&amp;@gs;
    $utitle =~ s@<@&lt;@gs;
    $utitle =~ s@>@&gt;@gs;

    $utitle =~ s@: @:<BR>@gs;

    $utitle .= ("<P>" .
                "<I CLASS='noclick'" .
                "   STYLE='font-weight:normal; font-size:10pt'>" .
                "Technical Difficulties:<BR>" .
                "Webcast was lost, sorry!</I>")
      if ($zerop);

    my @tt = localtime($start);

    if ($rawp) {
      my $size = $st[7];
      if ($size > 2*1024*1024*1024) {
        $size = sprintf("%.1f GB", $size / (1024*1024*1024));
      } elsif ($size > 1024*1024) {
        $size = sprintf("%d MB", $size / (1024*1024));
      } elsif ($size > 1024) {
        $size = sprintf("%d KB",   $size / 1024);
      }

      my $len_str = sprintf("%d:%02d",
                            int($len / (60 * 60)),
                            int($len / 60) % 60);

      if ($last_mon &&
          $last_mon != $mon &&
          $#names > 30) {
        $output .= "<TR><TD COLSPAN=7 NOWRAP ALIGN=CENTER><HR></TD></TR>\n\n";
      }

      $output .= ("<TR>" .
                  "<TD VALIGN=TOP ALIGN=RIGHT NOWRAP>" .
                  "<A HREF=\"$f2.mp3\">$size</A>" .
                  "</TD>" .
                  "<TD WIDTH=8></TD>" .
                  "<TD VALIGN=TOP ALIGN=RIGHT NOWRAP>$len_str</TD>" .
                  "<TD WIDTH=8></TD>" .
                  "<TD VALIGN=TOP ALIGN=RIGHT NOWRAP>" .
                  "<A HREF=\"$cal_url\">" . 
                  strftime("%a, %e-%b-%Y", @tt) .
                  "</A>" .
                  "</TD>" .
                  "<TD WIDTH=16></TD>" .
                  "<TD VALIGN=TOP>$title</TD>" .
                  "</TR>\n\n");

    } else {  # !$rawp

      my $flyer_img = $flyer_url;
      $flyer_img =~ s/\.html$/-1-thumb\.jpg/si if $flyer_img;
      $flyer_url = $cal_url if $cal_url;  # always link to calendar

      $output .= ("<DIV CLASS=\"box ebox\">\n" .
                  " <DIV CLASS=\"eflyer\">" .
                  ($flyer_img
                   ? ("<A HREF=\"$flyer_url\">" .
                      "<IMG SRC=\"$flyer_img\">" .
                      "</A>")
                   : ("<A HREF=\"$cal_url\">" .
                      "<IMG SRC=\"${html_base}flyers/noflyer-thumb.jpg\">" .
                      "</A>")) .
                   "</DIV>\n" .
                   "<DIV CLASS=\"ebody\">\n" .
                    "<DIV CLASS=\"edate\">" . strftime("%a %b %e",@tt) .
                    "</DIV>" .
                    "<DIV CLASS=\"etitle\">$utitle</DIV>" .
                  "<P>");

      my $interval = 30 * 60;  # 30 minutes
      $output .= make_listen_links ($url_base, $interval,
                                    $start, $len, $real_len, !$zerop);
      $output .= (" </DIV>\n" .
                  "</DIV>\n");

      $title =~ s/&(.)[^\s;]+;/$1/gsi;  # kludge for entities

      my $sdate = strftime ("%a, %d %b %Y %H:%M:%S %Z", localtime ($start));
      my $item = ("  <item>\n" .
                  "   <title>$title</title>\n" .
                  "   <guid isPermaLink=\"true\">" .
                       "$url_base.$file_ext</guid>\n".
                  "   <pubDate>$sdate</pubDate>\n" .
                  "  </item>\n");
      $rss .= $item;
    }
    $count++;
    $last_year = $year;
    $last_mon = $mon;
  }

  $output .= "</TABLE>\n" if ($rawp);

  $output = "<DIV ALIGN=CENTER>\n$output\n</DIV>\n";

  return ($output, $rss);
}


sub indexer($$@) {
  my ($rawp, $outfile, @names) = @_;

  pull_names();

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

  my ($body) = ($output =~ m@<!--\s+%%BOTTOM_START%%\s+--> (.*?)
                             <!--\s+%%BOTTOM_END%%\s+-->@sx);
  error ("$intro_file: unparsable body") unless $body;

  $body = "<!-- %%HEADING%% -->\nRaw MP3 Archive\n\n"
    if ($rawp);

  my $rss = $rss_header;
  my ($o1, $rss1) = make_index ($rawp, @names);
  $body .= $o1;
  $rss  .= $rss1;

  if ($rawp && $outfile =~ m@/(\d\d\d\d)/@) {  # kludge...
    $body =~ s@(HREF=\")$1/@$1@gi;
  }

  $rss .= " </channel>\n</rss>\n";

  $output =~ s@(<!--\s+%%BOTTOM_START%%\s+-->) .*? (<!--\s+%%BOTTOM_END%%\s+-->)
              @$1$body$2@sx;

  # FFFUUUUU (like buttons)
  $output =~ s@http(%3A%2F%2F|://)www\.dnalounge\.com[^<>\"]*?intro\.html
              @${html_base}webcast/@gsix;

  DNA::Menuify::write_file ($outfile, $output);

  if (!$rawp) {
    $outfile =~ s@/[^/]*$@/@;
    $outfile .= "archive.rss";
    DNA::Menuify::write_file ($outfile, $rss);
  }
}


sub check_files(@) {
  my (@names) = @_;

  @names = sort_files(@names);

  my $count = 0;
  foreach my $f (@names) {
    next unless ($f =~ m/\.mp3$/);

    my @st = stat($f);
    error "$f does not exist\n" unless ($st[9]);

    my $start = $start_times{$f};
    my $end   = $st[9];

    $f =~ s@^.*/@@;

    # $len is the difference between the first write, and the last write.
    # $real_len is the actual duration of the data in the file.

    my $real_len = int($st[7] / $file_bytes_per_second);
    my $len = $real_len;

#    if ($end < $start + $len) {
#      print STDERR "$progname: warning: start/end times were out " .
#                   "of whack on $f:\n";
#      print STDERR "$progname:     start: " . localtime($start) . "\n";
#      print STDERR "$progname:       end: " . localtime($end)   . "\n";
#      print STDERR "$progname: start+len: " . localtime($start+$len) . "\n";
#
#      $end = $start + $len;
#    } else {
      $len = $end - $start;
#    }

    my $ratio = ($real_len ? ($real_len / $len) : 0);

    my $missing_pct = (1 - $ratio) * 100;
    my $missing_secs = abs($len - $real_len);
    my $timestr = sprintf("%d:%02d:%02d",
                          int($missing_secs / (60 * 60)),
                          int($missing_secs / 60) % 60,
                          ($missing_secs % 60));

    if ($verbose || $ratio < 0.98 || $ratio > 1.0015) {
      if ($ratio == 1.0) {
        print STDERR "$progname: file $f is exactly right.\n";
      } elsif ($ratio <= 1.0) {
        print STDERR "$progname: file $f is missing " .
                       sprintf("%.2f%%", $missing_pct) .
                       " ($timestr)\n";
      } else {
        print STDERR "$progname: file $f is larger than expected: " .
                       sprintf("%.2f%%", $ratio * 100) .
                       " ($timestr)\n";
      }
    }
    $count++;
  }

  error "no files to check?" unless ($count > 0);
}



sub usage() {
  print STDERR "usage: $progname [--verbose] [--detail] [--check] " .
    "outfile filenames\n";
  exit 1;
}

sub main() {
  my @names = ();
  my $checkp = 0;
  my $rawp = 0;
  my $outfile = undef;

  while ($_ = $ARGV[0]) {
    shift @ARGV;
    if    (m/^--?verbose$/s)           { $verbose++; }
    elsif (m/^-v+$/)                   { $verbose += length($_)-1; }
    elsif (m/^--?debug$/s)             { $debug_p++; }
    elsif (m/^--?raw$/s)               { $rawp++; }
    elsif (m/^--?check$/s)             { $checkp++; }
    elsif (m/^-./)                     { usage; }
    elsif (!defined($outfile))         { $outfile = $_; }
    else                               { push @names, $_; }
  }

  $DNA::Menuify::base_url      = $html_base;
  $DNA::Menuify::template_file = $template_file;
  $DNA::Menuify::verbose       = $verbose;
  $DNA::Menuify::debug         = $debug_p;

  usage unless defined($outfile);
  usage unless ($#names >= 0);

  if ($checkp) {
    check_files (@names);
  } else {
    indexer ($rawp, $outfile, @names);
  }
}

main;
exit 0;