#!/usr/bin/perl -w

use strict;

##
##  User modifyable variables
##

## where to store cache files
# my $CACHEDIR = "/var/cache/carnegie";
my $CACHEDIR = "/tmp";

## Which schedule to get course information from.  Use "Open" or "Sched".
my $function = "Open";     # "Open classes as of last night"
# my $function = "Sched";    # "Published schedule"

##
## End of user modifyable section
##


my $urlhead='http://cgi.asu.edu/registrar/cgi-bin/sched.cgi?function=%s&college=%s&semester=%s';
#DEBUG: my $urlhead='http://localhost/cgi-bin/carn?function=%s&college=%s&semester=%s';

my @campuses = (
  'Main', 'West', 'East', 'Extended',
);
my %campuses = (
  'Main' => 'main',
  'West' => 'west',
  'East' => 'east',
  'Extended' => 'extd',
);
my %campus_colleges = (
  'main' => 'arch:bus:educ:engg:fineart:gradcol:honors:law:libart:nursing:pubprog:duas',
  'west' => 'wartsci:wdcolpg:weduc:whumsrv:wsmgmt',
  'east' => 'eagrib:eextend:egenrl:etech',
  'extd' => 'unvext',
);

#my $semesters_url = 'http://www.asu.edu/registrar/schedule/classes-%s.html';
my @semesters = (
  'Spring', 'Summer 1st 5-Wk', 'Summer 2nd 5-Wk', 'Summer 8-Wk', 'Fall',
);
my %semesters = (
  'Summer 1st 5-Wk' => 3,
  'Summer 2nd 5-Wk' => 5,
  'Summer 8-Wk' => 4,
  'Fall' => 7,
  'Spring' => 1,
);

