#!/usr/bin/perl -w
# Copyright © 2010-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.
#
# The various twittery we do.
#
#    utils/twit.pl --text whatever
#
#  Or, it will read the calendar and blog and extract titles:
#
#    utils/twit.pl --event announced 2010-10-14
#    Just announced: Thu Oct 14, 8pm: FISHBONE http://xyz
#
#    utils/twit.pl --event tonight 2010-10-14
#    FISHBONE at DNA Lounge tonight: Thu Oct 14, 8pm! http://xyz
#
#    utils/twit.pl --event now 2010-10-14
#    FISHBONE at DNA Lounge starting now! http://xyz
#
#    utils/twit.pl --event thisweek 2010-10-14 2010-10-15 ...
#    This week! Wed: IMMOLATION; Thu: FISHBONE; Fri: HUBBA HUBBA REVUE ...
#
#    utils/twit.pl --event blog 2010-09-28
#    Blog update, wherein there are photos. http://xyz
#
#
#  Expects $HOME/.dnalounge-twitter-pass to exist and contain secrets like:
#
#    consumer        = XXXXXXXXXXXXXXXXXXXXX
#    consumer_secret = XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
#    access          = XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
#    access_secret   = XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
#
#
#  This must only be run on cerebrum, because it also invokes "fbmirror.pl"
#  to ensure that the Facebook copy of the posts show up quickly, and
#  fbmirror.pl uses a state file: "/home/store/.dnalounge-twithist".
#  That file must be globally writable, since this script is run by both
#  the user "store" (for various cron-driven posts like "This week!", and
#  for mirroring manually-made twits) and also by user "archive" (for the
#  calendar-cron-driven "Tonight!" and "Starting now!" posts.)
#
#  Also, both "store" and "archive" must have a ".dnalounge-twitter-pass"
#  and ".dnalounge-facebook-pass" file.
#
#  For this to work as a CGI, ~store/.dnalounge-{facebook,twitter}-pass must
#  be readable by user "apache" and .dnalounge-twithist must be writable.
#
# 
# Created:  2-Oct-2010.

require 5;
use diagnostics;
use strict;

BEGIN { push @INC, ("../utils/", "utils/"); }

use POSIX qw(mktime strftime);
use Net::Twitter;
use LWP::UserAgent;
use LWP::Simple;
use Date::Parse;
use HTML::Entities;

use Menuify;  # DNA::Menuify
DNA::Menuify->import qw(error url_quote url_unquote html_quote html_unquote
                        cgi_exec);

use open ":encoding(utf8)";

BEGIN { push @INC, ("utils/", "../utils/"); }
use dna_auth;
use Menuify;

my $progname = $0; $progname =~ s@.*/@@g;
my $exec_dir = $0; $exec_dir =~ s@/[^/]*$@@;
my $version = q{ $Revision: 1.86 $ }; $version =~ s/^[^\d]+([\d.]+).*/$1/;

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

my $url_base   = "http://www.dnalounge.com/";
my $names_file = "calendar/names.txt";
my $cgi_dir    = "/var/www/dnalounge";
my $body_template = undef;
my $template_file = "../contact/index.html";
my $blog_rss   = "${url_base}backstage/log/feed/";


sub safe_system(@) {
  my (@cmd) = @_;

  print STDOUT "$progname: executing " . join(' ', @cmd) . "\n"
    if ($verbose > 2);

  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);
}


