perl/sctweb

   1 #!/usr/bin/perl -w
   2 # $Id$
   3 # -*- perl -*- vim: ft=perl sw=4 sts=4
   4
   5 # Brief usage instructions:
   6 # Create a ~/.sctwebrc that has SID=yourssn and PIN=yourpin
   7 # You'll need to change the url below if you go anywhere but Northwest Vista.
   8
   9 use strict;
  10 use LWP::UserAgent;
  11 use HTML::TableExtract;
  12 use vars qw($ua %opts);
  13 my ($ts, $row, $response);
  14 my $url="https://sctweb.accd.edu/ia-bin4/tsrvweb.exe?WID=W&tserve_tip_read_destroy&tserve_host_code=4&tserve_tiphost_code=0";
  15
  16 if (-r $ENV{HOME} . "/.sctwebrc") {
  17     open CONFIG, $ENV{HOME} . "/.sctwebrc";
  18     while(<CONFIG>) {
  19         s/\#.*//;
  20         next unless m/^([^=]*)=(.*)/;
  21         $opts{$1}=$2;
  22     }
  23     close CONFIG;
  24 }
  25
  26 $ua = LWP::UserAgent->new;
  27 $ua->timeout(10);
  28 $ua->env_proxy;
  29 $ua->cookie_jar( {} );
  30 $ua->get("$url&tserve_tip_write=||WID&tserve_transconfig=astulog.cfg") or die "$!";
  31 $response = $ua->post("$url&tserve_trans_config=astulog.cfg", { tserve_tip_write => "%7C%7CWID%7CSID%7CPIN", SID => $opts{SID}, PIN => $opts{PIN} }) or die "$!";
  32
  33 $response = $ua->get("$url&tserve_tip_write=||WID|SID|PIN|Term&tserve_trans_config=" . ("regterm.cfg"||"rgrdterm.cfg")); # Valid terms
  34 die $response->status_line unless $response->is_success;
  35 my @terms = grep {s/^<option value="([^"]*)">.*/$1/} (split( /\r\n/, $response->content));
  36 die "Site down. Try again later.\n" unless (@terms);
  37
  38 sub capitalize {
  39     local $_ = shift;
  40     s/\b([A-Z])([A-Z]*)\b/$1\L$2/g;
  41     s/\b(I)(i*)\b/$1\U$2/g;
  42     s/\bUs\b/US/g;
  43     s/ (And|For|Of|Or|The|To|With) / \l$1 /g;
  44     s/\b(Ma?c)([a-z])/$1\u$2/g;
  45     s/\b(Tcp\/Ip|Pc)\b/\U$&/g;
  46     s/\bThru\b/Through/g;
  47     s/\bAcct\b/Accounting/g;
  48     s/\bAmer\b/American/g;
  49     s/\bChem\b/Chemistry/g;
  50     s/\bComp\b/Composition/g;
  51     s/\bFed\b/Federal/g;
  52     s/\bGen\b/General/g;
  53     #s/\bGovt\b/Government/g;
  54     s/\bLit\b/Literature/g;
  55     s/\bPrin\b/Principles/g;
  56     return $_;
  57 }
  58 sub get_schedule_terms {
  59     my @terms;
  60     my @localtime=localtime();
  61     if ($localtime[4]<3) { # Through Mar 31
  62         @terms=((1900+$localtime[5])*10+2);
  63     } elsif ($localtime[4]<5) { # Through May 31
  64         @terms=((1900+$localtime[5])*10+2,(1900+$localtime[5])*10+3);
  65     } elsif ($localtime[4]<7) { # through July 31
  66         @terms=((1900+$localtime[5])*10+3,(1900+$localtime[5])*10+4);
  67     } elsif ($localtime[4]<8) { # through Aug 31
  68         @terms=((1900+$localtime[5])*10+4,(1900+$localtime[5])*10+1);
  69     } elsif ($localtime[4]<10) { # through Oct 31
  70         @terms=((1900+$localtime[5])*10+1);
  71     } else {
  72         @terms=((1900+$localtime[5])*10+1,(1901+$localtime[5])*10+2);
  73     }
  74     return @terms;
  75 }
  76
  77 sub do_mhc_schedule {
  78     my @readheaders = ("Section ID/Title", "Days", "Time", "Start/EndDates");
  79     my %days = (M => "Mon", T => "Tue", W => "Wed", R => "Thu", F => "Fri", S => "Sat");
  80     my $te = new HTML::TableExtract( headers => [ @readheaders ] );
  81     my (@terms, $row);
  82     @terms = get_schedule_terms();
  83     foreach(@ARGV || @terms) {
  84         $response = $ua->get("$url&tserve_tip_write=||WID|SID|PIN|Term&tserve_trans_config=" . ($opts{cfg} || "rstusch" || "rgrades") . ".cfg&Term=".($_) );
  85         die $response->status_line unless $response->is_success;
  86         $te->parse($response->content);
  87     }
  88     print "# MHC school schedule\n";
  89     print "# Autogenerated by sctweb ".localtime()."\n";
  90     foreach $ts ($te->table_states) {
  91         foreach $row ($ts->rows) {
  92             map { s/\xa0//g; s/\n/-/g; $_} @$row;
  93             $row->[0] =~ s/.*launchWebCT\("([^"]*)"\).*/$1/s;
  94             $row->[0] =~ s/.*<BR>//g;
  95             $row->[0] = capitalize($row->[0]);
  96             $row->[1] =~ s/([MTWRFS])/ $days{$1}/g;
  97             if($row->[2] =~ /^(\d\d):\d\d-(\d\d):\d\dPM$/) {
  98                 $row->[2] =~ s/^(\d\d)/$1+12/e
  99                 if($1 < $2);
 100                 $row->[2] =~ s/-(\d\d)/"-".($1+12)/e;
 101                 $row->[2] =~ s/PM$//;
 102             } else { $row->[2] =~ s/AM$//; }
 103             $row->[3] =~ s/(\d\d)-(\d\d)-(\d\d)/20$3$1$2/g;
 104             print "\n";
 105             print "X-SC-Subject: ", $row->[0], "\n";
 106             print "X-SC-Category: School\n";
 107             print "X-SC-Cond:", $row->[1], "\n"; # Space after colon not needed
 108             print "X-SC-Time: ", $row->[2], "\n";
 109             print "X-SC-Duration: ", $row->[3], "\n";
 110         }
 111     }
 112 }
 113
 114 sub do_html_schedule {
 115     my @readheaders = ("Section ID/Title", "Instructor", "Days", "Time", "Start/EndDates", "Site/Building/Room");
 116     my @showheaders = ("Section ID/Title", "Instructor", "Days", "Time", "Duration", "Location");
 117     my $te = new HTML::TableExtract( headers => [ @readheaders ] );
 118     my (@terms, $row);
 119     @terms = get_schedule_terms();
 120     foreach(@ARGV || @terms) {
 121         $response = $ua->get("$url&tserve_tip_write=||WID|SID|PIN|Term&tserve_trans_config=" . ($opts{cfg} || "rstusch" || "rgrades") . ".cfg&Term=".($_) );
 122         die $response->status_line unless $response->is_success;
 123         $te->parse($response->content);
 124     }
 125     print '<table cellpadding="3" cellspacing="0">'."\n<tr><th>";
 126     print join("</th><th>",@showheaders);
 127     print "</th></tr>\n";
 128     foreach $ts ($te->table_states) {
 129         foreach $row ($ts->rows) {
 130             map { s/\xa0//g; s/\n/<br \/>/g; $_} @$row;
 131             $row->[0] =~ s/.*launchWebCT\("([^"]*)"\).*/$1/s;
 132             $row->[0] =~ s/ <BR>(.*)/"<br \/>" . capitalize($1)/eg;
 133             $row->[1] = capitalize($row->[1]);
 134             $row->[5] =~ s/ON CAMPUS<br \/>//g;
 135             $row->[5] =~ s/<br \/>/ /g;
 136             print '<tr><td>';
 137             print join('</td><td>', @$row);
 138             print "</td></tr>\n";
 139         }
 140     }
 141     print "</table>\n";
 142 }
 143
 144 sub do_html_grades {
 145     my @readheaders = ("Section ID", "Course Title", "Grade", "Attempted  Hours", "Earned  Hours", "Quality  Hours", "Quality  Points", "GPA");
 146     my @showheaders = ("Section ID", "Course Title", "Grade", "Attempted<br>Hours", "Earned<br>Hours", "Quality<br>Hours", "Quality<br>Points", "GPA");
 147     my ($row, $lastrow);
 148     my $te = new HTML::TableExtract( headers => [ @readheaders ] );
 149     my $response = $ua->get("$url&tserve_tip_write=||WID|SID|PIN|Term&tserve_trans_config=rgrdterm.cfg"); # Valid grading terms
 150     die $response->status_line unless $response->is_success;
 151     my @terms = grep {s/^<option value="([^"]*)">.*/$1/} (split( /\r\n/, $response->content));
 152     foreach(@ARGV || reverse @terms) {
 153         $response = $ua->get("$url&tserve_tip_write=||WID|SID|PIN|Term&tserve_trans_config=rgrades.cfg&Term=".($_) );
 154         die $response->status_line unless $response->is_success;
 155         $te->parse($response->content);
 156     }
 157     print '<table cellpadding="3" cellspacing="0">'."\n<tr><th>";
 158     print join("</th><th>",@showheaders);
 159     print "</th></tr>\n";
 160     foreach $ts ($te->table_states) {
 161         foreach $row ($ts->rows) {
 162             map { s/\xa0//g; s/\n/<br \/>/g; $_} @$row;
 163             $row->[1] = capitalize($row->[1]);
 164             $lastrow=$row;
 165             next if $row->[0] =~ /:/;
 166             print '<tr><td>';
 167             print join('</td><td>', @$row);
 168             print "</td></tr>\n";
 169         }
 170     }
 171     print '<tr><td colspan="2">', capitalize($lastrow->[0]);
 172     shift @$lastrow; shift @$lastrow;
 173     print "</td><td>";
 174     print join('</td><td>', @$lastrow);
 175     print "</td></tr>\n";
 176     print "</table>\n";
 177 }
 178
 179 if (defined($ARGV[0]) && $ARGV[0] eq "-g") {
 180     shift;
 181     do_html_grades;
 182 } elsif (defined($ARGV[0]) && $ARGV[0] eq "-s") {
 183     shift;
 184     do_html_schedule;
 185 } else {
 186     do_mhc_schedule;
 187 }
 188
 189 $ua->get("$url&tserve_trans_config=alogout.cfg"); # Logout