New options system (messy)
[tpope-extra.git] / perl / schedproc
index 3c34f3ac1b4805d8d73a653d69a76fced65745e7..f06a7783d32d14db7c531adeebd1286c87bb5b04 100755 (executable)
@@ -3,84 +3,84 @@
 # -*- perl -*- vim: ft=perl sw=4 sts=4
 
 # Brief usage instructions:
-# Create a ~/.sct6rc that has SID=yourssn and PIN=yourpin
-# You'll need to change the url below if you go anywhere but TAMUK.
+# Create a ~/.schedprocrc that has schedule=/path/to/schedule.xml and
+# grades=/path/to/grades.xml.  HTTP URLs are acceptable
 
 use strict;
 use Date::Calc::Object qw(Day_of_Week Decode_Day_of_Week Decode_Month Week_of_Year Monday_of_Week Day_of_Week_Abbreviation Delta_Days Add_Delta_Days Nth_Weekday_of_Month_Year Gmtime Mktime);
 use Date::Calendar::Profiles qw($Profiles);
 use Date::Calendar::Year;
+use Getopt::Long;
 use LWP::UserAgent;
 use XML::Simple;
 use vars qw(%opts %faculty);
 
-my ($response);
+$opts{'config'} = $ENV{HOME} . "/.schedprocrc";
 
