X-Git-Url: http://git.tpope.net/?p=tpope-extra.git;a=blobdiff_plain;f=perl%2Fschedproc;h=2a80bc3df745f296e61985445c172f254d6c1f81;hp=f06a7783d32d14db7c531adeebd1286c87bb5b04;hb=HEAD;hpb=3a174b42109557c2040dfbe9fd6197d2046cb8d8 diff --git a/perl/schedproc b/perl/schedproc index f06a778..2a80bc3 100755 --- a/perl/schedproc +++ b/perl/schedproc @@ -13,15 +13,10 @@ use Date::Calendar::Year; use Getopt::Long; use LWP::UserAgent; use XML::Simple; -use vars qw(%opts %faculty); +use vars qw(%opts %faculty %facurl); $opts{'config'} = $ENV{HOME} . "/.schedprocrc"; -if(($ARGV[0] || "") eq '-F') { - shift; - $opts{'config'} = shift; -} - my $arg = $ARGV[0] || ""; if($arg eq "-x") { shift; @@ -45,16 +40,16 @@ if($arg eq "-x") { Getopt::Long::Configure ("bundling", "auto_help"); die "Invalid arguments\n" unless -GetOptions(\%opts, 'schedule=s', 'grades=s', 'name=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'}; + open CONFIG, $opts{'config'} or die $!; while() { s/\#.*//; next unless m/^([^=]*)=(.*)/; my ($l, $r) = ($1, $2); - if ($l =~ /^(schedule|grades|name)$/) { - $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"; } @@ -64,9 +59,11 @@ if (-r $opts{'config'}) { $opts{'schedule'} ||= "~/schedule.xml"; $opts{'grades'} ||= "~/grades.xml"; +$opts{'faculty'} ||= ""; -$opts{'schedule'} =~ s/^~\//$ENV{HOME}\//; -$opts{'grades'} =~ s/^~\//$ENV{HOME}\//; +$opts{'schedule'} =~ s/(^|,)~\//$1$ENV{HOME}\//; +$opts{'grades'} =~ s/(^|,)~\//$1$ENV{HOME}\//; +$opts{'faculty'} =~ s/(^|,)~\//$1$ENV{HOME}\//; if(!defined($opts{'out'}) && defined($ARGV[0])) { $opts{'out'} = shift; @@ -76,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'} ||= ""; @@ -85,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); @@ -98,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'}); @@ -117,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/ +$//; @@ -153,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 ("", ); - close F; + if(open(F,$url)) { + $content = join ("", ); + close F; + } else { + die "$!" unless $_[0]; + } } - return $content; + return $content||""; #my $ref = XMLin($content, ForceArray => [ 'class', 'cumulative', 'off' ], KeyAttr => ""); #return @{$ref->{'class'}}; } @@ -168,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'}}; } @@ -177,20 +214,26 @@ sub get_grades { return $ref; } -sub get_faculty_email { - my ($name, $school, $email); - if((-f $ENV{'HOME'} . "/public_html/faculty.csv") && ! %faculty) { - open INS, $ENV{'HOME'} . "/public_html/faculty.csv"; - while($_ = ) { - 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,6 +241,16 @@ sub get_faculty_email { return $faculty{$name}; } +sub get_faculty_url { + load_faculty(); + my ($name); + $name = shift; + $name =~ s/ [A-Z]r?\.//g; + $name = lc $name; + $name =~ s/\W//g; + return $facurl{$name}; +} + sub get_mhc_header { return ( "X-SC-Subject: New Years Day\nX-SC-Category: Holiday\nX-SC-Cond: 1 Jan\nX-SC-Duration: 00010101-\nX-SC-Record-Id: \n", @@ -223,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; @@ -234,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"; @@ -255,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"; @@ -268,7 +322,7 @@ sub do_mhc_schedule { my @lines; foreach my $name (<$file/[1-9]*>) { next unless $name =~ /^$file\/[1-9][0-9]*$/; - open FH, $name; + open (FH, $name) || die $!; @lines = ; close FH; foreach (@lines) { @@ -276,14 +330,14 @@ sub do_mhc_schedule { } } my $i=0; - foreach (@mhc) { + foreach my $h (@mhc) { while(-f ++$i) {} - open FH, ">$file/$i" or die $!; - print FH $_; + open (FH, ">$file/$i") || die $!; + print FH $h; close FH; } } else { - open(STDOUT, ">" . $file) if(defined($file)); + open(STDOUT, ">" . $file) || die $! if(defined($file)); print "# MHC school schedule\n# Autogenerated by sctweb ".localtime()."\n\n"; print join("\n", @mhc); } @@ -295,13 +349,13 @@ sub do_csv_schedule { my @mon = qw(Jan. Feb. Mar. Apr. May June July Aug. Sept. Oct. Nov. Dec.); my ($current, @mhc, @schedule); @schedule = get_schedule(@_); - open(STDOUT, ">" . $opts{'out'}) if(defined($opts{'out'})); + open(STDOUT, ">" . $opts{'out'}) || die $! if(defined($opts{'out'})); 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'} . ","; @@ -320,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) if(defined($file) && (! -d $file)); - open(STDOUT, ">/dev/null") 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; @@ -348,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)) { @@ -364,12 +421,93 @@ 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 = <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(@_) ] }; my $xml = XMLout($schedule, NoAttr => 1, RootName => 'schedule'); if($file) { - open FH, ">$file"; + open FH, ">$file" || die $!; print FH $xml; close FH; } else { @@ -382,7 +520,7 @@ sub do_html_schedule { my $shade = "dark"; my @schedule = get_schedule(@_); if($opts{'out'}) { - open FH, ">" . $opts{'out'}; + open (FH, ">".$opts{'out'}) || die $!; select FH; } print ''."\n"; - # } else { - print ""; - #} + my $url = get_faculty_url($row->{'instructor'}); + if($url) { + print '"; + } else { + print '"; + } print ""; my ($a,$b) = ($row->{'begin'}, $row->{'end'}); $b .= "AM"; @@ -413,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 ""; print ""; - print ""; + print ""; print "\n"; } print "
"; @@ -399,13 +537,13 @@ sub do_html_schedule { print '' .$row->{'title'}. ''; my $instructor = $row->{'instructor'}; #$instructor =~ s/ [A-Z. ]* / /; - my $email = get_faculty_email($row->{'instructor'}); - #if($email) { - #print '' - #. $row->{'instructor'} . "" . $instructor . "' + . $row->{'instructor'} . "' . $instructor . "" . $row->{'days'} . "$a-$b" . $row->{'duration'} . "" . $row->{'location'} . "" . (ref($row->{'location'})?"":$row->{'location'}) . "
\n"; @@ -427,7 +565,7 @@ sub do_html_grades { my ($row); my $shade = "dark"; if($opts{'out'}) { - open FH, ">" . $opts{'out'}; + open (FH, ">".$opts{'out'}) || die $!; select FH; } print ''."\n"; @@ -448,13 +586,15 @@ sub do_html_grades { print "\n"; } } - my $lastrow = $grades->{'cumulative'}->[scalar @{$grades->{'cumulative'}}-1]; - print '\n"; + if(exists($grades->{'cumulative'})) { + my $lastrow = $grades->{'cumulative'}->[scalar @{$grades->{'cumulative'}}-1]; + print '\n"; + } print "
Cumulative: through ', capitalize($lastrow->{'term'}); - print ''; - print $lastrow->{'gpa'}; - print ''; - print join('', ($lastrow->{'earned'}, $lastrow->{'hours'}, $lastrow->{'points'})); - print "
Cumulative: through ', capitalize($lastrow->{'term'}); + print ''; + print $lastrow->{'gpa'}; + print ''; + print join('', ($lastrow->{'earned'}, $lastrow->{'hours'}, $lastrow->{'points'})); + print "
\n"; select STDOUT; } @@ -470,9 +610,10 @@ 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 { die "Unknown format. Try specifying --format.\n" } -