#!/usr/local/bin/perl

#
#     NAME: WhatsForDinner (formerly 'menu')
#   AUTHOR: Michael J. Radwin, Adam Doppelt
#    DESCR: display today's UFS menu
# MODIFIED: $Id: WhatsForDinner,v 2.6 1997/04/09 13:49:27 mjr Exp $
#

require 'getopts.pl';

# configuration parameters
$pname = 'WhatsForDinner';
$webget = '/cs/bin/lynx';   # lynx is faster than webget
$webget_opts = '-source';
$zwrite = '/cs/bin/zwrite';
#$mail = '/usr/local/bin/mail';
$mail = '/usr/bin/mail';
$url = "http://www.netspace.org/herald/daylink/menu.f.html";
#$header_tag = '<H1>Daily UFS Menu</H1>';
$header_tag = '<H1>Today\'s Menu</H1>';
$appeared_tag = 'This story appeared';
$lookslike_tag = 'Looks like UFS is serving up some: ';

$usage = "usage: $pname [-hqsz] [-m <addr>] [-d <path>]
  -h         Display usage information.
  -q         Quiet mode: don't read .dinner file and match regexps.
  -s         Strict mode: only display meals matching at least one regexp.
  -z         Send results via zwrite to \$LOGNAME.
  -m <addr>  Send results via mail to <addr>, but only if there is output.
  -d <path>  Use <path> as .dinner file instead of \$HOME/.dinner.

Unless run with -q, $pname looks in your .dinner file for your
favorite meals and points them out to you.  This file lists a single
perl regular expression on each line, describing a meal you might enjoy.
The # character is the comment symbol.  See perlre(1) for regexp syntax.

If no meals match at least one entry in .dinner and the -s option is
used, $pname terminates silently.  The -m and -z options respect
the -s option, and will not notify you if there is nothing yummy being
served up.  A cron job [see crontab(1) for details] that mails you a
note about good meals every Mon-Fri at 9:30am might be:

30 9 * * 1-5 /cs/bin/$pname -s -m \$LOGNAME
";

&Getopts('hqszm:d:')  || die "$usage\n";
$opt_h                && die "$usage\n";
($opt_s && $opt_q)    && die "$pname: -s not allowed with -q\n$usage\n";
($opt_z && $opt_m)    && die "$pname: -z not allowed with -m\n$usage\n";

(-f $webget && -x $webget)  || die "$pname: Can't run helper $webget\n";

die "$pname: Can't run helper $mail\n" 
    if $opt_m && !(-f $mail && -x $mail);
die "$pname: Can't run helper $zwrite\n"
    if $opt_z && !(-f $zwrite && -x $zwrite);

# opt_d is the pathname of the dinnerfile
$opt_d = $ENV{'HOME'} . "/.dinner" unless $opt_d;
if ($opt_s && ! (-r $opt_d)) {
    die "$pname: strict mode failed to read $opt_d: $!\n";
}

# grab the contents of the regular expressions file for later use
if (!$opt_q && -r $opt_d) {
    open(REGEXPS, $opt_d) || die "$pname: failed to open $opt_d: $!\n";
    while(<REGEXPS>) {
	next if /^#/;                  # good perl style: common cases first
	next if /^\s*$/;               # (even if they're replicated below)

	chop;                          # clean up line by removing newline,
        s/^\s*//;                      # leading and trailing whitespace,
        s/#.*$//;                      # and comments
        s/\s*$//;
	next if /^$/;                  # see first two lines

	push(@regexps, $_); 
    }
    close(REGEXPS);
}


# we'll use lynx to retrieve the raw HTML from the BDH online
open(MENU, "$webget $webget_opts $url |") 
    || die "$pname: failed to run $webget: $!\n";
while(<MENU>) {
    # ignore the first several lines -- it's just HTML headers
    last if /$header_tag/i;
}

