Actually works
[tpope-extra.git] / perl / schedproc
index b1f9d173d223be5adfe044cadaa8777a6d8983f0..a61b4532491e20dbdf1dc0937d1f36427e575dc9 100755 (executable)
@@ -3,41 +3,81 @@
 # -*- 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);
+use vars qw(%opts %faculty %facurl);
 
-my ($response);
+$opts{'config'} = $ENV{HOME} . "/.schedprocrc";
 
-my $config = $ENV{HOME} . "/.schedprocrc";
-if (($ARGV[0] || "") eq '-F') {
+my $arg = $ARGV[0] || "";
+if($arg eq "-x") {
     shift;
-    $config = shift;
+    $opts{'format'} = "xml";
+} elsif($arg eq "-h") {
+    shift;
+    $opts{'format'} = "html";
+} elsif($arg eq "-m") {
+    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=s', 'grades|G=s', 'faculty=s', 'name|n=s', 'format|f=s', 'config|F=s', 'out|o=s');
 
-if (-r $config) {
-    open CONFIG, $config;
+if (-r $opts{'config'}) {
+    open CONFIG, $opts{'config'} or die $!;
     while(<CONFIG>) {
        s/\#.*//;
        next unless m/^([^=]*)=(.*)/;
-       $opts{$1}=$2;
+       my ($l, $r) = ($1, $2);
+       if ($l =~ /^(schedule|grades|name|faculty)$/) {
+           $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{'faculty'} ||= "";
+
+$opts{'schedule'} =~ s/(^|,)~\//$1$ENV{HOME}\//;
+$opts{'grades'} =~ s/(^|,)~\//$1$ENV{HOME}\//;
+$opts{'faculty'} =~ s/(^|,)~\//$1$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|vcs|xml|grades)$/);
+}
+
+$opts{'format'} ||= "";
+undef $opts{'out'} if(($opts{'out'}||"") eq "-");
 
 sub generate_id {
     my ($section, $number) = split("-", shift);
@@ -101,93 +141,60 @@ 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 => "");
+    die "Could not load schedule.\n" unless $ref->{'class'};
     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 $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) {
-       open INS, $ENV{'HOME'} . "/public_html/faculty.csv";
-       while($_ = <INS>) {
-           chomp;
+sub load_faculty {
+    my ($name, $email, $url, $content);
+    if(($opts{'faculty'}) && ! %faculty) {
+       $content = read_fileurl($opts{'faculty'});
+       foreach $_ (split("\n", $content)) {
            m/"([^"]*)",([^,]*),([^,]*)/; # "
-           ($name, $email, $school) = ($1, $2, $3);
+           ($name, $email, $url) = ($1, $2, $3);
+           next unless ($name);
            $name =~ s/ [A-Z]\.//g;
            $name = lc $name;
            $name =~ s/\W//g;
-           $faculty{$name} = $email;
+           $faculty{$name} = $email if($email);
+           $facurl{$name} = $url if ($url);
        }
     }
+}
+
+sub get_faculty_email {
+    load_faculty();
+    my ($name);
     $name = shift;
     $name =~ s/ [A-Z]r?\.//g;
     $name = lc $name;
@@ -195,6 +202,16 @@ sub get_faculty_email {
     return $faculty{$name};
 }
 
+sub get_faculty_url {
+    load_faculty();
+    my ($name);
+    $name = shift;
+    $name =~ s/ [A-Z]r?\.//g;
+    $name = lc $name;
+    $name =~ s/\W//g;
+    return $facurl{$name};
+}
+
 sub get_mhc_header {
 return (
 "X-SC-Subject: New Years Day\nX-SC-Category: Holiday\nX-SC-Cond: 1 Jan\nX-SC-Duration: 00010101-\nX-SC-Record-Id: <New_Years_Day\@from.sctweb>\n",
@@ -215,7 +232,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)) {
@@ -265,7 +282,7 @@ sub do_mhc_schedule {
        my @lines;
        foreach my $name (<$file/[1-9]*>) {
            next unless $name =~ /^$file\/[1-9][0-9]*$/;
-           open FH, $name;
+           open (FH, $name) || die $!;
            @lines = <FH>;
            close FH;
            foreach (@lines) {
@@ -275,12 +292,12 @@ sub do_mhc_schedule {
        my $i=0;
        foreach (@mhc) {
            while(-f ++$i) {}
-           open FH, ">$file/$i" or die $!;
+           open (FH, ">$file/$i") || die $!;
            print FH $_;
            close FH;
        }
     } else {
-       open(STDOUT, ">" . $file) if(defined($file));
+       open(STDOUT, ">" . $file) || die $! if(defined($file));
        print "# MHC school schedule\n# Autogenerated by sctweb ".localtime()."\n\n";
        print join("\n", @mhc);
     }
@@ -290,10 +307,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'}) || die $! if(defined($opts{'out'}));
     foreach my $row (@schedule) {
        map {s/\n/-/g if defined; $_} %$row;
        my $id=generate_id($row->{'id'});
@@ -304,7 +320,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;
@@ -314,10 +332,10 @@ 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));
+    open(STDOUT, ">>" . $file) || die $! if(defined($file) && (! -d $file));
+    open(STDOUT, ">/dev/null") || die $! if(defined($file) && (-d $file));
     print "BEGIN:VCALENDAR\r\nVERSION:1.0\r\n";
     foreach my $row (@schedule) {
        map { s/\n/-/g; $_} %$row;
@@ -361,11 +379,11 @@ 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) {
-       open FH, ">$file";
+       open FH, ">$file" || die $!;
        print FH $xml;
        close FH;
     } else {
@@ -377,12 +395,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'}) || die $!;
+       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.'">';
@@ -391,33 +412,80 @@ sub do_html_schedule {
            print '<span class="sectionid">' .$row->{'id'}. '</span><br />';
            print '<span class="coursetitle">' .$row->{'title'}. '</span></td>';
            my $instructor = $row->{'instructor'};
-           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>";
-           #}
+           #$instructor =~ s/ [A-Z. ]* / /;
+           my $url = get_faculty_url($row->{'instructor'});
+           if($url) {
+               print '<td class="instructor"><a href="' . $url . '">'
+               . $row->{'instructor'} . "</a></td>";
+           } else {
+               print '<td class="instructor">' . $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'}) || die $!;
+       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"
 }
-