Assorted away-tpope updates
[tpope-extra.git] / perl / schedproc
index 8c45f83bbd334fde796f909982f554c92be2b348..2a80bc3df745f296e61985445c172f254d6c1f81 100755 (executable)
@@ -40,7 +40,7 @@ if($arg eq "-x") {
 
 Getopt::Long::Configure ("bundling", "auto_help");
 die "Invalid arguments\n" unless
-GetOptions(\%opts, 'schedule|S=s', 'grades|G=s', 'facmail=s', 'facurl=s', 'name|n=s', 'format|f=s', 'config|F=s', 'out|o=s');
+GetOptions(\%opts, 'schedule|S=s', 'grades|G=s', 'faculty=s', 'name|n=s', 'email|e=s', 'format|f=s', 'config|F=s', 'out|o=s');
 
 if (-r $opts{'config'}) {
     open CONFIG, $opts{'config'} or die $!;
@@ -48,8 +48,8 @@ if (-r $opts{'config'}) {
        s/\#.*//;
        next unless m/^([^=]*)=(.*)/;
        my ($l, $r) = ($1, $2);
-       if ($l =~ /^(schedule|grades|name|facmail|facurl)$/) {
-           $opts{$l}||=$r;
+       if ($l =~ /^(schedule|grades|name|email|faculty)$/) {
+           $opts{$l}=$r unless(defined($opts{$l}));
        } else {
            warn "Unknown config file option $l.\n";
        }
@@ -59,13 +59,11 @@ if (-r $opts{'config'}) {
 
 $opts{'schedule'} ||= "~/schedule.xml";
 $opts{'grades'} ||= "~/grades.xml";
-$opts{'facmail'} ||= "";
-$opts{'facurl'} ||= "";
+$opts{'faculty'} ||= "";
 
 $opts{'schedule'} =~ s/(^|,)~\//$1$ENV{HOME}\//;
 $opts{'grades'} =~ s/(^|,)~\//$1$ENV{HOME}\//;
-$opts{'facmail'} =~ s/(^|,)~\//$1$ENV{HOME}\//;
-$opts{'facurl'} =~ s/(^|,)~\//$1$ENV{HOME}\//;
+$opts{'faculty'} =~ s/(^|,)~\//$1$ENV{HOME}\//;
 
 if(!defined($opts{'out'}) && defined($ARGV[0])) {
     $opts{'out'} = shift;
@@ -75,7 +73,7 @@ if(!defined($opts{'format'}) && defined($opts{'out'})) {
     $opts{'format'} = $opts{'out'};
     $opts{'format'} =~ s/.*\.//;
     $opts{'format'} =~ s/^(.*\/|)\.?schedule$/mhc/;
-    undef $opts{'out'} if($opts{'out'} =~ /^(html|mhc|csv|cvs|xml|grades)$/);
+    undef $opts{'out'} if($opts{'out'} =~ /^(html|mhc|csv|vcs|ics|xml|grades)$/);
 }
 
 $opts{'format'} ||= "";
@@ -84,12 +82,35 @@ undef $opts{'out'} if(($opts{'out'}||"") eq "-");
 sub generate_id {
     my ($section, $number) = split("-", shift);
     my $id = 0;
-    foreach (split //, $section) {$id=26*$id+(ord($_)-1)%32;}
+    foreach my $c (split //, $section) {$id=26*$id+(ord($c)-1)%32;}
     $id=10000*$id+$number;
     return $id;
 }
 
+sub first_class {
+    my %days = (M => 1, T => 2, W => 3, R => 4, F => 5, S => 6, U => 7);
+    my %class = @_;
+    $class{'duration'} =~ /(\d\d\d\d)(\d\d)(\d\d)-(\d\d\d\d)(\d\d)(\d\d)/;
+    my $days = Delta_Days($1,$2,$3,$4,$5,$6);
+    my $firstday = Date::Calc->new($1,$2,$3);
+    my $lastday = Date::Calc->new($4,$5,$6);
+    my $today;
+    my @days=();
+    foreach my $d (split("",$class{'days'})) {
+       push @days, $days{$d};
+    }
+    my @off = ();
+    @off = @{$class{'off'}} if ($class{'off'});
+    for($today = $firstday; $today < $lastday; $today++) {
+       next unless(grep($_ == Day_of_Week($today->date), @days));
+       next if(grep($_ == "$today", @off));
+       return $today;
+    }
+    return undef;
+}
+
 sub next_class {
+    my %days = (M => 1, T => 2, W => 3, R => 4, F => 5, S => 6, U => 7);
     my %class = @_;
     $class{'duration'} =~ /(\d\d\d\d)(\d\d)(\d\d)-(\d\d\d\d)(\d\d)(\d\d)/;
     my $days = Delta_Days($1,$2,$3,$4,$5,$6);
@@ -97,8 +118,8 @@ sub next_class {
     my $lastday = Date::Calc->new($4,$5,$6);
     my $today = Date::Calc->new(Date::Calc->localtime(time+3600*6)->date);
     my @days=();
-    foreach(split(" ",$class{'days'})) {
-       push @days, Decode_Day_of_Week($_);
+    foreach my $d(split("",$class{'days'})) {
+       push @days, $days{$d};
     }
     my @off = ();
     @off = @{$class{'off'}} if ($class{'off'});
@@ -116,6 +137,16 @@ sub next_class {
     return undef;
 }
 
+sub vcal_datetime {
+    my $date=shift;
+    my $time=shift;
+    $date =~ /(\d\d\d\d)(\d\d)(\d\d)/;
+    my ($y,$m,$d)=($1,$2,$3);
+    $time =~ /(\d\d):?(\d\d)/;
+    my $day=Date::Calc->gmtime(Mktime($y,$m,$d,$1,$2,0));
+    return sprintf ("%02d%02d%02dT%02d%02d%02dZ", $day->year(), $day->month(), $day->day(), $day->time());
+}
+
 sub capitalize {
     local $_ = shift || "";
     s/ +$//;
@@ -152,14 +183,20 @@ sub read_fileurl {
        $ua->env_proxy;
 #      $ua->cookie_jar( {} );
        my $response = $ua->get("$url") or die "$!";
-       die $response->status_line unless $response->is_success;
-       $content = $response->content;
+       if($response->is_success) {
+           $content = $response->content;
+       } else {
+           die "$!" unless $_[0];
+       }
     } else {
-       open(F,$url) || die "$!";
-       $content = join ("", <F>);
-       close F;
+       if(open(F,$url)) {
+           $content = join ("", <F>);
+           close F;
+       } else {
+           die "$!" unless $_[0];
+       }
     }
-    return $content;
+    return $content||"";
     #my $ref = XMLin($content, ForceArray => [ 'class', 'cumulative', 'off' ], KeyAttr => "");
     #return @{$ref->{'class'}};
 }
@@ -167,6 +204,7 @@ sub read_fileurl {
 sub get_schedule {
     my $content = read_fileurl($opts{'schedule'});
     my $ref = XMLin($content, ForceArray => [ 'class', 'off' ], KeyAttr => "");
+    die "Could not load schedule.\n" unless $ref->{'class'};
     return @{$ref->{'class'}};
 }
 
@@ -176,20 +214,26 @@ sub get_grades {
     return $ref;
 }
 
-sub get_faculty_email {
-    my ($name, $school, $email);
-    if((-f ($opts{'facmail'}||"")) && ! %faculty) {
-       open INS,$opts{'facmail'} or die $!;
-       while($_ = <INS>) {
-           chomp;
-           m/"([^"]*)",([^,]*),([^,]*)/; # "
-           ($name, $email, $school) = ($1, $2, $3);
+sub load_faculty {
+    my ($name, $email, $url, $content);
+    if(($opts{'faculty'}) && ! %faculty) {
+       $faculty{'done'} = "true";
+       $content = read_fileurl($opts{'faculty'},1);
+       foreach my $f (split("\n", $content)) {
+           ($name, $email, $url) = $f =~ m/"([^"]*)",([^,]*),([^,]*)/; # "
+           next unless ($name);
            $name =~ s/ [A-Z]\.//g;
            $name = lc $name;
            $name =~ s/\W//g;
-           $faculty{$name} = $email;
+           $faculty{$name} = $email if($email);
+           $facurl{$name} = $url if ($url);
        }
     }
+}
+
+sub get_faculty_email {
+    load_faculty();
+    my ($name);
     $name = shift;
     $name =~ s/ [A-Z]r?\.//g;
     $name = lc $name;
@@ -198,19 +242,8 @@ sub get_faculty_email {
 }
 
 sub get_faculty_url {
-    my ($name, $url);
-    if((-f ($opts{'facurl'}||"")) && ! %facurl) {
-       open INS, $opts{'facurl'} or die $!;
-       while($_ = <INS>) {
-           chomp;
-           m/([^,]*),([^,]*)/; # "
-           ($name, $url) = ($1, $2);
-           $name =~ s/ [A-Z]\.//g;
-           $name = lc $name;
-           $name =~ s/\W//g;
-           $facurl{$name} = $url;
-       }
-    }
+    load_faculty();
+    my ($name);
     $name = shift;
     $name =~ s/ [A-Z]r?\.//g;
     $name = lc $name;
@@ -243,10 +276,11 @@ sub do_mhc_schedule {
     @mhc = get_mhc_header;
     if(defined($file) && (-d $file)) {
        my @mhc2;
+       local $_;
        foreach (@mhc) {
-           $_ =~ s/X-SC-Subject: ([^\n]*)/X-SC-Subject: $1\nSubject: $1/;
-           $_ =~ s/X-SC-Category: ([^\n]*)/X-SC-Category: $1\nFrom: $1/;
-           $_ =~ s/X-SC-Duration: (\d\d\d\d)(\d\d)(\d\d)-/"X-SC-Duration: $1$2$3-\nDate: $3 " . $mon[$2-1] . " 1970 12:00:00 +0000"/e;
+           s/X-SC-Subject: ([^\n]*)/X-SC-Subject: $1\nSubject: $1/;
+           s/X-SC-Category: ([^\n]*)/X-SC-Category: $1\nFrom: $1/;
+           s/X-SC-Duration: (\d\d\d\d)(\d\d)(\d\d)-/"X-SC-Duration: $1$2$3-\nDate: $3 " . $mon[$2-1] . " 1970 12:00:00 +0000"/e;
            push @mhc2, $_;
        }
        @mhc = @mhc2;
@@ -254,11 +288,12 @@ sub do_mhc_schedule {
     foreach my $row (@schedule) {
        map {s/\n/-/g if defined; $_} %$row;
        my $id=generate_id($row->{'id'});
+       my $next = next_class(%$row);
        $row->{'days'} =~ s/([MTWRFS])/ $days{$1}/g;
        $row->{'days'} =~ s/^ //;
        #$row->{'duration'} =~ s/(\d\d)-(\d\d)-(\d\d)/20$3$1$2/g;
        my @day = ();
-       @day = map { "!" . $_ } (@{$row->{'off'}}) if ($row->{'off'});
+       @day = map { "!$_" } (@{$row->{'off'}}) if ($row->{'off'});
        $current = "";
        #print "# $id\n";
        $current .= "X-SC-Subject: " . $row->{'title'} . "\n";
@@ -275,7 +310,6 @@ sub do_mhc_schedule {
            $row->{'instructor'} = '"' . $row->{'instructor'} . '" <'. ($email || ($1 || "unknown") . "\@from.sctweb") . ">";
            $row->{'duration'} =~ /^(\d\d\d\d)(\d\d)(\d\d)-\d{8}$/;
            $row->{'begin'} =~ /^(\d\d):(\d\d)$/;
-           my $next = next_class(%$row);
            my @date = Gmtime(Mktime($next->date,$1,$2,0));
            $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];
            $current .= "Subject: " . $row->{'title'} . "\n";
@@ -296,10 +330,10 @@ sub do_mhc_schedule {
            }
        }
        my $i=0;
-       foreach (@mhc) {
+       foreach my $h (@mhc) {
            while(-f ++$i) {}
            open (FH, ">$file/$i") || die $!;
-           print FH $_;
+           print FH $h;
            close FH;
        }
     } else {
@@ -319,9 +353,9 @@ sub do_csv_schedule {
     foreach my $row (@schedule) {
        map {s/\n/-/g if defined; $_} %$row;
        my $id=generate_id($row->{'id'});
+       my $next = next_class(%$row);
        $row->{'days'} =~ s/([MTWRFS])/ $days{$1}/g;
        $row->{'days'} =~ s/^ //;
-       my $next = next_class(%$row);
        $current = "";
        #print "# $id\n";
        $current .= $row->{'id'} . ",";
@@ -340,24 +374,23 @@ sub do_vcalendar_schedule {
     my %days = (M => "MO", T => "TU", W => "WE", R => "TH", F => "FR", S => "SA", U => "SU");
     my $file = $opts{'out'};
     my @schedule = get_schedule(@_);
-    open(STDOUT, ">>" . $file) || die $! if(defined($file) && (! -d $file));
+    open(STDOUT, ">" . $file) || die $! if(defined($file) && (! -d $file));
     open(STDOUT, ">/dev/null") || die $! if(defined($file) && (-d $file));
     print "BEGIN:VCALENDAR\r\nVERSION:1.0\r\n";
     foreach my $row (@schedule) {
        map { s/\n/-/g; $_} %$row;
-       $row->{'days'} =~ s/([MTWRFS])/ $days{$1}/g;
-       $row->{'days'} =~ s/^ //;
+       my ($starttime, $stoptime)=($row->{'begin'}, $row->{'end'});
+       my ($startdate, $stopdate)=split(/-/, $row->{'duration'});
+       $starttime =~ s/://;
+       $stoptime =~ s/://;
+       my $first = first_class(%$row);
        my @day = ();
        @day = @{$row->{'off'}} if ($row->{'off'});
        my $day = "";
        if(exists($day[0])) {
            $day = join(";", @day);
-           $day =~ s/\b(\d{8})\b/$1T000000/g;
+           $day =~ s/\b(\d{8})\b/$1T${starttime}00/g;
        }
-       my ($starttime, $stoptime)=($row->{'begin'}, $row->{'end'});
-       my ($startdate, $stopdate)=split(/-/, $row->{'duration'});
-       $starttime =~ s/://;
-       $stoptime =~ s/://;
        if(defined($file) && (-d $file)) {
            open FH, ">$file/" . $row->{'id'} . ".vcs" or die "$!";
            select FH;
@@ -368,11 +401,15 @@ sub do_vcalendar_schedule {
        print "DESCRIPTION:", $row->{'id'}, "\r\n";
        print "LOCATION:", $row->{'location'}, "\r\n";
        print "CATEGORIES:Education\r\n";
-       print "DTSTART:", $startdate."T".$starttime, "00\r\n";
-       print "DTEND:", $startdate."T".$stoptime, "00\r\n";
+       print "DTSTART:", vcal_datetime($first,$starttime), "\r\n";
+       print "DTEND:", vcal_datetime($first,$stoptime), "\r\n";
+       #print "DTSTART:", $first."T".$starttime, "00\r\n";
+       #print "DTEND:", $first."T".$stoptime, "00\r\n";
+       $row->{'days'} =~ s/([MTWRFS])/ $days{$1}/g;
+       $row->{'days'} =~ s/^ //;
        print "RRULE:W1 ", $row->{'days'} . " $stopdate", "T000000\r\n";
        print("EXDATE:$day\r\n") if($day);
-       print "ATTENDEE;ROLE=OWNER;STATUS=CONFIRMED:", $opts{'name'}, "\r\n" if(defined($opts{'name'}));
+       print "ATTENDEE;ROLE=OWNER;STATUS=CONFIRMED:", $opts{'name'}, ($opts{'email'}?" <".$opts{'email'}.">":""), "\r\n" if(defined($opts{'name'}));
        print "ATTENDEE;ROLE=ORGANIZER;STATUS=CONFIRMED:", $row->{'instructor'}, " <" . (get_faculty_email($row->{'instructor'}) || "fake\@ddress"), ">\r\n";
        print "END:VEVENT\r\n";
        if(defined($file) && (-d $file)) {
@@ -384,6 +421,87 @@ sub do_vcalendar_schedule {
     print "END:VCALENDAR\r\n";
 }
 
+sub do_icalendar_schedule {
+    $| = 1;
+    my $r="\r";
+    # Ugh, I can't find a better solution than hardwiring it to CST
+    my $tzn = "America/Chicago";
+    my $timezone = <<EOF
+BEGIN:VTIMEZONE$r
+TZID:$tzn$r
+BEGIN:STANDARD$r
+DTSTART:20041031T020000$r
+RRULE:FREQ=YEARLY;INTERVAL=1;BYDAY=-1SU;BYMONTH=10$r
+TZOFFSETFROM:-0500$r
+TZOFFSETTO:-0600$r
+TZNAME:Standard Time$r
+END:STANDARD$r
+BEGIN:DAYLIGHT$r
+DTSTART:20050403T020000$r
+RRULE:FREQ=YEARLY;INTERVAL=1;BYDAY=1SU;BYMONTH=4$r
+TZOFFSETFROM:-0600$r
+TZOFFSETTO:-0500$r
+TZNAME:Daylight Saving Time$r
+END:DAYLIGHT$r
+END:VTIMEZONE$r
+EOF
+    ;
+    my $now = Date::Calc->now();
+    $now = sprintf ("%02d%02d%02dT%02d%02d%02dZ", $now->datetime());
+    my %days = (M => "MO", T => "TU", W => "WE", R => "TH", F => "FR", S => "SA", U => "SU");
+    my $file = $opts{'out'};
+    my @schedule = get_schedule(@_);
+    open(STDOUT, ">" . $file) || die $! if(defined($file) && (! -d $file));
+    open(STDOUT, ">/dev/null") || die $! if(defined($file) && (-d $file));
+    print "BEGIN:VCALENDAR$r\nPRODID:-//Tim Pope//NONSGML Schedproc//EN$r\nVERSION:2.0$r\nMETHOD:PUBLISH$r\n$timezone";
+    foreach my $row (@schedule) {
+       map { s/\n/-/g; $_} %$row;
+       my ($starttime, $stoptime)=($row->{'begin'}, $row->{'end'});
+       my ($startdate, $stopdate)=split(/-/, $row->{'duration'});
+       $starttime =~ s/://;
+       $stoptime =~ s/://;
+       my $first = first_class(%$row);
+       my @day = ();
+       @day = @{$row->{'off'}} if ($row->{'off'});
+       my $day = "";
+       if(exists($day[0])) {
+           $day = join(",", @day);
+           #$day =~ s/\b(\d{8})\b/$1T${starttime}00/g;
+       }
+       if(defined($file) && (-d $file)) {
+           open FH, ">$file/" . $row->{'id'} . ".vcs" or die "$!";
+           select FH;
+           print "BEGIN:VCALENDAR$r\nPRODID:-//Tim Pope//NONSGML Schedproc//EN$r\nVERSION:2.0$r\nMETHOD:PUBLISH$r\n$timezone";
+       }
+       print "BEGIN:VEVENT$r\n";
+       print "ORGANIZER:mailto:" . $opts{'email'} . "$r\n" if $opts{'email'};
+       print "UID:" . $row->{'id'} . "\@from.sctweb$r\n";
+       print "DTSTAMP:$now$r\n";
+       print "SUMMARY:", $row->{'title'}, "$r\n";
+       print "DESCRIPTION:", $row->{'id'}, "$r\n";
+       print "LOCATION:", $row->{'location'}, "$r\n";
+       print "CATEGORIES:Education$r\n";
+       print "TRANSP:OPAQUE$r\n";
+       print "DTSTART;TZID=\"$tzn\":", $first."T".$starttime, "00$r\n";
+       print "DTEND;TZID=\"$tzn\":", $first."T".$stoptime, "00$r\n";
+       $row->{'days'} =~ s/([MTWRFS])/,$days{$1}/g;
+       $row->{'days'} =~ s/^,//;
+       #$stopdate++;
+       print "RRULE:FREQ=WEEKLY;UNTIL=${stopdate}T000000Z;BYDAY=", $row->{'days'}, "$r\n";
+       #print("EXDATE;TZID=\"$tzn\":$day$r\n") if($day);
+       print("EXDATE;VALUE=DATE:$day$r\n") if($day);
+       print "ATTENDEE;CN=".$row->{'instructor'}.";RSVP=FALSE;PARTSTAT=ACCEPTED;ROLE=CHAIR:mailto:" . (get_faculty_email($row->{'instructor'}) || "fake\@ddress"), "$r\n";
+       print "ATTENDEE;CN=".$opts{'name'}.";RSVP=FALSE;PARTSTAT=ACCEPTED;ROLE=REQ-PARTICIPANT:mailto:" . ($opts{'email'} || "fake\@ddress"), "$r\n" if $opts{'name'};
+       print "END:VEVENT$r\n";
+       if(defined($file) && (-d $file)) {
+           print "END:VCALENDAR$r\n";
+           close FH;
+           select STDOUT;
+       }
+    }
+    print "END:VCALENDAR$r\n";
+}
+
 sub do_xml_schedule {
     my $file = $opts{'out'};
     my $schedule = { class => [ get_schedule(@_) ] };
@@ -421,10 +539,10 @@ sub do_html_schedule {
            #$instructor =~ s/ [A-Z. ]* / /;
            my $url = get_faculty_url($row->{'instructor'});
            if($url) {
-               print '<td><a href="' . $url . '">'
+               print '<td class="instructor"><a href="' . $url . '">'
                . $row->{'instructor'} . "</a></td>";
            } else {
-               print "<td>" . $instructor . "</td>";
+               print '<td class="instructor">' . $instructor . "</td>";
            }
            print "<td>" . $row->{'days'} . "</td>";
            my ($a,$b) = ($row->{'begin'}, $row->{'end'});
@@ -433,7 +551,7 @@ sub do_html_schedule {
            $b=~s/(1[3-9]|2\d|00):(\d\d)AM/sprintf "%d:%02dPM",abs $1-12,$2/e;
            print "<td>$a-<wbr />$b</td>";
            print "<td>" . $row->{'duration'} . "</td>";
-           print "<td>" . $row->{'location'} . "</td>";
+           print "<td>" . (ref($row->{'location'})?"":$row->{'location'}) . "</td>";
            print "</tr>\n";
        }
     print "</table>\n";
@@ -468,13 +586,15 @@ sub do_html_grades {
            print "</td></tr>\n";
        }
     }
-    my $lastrow = $grades->{'cumulative'}->[scalar @{$grades->{'cumulative'}}-1];
-    print '<tr class="cumulative '.$shade.'"><td id="cumulative" colspan="2">Cumulative: through ', capitalize($lastrow->{'term'});
-    print '</td><td align="center" id="gpa" class="grade">';
-    print $lastrow->{'gpa'};
-    print '</td><td align="right" class="right-number">';
-    print join('</td><td align="right" class="right-number">', ($lastrow->{'earned'}, $lastrow->{'hours'}, $lastrow->{'points'}));
-    print "</td></tr>\n";
+    if(exists($grades->{'cumulative'})) {
+        my $lastrow = $grades->{'cumulative'}->[scalar @{$grades->{'cumulative'}}-1];
+        print '<tr class="cumulative '.$shade.'"><td id="cumulative" colspan="2">Cumulative: through ', capitalize($lastrow->{'term'});
+        print '</td><td align="center" id="gpa" class="grade">';
+        print $lastrow->{'gpa'};
+        print '</td><td align="right" class="right-number">';
+        print join('</td><td align="right" class="right-number">', ($lastrow->{'earned'}, $lastrow->{'hours'}, $lastrow->{'points'}));
+        print "</td></tr>\n";
+    }
     print "</table>\n";
     select STDOUT;
 }
@@ -490,6 +610,8 @@ if ($opts{'format'} eq "xml") {
     do_csv_schedule(@ARGV);
 } elsif ($opts{'format'} eq "vcs") {
     do_vcalendar_schedule(@ARGV);
+} elsif ($opts{'format'} eq "ics") {
+    do_icalendar_schedule(@ARGV);
 } elsif ($opts{'format'} eq "grades") {
     do_html_grades(@ARGV);
 } else {