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", "Site/Building/Room");
  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             $row->[4] =~ s/ON CAMPUS-//g;
 105             $row->[4] =~ s/-/ /g;
 106             print "\n";
 107             print "X-SC-Subject: ", $row->[0], "\n";
 108             print "X-SC-Category: School\n";
 109             print "X-SC-Cond:", $row->[1], "\n"; # Space after colon not needed
 110             print "X-SC-Time: ", $row->[2], "\n";
 111             print "X-SC-Duration: ", $row->[3], "\n";
 112             print "X-SC-Location: ", $row->[4], "\n";
 113         }
 114     }
 115 }
 116
 117 sub do_html_schedule {
 118     my @readheaders = ("Section ID/Title", "Instructor", "Days", "Time", "Start/EndDates", "Site/Building/Room");
 119     my @showheaders = ("Section ID/Title", "Instructor", "Days", "Time", "Duration", "Location");
 120     my $te = new HTML::TableExtract( headers => [ @readheaders ] );
 121     my (@terms, $row);
 122     @terms = get_schedule_terms();
 123     foreach(@ARGV || @terms) {
 124         $response = $ua->get("$url&tserve_tip_write=||WID|SID|PIN|Term&tserve_trans_config=" . ($opts{cfg} || "rstusch" || "rgrades") . ".cfg&Term=".($_) );
 125         die $response->status_line unless $response->is_success;
 126         $te->parse($response->content);
 127     }
 128     print '<table cellpadding="3" cellspacing="0">'."\n<tr><th>";
 129     print join("</th><th>",@showheaders);
 130     print "</th></tr>\n";
 131     foreach $ts ($te->table_states) {
 132         foreach $row ($ts->rows) {
 133             map { s/\xa0//g; s/\n/<br \/>/g; $_} @$row;
 134             $row->[0] =~ s/.*launchWebCT\("([^"]*)"\).*/$1/s;
 135             $row->[0] =~ s/ <BR>(.*)/"<br \/>" . capitalize($1)/eg;
 136             $row->[1] = capitalize($row->[1]);
 137             $row->[5] =~ s/ON CAMPUS<br \/>//g;
 138             $row->[5] =~ s/<br \/>/ /g;
 139             print '<tr><td>';
 140             print join('</td><td>', @$row);
 141             print "</td></tr>\n";
 142         }
 143     }
 144     print "</table>\n";
 145 }
 146
 147 sub do_html_grades {
 148     my @readheaders = ("Section ID", "Course Title", "Grade", "Attempted  Hours", "Earned  Hours", "Quality  Hours", "Quality  Points", "GPA");
 149     my @showheaders = ("Section ID", "Course Title", "Grade", "Attempted<br>Hours", "Earned<br>Hours", "Quality<br>Hours", "Quality<br>Points", "GPA");
 150     my ($row, $lastrow);
 151     my $te = new HTML::TableExtract( headers => [ @readheaders ] );
 152     my $response = $ua->get("$url&tserve_tip_write=||WID|SID|PIN|Term&tserve_trans_config=rgrdterm.cfg"); # Valid grading terms
 153     die $response->status_line unless $response->is_success;
 154     my @terms = grep {s/^<option value="([^"]*)">.*/$1/} (split( /\r\n/, $response->content));
 155     foreach(@ARGV || reverse @terms) {
 156         $response = $ua->get("$url&tserve_tip_write=||WID|SID|PIN|Term&tserve_trans_config=rgrades.cfg&Term=".($_) );
 157         die $response->status_line unless $response->is_success;
 158         $te->parse($response->content);
 159     }
 160     print '<table cellpadding="3" cellspacing="0">'."\n<tr><th>";
 161     print join("</th><th>",@showheaders);
 162     print "</th></tr>\n";
 163     foreach $ts ($te->table_states) {
 164         foreach $row ($ts->rows) {
 165             map { s/\xa0//g; s/\n/<br \/>/g; $_} @$row;
 166             $row->[1] = capitalize($row->[1]);
 167             $lastrow=$row;
 168             next if $row->[0] =~ /:/;
 169             print '<tr><td>';
 170             print join('</td><td>', @$row);
 171             print "</td></tr>\n";
 172         }
 173     }
 174     print '<tr><td colspan="2">', capitalize($lastrow->[0]);
 175     shift @$lastrow; shift @$lastrow;
 176     print "</td><td>";
 177     print join('</td><td>', @$lastrow);
 178     print "</td></tr>\n";
 179     print "</table>\n";
 180 }
 181
 182 if (defined($ARGV[0]) && $ARGV[0] eq "-g") {
 183     shift;
 184     do_html_grades;
 185 } elsif (defined($ARGV[0]) && $ARGV[0] eq "-s") {
 186     shift;
 187     do_html_schedule;
 188 } else {
 189     do_mhc_schedule;
 190 }
 191
 192 $ua->get("$url&tserve_trans_config=alogout.cfg"); # Logout