# These are where to find all the various course prefixes
my %colleges = (
  'arch'    => ':AAD:ADE:AED:ANP:APH:ATE:DSC:EPD:GRA:HUD:IND:INT:PLA:PLN:PUP:THE:',
  'bus'     => ':ACC:BUS:CIS:COB:ECN:FIN:HSA:IBS:LES:MGT:MKT:OPM:QBA:REA:SCM:',
  'educ'    => ':BAC:BLE:BUE:CED:COE:CPY:DCI:DEV:ECD:EDA:EDB:EDP:EDT:EED:EMC:FOR:HED:IED:ISS:LIS:MCE:RDG:SCH:SED:SOC:SPE:SPF:TBA:VOC:WWW:',
  'engg'    => ':ASE:BME:CEE:CHE:CHE:CON:CSE:ECE:EEE:IEE:MAE:MSE:STE:',
  'fineart' => ':ARA:ARE:ARS:ART:CFA:CUT:DAH:DAN:FAC:FOR:III:MHL:MTC:MUE:MUP:MUR:MUS:NOW:POP:THE:THP:',
  'gradcol' => ':GRD:GRN:GWC:LAB:LEC:SEM:SRC:TRC:',
  'honors'  => ':HON:',
  'law'     => ':LAW:',
  'libart'  => ':AES:AFH:AFR:AFS:ARB:ASB:ASM:AST:BCH:BIO:CCS:CDE:CHI:CHM:CLS:CSH:CSS:ENG:EPE:FAS:FLA:FRD:FRE:GCU:GER:GLG:GPH:GRK:HEB:HIS:HPS:HUM:IDN:IPO:ITA:JPN:KOR:LAT:LIA:LIN:MAT:MBB:MCB:MIC:MIS:MTE:NOR:PGS:PHI:PHS:PHY:PLB:POR:POS:PSY:PUB:REL:ROM:RUS:SCA:SHS:SOC:SPA:STP:SWE:THA:UNI:VTN:WAC:WSH:WST:',
  'nursing' => ':ADV:CHP:CSB:HCR:NUR:',
  'pubprog' => ':AIS:AND:APA:COM:JRN:JUS:LAW:MCO:NAU:ORG:PAF:REC:SOC:SRC:SWG:SWU:TCM:',
  'duas'    => ':BIS:ECG:EDB:PSY:',
  'wartsci' => ':ADV:AMS:AND:ARS:ASB:AST:BIO:CHM:ENG:ETH:FAS:FOR:GCU:HIS:HPS:HUM:IAP:IAS:LSC:MAS:MAT:MIC:MUS:PGS:PHI:POL:PSY:REL:SBS:SOC:SPA:STP:THE:WAR:WEB:WST:',
  'wdcolpg' => ':CDE:CHE:COM:CSE:DIV:ECE:EEE:ENG:EPE:FLA:HIS:HON:HUD:HUM:JAC:LES:MCO:MGT:MKT:NUR:SEM:SIM:',
  'weduc'   => ':BLE:CED:COE:DCI:ECD:EDA:EDP:EED:EMC:FOR:GEN:MCE:MUE:RDG:SCH:SED:SPE:SPF:STU:',
  'whumsrv' => ':AJS:COM:CRJ:GRN:HES:HMN:REC:SWG:SWU:THE:UCB:',
  'wsmgmt'  => ':ACC:BUS:CIS:ECN:FIN:GLB:HRM:ISM:LES:MGT:MKT:OPM:QBA:',
  'eagrib'  => ':AGB:ERS:GOV:',
  'eextend' => ':CDE:CHE:COM:CSE:ECE:EEE:ENG:EPE:FLA:HIS:HUD:HUM:LES:MCO:MKT:SEM:THE:THP:',
  'egenrl'  => ':ARS:ART:ASB:ASC:BCH:BIO:BLE:BUS:CIS:COM:ECD:ECN:EDC:EDP:EED:ENG:FAS:FIN:GRN:HIS:HON:HSC:IBS:JAC:LES:MGT:MHL:MKT:MUS:NTR:OPM:PGS:PHI:POS:PSY:RDG:REL:SIM:SOC:SPE:STP:SWG:SWU:THE:THP:TWC:',
  'etech'   => ':AET:AMT:AND:CET:CGC:CIR:EET:ENG:ETC:ETM:FSM:GIT:IMC:ITM:MET:MGT:SIM:UET:',
  'unvext'  => ':ACC:AFH:AGB:AJS:AMT:AND:ARA:ARE:ARS:ART:ASC:ASE:BIO:BIS:BLE:CDE:CHE:COE:COM:CON:CSB:CSE:CUT:DAN:DCI:ECD:ECE:ECN:EDA:EDB:EDP:EDT:EED:EEE:EMC:ENG:EPE:FAS:FLA:FOR:FSM:GCU:GLG:GRN:HED:HIS:HON:HSA:HUD:HUM:IAS:IED:IEE:III:ITA:JUS:LAT:LAW:LES:MAT:MCE:MCO:MGT:MID:MKT:MUE:MUP:MUS:NAU:NTR:NUR:ORG:PAF:PGS:PHS:PHY:PLB:POP:POR:POS:PSY:PUP:RDG:REC:REL:SCM:SED:SEM:SHS:SIM:SOC:SPE:SPF:SRC:STE:SWG:SWU:TBA:THE:THP:WST:WWW:',
);

my( $campus_id, $semester_id, $college_id, $prefix, $number, $url, @lines );
my( $course, $title, $flags, $credits, $schedline, $days, $start, $end );
my $printed = 0;

sub
cleancache
{
  my $now = time;

  while (glob("$CACHEDIR/carnegie-ASU-*.cache")) {
    if ($now - (stat $_)[9] > 86400) {
      print STDERR "Expiring cache file $_\n";
      unlink $_;
    }
  }
}

sub
getdata($$)
{
  my( $college_id, $semester_id ) = @_;
  my $data;

  cleancache;

  my $cachefile =
    "$CACHEDIR/carnegie-ASU-${college_id}-${semester_id}-${function}.cache";
  if (-f $cachefile) {
    print STDERR "Using cache file: $cachefile\n";
    open INPUT, "<$cachefile";
    @lines = <INPUT>;
    close INPUT;
  }
  else {
    $url = sprintf $urlhead, $function, $college_id, $semester_id;
    print STDERR "Getting data from $url . . . ";
    $data = `lynx -useragent="carnegie-scheduler-(L_y_n_x)" -source "$url"`;
    if ($? > 0) {
      return ();
    }
    print STDERR "done; ", length($data), " bytes recieved.\n";
    $data =~ s/.*^<pre>(.*)^<\/pre>.*/$1/msi;
    if (open(OUTPUT, "> $cachefile")) {
      print OUTPUT $data;
      close OUTPUT;
    }
    @lines = split /\n/, $data;
  }
  return @lines;
}

