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 Time::Local;
  13 use Date::Calc::Object qw(Day_of_Week Decode_Day_of_Week Week_of_Year Monday_of_Week Day_of_Week_Abbreviation Delta_Days Add_Delta_Days Gmtime Mktime);
  14 use Date::Calendar::Profiles qw($Profiles);
  15 use Date::Calendar::Year;
  16 use vars qw($ua %opts);
  17
  18 my ($ts, $row, $response);
  19 my $url="https://sctweb.accd.edu/ia-bin4/tsrvweb.exe?WID=W&tserve_tip_read_destroy&tserve_host_code=4&tserve_tiphost_code=0";
  20
  21 if (-r $ENV{HOME} . "/.sctwebrc") {
  22     open CONFIG, $ENV{HOME} . "/.sctwebrc";
  23     while(<CONFIG>) {
  24         s/\#.*//;
  25         next unless m/^([^=]*)=(.*)/;
  26         $opts{$1}=$2;
  27     }
  28     close CONFIG;
  29 }
  30 $url = $opts{'url'} if(defined($opts{'url'}));
  31
  32 $ua = LWP::UserAgent->new;
  33 $ua->timeout(10);
  34 $ua->env_proxy;
  35 $ua->cookie_jar( {} );
  36 $ua->get("$url&tserve_tip_write=||WID&tserve_transconfig=astulog.cfg") or die "$!";
  37 $response = $ua->post("$url&tserve_trans_config=astulog.cfg", { tserve_tip_write => "%7C%7CWID%7CSID%7CPIN", SID => $opts{SID}, PIN => $opts{PIN} }) or die "$!";
  38
  39 $response = $ua->get("$url&tserve_tip_write=||WID|SID|PIN|Term&tserve_trans_config=" . ("regterm.cfg"||"rgrdterm.cfg")); # Valid terms
  40 die $response->status_line unless $response->is_success;
  41 my @terms = grep {s/^<option value="([^"]*)">.*/$1/} (split( /\r\n/, $response->content));
  42 die "Site down. Try again later.\n" unless (@terms);
  43
  44 sub generate_id {
  45     my ($section, $number) = split("-", shift);
  46     my $id = 0;
  47     foreach (split //, $section) {$id=26*$id+(ord($_)-1)%32;}
  48     $id=10000*$id+$number;
  49     return $id;
  50 }
  51
  52 sub off_for_holidays {
  53     my %class = @_;
  54     $class{'duration'} =~ /(\d\d\d\d)(\d\d)(\d\d)-(\d\d\d\d)(\d\d)(\d\d)/;
  55     my $days = Delta_Days($1,$2,$3,$4,$5,$6);
  56     my $firstday = Date::Calc->new($1,$2,$3);
  57     my $lastday = Date::Calc->new($4,$5,$6);
  58     my $year = Date::Calendar::Year->new($1, $Profiles->{'US-TX'});
  59     my @holidays=();
  60     my @days=();
  61     foreach(split(" ",$class{days})) {
  62         $days[Decode_Day_of_Week($_)] = 1;
  63     }
  64     foreach ($year->search("")) {
  65         next unless ($year->is_full($_) && $_>=$firstday && $_<=$lastday);
  66         if (defined($days[Day_of_Week($_->date)])) {
  67             push @holidays, $_;
  68         }
  69     }
  70     return wantarray ? @holidays : "@holidays";
  71 }
  72
  73 sub off_for_exams {
  74     my %class = @_;
  75     my $time = $class{'begin'} . "-" . $class{'end'};
  76     $class{'duration'} =~ /\d{8}-(\d\d\d\d)(\d\d)(\d\d)/;
  77     my $lastday = Date::Calc->new($1,$2,$3);
  78     return wantarray ? () : undef unless (Day_of_Week($lastday->date) == 7);
  79     my $beginning="(08:00-09:15|11:00-12:15|14:00-15:15|17:00-18:15|17:30-18:45|20:00-21:15|20:30-21:45)";
  80     my $ending   ="(06:30-07:45|09:30-10:45|12:30-13:45|15:30-16:45|18:30-19:45|19:00-20:15)";
  81     my $days = join(" ",map {Decode_Day_of_Week($_)} split(/ /, $class{'days'}));
  82     if($days eq "1 3") {
  83         if($time =~ /$beginning/) {
  84             return $lastday-4;
  85         } elsif($time =~ /$ending/) {
  86             return $lastday-6;
  87         }
  88     } elsif($days eq "2 4") {
  89         if($time =~ /$beginning/) {
  90             return $lastday-3;
  91         } elsif($time =~ /$ending/) {
  92             return $lastday-5;
  93         }
  94     } else {
  95         return wantarray ? () : "";
  96     }
  97 }
  98
  99 sub capitalize {
 100     local $_ = shift;
 101     s/\b([A-Z])([A-Z]*)\b/$1\L$2/g;
 102     s/\b(I)(i*)\b/$1\U$2/g;
 103     s/\bUs\b/US/g;
 104     s/ (And|For|Of|Or|The|To|With) / \l$1 /g;
 105     s/\b(Ma?c)([a-z])/$1\u$2/g;
 106     s/\b(Tcp\/Ip|Pc)\b/\U$&/g;
 107     s/\bThru\b/Through/g;
 108     s/\bAcct\b/Accounting/g;
 109     s/\bAmer\b/American/g;
 110     s/\bChem\b/Chemistry/g;
 111     s/\bComp\b/Composition/g;
 112     s/\bFed\b/Federal/g;
 113     s/\bGen\b/General/g;
 114     #s/\bGovt\b/Government/g;
 115     s/\bLit\b/Literature/g;
 116     s/\bPrin\b/Principles/g;
 117     return $_;
 118 }
 119
 120 sub get_schedule_terms {
 121     my @terms;
 122     my @localtime=localtime();
 123     if ($localtime[4]<3) { # Through Mar 31
 124         @terms=((1900+$localtime[5])*10+2);
 125     } elsif ($localtime[4]<5) { # Through May 31
 126         @terms=((1900+$localtime[5])*10+2,(1900+$localtime[5])*10+3);
 127     } elsif ($localtime[4]<7) { # through July 31
 128         @terms=((1900+$localtime[5])*10+3,(1900+$localtime[5])*10+4);
 129     } elsif ($localtime[4]<8) { # through Aug 31
 130         @terms=((1900+$localtime[5])*10+4,(1900+$localtime[5])*10+1);
 131     } elsif ($localtime[4]<10) { # through Oct 31
 132         @terms=((1900+$localtime[5])*10+1);
 133     } else {
 134         @terms=((1900+$localtime[5])*10+1,(1901+$localtime[5])*10+2);
 135     }
 136     return @terms;
 137 }
 138
 139 sub get_schedule {
 140     my @readheaders = ("Section ID/Title", "Session", "Instructor", "Credits", "CallNumber","GradeType", "Days", "Time", "Start/EndDates", "Site/Building/Room", "Message");
 141     my $te = new HTML::TableExtract( headers => [ @readheaders ] );
 142     my (@schedule, @terms, $classid, $begin, $end);
 143     @terms = get_schedule_terms();
 144     foreach(@_ || @terms) {
 145         $response = $ua->get("$url&tserve_tip_write=||WID|SID|PIN|Term&tserve_trans_config=rstusch.cfg&Term=".($_) );
 146         die $response->status_line unless $response->is_success;
 147         $te->parse($response->content);
 148     }
 149     foreach my $ts ($te->table_states) {
 150         foreach my $row ($ts->rows) {
 151             map { s/\xa0//g; $_} @$row;
 152             $row->[0] =~ s/.*launchWebCT\("([^"]*)"\).*/$1/s;
 153             $row->[0] =~ s/(.*) <BR>(.*)/capitalize($2)/eg;
 154             $classid=$1;
 155             $row->[2] = capitalize($row->[2]);
 156             $row->[2] =~ s/([A-Z]r?)$/$1./;
 157             ($begin, $end) = split("-", $row->[7]);
 158             if($row->[7] =~ /^(\d\d):\d\d-(\d\d):\d\dPM$/) {
 159                 $begin =~ s/^(\d\d)/$1+12/e
 160                 if($1 < $2);
 161                 $end =~ s/^(\d\d)/$1+12/e;
 162                 $end =~ s/PM$//;
 163             } else { $end =~ s/AM$//; }
 164             $row->[9] =~ s/ON CAMPUS\n//g;
 165             $row->[9] =~ s/\n/ /g;
 166             push @schedule, {
 167                 id => $classid,
 168                 title => $row->[0],
 169                 session => $row->[1],
 170                 instructor => $row->[2],
 171                 credits => $row->[3],
 172                 callnumber => $row->[4],
 173                 gradetype => $row->[5],
 174                 days => $row->[6],
 175                 'time' => $row->[7],
 176                 begin => $begin,
 177                 end => $end || undef,
 178                 duration => $row->[8],
 179                 location => $row->[9],
 180                 message => $row->[10],
 181             };
 182         }
 183     }
 184     return @schedule;
 185 }
 186
 187 sub get_mhc_header {
 188 return (
 189 "X-SC-Subject: New Years Day\nX-SC-Category: Holiday\nX-SC-Cond: 1 Jan\nX-SC-Record-Id: <New_Years_Day\@from.sctweb>\n",
 190 "X-SC-Subject: Martin Luther King, Jr. Day\nX-SC-Category: Holiday\nX-SC-Cond: 3rd Mon Jan\nX-SC-Duration: 19861102-\nX-SC-Record-Id: <Martin_Luther_King_Jr_Day\@from.sctweb>\n",
 191 "X-SC-Subject: Presidents Day\nX-SC-Category: Holiday\nX-SC-Cond: 3rd Mon Feb\nX-SC-Duration: 19710515-\nX-SC-Record-Id: <Presidents_Day\@from.sctweb>\n",
 192 "X-SC-Subject: Memorial Day\nX-SC-Category: Holiday\nX-SC-Cond: Last Mon May\nX-SC-Duration: 19710531-\nX-SC-Record-Id: <Memorial_Day\@from.sctweb>\n",
 193 "X-SC-Subject: Independence Day\nX-SC-Category: Holiday\nX-SC-Cond: 4 Jul\nX-SC-Duration: 17760704-\nX-SC-Record-Id: <Independence_Day\@from.sctweb>\n",
 194 "X-SC-Subject: Labor Day\nX-SC-Category: Holiday\nX-SC-Cond: 1st Mon Sep\nX-SC-Duration: 18840901-\nX-SC-Record-Id: <Labor_Day\@from.sctweb>\n",
 195 "X-SC-Subject: Columbus Day\nX-SC-Category: Holiday\nX-SC-Cond: 2nd Mon Oct\nX-SC-Duration: 19711011-\nX-SC-Record-Id: <Columbus_Day\@from.sctweb>\n",
 196 "X-SC-Subject: Veterans Day\nX-SC-Category: Holiday\nX-SC-Cond: 11 Nov\nX-SC-Duration: 19261111-\nX-SC-Record-Id: <Veterans_Day\@from.sctweb>\n",
 197 "X-SC-Subject: Thanksgiving\nX-SC-Category: Holiday\nX-SC-Cond: 4th Thu Nov\nX-SC-Record-Id: <Thanksgiving\@from.sctweb>\n",
 198 "X-SC-Subject: Christmas\nX-SC-Category: Holiday\nX-SC-Cond: 25 Dec\nX-SC-Record-Id: <Christmas\@from.sctweb>\n",
 199 );
 200 }
 201
 202 sub do_mhc_schedule {
 203     $| = 1;
 204     my %days = (M => "Mon", T => "Tue", W => "Wed", R => "Thu", F => "Fri", S => "Sat", U => "SU");
 205     my (@terms, $file, $current, @mhc, @schedule);
 206     $file = shift unless (!defined $_[0] or $_[0] =~ /^\d/);
 207     @schedule = get_schedule(@_);
 208     @mhc = get_mhc_header;
 209     foreach my $row (@schedule) {
 210         map {s/\n/-/g if defined; $_} %$row;
 211         my $id=generate_id($row->{'id'});
 212         $row->{'days'} =~ s/([MTWRFS])/ $days{$1}/g;
 213         $row->{'days'} =~ s/^ //;
 214         $row->{'duration'} =~ s/(\d\d)-(\d\d)-(\d\d)/20$3$1$2/g;
 215         my @day = map { "!" . $_ } (off_for_holidays(%$row),off_for_exams(%$row));
 216         $current = "";
 217         #print "# $id\n";
 218         $current .= "X-SC-Subject: " . $row->{'title'} . "\n";
 219         $current .= "X-SC-Location: " . $row->{'location'} . "\n";
 220         $current .= "X-SC-Category: School\n";
 221         $current .= "X-SC-Cond: " . $row->{'days'} . "\n";
 222         $current .= "X-SC-Time: ".$row->{'begin'}."-".$row->{'end'}."\n";
 223         $current .= "X-SC-Duration: " . $row->{'duration'} . "\n";
 224         $current .= "X-SC-Day: @day\n" if(exists $day[0]);
 225         $current .= "X-SC-Alarm: 20 minutes\n";
 226         $current .= "X-SC-Record-Id: <".$row->{'id'}."\@from.sctweb>\n";
 227         if(defined($file) && (-d $file)) {
 228             $row->{'instructor'} =~ s/(.*), (.*)/$2 $1 <$1\@from.sctweb>/;
 229             $row->{'days'} =~ s/ .*$//;
 230             $row->{'duration'} =~ /^(\d\d\d\d)(\d\d)(\d\d)-\d{8}$/;
 231             my @date = Add_Delta_Days(Monday_of_Week(Week_of_Year
 232                     ($1,$2,$3)),Decode_Day_of_Week($row->{'days'})-1);
 233             $row->{'begin'} =~ /^(\d\d):(\d\d)$/;
 234             @date = Gmtime(Mktime(@date,$1,$2,0));
 235             my @mon = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
 236             $current .= sprintf "Date: %s, %2d %s %4d %02d:%02d:00 +0000\n", Day_of_Week_Abbreviation($date[7]), $date[2], $mon[$date[1]-1], $date[0], $date[3], $date[4], $date[5];
 237             $current .= "Subject: " . $row->{'title'} . "\n";
 238             $current .= "From: " . $row->{'instructor'} . "\n";
 239         }
 240         #print "\n$current";
 241         push @mhc, $current;
 242     }
 243     if(defined($file) && (-d $file)) {
 244         my @lines;
 245         foreach my $name (<$file/[1-9]*>) {
 246             next unless $name =~ /^$file\/[1-9][0-9]*$/;
 247             open FH, $name;
 248             @lines = <FH>;
 249             close FH;
 250             foreach (@lines) {
 251                 unlink $name if /^X-SC-Record-Id: <.*\@from.sctweb>/;
 252             }
 253         }
 254         my $i=0;
 255         foreach (@mhc) {
 256             while(-f ++$i) {}
 257             open FH, ">$file/$i" or die $!;
 258             print FH $_;
 259             close FH;
 260         }
 261     } else {
 262         open(STDOUT, ">>" . $file) if(defined($file));
 263         print "# MHC school schedule\n# Autogenerated by sctweb ".localtime()."\n\n";
 264         print join("\n", @mhc);
 265     }
 266 }
 267
 268 sub do_vcalendar_schedule {
 269     $| = 1;
 270     my %days = (M => "MO", T => "TU", W => "WE", R => "TH", F => "FR", S => "SA", U => "SU");
 271     my $file = shift if (defined $_[0] and $_[0] !~ /^\d/);
 272     my @schedule = get_schedule(@_);
 273     open(STDOUT, ">>" . $file) if(defined($file) && (! -d $file));
 274     open(STDOUT, ">/dev/null") if(defined($file) && (-d $file));
 275     print "BEGIN:VCALENDAR\r\nVERSION:1.0\r\n";
 276     foreach my $row (@schedule) {
 277         map { s/\n/-/g; $_} %$row;
 278         $row->{'days'} =~ s/([MTWRFS])/ $days{$1}/g;
 279         $row->{'days'} =~ s/^ //;
 280         $row->{'duration'} =~ s/(\d\d)-(\d\d)-(\d\d)/20$3$1$2/g;
 281         my @day = (off_for_holidays(%$row),off_for_exams(%$row));
 282         my $day = "";
 283         if(exists($day[0])) {
 284             $day = join(";", @day);
 285             $day =~ s/\b(\d{8})\b/$1T000000/g;
 286         }
 287         my ($starttime, $stoptime)=($row->{'begin'}, $row->{'end'});
 288         my ($startdate, $stopdate)=split(/-/, $row->{'duration'});
 289         $starttime =~ s/://;
 290         $stoptime =~ s/://;
 291         if(defined($file) && (-d $file)) {
 292             open FH, ">$file/" . $row->{'id'} . ".vcs" or die "$!";
 293             select FH;
 294             print "BEGIN:VCALENDAR\r\nVERSION:1.0\r\n";
 295         }
 296         print "BEGIN:VEVENT\r\n";
 297         print "SUMMARY:", $row->{'title'}, "\r\n";
 298         print "DESCRIPTION:", $row->{'id'}, "\r\n";
 299         print "LOCATION:", $row->{'location'}, "\r\n";
 300         print "CATEGORIES:Education\r\n";
 301         print "DTSTART:", $startdate."T".$starttime, "00\r\n";
 302         print "DTEND:", $startdate."T".$stoptime, "00\r\n";
 303         print "RRULE:W1 ", $row->{'days'} . " $stopdate", "T000000\r\n";
 304         print("EXDATE:$day\r\n") if($day);
 305         print "ATTENDEE;ROLE=OWNER;STATUS=CONFIRMED:", $opts{NAME}, "\r\n" if(defined($opts{NAME}));
 306         print "END:VEVENT\r\n";
 307         if(defined($file) && (-d $file)) {
 308             print "END:VCALENDAR\r\n";
 309             close FH;
 310             select STDOUT;
 311         }
 312     }
 313     print "END:VCALENDAR\r\n";
 314 }
 315
 316 sub do_html_schedule {
 317     my @showheaders = ("Section ID/Title", "Instructor", "Days", "Time", "Duration", "Location");
 318     my @schedule = get_schedule(@_);
 319     print '<table cellpadding="3" cellspacing="0">'."\n<tr><th>";
 320     print join("</th><th>",@showheaders);
 321     print "</th></tr>\n";
 322         foreach my $row (@schedule) {
 323             map { s/\n/<br \/>/g; $_} %$row;
 324             $row->{'time'} =~ s/-/-<wbr \/>/;
 325             print '<tr>';
 326             print "<td>" . $row->{'id'} . "<br />" . $row->{'title'} . "</td>";
 327             print "<td>" . $row->{'instructor'} . "</td>";
 328             print "<td>" . $row->{'days'} . "</td>";
 329             print "<td>" . $row->{'time'} . "</td>";
 330             print "<td>" . $row->{'duration'} . "</td>";
 331             print "<td>" . $row->{'location'} . "</td>";
 332             print "</tr>\n";
 333         }
 334     print "</table>\n";
 335 }
 336
 337 sub do_html_grades {
 338     my @readheaders = ("Section ID", "Course Title", "Grade", "Earned  Hours", "Quality  Hours", "Quality  Points", "GPA");
 339     my @showheaders = ("Section ID", "Course Title", "Grade", "Earned<br />Hours", "Quality<br />Hours", "Quality<br />Points", "GPA");
 340     my ($row, $lastrow);
 341     my $te = new HTML::TableExtract( headers => [ @readheaders ] );
 342     my $response = $ua->get("$url&tserve_tip_write=||WID|SID|PIN|Term&tserve_trans_config=rgrdterm.cfg"); # Valid grading terms
 343     die $response->status_line unless $response->is_success;
 344     my @terms = grep {s/^<option value="([^"]*)">.*/$1/} (split( /\r\n/, $response->content));
 345     foreach(@ARGV || reverse @terms) {
 346         $response = $ua->get("$url&tserve_tip_write=||WID|SID|PIN|Term&tserve_trans_config=rgrades.cfg&Term=".($_) );
 347         die $response->status_line unless $response->is_success;
 348         $te->parse($response->content);
 349     }
 350     print '<table cellpadding="3" cellspacing="0">'."\n<tr><th>";
 351     print join("</th><th>",@showheaders);
 352     print "</th></tr>\n";
 353     foreach $ts ($te->table_states) {
 354         foreach $row ($ts->rows) {
 355             map { s/\xa0//g; s/\n/<br \/>/g; $_} @$row;
 356             $row->[1] = capitalize($row->[1]);
 357             $lastrow=$row;
 358             next if $row->[0] =~ /:/;
 359             print '<tr><td>';
 360             print join('</td><td>', @$row);
 361             print "</td></tr>\n";
 362         }
 363     }
 364     print '<tr><td colspan="2">', capitalize($lastrow->[0]);
 365     shift @$lastrow; shift @$lastrow;
 366     print "</td><td>";
 367     print join('</td><td>', @$lastrow);
 368     print "</td></tr>\n";
 369     print "</table>\n";
 370 }
 371
 372 sub do_transcripts {
 373     $response = $ua->get("$url&tserve_tip_write=||WID|SID|PIN&tserve_trans_config=rtranscr.cfg&CareerReqNum=1");
 374     foreach (split /\n/, $response->content) {
 375         next unless s/^\&nbsp;|<pre>// || s/\&nbsp;/ /;
 376         s/<\/?[Hh]\d>//g;
 377         print "$_\n";
 378     }
 379 }
 380
 381 my $arg = "";
 382 $arg = shift if (defined($ARGV[0]) && $ARGV[0] =~ /^-\w$/);
 383
 384 if ($arg eq "-g") {
 385     do_html_grades(@ARGV);
 386 } elsif ($arg eq "-s") {
 387     do_html_schedule(@ARGV);
 388 } elsif ($arg eq "-m") {
 389     do_mhc_schedule(@ARGV);
 390 } elsif ($arg eq "-v") {
 391     do_vcalendar_schedule(@ARGV);
 392 } elsif ($arg eq "-t") {
 393     do_transcripts;
 394 }
 395
 396 $ua->get("$url&tserve_trans_config=alogout.cfg"); # Logout