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