#print STDERR "DEBUG: @{ARGV}\n";
if (@ARGV == 1 && $ARGV[0] eq "handlerinfo") {
  print join("\t", @semesters), "\n";
  print join("\t", @campuses), "\n";
}
elsif (@ARGV == 3) {
  if (!($campus_id = $campuses{$ARGV[2]})) {
    print "error: invalid campus name '$ARGV[2]'\n";
    exit 1;
  }
  if (!($semester_id = $semesters{$ARGV[1]})) {
    print "error: invalid semester name '$ARGV[1]'\n";
    exit 1;
  }
  ($prefix, $number) = ($ARGV[0] =~ m/([A-Za-z]{3}) ?([0-9]{3})/);
  if (!$prefix) {
    print "error: course prefix must be in the form 'XXX NNN'\n";
    exit 1;
  }
  $prefix = uc($prefix);
  foreach my $key (split /:/, $campus_colleges{$campus_id}) {
    if ($colleges{$key} =~ m/:$prefix:/i) {
      $college_id = $key;
      last;
    }
  }
  if (!defined($college_id)) {
    print "error: No course prefix matching '$prefix'\n";
    exit 1;
  }
  @lines = getdata($college_id, $semester_id);

sub
parsesection($)
{
  $_ = shift;
  if (m/^(..):(..)(..) (..):(..)  (.{6}) (.{12}) (.{20})/) {
    $start = sprintf "%02d%02d", (($1 < 7) ? $1 + 12 : $1), $2;
    $end = sprintf "%02d%02d", (($1 < 7 || $4 < $1) ? $4 + 12 : $4), $5;
    $days = $6;
    $days =~ s/ *$//;
    $days =~ s/TH/R/;
#    $location = trim($7);
#    $instruct = trim($8);
  }
  else {
    print STDERR "DEBUG: error matching section info\n";
  }
}

sub
printlecture()
{
  print
    $course, "\t",
    "${title} ${flags} ${credits}", "\t",
    $schedline, "\t",
    $days, "\t",
    $start, "\t",
    $end, "\n";
  $printed = 1;
}

sub
trim($)
{
  my $val = shift;
  $val =~ s/ *$//;
  return $val;
}

## parse the data
  my $search_course = $prefix.$number;
  my $found = 0;
  undef $course;
  foreach $_ (@lines) {
    if ($function eq "Open") {
      s/^(.{16})  (.{47}) (.{12})(.{54}) $/$1   $2$4  I/;
      #print STDERR "DEBUG: $_";
    }
    if (!m/.{5}  M/) {
      next  if (!$course);
      if (m/^.{21}([^ ].{20})/) {
        #print STDERR "DEBUG: matched extended title\n";
	$title .= " ".trim($1);
      }
      if (m/^.{65} (..:.{52})/) {
        printlecture()  if (!$printed);
	parsesection($1);
        print "\t"; printlecture();
      }
    }
    else { #XXXX
      printlecture()  if ($course && !$printed);
      if (m/^(.{5})  M (...) (...)   (.{21}) (.{13}) (..) {9}(.{55}) I/) {
	#print STDERR "DEBUG: got match\n";
        if ($search_course ne ($2.$3)) {
	  undef $course;
	  next;
	}
	#print STDERR "DEBUG: got course match\n";
	$printed = 0;
	$found = 1;
        $schedline = $1;
	$course = $2.$3;
	$title = trim($4);
	$flags = trim($5);
	$credits = trim($6);
	parsesection($7);
      }
    }
  }
  if (!$found) {
    print "error: No course matching '$search_course'\n";
  }
}
else {
  print "error: invalid usage\n";
  print "error: this script is used from carnegie\n";
  exit 1;
}