3 # -*- perl -*- vim: ft=perl sw=4 sts=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.
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";
16 if (-r $ENV{HOME} . "/.sctwebrc") {
17 open CONFIG, $ENV{HOME} . "/.sctwebrc";
20 next unless m/^([^=]*)=(.*)/;
26 $ua = LWP::UserAgent->new;
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);
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);
40 sub get_schedule_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);
54 @terms=((1900+$localtime[5])*10+1,(1901+$localtime[5])*10+2);
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 ] );
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);
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
80 $row->[2] =~ s/-(\d\d)/"-".($1+12)/e;
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";
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 ] );
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);
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;
116 print join('</td><td>', @$row);
117 print "</td></tr>\n";
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");
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);
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;
145 next if $row->[0] =~ /:/;
147 print join('</td><td>', @$row);
148 print "</td></tr>\n";
151 print '<tr><td colspan="3">', $lastrow->[0];
152 shift @$lastrow; shift @$lastrow;
153 print join('</td><td>', @$lastrow);
154 print "</td></tr>\n";
158 if (defined($ARGV[0]) && $ARGV[0] eq "-g") {
161 } elsif (defined($ARGV[0]) && $ARGV[0] eq "-s") {
168 $ua->get("$url&tserve_trans_config=alogout.cfg"); # Logout