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/ (Of|For|The) / \l$1 /g;
  44     s/\b(Ma?c)([a-z])/$1u$2/g;
  45     return $_;
  46 }
  47 sub get_schedule_terms {
  48     my @terms;
  49     my @localtime=localtime();
  50     if ($localtime[4]<3) { # Through Mar 31
  51         @terms=((1900+$localtime[5])*10+2);
  52     } elsif ($localtime[4]<5) { # Through May 31
  53         @terms=((1900+$localtime[5])*10+2,(1900+$localtime[5])*10+3);
  54     } elsif ($localtime[4]<7) { # through July 31
  55         @terms=((1900+$localtime[5])*10+3,(1900+$localtime[5])*10+4);
  56     } elsif ($localtime[4]<8) { # through Aug 31
  57         @terms=((1900+$localtime[5])*10+4,(1900+$localtime[5])*10+1);
  58     } elsif ($localtime[4]<10) { # through Oct 31
  59         @terms=((1900+$localtime[5])*10+1);
  60     } else {
  61         @terms=((1900+$localtime[5])*10+1,(1901+$localtime[5])*10+2);
  62     }
  63     return @terms;
  64 }
  65
  66 sub do_mhc_schedule {
  67     my @readheaders = ("Section ID/Title", "Days", "Time", "Start/EndDates");
  68     my %days = (M => "Mon", T => "Tue", W => "Wed", R => "Thu", F => "Fri", S => "Sat");
  69     my $te = new HTML::TableExtract( headers => [ @readheaders ] );
  70     my (@terms, $row);
  71     @terms = get_schedule_terms();
  72     foreach(@ARGV || @terms) {
  73         $response = $ua->get("$url&tserve_tip_write=||WID|SID|PIN|Term&tserve_trans_config=" . ($opts{cfg} || "rstusch" || "rgrades") . ".cfg&Term=".($_) );
  74         die $response->status_line unless $response->is_success;
  75         $te->parse($response->content);
  76     }
  77     print "# MHC school schedule\n";
  78     print "# Autogenerated by sctweb ".localtime()."\n";
  79     foreach $ts ($te->table_states) {
  80         foreach $row ($ts->rows) {
  81             map { s/\xa0//g; s/\n/-/g; $_} @$row;
  82             $row->[0] =~ s/.*launchWebCT\("([^"]*)"\).*/$1/s;
  83             $row->[0] =~ s/.*<BR>//g;
  84             $row->[0] = capitalize($row->[0]);
  85             $row->[1] =~ s/([MTWRFS])/ $days{$1}/g;
  86             if($row->[2] =~ /^(\d\d):\d\d-(\d\d):\d\dPM$/) {
  87                 $row->[2] =~ s/^(\d\d)/$1+12/e
  88                 if($1 < $2);
  89                 $row->[2] =~ s/-(\d\d)/"-".($1+12)/e;
  90                 $row->[2] =~ s/PM$//;
  91             } else { $row->[2] =~ s/AM$//; }
  92             $row->[3] =~ s/(\d\d)-(\d\d)-(\d\d)/20$3$1$2/g;
  93             print "\n";
  94             print "X-SC-Subject: ", $row->[0], "\n";
  95             print "X-SC-Category: School\n";
  96             print "X-SC-Cond:", $row->[1], "\n"; # Space after colon not needed
  97             print "X-SC-Time: ", $row->[2], "\n";
  98             print "X-SC-Duration: ", $row->[3], "\n";
  99         }
 100     }
 101 }
 102
 103 sub do_html_schedule {
 104     my @readheaders = ("Section ID/Title", "Instructor", "Days", "Time", "Start/EndDates", "Site/Building/Room");
 105     my @showheaders = ("Section ID/Title", "Instructor", "Days", "Time", "Start/End\nDates", "Location");
 106     my $te = new HTML::TableExtract( headers => [ @readheaders ] );
 107     my (@terms, $row);
 108     @terms = get_schedule_terms();
 109     foreach(@ARGV || @terms) {
 110         $response = $ua->get("$url&tserve_tip_write=||WID|SID|PIN|Term&tserve_trans_config=" . ($opts{cfg} || "rstusch" || "rgrades") . ".cfg&Term=".($_) );
 111         die $response->status_line unless $response->is_success;
 112         $te->parse($response->content);
 113     }
 114     print '<table cellpadding="3" cellspacing="0">'."\n<tr><th>";
 115     print join("</th><th>",@showheaders);
 116     print "</th></tr>\n";
 117     foreach $ts ($te->table_states) {
 118         foreach $row ($ts->rows) {
 119             map { s/\xa0//g; s/\n/<br \/>/g; $_} @$row;
 120             $row->[0] =~ s/.*launchWebCT\("([^"]*)"\).*/$1/s;
 121             $row->[0] =~ s/ <BR>/<br \/>/g;
 122             $row->[5] =~ s/ON CAMPUS<br \/>//g;
 123             $row->[5] =~ s/<br \/>/ /g;
 124             print '<tr><td>';
 125             print join('</td><td>', @$row);
 126             print "</td></tr>\n";
 127         }
 128     }
 129     print "</table>\n";
 130 }
 131
 132 sub do_html_grades {
 133     my @readheaders = ("Section ID", "Course Title", "Grade", "Attempted  Hours", "Earned  Hours", "Quality  Hours", "Quality  Points", "GPA");
 134     my @showheaders = ("Section ID", "Course Title", "Grade", "Attempted<br>Hours", "Earned<br>Hours", "Quality<br>Hours", "Quality<br>Points", "GPA");
 135     my ($row, $lastrow);
 136     my $te = new HTML::TableExtract( headers => [ @readheaders ] );
 137     my $response = $ua->get("$url&tserve_tip_write=||WID|SID|PIN|Term&tserve_trans_config=rgrdterm.cfg"); # Valid grading terms
 138     die $response->status_line unless $response->is_success;
 139     my @terms = grep {s/^<option value="([^"]*)">.*/$1/} (split( /\r\n/, $response->content));
 140     foreach(@ARGV || reverse @terms) {
 141         $response = $ua->get("$url&tserve_tip_write=||WID|SID|PIN|Term&tserve_trans_config=rgrades.cfg&Term=".($_) );
 142         die $response->status_line unless $response->is_success;
 143         $te->parse($response->content);
 144     }
 145     print '<table cellpadding="3" cellspacing="0">'."\n<tr><th>";
 146     print join("</th><th>",@showheaders);
 147     print "</th></tr>\n";
 148     foreach $ts ($te->table_states) {
 149         foreach $row ($ts->rows) {
 150             map { s/\xa0//g; s/\n/<br \/>/g; $_} @$row;
 151             #$row->[0] =~ s/.*launchWebCT\("([^"]*)"\).*/$1/s;
 152             #$row->[0] =~ s/ <BR>/<br \/>/s;
 153             $lastrow=$row;
 154             next if $row->[0] =~ /:/;
 155             print '<tr><td>';
 156             print join('</td><td>', @$row);
 157             print "</td></tr>\n";
 158         }
 159     }
 160     print '<tr><td colspan="3">', $lastrow->[0];
 161     shift @$lastrow; shift @$lastrow;
 162     print join('</td><td>', @$lastrow);
 163     print "</td></tr>\n";
 164     print "</table>\n";
 165 }
 166
 167 if (defined($ARGV[0]) && $ARGV[0] eq "-g") {
 168     shift;
 169     do_html_grades;
 170 } elsif (defined($ARGV[0]) && $ARGV[0] eq "-s") {
 171     shift;
 172     do_html_schedule;
 173 } else {
 174     do_mhc_schedule;
 175 }
 176
 177 $ua->get("$url&tserve_trans_config=alogout.cfg"); # Logout