# Run the URL through http://tinyurl.com/ and return the shortened one.
#
sub tinyurlify($) {
  my ($url) = @_;
  return $url if ($url =~ m@^http://tinyurl@s ||
                  $url =~ m@^http://dnalounge\.com/b/@s ||
                  $url =~ m@^http://youtu\.be/@s);
  my $ua = LWP::UserAgent->new;
  $ua->agent ("$progname/$version");

  # See if the URL has a <LINK REL="shortlink"> tag.
  # (This doesn't work if there's an #anchor).
  if ($url !~ m/#/s) {
    my $body = LWP::Simple::get($url) || '';
    if ($body =~ m@<LINK\b [^<>]*? \b REL \s* = \s* [\"\']? shortlink [\"\']?
                   [^<>]*? \b HREF \s* = \s* [\"\']? ([^\"\'<>]+)@six) {
      return $1 if (length ($1) < length($body));
    }
  }

  # Otherwise use tinyurl.com.
  # For some reason we have to post for it to preserve the #anchor in the URL.
  my $res = $ua->post ('http://tinyurl.com/api-create.php',
                      { 'url' => $url });
  my $url2 = ($res->is_success ? $res->decoded_content : '');
  print STDERR "tinyurl: $url\n     ==> $url2\n" if ($verbose > 1);
  return $url unless $url2;
  return $url2 if (length($url2) < length($url));
  return $url;
}


# Run URLs in the text through http://tinyurl.com/ until the text is less
# than 140 characters.  Only shrink URLs until the text is short enough;
# leave remaining URLs un-shrunk as soon as the text is short enough.
#
sub shorten_urls($) {
  my ($txt) = @_;

  my $max_length = 140 - 10;	# slack for re-twits
  #$max_length = 10;		# always shrink 'em

  return $txt if (length($txt) <= $max_length);

  my @chunks = split(m@(\bhttps?://[^\s<>]+[A-Za-z\d/])@s, $txt);
  foreach my $chunk (@chunks) {
    next unless ($chunk =~ m@^https?://@s);
    $chunk = tinyurlify ($chunk);

    $txt = join ('', @chunks);
    last if (length($txt) <= $max_length);
  }

  return $txt;
}


sub load_keys($) {
  my ($user) = @_;

  my $consumer        = 'UNKNOWN';
  my $consumer_secret = 'UNKNOWN';
  my $access          = 'UNKNOWN';
  my $access_secret   = 'UNKNOWN';

  # Read our twitter tokens
  error ("no \$HOME") unless defined($ENV{HOME});
  my $twitter_pass_file = "$ENV{HOME}/.$user-twitter-pass";
  if (open (my $in, '<', $twitter_pass_file)) {
    print STDERR "$progname: read $twitter_pass_file\n" if ($verbose > 1);
    while (<$in>) { 
      s/#.*$//s;
      if (m/^\s*$/s) {
      } elsif (m/^consumer\s*=\s*(.*?)\s*$/) { 
        $consumer = $1;
      } elsif (m/^consumer_secret\s*=\s*(.*?)\s*$/) { 
        $consumer_secret = $1;
      } elsif (m/^access\s*=\s*(.*?)\s*$/) { 
        $access = $1;
      } elsif (m/^access_secret\s*=\s*(.*?)\s*$/) { 
        $access_secret = $1;
      } else {
        error ("$twitter_pass_file: unparsable line: $_");
      }
    }
    close $in;

  } elsif ($debug_p) {
    print STDERR "$progname: $twitter_pass_file: $!\n";
  } else {
    error ("$twitter_pass_file: $!");
  }

  return ($consumer, $consumer_secret, $access, $access_secret);
}


sub twitter_status_update($$$$) {
  my ($user, $txt, $lat, $long) = @_;

  my ($consumer, $consumer_secret, $access, $access_secret) = load_keys($user);

  $txt = shorten_urls ($txt);
  print STDERR "$progname: " . length($txt) . ": $txt\n"
    if ($verbose);

  my $nt = Net::Twitter->new (
      traits              => [qw/OAuth API::REST WrapError/],
      consumer_key        => $consumer,
      consumer_secret     => $consumer_secret,
      access_token        => $access,
      access_token_secret => $access_secret,
  );

  if ($debug_p) {
    binmode (STDERR, ':utf8');
    print STDERR "$progname: debug: not twitting: $txt\n";
    return;
  }

  my $retries = 5;
  my $err;
  for (my $i = 0; $i < $retries; $i++) {
    my $ret = $nt->update ({status              => $txt,
                            lat                 => $lat,
                            long                => $long,
                            display_coordinates => 1});
    last if defined ($ret);
    $err = $nt->get_error()->{error};

    my $secs = 10;
    print STDERR "twitter: $err (retrying in $secs secs)\n" if $verbose;
    sleep $secs;
  }
  error ("twitter: $err (after $retries tries)") if $err;
}


sub load_info($$) {
  my ($date, $blog_p) = @_;

  if (!$blog_p) {
    $names_file =~ s@^.*/@@s unless -f $names_file;
    print STDERR "$progname: read $names_file\n" if ($verbose > 1);
    open (my $in, '<:utf8', $names_file) || error ("$names_file: $!");
    while (<$in>) {
      my ($key, $pres, $title, $url, $time, $age) = split(/\t/, $_);
      if ($key eq $date) {
        $title =~ s/^\*//s;

        $time = strftime ("%a %b %d, %I:%M%p", localtime($time));
        $time =~ s/(AM|PM)$/\L$1/s;
        $time =~ s/ 0/ /gs;
        $time =~ s/:00//gs;

        # Let's always use the calendar URL instead of the flyer URL.
        my ($yyyy, $mm, $dd) = ($date =~ m/^(\d{4})-(\d\d)-(\d\d[a-z]?)$/si);
        $url = "${url_base}calendar/$yyyy/$mm-$dd.html";

        return ($title, $time, $url);
      }
    }
    close $in;
    error ("no such event: $date");

  } else {
    error ("date should be 'now'") unless ($date eq 'now');
    $LWP::Simple::ua->agent("$progname/$version");
    my $rss = LWP::Simple::get ($blog_rss);
    my ($item) = ($rss =~ m@<item>(.*?)</item>@si);
    error ("no item in $blog_rss") unless $item;

    my ($title) = ($item =~ m@<title>\s*(.*?)\s*</title>@si);
       ($date)  = ($item =~ m@<pubDate>\s*(.*?)\s*</pubDate>@si);
    my ($url)   = ($item =~ m@<link>\s*(.*?)\s*</link>@si);
    error ("$blog_rss: no title") unless $title;
    error ("$blog_rss: no date")  unless $date;
    error ("$blog_rss: no link")  unless $url;

    $date = str2time ($date);
    $date = strftime ("%a %b %d", localtime ($date));

    $title = html_unquote ($title);
    $title =~ s/^DNA Lounge: //s;
    $title =~ s/^[-a-z\d]+ \([a-z]{3}\):?\s+//si;	# "4-Jan-2010 (Mon) "

    return ($title, $date, $url);
  }
}


sub twit($@) {
  my ($kind, @dates) = @_;

  my $lat  = '37.771007';		# DNA Lounge ICBM coordinates.
  my $long = '-122.412694';

  my @twits = ();
  my ($title, $url);

  if ($kind eq 'txt') {			# --text accepts only one arg
    push @twits, html_unquote ($dates[0]);

  } elsif ($kind eq 'thisweek') {	# all dates go into one twit.
    my @blurbs = ();
    my $count = 0;
    foreach my $date (@dates) {
      my ($yyyy, $mm, $dd) = ($date =~ m/^(\d{4})-(\d\d)-(\d\d[a-z]?)$/si);
      error ("unparsable date: " . $date) unless $dd;
      ($title, $date, $url) = load_info ($date, 0);
      my ($dotm) = ($date =~ m/^([A-Z][a-z][a-z]),? [A-Z][a-z][a-z] \d/s);
      error ("unparsable dotm: $date") unless $dotm;
      #$title = uc($title);

      # If the first event in the list is DG, omit it.
      # This is so that when we send this twit out on Monday,
      # it doesn't constantly list tonight's event.
      #
      next if ($count == 0 && $title =~ m/^Death Guild$/si);

      push @blurbs, "$dotm: $title";
      $count++;
    }

    $url = "${url_base}calendar/latest.html";
    $url = tinyurlify($url);

    my $max = 140;

    my $head = "THIS WEEK! ";
    my $tail = " $url";
    my $txt = $head . join ("; ", @blurbs) . $tail;

    # If that is too long, then starting at the back, remove subtitles
    # from blurbs until it fits.
    #
    if (length($txt) > $max) {
      for (my $i = $#blurbs; $i >= 0; $i--) {
        my $old = $blurbs[$i];
        $blurbs[$i] =~ s/^([^:]+: .+?): .+$/$1/s;
        if ($verbose > 1 && $old ne $blurbs[$i]) {
          print STDERR "$progname: trimmed: \"$old\" => \"" . $blurbs[$i] .
            "\"\n";
        }
        $txt = $head . join ("; ", @blurbs) . $tail;
        last unless (length($txt) > $max);
      }
    }


    # If that is still too long, then start removing blurbs from the back.
    #
    while (length($txt) > $max && $#blurbs > 0) {
      my $old = pop @blurbs;
      print STDERR "$progname: omitted \"$old\"\n" if ($verbose > 1);
      $txt = $head . join ("; ", @blurbs) . $tail;
    }

    push @twits, $txt;

  } else {				# Each date gets its own twit.
    foreach my $date (@dates) {
      my $txt;
      my $music = "\x{266c} ";	# "Beamed Sixteenth Notes"
      ($title, $date, $url) = load_info ($date, ($kind eq 'blog'));
      if ($kind eq 'tonight') {
        $title = uc($title);
        $txt = "${music}$title at DNA Lounge tonight: $date! $url";
      } elsif ($kind eq 'now') {
        $title = uc($title);
        $txt = "${music}$title at DNA Lounge starting now! $url";
      } elsif ($kind eq 'announced') {
        $title = uc($title);
        $txt = "${music}Just announced: $date: $title $url";
      } elsif ($kind eq 'blog') {
        $title =~ s/^([A-Z])([a-z])/\L$1\E$2/s; # uncap
          $title .= '.' unless ($title =~ m/[.?!]$/s);
        $txt = "Blog update, $title $url";
      } else {
        error ("unknown post kind: $kind");
      }

      if (($kind eq 'tonight' || $kind eq 'now') &&
          ($title =~ m/\b(PRIVATE\s+(PARTY|EVENT)|CLOSED|SUSPENDED)\b/i)) {
        print STDERR "$progname: skipping $title\n" if ($verbose);
        next;
      }

      push @twits, html_unquote ($txt);
    }
  }

  my $user = 'dnalounge';

  foreach my $txt (@twits) {
    twitter_status_update ($user, $txt, $lat, $long);
  }

  crosspost ($url, $title, $lat, $long) if ($kind eq 'blog');
  facebook_mirror ($user) unless ($debug_p);
}


# Force a Facebook update by running "fbmirror.pl" right now.
# Without this, it would happen from cron anyway within 5 minutes,
# but this makes the updates be closer to simultaneous.
#
sub facebook_mirror($) {
  my ($user) = @_;
  my @cmd = ("$exec_dir/fbmirror.pl", "--user", $user);
  push @cmd, "--debug" if ($debug_p);
  push @cmd, ("-" . ("v" x $verbose)) if ($verbose);
  safe_system (@cmd);
}


# Crosspost to the jwz.org blog.
#
sub crosspost($$$$) {
  my ($url, $title, $lat, $long) = @_;

  my $host   = "cerebrum.dnalounge.com";
  my $dir    = "~jwz/www/blog";
  my $wppost = "../hacks/wppost.php";

  $title =~ s/"/&quot;/gs;	# avoid shell meta lossage
  $title =~ s/!/&#x21;/gs;

  $title = "<A HREF='$url'>DNA Lounge update</A>, $title";

# my $deg = "\302\260";
# my $deg = "\x{00B0}";
  my $deg = "\260";
  my $loc = sprintf("%d$deg %d' %.02f\\\" %s, " .
                    "%d$deg %d' %.02f\\\" %s",
                    abs($lat),
                    (abs($lat) - int(abs($lat))) * 60,
                    (abs($lat * 60) - int(abs($lat * 60))) * 60,
                    ($lat > 0 ? 'N' : 'S'),
                    abs($long),
                    (abs($long) - int(abs($long))) * 60,
                    (abs($long * 60) - int(abs($long * 60))) * 60,
                    ($long > 0 ? 'E' : 'W'));
  $title =~ s/([\$])/\\$1/gs;
  my $cmd = ("cd $dir ; $wppost" .
             " --user jwz" .
             " --body \"$title\"" .
             " --subject \"DNA Lounge update\"" .
             " --tags dnalounge" .
             " --location \"$loc\"" .
             " --closed" .
             " > /dev/null");

  my $remote = "ssh -xT $host /bin/sh";

  $remote = "/bin/sh" if (`uname -n` =~ m@\Q$host@si);

  if ($debug_p) {
    print STDERR "$progname: not running: $remote: $cmd\n";
  } else {
    print STDERR "$progname: $remote: $cmd\n" if ($verbose);
    open (my $pipe, '|-', $remote) || error ("open: $remote: $!");
    (print $pipe $cmd) || error ("pipe: $!");
    close $pipe;
  }
}


sub pre_system($) {
  my ($cmd) = @_;

  # Someone is buffering the first 1k of the document!  Blow through that
  # so that we can see output of sub-commands in real-time.
  #
  print STDOUT "<!-- " . ('x' x 1024) . " -->\n";

  print STDOUT "<P><B><I>$cmd ...</I></B><P>\n";
  print STDOUT "<PRE STYLE='white-space:pre-wrap'>\n";

  # This is crazy, but it's the only  way I've found to get the lines
  # to actually show up as they are printed.  A newline alone inside
  # <PRE> doesn't cause Safari to push the line out, but a <BR> does.
  #
  system("(cd ..; $cmd) 2>&1 | " .
         "perl -p -e '\$|=1; s/&/&amp;/g; s/</&lt;/g; s/\n/<BR>/g'");

  print STDOUT "</PRE>\n";
}


sub do_cgi() {
  $|=1;

  chdir ($cgi_dir . "/utils");

  error ("HTTPS only") unless (($ENV{HTTPS} || '') eq 'on');

  eval {
    if (! $debug_p) {
      dna_auth::dna_auth_demand_login(['calendar_edit']);
    }
  };
  error ("Auth error: $@") if ($@);

  my $args = "";
  if (!defined ($ENV{REQUEST_METHOD})) {
  } elsif ($ENV{REQUEST_METHOD} eq "GET") {
    $args = $ENV{QUERY_STRING} if (defined($ENV{QUERY_STRING}));
  } elsif ($ENV{REQUEST_METHOD} eq "POST") {
    local $/ = undef;  # read entire file
    $args .= <STDIN>;
  }

  if (!$args &&
      defined($ENV{REQUEST_URI}) && 
      $ENV{REQUEST_URI} =~ m/^(.*?)\?(.*)$/s) {
    $args = $2;
  }

  my ($since, $twit);
  foreach (split (/&/, $args)) {
    my ($key, $val) = m/^([^=]+)=(.*)$/;
    $key = url_unquote ($key);
    $val = url_unquote ($val);
    if    ($key eq 'twit')  { $twit  = $val; }
    elsif ($key eq 'since') { $since = $val; }
    else { error ("unknown option: $key"); }
  }

  if ($twit) {
    print STDOUT "Content-Type: text/html\n\n";
    my $now = time;

    my $head = ("<TITLE>DNA Lounge: Posting...</TITLE>\n" .
                "<!-- %%BOTTOM_START%% -->\n" .
                "<!-- %%BOTTOM_END%% -->\n");
    $head = DNA::Menuify::write_file ('-', $head);
    $head =~ s@"<!-- %%BOTTOM_END%% -->.*$@@s;
    print STDOUT $head;

    $twit =~ s!([^-a-z\d_.,:/@])!\\$1!gsi;
    delete $ENV{REQUEST_URI};

    pre_system ("$cgi_dir/utils/twit.pl -v --text $twit");

    $now = lc (strftime("%I:%M%p", localtime ($now - 60)));
    $now =~ s/^0//s;

    print STDOUT "<P><B>Done!</B>\n";

    print STDOUT "<P><A HREF=\"?since=$now\">See updates since $now</A><P>\n";

  } elsif ($since) {

    print STDOUT ("Content-Type: text/html\n" .
                  "Refresh: 60\n" .
                  "Cache-Control: max-age=0\n" .
                  "Expires: Thu,  1 Jan 2011 00:00:00 GMT\n" .
                  "\n");

    my $title = "Twitter / Facebook replies since " . html_quote($since);
    my $head = ("<TITLE>DNA Lounge: $title</TITLE>\n" .
                "<!-- %%BOTTOM_START%% -->\n" .
                "<DIV ALIGN=CENTER>\n" .
                "<DIV CLASS=\"ghbox\">$title</DIV>\n" .
                "</DIV><P>\n" .
                "<!-- %%BOTTOM_END%% -->\n");

    $head = DNA::Menuify::write_file ('-', $head);
    $head =~ s@"<!-- %%BOTTOM_END%% -->.*$@@s;

    print STDOUT $head;

    $since =~ s!([^-a-z\d_.,:/@])!\\$1!gsi;
    delete $ENV{REQUEST_URI};

    my $cmd = "$cgi_dir/utils/replies.pl --html --since $since";
    print STDOUT "<P><B><I>$cmd ...</I></B><P>\n";
    #pre_system ($cmd);
    safe_system ("(cd ..; $cmd) 2>&1");
    print STDOUT "<P><B>Done.</B><P>\n";

    print STDOUT "<P><A HREF=\"https://www.dnalounge.com/guest/\">" .
      "Guest List</A><P>\n";

  } else {

    print STDOUT "Content-Type: text/html\n\n";

    my $title = "Twitter / Facebook Post";
    my $body = ("<TITLE>DNA Lounge: $title</TITLE>\n" .
                "<!-- %%BOTTOM_START%% -->\n" .
                "<DIV ALIGN=CENTER>\n" .
                "<DIV CLASS=\"gwbox\">$title</DIV><P>\n" .
                dna_auth::dna_auth_header_links() .
                "<P>" .
                "<FORM METHOD=POST>\n" .
                "<TEXTAREA NAME=\"twit\" ID=\"twit\"" .
                " ROWS=4 COLS=40 WRAP=SOFT" .
                " ONBLUR='upd()' ONCHANGE='upd()'" .
                " ONINPUT='upd()' ONKEYUP='upd()'" .
                ">" .
                "</TEXTAREA>\n" .
                "<P>\n" .
                "<INPUT TYPE=SUBMIT VALUE=\"Post\">\n" .
                "<INPUT TYPE=RESET VALUE=\"Clear\">\n" .
                " &nbsp; <SPAN ID='counter'>&nbsp;</SPAN>\n" .
                "</FORM>\n" .
                "</DIV>\n" .
                "<P>" .
                "<!-- %%BOTTOM_END%% -->\n");
    $body = DNA::Menuify::write_file ('-', $body);

    $body =~ s@<!-- %%BOTTOM_END%% -->.*$@@s;
    $body   .= ("<SCRIPT LANGUAGE='JavaScript1.1'>\n" .
                "<!--\n" .

                "function upd() {\n" .
                " var n = document.getElementById('twit').value.length;\n" .
                " n = 140 - n;\n" .
                " if (n < 0) {\n" .
                "   n = \"<B STYLE='color:red'>\" + n + \"</B>\";\n" .
                " }\n" .
                " document.getElementById('counter').innerHTML = n;\n" .
                "}\n" .

                "upd();\n" .
                "-->\n" .
                "</SCRIPT>\n");

    print STDOUT $body;
  }
}


sub usage() {
  print STDERR "usage: $progname [--verbose] [--debug] [--delay fuzz]\n" .
	"\t       [--event kind date ...] | [--text txt]\n";
  exit 1;
}

sub main() {
  my ($eventp, $kind, @dates, $txt, $delay);
  while ($#ARGV >= 0) {
    $_ = shift @ARGV;
    if (m/^--?verbose$/)  { $verbose++; }
    elsif (m/^-v+$/)      { $verbose += length($_)-1; }
    elsif (m/^--?debug$/) { $debug_p++; }
    elsif (m/^--?event$/) { $eventp = 1; $kind = shift @ARGV; }
    elsif (m/^--?text$/)  { $txt    = shift @ARGV; }
    elsif (m/^--?delay$/) { $delay  = shift @ARGV; }
    elsif (m/^-./)        { usage; }
    elsif ($eventp)       { push @dates, $_; }
    else { usage; }
  }

  if (! $debug_p) {
    my $h = 'cerebrum.dnalounge.com';
    error ("this must run on $h!") unless (`uname -n` eq "$h\n");
  }

  my $who = `whoami`; chomp($who);
  $ENV{HOME} = '/home/store' if ($who eq 'apache' || $debug_p);

  error ("no \$HOME") unless defined($ENV{HOME});

  # Sleep for a random (bell-curved) amount of time between 0 and --delay.
  #
  $delay = 0 if (!defined($kind) || $kind eq 'now' || $#dates < 0);
  if ($delay) {
    my $d2 = $delay;
    $d2 =~ s/\s*s(ec(onds?)?)?$//si;
    $d2 = $1 * 60      if ($d2 =~ m/^(\d+)\s*m(in(utes?)?)?$/si);
    $d2 = $1 * 60 * 60 if ($d2 =~ m/^(\d+)\s*h(ours?)?$/si);
    $d2 = int ((rand($d2 / 3) + rand($d2 / 3) + rand($d2 / 3)) + 0.5);
    print STDERR "$progname: waiting for $d2 sec (of $delay)\n" if ($verbose);
    sleep ($d2) unless $debug_p;
  }

  if (defined ($ENV{REQUEST_URI})) {
    do_cgi();
  } elsif ($eventp) {
    usage if $txt;
    if (! ($kind eq 'thisweek' || $kind eq 'announced')) {
      usage unless ($#dates == 0);
    }
    twit ($kind, @dates);
  } else {
    usage if $kind;
    usage if ($#dates >= 0);
    twit ('txt', $txt);
  }
}

main();
exit 0;