-$opts{'holidays'} = { # %{$Profiles->{'US-TX'}},
-    "Martin Luther King Day"    => "3/Mon/Jan",
-    "Good Friday"               => "-2",
-    "Spring Break Monday"      => \&Spring_Break,
-    "Spring Break Tuesday"     => \&Spring_Break,
-    "Spring Break Wednesday"   => \&Spring_Break,
-    "Spring Break Thursday"    => \&Spring_Break,
-    "Spring Break Friday"      => \&Spring_Break,
-    "Spring Break Saturday"    => \&Spring_Break,
-    "Study Day"                 => "4/Thu/Apr", # ?
-    "Memorial Day"              => "5/Mon/May",
-    "Independence Day"          => \&US_Independence,
-    "Labor Day"                 => \&US_Labor,
-    #"Columbus Day"              => "2/Mon/Oct",
-    "Thanksgiving Day"          => "4/Thu/Nov",
-    "Thanksgiving Friday"       => \&Thanksgiving_Friday,
-};
-
-sub Spring_Break {
-    my($year,$label) = @_;
-    $label =~ s/^Spring Break //;
-    return( Add_Delta_Days(
-           Nth_Weekday_of_Month_Year($year,1,1,1),
-           7*(11-1) # This is for the 11th Monday of the year
-           +Decode_Day_of_Week($label)-1) );
-}
-
-sub Thanksgiving_Friday {
-    my($year,$label) = @_;
-    return( Add_Delta_Days(Nth_Weekday_of_Month_Year($year,11,4,4), 1) );
-}
-sub US_Independence # Fourth of July
-{
-    my($year,$label) = @_;
-    return( &Date::Calendar::Profiles::Nearest_Workday($year,7,4) );
-}
-sub US_Labor # First Monday after the first Sunday in September
-{
-    my($year,$label) = @_;
-    return( Add_Delta_Days(
-        Nth_Weekday_of_Month_Year($year,9,7,1), +1) );
+if(($ARGV[0] || "") eq '-F') {
+    shift;
+    $opts{'config'} = shift;
 }
 
-my $config = $ENV{HOME} . "/.schedprocrc";
-if (($ARGV[0] || "") eq '-F') {
+my $arg = $ARGV[0] || "";
+if($arg eq "-x") {
+    shift;
+    $opts{'format'} = "xml";
+} elsif($arg eq "-h") {
+    shift;
+    $opts{'format'} = "html";
+} elsif($arg eq "-m") {
     shift;
-    $config = shift;
+    $opts{'format'} = "mhc";
+} elsif($arg eq "-c") {
+    shift;
+    $opts{'format'} = "csv";
+} elsif($arg eq "-v") {
+    shift;
+    $opts{'format'} = "vcs";
+} elsif($arg eq "-g") {
+    shift;
+    $opts{'format'} = "grades";
 }
 
-my $arg = "";
-$arg = shift if (defined($ARGV[0]) && $ARGV[0] =~ /^-\w$/);
+Getopt::Long::Configure ("bundling", "auto_help");
+die "Invalid arguments\n" unless
+GetOptions(\%opts, 'schedule=s', 'grades=s', 'name=s', 'format|f=s', 'config|F=s', 'out|o=s');
 
-if (-r $config) {
-    open CONFIG, $config;
+if (-r $opts{'config'}) {
+    open CONFIG, $opts{'config'};
     while(<CONFIG>) {
        s/\#.*//;
        next unless m/^([^=]*)=(.*)/;
-       $opts{$1}=$2;
+       my ($l, $r) = ($1, $2);
+       if ($l =~ /^(schedule|grades|name)$/) {
+           $opts{$l}||=$r;
+       } else {
+           warn "Unknown config file option $l.\n";
+       }
     }
     close CONFIG;
 }
-my $schedurl = $ENV{HOME} . "/schedule.xml";
-$schedurl = $opts{'schedule'} if(defined($opts{'schedule'}));
-my $gradeurl = $ENV{HOME} . "/grades.xml";
-$gradeurl = $opts{'grades'} if(defined($opts{'schedule'}));
+
+$opts{'schedule'} ||= "~/schedule.xml";
+$opts{'grades'} ||= "~/grades.xml";
+
+$opts{'schedule'} =~ s/^~\//$ENV{HOME}\//;
+$opts{'grades'} =~ s/^~\//$ENV{HOME}\//;
+
+if(!defined($opts{'out'}) && defined($ARGV[0])) {
+    $opts{'out'} = shift;
+}
+
+if(!defined($opts{'format'}) && defined($opts{'out'})) {
+    $opts{'format'} = $opts{'out'};
+    $opts{'format'} =~ s/.*\.//;
+    $opts{'format'} =~ s/^(.*\/|)\.?schedule$/mhc/;
+    undef $opts{'out'} if($opts{'out'} =~ /^(html|mhc|csv|cvs|xml|grades)$/);
+}
+
+$opts{'format'} ||= "";
+undef $opts{'out'} if(($opts{'out'}||"") eq "-");
 
 sub generate_id {
     my ($section, $number) = split("-", shift);
@@ -105,7 +105,6 @@ sub next_class {
     @off = @{$class{'off'}} if ($class{'off'});
     for($today = ($today > $firstday ? $today : $firstday); $today < $lastday; $today++) {
        next unless(grep($_ == Day_of_Week($today->date), @days));
-       print "$today\n";
        next if(grep($_ == "$today", @off));
        return $today;
     }
@@ -118,57 +117,6 @@ sub next_class {
     return undef;
 }
 
-sub off_for_holidays {
-    my %class = @_;
-    $class{'duration'} =~ /(\d\d\d\d)(\d\d)(\d\d)-(\d\d\d\d)(\d\d)(\d\d)/;
-    my $days = Delta_Days($1,$2,$3,$4,$5,$6);
-    my $firstday = Date::Calc->new($1,$2,$3);
-    my $lastday = Date::Calc->new($4,$5,$6);
-    my $year = Date::Calendar::Year->new($1, $opts{'holidays'});
-    my @holidays=();
-    my @days=();
-    foreach(split(" ",$class{days})) {
-       $days[Decode_Day_of_Week($_)] = 1;
-    }
-    foreach ($year->search("")) {
-       my $good=1;
-       #foreach my $x ($year->labels($_)) {
-       #    $good=0 if ($x =~ /Veteran/ or $x =~ /President/);
-       #}
-       next unless ($year->is_full($_) && $_>=$firstday && $_<=$lastday);
-       push @holidays, $_
-           if (defined($days[Day_of_Week($_->date)]) && $good > 0);
-    }
-    return wantarray ? @holidays : "@holidays";
-}
-
-sub off_for_exams {
-    my %class = @_;
-    my $time = $class{'begin'} . "-" . $class{'end'};
-    $class{'duration'} =~ /\d{8}-(\d\d\d\d)(\d\d)(\d\d)/;
-    my $lastday = Date::Calc->new($1,$2,$3);
-    return wantarray ? () : undef unless (Day_of_Week($lastday->date) == 7);
-    my $beginning="(08:00-09:15|11:00-12:15|14:00-15:15|17:00-18:15|17:30-18:45|20:00-21:15|20:30-21:45)";
-    my $ending   ="(06:30-07:45|09:30-10:45|12:30-13:45|15:30-16:45|18:30-19:45|19:00-20:15)";
-    my $days = join(" ",map {Decode_Day_of_Week($_)} split(/ /, $class{'days'}));
-    if($days eq "1 3") {
-       if($time =~ /$beginning/) {
-           return $lastday-4;
-       } elsif($time =~ /$ending/) {
-           return $lastday-6;
-       }
-    } elsif($days eq "2 4") {
-       if($time =~ /$beginning/) {
-           return $lastday-3;
-       } elsif($time =~ /$ending/) {
-           return $lastday-5;
-       }
-    } elsif($days eq "5") {
-       return $lastday-2;
-    }
-    return wantarray ? () : "";
-}
-
 sub capitalize {
     local $_ = shift || "";
     s/ +$//;
@@ -196,79 +144,39 @@ sub capitalize {
     return $_;
 }
 
-sub get_schedule {
+sub read_fileurl {
     my $content;
-    if($schedurl =~ /:\/\//) {
+    my $url=shift;
+    if($url =~ /:\/\//) {
        my $ua = LWP::UserAgent->new;
        $ua->timeout(10);
        $ua->env_proxy;
 #      $ua->cookie_jar( {} );
-       $response = $ua->get("$schedurl") or die "$!";
+       my $response = $ua->get("$url") or die "$!";
        die $response->status_line unless $response->is_success;
        $content = $response->content;
     } else {
-       open(F,$schedurl) || die "$!";
+       open(F,$url) || die "$!";
        $content = join ("", <F>);
        close F;
     }
+    return $content;
+    #my $ref = XMLin($content, ForceArray => [ 'class', 'cumulative', 'off' ], KeyAttr => "");
+    #return @{$ref->{'class'}};
+}
+
+sub get_schedule {
+    my $content = read_fileurl($opts{'schedule'});
     my $ref = XMLin($content, ForceArray => [ 'class', 'off' ], KeyAttr => "");
     return @{$ref->{'class'}};
 }
 
 sub get_grades {
-    my $content;
-    if($gradeurl =~ /:\/\//) {
-       my $ua = LWP::UserAgent->new;
-       $ua->timeout(10);
-       $ua->env_proxy;
-#      $ua->cookie_jar( {} );
-       $response = $ua->get("$gradeurl") or die "$!";
-       die $response->status_line unless $response->is_success;
-       $content = $response->content;
-    } else {
-       open(F,$schedurl) || die "$!";
-       $content = join ("", <F>);
-       close F;
-    }
+    my $content = read_fileurl($opts{'grades'});
     my $ref = XMLin($content, ForceArray => [ 'class', 'cumulative' ], KeyAttr => "");
     return $ref;
 }
 
-sub do_html_grades {
-    my ($file, $grades);
-    my @showheaders = ("Section ID", "Course Title", "Grade", "Earned<br />Hours", "Quality<br />Hours", "Quality<br />Points");
-    #$file = shift unless (!defined $_[0] or $_[0] =~ /^\d/);
-    $grades = get_grades(@_);
-    my ($row);
-    my $shade = "dark";
-    print '<table id="grades" cellpadding="3" cellspacing="0">'."\n<tr>";
-    print '<th align="left" class="sectionid">', $showheaders[0];
-    print '</th><th align="left" class="coursetitle">', $showheaders[1];
-    print '</th><th align="center" class="grade">';
-    print join('</th><th align="center" class="right-number">',@showheaders[2 .. 5]);
-    print "</th></tr>\n";
-    foreach my $ts ($grades->{'class'}) {
-       foreach my $row (@$ts) {
-           print '<tr class="'.$shade.'">';
-           $shade = ($shade eq "dark"?"light":"dark");
-           print '<td align="left" class="sectionid">', $row->{'id'}, '</td>';
-           print '<td align="left" class="coursetitle">', $row->{'title'}, '</td>';
-           print '<td align="center" class="grade">';
-           #print join('</td><td>', @$row[0 .. 1]);
-           print join('</td><td align="right" class="right-number">', ($row->{'grade'},$row->{'earned'},$row->{'hours'},$row->{'points'}));
-           print "</td></tr>\n";
-       }
-    }
-    my $lastrow = $grades->{'cumulative'}->[scalar @{$grades->{'cumulative'}}-1];
-    print '<tr class="cumulative '.$shade.'"><td id="cumulative" colspan="2">Cumulative: through ', capitalize($lastrow->{'term'});
-    print '</td><td align="center" id="gpa" class="grade">';
-    print $lastrow->{'gpa'};
-    print '</td><td align="right" class="right-number">';
-    print join('</td><td align="right" class="right-number">', ($lastrow->{'earned'}, $lastrow->{'hours'}, $lastrow->{'points'}));
-    print "</td></tr>\n";
-    print "</table>\n";
-}
-
 sub get_faculty_email {
     my ($name, $school, $email);
     if((-f $ENV{'HOME'} . "/public_html/faculty.csv") && ! %faculty) {
@@ -310,7 +218,7 @@ sub do_mhc_schedule {
     my %days = (M => "Mon", T => "Tue", W => "Wed", R => "Thu", F => "Fri", S => "Sat", U => "SU");
     my @mon = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
     my ($file, $current, @mhc, @schedule);
-    $file = shift unless (!defined $_[0] or $_[0] =~ /^\d/);
+    $file = $opts{'out'};
     @schedule = get_schedule(@_);
     @mhc = get_mhc_header;
     if(defined($file) && (-d $file)) {
@@ -385,10 +293,9 @@ sub do_csv_schedule {
     $| = 1;
     my %days = (M => "Mon", T => "Tue", W => "Wed", R => "Thu", F => "Fri", S => "Sat", U => "SU");
     my @mon = qw(Jan. Feb. Mar. Apr. May June July Aug. Sept. Oct. Nov. Dec.);
-    my (@terms, $file, $current, @mhc, @schedule);
-    $file = shift unless (!defined $_[0] or $_[0] =~ /^\d/);
+    my ($current, @mhc, @schedule);
     @schedule = get_schedule(@_);
-    open(STDOUT, ">" . $file) if(defined($file));
+    open(STDOUT, ">" . $opts{'out'}) if(defined($opts{'out'}));
     foreach my $row (@schedule) {
        map {s/\n/-/g if defined; $_} %$row;
        my $id=generate_id($row->{'id'});
@@ -399,7 +306,9 @@ sub do_csv_schedule {
        #print "# $id\n";
        $current .= $row->{'id'} . ",";
        $current .= $row->{'title'} . ",";
-       $current .= '"' . $row->{'instructor'} . '",';
+       my $instructor = $row->{'instructor'};
+       $instructor =~ s/ [A-Z. ]* / /;
+       $current .= '"' . $instructor . '",';
        $next =~ /^(\d\d\d\d)(\d\d)(\d\d)$/;
        $current .= $1 . "-". $2 ."-" . $3 . "\n";
        print $current;
@@ -409,7 +318,7 @@ sub do_csv_schedule {
 sub do_vcalendar_schedule {
     $| = 1;
     my %days = (M => "MO", T => "TU", W => "WE", R => "TH", F => "FR", S => "SA", U => "SU");
-    my $file = shift if (defined $_[0] and $_[0] !~ /^\d/);
+    my $file = $opts{'out'};
     my @schedule = get_schedule(@_);
     open(STDOUT, ">>" . $file) if(defined($file) && (! -d $file));
     open(STDOUT, ">/dev/null") if(defined($file) && (-d $file));
@@ -456,7 +365,7 @@ sub do_vcalendar_schedule {
 }
 
 sub do_xml_schedule {
-    my $file = shift if (defined $_[0] and $_[0] !~ /^\d/);
+    my $file = $opts{'out'};
     my $schedule = { class => [ get_schedule(@_) ] };
     my $xml = XMLout($schedule, NoAttr => 1, RootName => 'schedule');
     if($file) {
@@ -472,12 +381,15 @@ sub do_html_schedule {
     my @showheaders = ("Section ID/Title", "Instructor", "Days", "Time", "Duration", "Location");
     my $shade = "dark";
     my @schedule = get_schedule(@_);
+    if($opts{'out'}) {
+       open FH, ">" . $opts{'out'};
+       select FH;
+    }
     print '<table id="schedule" cellpadding="3" cellspacing="0">'."\n<tr><th>";
     print join("</th><th>",@showheaders);
     print "</th></tr>\n";
        foreach my $row (@schedule) {
            map { s/\n/<br \/>/g; $_} %$row;
-           #$row->{'time'} =~ s/-/-<wbr \/>/;
            $row->{'duration'} =~ s/-/<br \/>/g;
            $row->{'duration'} =~ s/\d\d(\d\d)(\d\d)(\d\d)/$2-$3-$1/g;
            print '<tr class="'.$shade.'">';
@@ -486,33 +398,81 @@ sub do_html_schedule {
            print '<span class="sectionid">' .$row->{'id'}. '</span><br />';
            print '<span class="coursetitle">' .$row->{'title'}. '</span></td>';
            my $instructor = $row->{'instructor'};
+           #$instructor =~ s/ [A-Z. ]* / /;
            my $email = get_faculty_email($row->{'instructor'});
            #if($email) {
                #print '<td><a href="mailto:' . $email . '">'
                #. $row->{'instructor'} . "</a></td>";
            # } else {
-               print "<td>" . $row->{'instructor'} . "</td>";
+           print "<td>" . $instructor . "</td>";
            #}
            print "<td>" . $row->{'days'} . "</td>";
-           print "<td>" . $row->{'begin'}."-<wbr />".$row->{'end'} . "</td>";
+           my ($a,$b) = ($row->{'begin'}, $row->{'end'});
+           $b .= "AM";
+           $a=~s/(1[3-9]|2\d|00):(\d\d)/sprintf "%d:%02d",abs $1-12,$2/e;
+           $b=~s/(1[3-9]|2\d|00):(\d\d)AM/sprintf "%d:%02dPM",abs $1-12,$2/e;
+           print "<td>$a-<wbr />$b</td>";
            print "<td>" . $row->{'duration'} . "</td>";
            print "<td>" . $row->{'location'} . "</td>";
            print "</tr>\n";
        }
     print "</table>\n";
+    select STDOUT;
+}
+
+sub do_html_grades {
+    my $grades;
+    my @showheaders = ("Section ID", "Course Title", "Grade", "Earned<br />Hours", "Quality<br />Hours", "Quality<br />Points");
+    $grades = get_grades(@_);
+    my ($row);
+    my $shade = "dark";
+    if($opts{'out'}) {
+       open FH, ">" . $opts{'out'};
+       select FH;
+    }
+    print '<table id="grades" cellpadding="3" cellspacing="0">'."\n<tr>";
+    print '<th align="left" class="sectionid">', $showheaders[0];
+    print '</th><th align="left" class="coursetitle">', $showheaders[1];
+    print '</th><th align="center" class="grade">';
+    print join('</th><th align="center" class="right-number">',@showheaders[2 .. 5]);
+    print "</th></tr>\n";
+    foreach my $ts ($grades->{'class'}) {
+       foreach my $row (@$ts) {
+           print '<tr class="'.$shade.'">';
+           $shade = ($shade eq "dark"?"light":"dark");
+           print '<td align="left" class="sectionid">', $row->{'id'}, '</td>';
+           print '<td align="left" class="coursetitle">', $row->{'title'}, '</td>';
+           print '<td align="center" class="grade">';
+           #print join('</td><td>', @$row[0 .. 1]);
+           print join('</td><td align="right" class="right-number">', ($row->{'grade'},$row->{'earned'},$row->{'hours'},$row->{'points'}));
+           print "</td></tr>\n";
+       }
+    }
+    my $lastrow = $grades->{'cumulative'}->[scalar @{$grades->{'cumulative'}}-1];
+    print '<tr class="cumulative '.$shade.'"><td id="cumulative" colspan="2">Cumulative: through ', capitalize($lastrow->{'term'});
+    print '</td><td align="center" id="gpa" class="grade">';
+    print $lastrow->{'gpa'};
+    print '</td><td align="right" class="right-number">';
+    print join('</td><td align="right" class="right-number">', ($lastrow->{'earned'}, $lastrow->{'hours'}, $lastrow->{'points'}));
+    print "</td></tr>\n";
+    print "</table>\n";
+    select STDOUT;
 }
 
-if ($arg eq "-s" || $arg eq "-h") {
+
+if ($opts{'format'} eq "xml") {
+    do_xml_schedule(@ARGV);
+} elsif ($opts{'format'} eq "html") {
     do_html_schedule(@ARGV);
-} elsif ($arg eq "-m") {
+} elsif ($opts{'format'} eq "mhc") {
     do_mhc_schedule(@ARGV);
-} elsif ($arg eq "-c") {
+} elsif ($opts{'format'} eq "csv") {
     do_csv_schedule(@ARGV);
-} elsif ($arg eq "-v") {
+} elsif ($opts{'format'} eq "vcs") {
     do_vcalendar_schedule(@ARGV);
-} elsif ($arg eq "-x") {
-    do_xml_schedule(@ARGV);
-} elsif ($arg eq "-g") {
+} elsif ($opts{'format'} eq "grades") {
     do_html_grades(@ARGV);
+} else {
+    die "Unknown format.  Try specifying --format.\n"
 }