Added sctweb

diff --git a/perl/sctweb b/perl/sctweb
new file mode 100755 (executable)
index 0000000..af6bdc6
--- /dev/null
+++ b/perl/sctweb
@@ -0,0 +1,120 @@
+#!/usr/bin/perl -w
+# $Id$
+# -*- perl -*- vim: ft=perl sw=4 sts=4
+
+use strict;
+use LWP::UserAgent;
+use HTML::TableExtract;
+use vars qw($ua %opts);
+my ($ts, $row, $response);
+my $url="https://sctweb.accd.edu/ia-bin4/tsrvweb.exe?WID=W&tserve_tip_read_destroy&tserve_host_code=4&tserve_tiphost_code=0";
+
+if (-r $ENV{HOME} . "/.sctwebrc") {
+    open CONFIG, $ENV{HOME} . "/.sctwebrc";
+    while(<CONFIG>) {
+       s/\#.*//;
+       next unless m/^([^=]*)=(.*)/;
+       $opts{$1}=$2;
+    }
+    close CONFIG;
+}
+
+$ua = LWP::UserAgent->new;
+$ua->timeout(10);
+$ua->env_proxy;
+$ua->cookie_jar( {} );
+$ua->get("$url&tserve_tip_write=||WID&tserve_transconfig=astulog.cfg") or die "$!";
+$response = $ua->post("$url&tserve_trans_config=astulog.cfg", { tserve_tip_write => "%7C%7CWID%7CSID%7CPIN", SID => $opts{SID}, PIN => $opts{PIN} }) or die "$!";
+#print $response->content;
+#die "Site down.  Try again later.\n" if(length($response->content)<256);
+
+$response = $ua->get("$url&tserve_tip_write=||WID|SID|PIN|Term&tserve_trans_config=" . ("regterm.cfg"||"rgrdterm.cfg")); # Valid terms
+die $response->status_line unless $response->is_success;
+my @terms = grep {s/^<option value="([^"]*)">.*/$1/} (split( /\r\n/, $response->content));
+die "Site down. Try again later.\n" unless (@terms);
+
+sub do_schedule {
+    my @readheaders = ("Section ID/Title", "Instructor", "Days", "Time", "Start/EndDates", "Site/Building/Room");
+    my @showheaders = ("Section ID/Title", "Instructor", "Days", "Time", "Start/End\nDates", "Location");
+    my $te = new HTML::TableExtract( headers => [ @readheaders ] );
+    my (@terms, $row);
+    my @localtime=localtime();
+    if ($localtime[4]<3) { # Through Mar 31
+       @terms=((1900+$localtime[5])*10+2);
+    } elsif ($localtime[4]<5) { # Through May 31
+       @terms=((1900+$localtime[5])*10+2,(1900+$localtime[5])*10+3);
+    } elsif ($localtime[4]<7) { # through July 31
+       @terms=((1900+$localtime[5])*10+3,(1900+$localtime[5])*10+4);
+    } elsif ($localtime[4]<8) { # through Aug 31
+       @terms=((1900+$localtime[5])*10+4,(1900+$localtime[5])*10+1);
+    } elsif ($localtime[4]<10) { # through Oct 31
+       @terms=((1900+$localtime[5])*10+1);
+    } else {
+       @terms=((1900+$localtime[5])*10+1,(1901+$localtime[5])*10+2);
+    }
+    foreach(@ARGV || @terms) {
+       $response = $ua->get("$url&tserve_tip_write=||WID|SID|PIN|Term&tserve_trans_config=" . ($opts{cfg} || "rstusch" || "rgrades") . ".cfg&Term=".($_) );
+       die $response->status_line unless $response->is_success;
+       $te->parse($response->content);
+    }
+    print '<table cellpadding="3" cellspacing="0">'."\n<tr><th>";
+    print join("</th><th>",@showheaders);
+    print "</th></tr>\n";
+    foreach $ts ($te->table_states) {
+       foreach $row ($ts->rows) {
+           map { s/\xa0//g; s/\n/<br \/>/g; $_} @$row;
+           $row->[0] =~ s/.*launchWebCT\("([^"]*)"\).*/$1/s;
+           $row->[0] =~ s/ <BR>/<br \/>/g;
+           $row->[5] =~ s/ON CAMPUS<br \/>//g;
+           $row->[5] =~ s/<br \/>/ /g;
+           print '<tr><td>';
+           print join('</td><td>', @$row);
+           print "</td></tr>\n";
+       }
+    }
+    print "</table>\n";
+}
+
+sub do_grades {
+    my @readheaders = ("Section ID", "Course Title", "Grade", "Attempted  Hours", "Earned  Hours", "Quality  Hours", "Quality  Points", "GPA");
+    my @showheaders = ("Section ID", "Course Title", "Grade", "Attempted<br>Hours", "Earned<br>Hours", "Quality<br>Hours", "Quality<br>Points", "GPA");
+    my ($row, $lastrow);
+    my $te = new HTML::TableExtract( headers => [ @readheaders ] );
+    my $response = $ua->get("$url&tserve_tip_write=||WID|SID|PIN|Term&tserve_trans_config=rgrdterm.cfg"); # Valid grading terms
+    die $response->status_line unless $response->is_success;
+    my @terms = grep {s/^<option value="([^"]*)">.*/$1/} (split( /\r\n/, $response->content));
+    foreach(@ARGV || reverse @terms) {
+       $response = $ua->get("$url&tserve_tip_write=||WID|SID|PIN|Term&tserve_trans_config=rgrades.cfg&Term=".($_) );
+       die $response->status_line unless $response->is_success;
+       $te->parse($response->content);
+    }
+    print '<table cellpadding="3" cellspacing="0">'."\n<tr><th>";
+    print join("</th><th>",@showheaders);
+    print "</th></tr>\n";
+    foreach $ts ($te->table_states) {
+       foreach $row ($ts->rows) {
+           map { s/\xa0//g; s/\n/<br \/>/g; $_} @$row;
+           #$row->[0] =~ s/.*launchWebCT\("([^"]*)"\).*/$1/s;
+           #$row->[0] =~ s/ <BR>/<br \/>/s;
+           $lastrow=$row;
+           next if $row->[0] =~ /:/;
+           print '<tr><td>';
+           print join('</td><td>', @$row);
+           print "</td></tr>\n";
+       }
+    }
+    print '<tr><td colspan="3">', $lastrow->[0];
+    shift @$lastrow; shift @$lastrow;
+    print join('</td><td>', @$lastrow);
+    print "</td></tr>\n";
+    print "</table>\n";
+}
+
+if(defined($ARGV[0]) && $ARGV[0] eq "-g") {
+    shift;
+    do_grades;
+} else {
+    do_schedule;
+}
+
+$ua->get("$url&tserve_trans_config=alogout.cfg"); # Logout