Ugly ugly hacks to support TAMUK in addition to ACCD
authorTim Pope <code@tpope.net>
Thu, 21 Apr 2005 05:13:44 +0000 (05:13 +0000)
committerTim Pope <code@tpope.net>
Thu, 21 Apr 2005 05:13:44 +0000 (05:13 +0000)
perl/sctweb

index 018077c0793336d20a7304fce624c2927df8da1d..9aef892403e2d7d2290ea829cff15516970944a9 100755 (executable)
@@ -60,8 +60,17 @@ sub US_Labor # First Monday after the first Sunday in September
         Nth_Weekday_of_Month_Year($year,9,7,1), +1) );
 }
 
-if (-r $ENV{HOME} . "/.sctwebrc") {
-    open CONFIG, $ENV{HOME} . "/.sctwebrc";
+my $config = $ENV{HOME} . "/.sctwebrc";
+if ($ARGV[0] eq '-f') {
+    shift;
+    $config = shift;
+}
+
+my $arg = "";
+$arg = shift if (defined($ARGV[0]) && $ARGV[0] =~ /^-\w$/);
+
+if (-r $config) {
+    open CONFIG, $config;
     while(<CONFIG>) {
        s/\#.*//;
        next unless m/^([^=]*)=(.*)/;
@@ -83,6 +92,14 @@ $response = $ua->post("$url&tserve_trans_config=astulog.cfg", { tserve_tip_write
 $response = $ua->get("$url&tserve_tip_write=||WID|SID|PIN|Term&tserve_trans_config=" . ("regterm.cfg"||"rgrdterm.cfg")); # Valid terms
 die $response->status_line unless $response->is_success;
 my @terms = grep {s/^<option value="([^"]*)">.*/$1/} (split( /\r\n/, $response->content));
+if(@terms) {
+    $opts{school} = 'accd';
+} else {
+    $response = $ua->get("$url&tserve_tip_write=||WID|SID|PIN|Term&tserve_trans_config=aterm.cfg"); # Valid terms
+    die $response->status_line unless $response->is_success;
+    @terms = grep {s/&amp;Term=(\w*)$/$1/} (split( /\r\n/, $response->content));
+    $opts{school} = 'tamuk';
+}
 die "Site down. Try again later.\n" unless (@terms);
 
 sub generate_id {
@@ -190,37 +207,47 @@ sub capitalize {
     #s/\bGovt\b/Government/g;
     s/\bLit\b/Literature/g;
     s/\bPrin\b/Principles/g;
+    s/\bBus\b/Business/g;
     return $_;
 }
 
 sub get_schedule_terms {
-    my @terms;
+    my (@sterms, @a);
+    if($opts{school} eq 'tamuk') {
+       @a=('F','S','1','2');
+    } else {
+       @a=('1','2','3','4');
+    }
     my @localtime=localtime();
     if ($localtime[4]<3) { # Through Mar 31
-       @terms=((1900+$localtime[5])*10+2);
+       @sterms=((1900+$localtime[5]).$a[1]);
     } elsif ($localtime[4]<5) { # Through May 31
-       @terms=((1900+$localtime[5])*10+2,(1900+$localtime[5])*10+3);
+       @sterms=((1900+$localtime[5]).$a[1],(1900+$localtime[5]).$a[2]);
     } elsif ($localtime[4]<7) { # through July 31
-       @terms=((1900+$localtime[5])*10+3,(1900+$localtime[5])*10+4);
+       @sterms=((1900+$localtime[5]).$a[2],(1900+$localtime[5]).$a[3]);
     } elsif ($localtime[4]<8) { # through Aug 31
-       @terms=((1900+$localtime[5])*10+4,(1900+$localtime[5])*10+1);
+       @sterms=((1900+$localtime[5]).$a[3],(1900+$localtime[5]).$a[0]);
     } elsif ($localtime[4]<10) { # through Oct 31
-       @terms=((1900+$localtime[5])*10+1);
+       @sterms=((1900+$localtime[5]).$a[0]);
     } else {
-       @terms=((1900+$localtime[5])*10+1,(1901+$localtime[5])*10+2);
+       @sterms=((1900+$localtime[5])."1",(1901+$localtime[5])."2");
     }
-    return @terms;
+    return @sterms;
 }
 
 sub get_schedule {
     my @readheaders = ("Section ID/Title", "Session", "Instructor", "Credits", "CallNumber","GradeType", "Days", "Time", "Start/EndDates", "Site/Building/Room", "Message");
     my $te = new HTML::TableExtract( headers => [ @readheaders ] );
-    my (@schedule, @terms, $classid, $begin, $end);
+    @readheaders = ("Course", "Days\xa0TimeLocation", "Session and Dates", "Instructor", "Credit", "CallNumber", "GradeType", "Message");
+    my $tf = new HTML::TableExtract( headers => [ @readheaders ] );
+    my (@schedule, @terms, $classid, $begin, $end, $times, $days, $session);
     @terms = get_schedule_terms();
-    foreach(@_ || @terms) {
+    foreach (@_ ? @_ : @terms) {
        $response = $ua->get("$url&tserve_tip_write=||WID|SID|PIN|Term&tserve_trans_config=rstusch.cfg&Term=".($_) );
        die $response->status_line unless $response->is_success;
        $te->parse($response->content);
+       $tf->parse($response->content);
+       #print $response->content;
     }
     foreach my $ts ($te->table_states) {
        foreach my $row ($ts->rows) {
@@ -261,6 +288,51 @@ sub get_schedule {
            };
        }
     }
+    foreach my $ts ($tf->table_states) {
+       foreach my $row ($ts->rows) {
+           next if ($row->[0] =~ /Total Enrolled Hours/);
+           $row->[1] =~ s/\xa0/ /g;
+           map { s/\xa0//g; $_} @$row;
+           map { s/^\r?\n? *//g; $_} @$row;
+           $row->[0] =~ s/.*launchWebCT\("([^"]*)"[^)]*\).*>\s*//s;
+           $classid=$1;
+           $row->[0] =~ s/(.*)/capitalize($1)/eg;
+           $row->[1] =~ s/^([MTWRFS]*) *([0-9:-]*[AP]M)\s*//;
+           ($days, $times) = ($1, $2);
+           ($begin, $end) = split("-", $times);
+           if($times =~ /^(\d\d):\d\d-(\d\d):\d\dPM$/) {
+               if($1 < $2 && $2 != 12) {
+                   $begin =~ s/^(\d\d)/$1+12/e;
+               }
+               if($2 != 12) {
+                   $end =~ s/^(\d\d)/$1+12/e;
+               }
+               $end =~ s/PM$//;
+           } else { $end =~ s/AM$//; }
+           $row->[2] =~ s/(.*\S)\s*//;
+           $session = $1;
+           $row->[2] =~ s/(\d\d)-(\d\d)-(\d\d)/20$3$1$2/g;
+           $row->[2] =~ s/ *to */-/g;
+           $row->[3] = capitalize($row->[3]);
+           $row->[3] =~ s/([A-Z]r?)$/$1./;
+           push @schedule, {
+               id => $classid,
+               title => $row->[0],
+               session => $session,
+               instructor => $row->[3],
+               credits => $row->[4],
+               callnumber => $row->[5],
+               gradetype => $row->[6],
+               days => $days,
+               'time' => $times,
+               begin => $begin,
+               end => $end || undef,
+               duration => $row->[2],
+               location => $row->[1],
+               message => $row->[7],
+           };
+       }
+    }
     return @schedule;
 }
 
@@ -548,9 +620,6 @@ sub do_transcripts {
     }
 }
 
-my $arg = "";
-$arg = shift if (defined($ARGV[0]) && $ARGV[0] =~ /^-\w$/);
-
 if ($arg eq "-g") {
     do_html_grades(@ARGV);
 } elsif ($arg eq "-s") {