X-Git-Url: http://git.tpope.net/?p=tpope-extra.git;a=blobdiff_plain;f=perl%2Fschedproc;h=2a80bc3df745f296e61985445c172f254d6c1f81;hp=a61b4532491e20dbdf1dc0937d1f36427e575dc9;hb=HEAD;hpb=a4c8429c4825364d7dbac889e9cd690f2669f0ad diff --git a/perl/schedproc b/perl/schedproc index a61b453..2a80bc3 100755 --- a/perl/schedproc +++ b/perl/schedproc @@ -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', 'faculty=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|faculty)$/) { - $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"; } @@ -73,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|vcs|xml|grades)$/); + undef $opts{'out'} if($opts{'out'} =~ /^(html|mhc|csv|vcs|ics|xml|grades)$/); } $opts{'format'} ||= ""; @@ -82,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); @@ -95,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'}); @@ -114,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/ +$//; @@ -150,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'}}; } @@ -178,10 +217,10 @@ sub get_grades { sub load_faculty { my ($name, $email, $url, $content); if(($opts{'faculty'}) && ! %faculty) { - $content = read_fileurl($opts{'faculty'}); - foreach $_ (split("\n", $content)) { - m/"([^"]*)",([^,]*),([^,]*)/; # " - ($name, $email, $url) = ($1, $2, $3); + $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; @@ -237,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; @@ -248,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"; @@ -269,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"; @@ -290,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 { @@ -313,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'} . ","; @@ -334,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; @@ -362,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)) { @@ -378,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 = <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(@_) ] }; @@ -427,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 "$a-$b"; print "" . $row->{'duration'} . ""; - print "" . $row->{'location'} . ""; + print "" . (ref($row->{'location'})?"":$row->{'location'}) . ""; print "\n"; } print "\n"; @@ -462,13 +586,15 @@ sub do_html_grades { print "\n"; } } - my $lastrow = $grades->{'cumulative'}->[scalar @{$grades->{'cumulative'}}-1]; - print 'Cumulative: through ', capitalize($lastrow->{'term'}); - print ''; - print $lastrow->{'gpa'}; - print ''; - print join('', ($lastrow->{'earned'}, $lastrow->{'hours'}, $lastrow->{'points'})); - print "\n"; + if(exists($grades->{'cumulative'})) { + my $lastrow = $grades->{'cumulative'}->[scalar @{$grades->{'cumulative'}}-1]; + print 'Cumulative: through ', capitalize($lastrow->{'term'}); + print ''; + print $lastrow->{'gpa'}; + print ''; + print join('', ($lastrow->{'earned'}, $lastrow->{'hours'}, $lastrow->{'points'})); + print "\n"; + } print "\n"; select STDOUT; } @@ -484,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 {