# grab HTML code until we see the horizontal rule.  turn paragraph
# markers into null terminators and clean up the rest of the html tags.
$menu = '';
while(<MENU>) {
    last if /^<HR>/i;

    s/\s*<p[^>]*>\s*/\0/ig;            # paragraph markers == meal delimiters
    s/<[^>]*>//g;                      # ignore all other tags

    s/&nbsp;/ /g;                      # fix html entities - spaces
    s/&amp;/&/g;                       # and ampersands

    # support all entities?  http://www.uni-passau.de/~ramsch/iso8859-1.html
    s/&([EeIiOo])grave;/pack("c",   ord($1)+131)/ge;  # there's a pattern
    s/&(Uu)grave;/pack("c",         ord($1)+132)/ge;  # here... can you
    s/&(Aa)grave;/pack("c",         ord($1)+127)/ge;  # see what it is?

    s/&([EeIiOoYy])acute;/pack("c", ord($1)+132)/ge;  # of course, it's not
    s/&(Uu)acute;/pack("c",         ord($1)+133)/ge;  # consistent.  Bastards.
    s/&(Aa)acute;/pack("c",         ord($1)+128)/ge;

    s/&([EeIiOo])circ;/pack("c",    ord($1)+133)/ge;
    s/&(Uu)circ;/pack("c",          ord($1)+134)/ge;
    s/&(Aa)circ;/pack("c",          ord($1)+129)/ge;

    s/&([EeIiOoy])uml|die;/pack("c",ord($1)+134)/ge;
    s/&(Uu)uml|die;/pack("c",       ord($1)+135)/ge;
    s/&(Aa)uml|die;/pack("c",       ord($1)+130)/ge;

    $menu .= $_;
}

# print out date of menu so the user can see if the info is current.
while(<MENU>) { 
    if (/^$appeared_tag/i) {
	$story_appeared = <MENU>;
	last;
    }
}

# this code borrowed from the camel book
$menu =~ s/([.!?])\n\s*/$1  /g;        # make the menu text one big line
$menu =~ s/\n\s*/ /g;
$menu =~ s/^\s*//;
$menu =~ s/\s+/ /g;                    # make multiple spaces a single space

# main data loop
$already_setup = 0;                    # has the mail output been set up?
@menu = split(/\0/, $menu);
foreach $meal (@menu) {
    # some meals may be blank because the BDH may put multiple adjacent
    # <p>'s on weekends.  Ignore 'em.
    next if $meal =~ /^\s*$/;

    undef(@matching);                  # clear last meal's matches
    $lookslike = '';

    if (!$opt_q) {
	$found = !@regexps;
	foreach $pat (@regexps) {
	    if ($meal =~ /($pat)/i) {
		push(@matching, $1);
		$found = 1;
	    }
	}
	next if $opt_s && !$found;
    }

    &setup_output unless $already_setup;
    if (!$opt_q && @matching) {
	#print STDOUT "Looks like UFS is serving up some: ";
	#print STDOUT join(", ", @matching), "\n";
	$lookslike = $lookslike_tag . join(", ", @matching);
    }

    write;
    print STDOUT "\n";
}

if ($already_setup && $opt_m) {
    print STDOUT "\nLove,\n$pname\n";
} elsif (!@menu && !$opt_m) {
    print STDOUT "Error: no meals listed in today's BDH.\n";
}

close(STDOUT);
exit(0);


# if they want to mail the results, change STDOUT to pipe to the mail
# program.
sub setup_output {
    if ($opt_z) {
	open(STDOUT, "| $zwrite $ENV{'LOGNAME'}") 
	    || die "$pname: failed to redirect STDOUT: $!\n";
	select(STDOUT); $| = 1;        # make unbuffered

    } elsif ($opt_m) {
	open(STDOUT, "| $mail -s $pname $opt_m") 
	    || die "$pname: failed to redirect STDOUT: $!\n";
	select(STDOUT); $| = 1;        # make unbuffered

	print STDOUT "Dear $opt_m,\n\n";
    }

    if (defined($story_appeared)) {
	print STDOUT $story_appeared, "\n";
    }

    $already_setup = 1;
}


# this is a silly use of perl's format feature.  Make the menu
# paragraphs fit nicely in 74 columns and place line-breaks where
# convenient.  Come to think of it, this whole program is silly.
format STDOUT = 
^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<~~
$lookslike
~~^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$meal
.