perl/sctweb

   1 #!/usr/bin/perl -w
   2 # $Id$
   3 # -*- perl -*- vim: ft=perl sw=4 sts=4
   4
   5 use strict;
   6 use LWP::UserAgent;
   7 use HTML::TableExtract;
   8 use vars qw($ua %opts);
   9 my ($ts, $row, $response);
  10 my $url="https://sctweb.accd.edu/ia-bin4/tsrvweb.exe?WID=W&tserve_tip_read_destroy&tserve_host_code=4&tserve_tiphost_code=0";
  11
  12 if (-r $ENV{HOME} . "/.sctwebrc") {
  13     open CONFIG, $ENV{HOME} . "/.sctwebrc";
  14     while(<CONFIG>) {
  15         s/\#.*//;
  16         next unless m/^([^=]*)=(.*)/;
  17         $opts{$1}=$2;
  18     }
  19     close CONFIG;
  20 }
  21
  22 $ua = LWP::UserAgent->new;
  23 $ua->timeout(10);
  24 $ua->env_proxy;
  25 $ua->cookie_jar( {} );
  26 $ua->get("$url&tserve_tip_write=||WID&tserve_transconfig=astulog.cfg") or die "$!";
  27 $response = $ua->post("$url&tserve_trans_config=astulog.cfg", { tserve_tip_write => "%7C%7CWID%7CSID%7CPIN", SID => $opts{SID}, PIN => $opts{PIN} }) or die "$!";
  28 #print $response->content;
  29 #die "Site down.  Try again later.\n" if(length($response->content)<256);
  30
  31 $response = $ua->get("$url&tserve_tip_write=||WID|SID|PIN|Term&tserve_trans_config=" . ("regterm.cfg"||"rgrdterm.cfg")); # Valid terms
  32 die $response->status_line unless $response->is_success;
  33 my @terms = grep {s/^<option value="([^"]*)">.*/$1/} (split( /\r\n/, $response->content));
  34 die "Site down. Try again later.\n" unless (@terms);
  35
  36 sub do_schedule {
  37     my @readheaders = ("Section ID/Title", "Instructor", "Days", "Time", "Start/EndDates", "Site/Building/Room");
  38     my @showheaders = ("Section ID/Title", "Instructor", "Days", "Time", "Start/End\nDates", "Location");
  39     my $te = new HTML::TableExtract( headers => [ @readheaders ] );
  40     my (@terms, $row);
  41     my @localtime=localtime();
  42     if ($localtime[4]<3) { # Through Mar 31
  43         @terms=((1900+$localtime[5])*10+2);
  44     } elsif ($localtime[4]<5) { # Through May 31
  45         @terms=((1900+$localtime[5])*10+2,(1900+$localtime[5])*10+3);
  46     } elsif ($localtime[4]<7) { # through July 31
  47         @terms=((1900+$localtime[5])*10+3,(1900+$localtime[5])*10+4);
  48     } elsif ($localtime[4]<8) { # through Aug 31
  49         @terms=((1900+$localtime[5])*10+4,(1900+$localtime[5])*10+1);
  50     } elsif ($localtime[4]<10) { # through Oct 31
  51         @terms=((1900+$localtime[5])*10+1);
  52     } else {
  53         @terms=((1900+$localtime[5])*10+1,(1901+$localtime[5])*10+2);
  54     }
  55     foreach(@ARGV || @terms) {
  56         $response = $ua->get("$url&tserve_tip_write=||WID|SID|PIN|Term&tserve_trans_config=" . ($opts{cfg} || "rstusch" || "rgrades") . ".cfg&Term=".($_) );
  57         die $response->status_line unless $response->is_success;
  58         $te->parse($response->content);
  59     }
  60     print '<table cellpadding="3" cellspacing="0">'."\n<tr><th>";
  61     print join("</th><th>",@showheaders);
  62     print "</th></tr>\n";
  63     foreach $ts ($te->table_states) {
  64         foreach $row ($ts->rows) {
  65             map { s/\xa0//g; s/\n/<br \/>/g; $_} @$row;
  66             $row->[0] =~ s/.*launchWebCT\("([^"]*)"\).*/$1/s;
  67             $row->[0] =~ s/ <BR>/<br \/>/g;
  68             $row->[5] =~ s/ON CAMPUS<br \/>//g;
  69             $row->[5] =~ s/<br \/>/ /g;
  70             print '<tr><td>';
  71             print join('</td><td>', @$row);
  72             print "</td></tr>\n";
  73         }
  74     }
  75     print "</table>\n";
  76 }
  77
  78 sub do_grades {
  79     my @readheaders = ("Section ID", "Course Title", "Grade", "Attempted  Hours", "Earned  Hours", "Quality  Hours", "Quality  Points", "GPA");
  80     my @showheaders = ("Section ID", "Course Title", "Grade", "Attempted<br>Hours", "Earned<br>Hours", "Quality<br>Hours", "Quality<br>Points", "GPA");
  81     my ($row, $lastrow);
  82     my $te = new HTML::TableExtract( headers => [ @readheaders ] );
  83     my $response = $ua->get("$url&tserve_tip_write=||WID|SID|PIN|Term&tserve_trans_config=rgrdterm.cfg"); # Valid grading terms
  84     die $response->status_line unless $response->is_success;
  85     my @terms = grep {s/^<option value="([^"]*)">.*/$1/} (split( /\r\n/, $response->content));
  86     foreach(@ARGV || reverse @terms) {
  87         $response = $ua->get("$url&tserve_tip_write=||WID|SID|PIN|Term&tserve_trans_config=rgrades.cfg&Term=".($_) );
  88         die $response->status_line unless $response->is_success;
  89         $te->parse($response->content);
  90     }
  91     print '<table cellpadding="3" cellspacing="0">'."\n<tr><th>";
  92     print join("</th><th>",@showheaders);
  93     print "</th></tr>\n";
  94     foreach $ts ($te->table_states) {
  95         foreach $row ($ts->rows) {
  96             map { s/\xa0//g; s/\n/<br \/>/g; $_} @$row;
  97             #$row->[0] =~ s/.*launchWebCT\("([^"]*)"\).*/$1/s;
  98             #$row->[0] =~ s/ <BR>/<br \/>/s;
  99             $lastrow=$row;
 100             next if $row->[0] =~ /:/;
 101             print '<tr><td>';
 102             print join('</td><td>', @$row);
 103             print "</td></tr>\n";
 104         }
 105     }
 106     print '<tr><td colspan="3">', $lastrow->[0];
 107     shift @$lastrow; shift @$lastrow;
 108     print join('</td><td>', @$lastrow);
 109     print "</td></tr>\n";
 110     print "</table>\n";
 111 }
 112
 113 if(defined($ARGV[0]) && $ARGV[0] eq "-g") {
 114     shift;
 115     do_grades;
 116 } else {
 117     do_schedule;
 118 }
 119
 120 $ua->get("$url&tserve_trans_config=alogout.cfg"); # Logout