################################# # Module for making conference programs # Based on HSSbot.pm # so it carries a lot of excess baggage # 3 apr 20002 -- kcb ################################## # Package declaration package Conference; ################################## # Exported variables and other symbols use vars qw( @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $DivHome $SSHome $HumHome $CITHome $hss_url $html_pub $database_mod_date $weekday $today $weekday_num $month $today_serial ); use Exporter(); @ISA = ( "Exporter" ); @EXPORT = qw($DivHome $SSHome $HumHome $hss_url $html_pub $CITHome ); @EXPORT_OK = qw( $weekday $today $weekday_num $today_serial $month ); %EXPORT_TAGS = ( Times => [ qw($weekday $today $weekday_num $today_serial $month) ], ); use Time::Local; ################################## # CONSTANTS ################################## # Paths: my $db_dir = '.'; my $log_dir = '.'; my $prog_dir = '.'; $html_pub = '/infosys/www/www.hss.caltech.edu/docroot'; # URLs: $hss_url = 'http://www.hss.caltech.edu'; $CITHome = qq(Caltech Home Page); $DivHome = qq(Division Home Page); $SSHome = qq(Social Science Home Page); $HumHome = qq(Humanities Home Page); ################################## # MISC GLOBAL VARIABLE DECLARATION ################################## my @months = qw(January February March April May June July August September October November December); my @days = qw(Sunday Monday Tuesday Wednesday Thursday Friday Saturday); # flag for logging my $silent; # for saved file handle my $prev_fh; ################################## # DEFAULT FUNCTION ARGUMENTS ################################## my %default = ( 'record_separator' => "\n", 'field_separator' => "\t", 'banner_icon' => 'hss.jpg', 'cleanup' => \&cleanup, 'top_links_ref' => [], 'bottom_links_ref' => [], 'logfile' => 0, 'background' => "http://www.caltech.edu/pics/background.jpg", 'bgcolor' => '#ffffcc', 'group_id' => 104, ); # end %default ################################## # TOOLS FOR FUNCTION ARGUMENTS ################################## # Usage: %p = my_args(@_); # returns parameter hash for a function # filling in default values for missing args sub my_args { my %p = %default; # set initial parameters to default values my %in = @_; # read in additional parameters and overrides # replace parameters with new values using hash slice @p{ keys %in } = values %in; return %p; } # END sub my_args ################################## # Usage: fatal_omissions('function name', \%p, 'arg1', 'arg2', ... ); # dies with diagnostic if args missing sub fatal_omissions { my ($fn, $href, @args) = @_; my $arg; foreach $arg (@args) { die qq($0 Fatal Error: No "$arg" => "value" supplied to $fn.) unless $href->{$arg}; } } # END sub fatal_omissions ################################## sub venial_omissions { my ($fn, $href, @args) = @_; my $arg; foreach $arg (@args) { warn qq($0 Warning: No "$arg" => "value" supplied to $fn. Using default value = $default{$arg}.) unless $href->{$arg}; } } # END sub venial_omissions ################################## # READ DATA AND CREATE ARRAY REFERENCE ################################## # Usage: # $recordset_ref = Conference::create_recordset( # database => 'papers' , # db_fields_ref => \@db_fields, # required_fields_ref => \@required_fields, # sort_routine => \&by_Session, # record_separator => "\n", # field_separator => "\t", # ); sub create_recordset { # Get arguments my %p = my_args(@_); # Check argument list for completeness fatal_omissions('create_recordset', \%p, 'database', 'db_fields_ref'); # accept a list of databases my @database = split /, / , $p{'database'}; # make nicknames my $db_fields_ref = $p{'db_fields_ref'}; my $required_fields_ref = $p{'required_fields_ref'}; my $sort_routine_ref = $p{'sort_routine'}; my $cleanup = $p{'cleanup'}; # Use proper input separators. $/ = $p{'record_separator'}; my $fs = $p{'field_separator'}; # scratch variables my ($database, $field, @records, $rec); my ($num_processed, $num_warnings) = (0, 0); my @padding = ("") x scalar @{$p{'db_fields_ref'}}; local $_; # Next, open each $database or die. foreach $database ( @database ) { open (DB, "$db_dir/$database") or die qq(Cannot open file "$db_dir/$database": $!); log_msg("\tProcessing $db_dir/$database database:"); # While reading each record ... while () { next if /^\s*$/; # ignore blank lines next if /^\s*#/; # ignore comments chomp; my %hash = (); # Keep this private to this loop # cf. page 263 of the Camel book # create a hash reference for each record, using @db_fields for keys # Initialize to "" if missing from database @hash{ @$db_fields_ref } = ( ( split /$fs/, &$cleanup($_) ), @padding ); # push a reference to this private hash push @records, \%hash; # Generate warnings for missing data foreach $field ( @$required_fields_ref ) { log_msg("HEY!: Record $. " . (exists $hash{'Name'} ? "$hash{'Name'} ": "") . "in $database database is missing $field"), ++$num_warnings if ! $hash{$field}; } # end foreach $field ( @$required_fields_ref ), } # end of: while () # Get record count before closing $num_processed += $.; close (DB); } # end foreach $database ( @database ) # Report record count and warning count log_msg("\t$num_processed in recordset. \t$num_warnings warning" . ($num_warnings ==1 ? "": "s") . ".\n"); # Sort the record list and return a reference to it return [ sort { &$sort_routine_ref } @records ] ; } # end sub create_recordset ################################## # Sorting Routines ################################## sub by_Session { "\l$a->{'Session'}" cmp "\l$b->{'Session'}"; } ################################## sub by_time { # this is a real kludge my ($a_raw, $a_ampm) = split /\s+/, $a; my ($b_raw, $b_ampm) = split /\s+/, $b; my ($a_hour, $a_min) = split /:/, $a_raw; my ($b_hour, $b_min) = split /:/, $b_raw; $a_hour ||= 0; $b_hour ||= 0; $a_min ||= 0; $b_min ||= 0; $a_hour += 12 if ($a_ampm =~ /P/i and $a_hour < 12); $b_hour += 12 if ($b_ampm =~ /P/i and $b_hour < 12); $a_hour + ($a_min/60) <=> $b_hour + ($a_min/60); } # END sub by_time ################################## sub by_duration_end { # this is a worse kludge my ($a_start, $a_end) = split /-/, $a; my ($b_start, $b_end) = split /-/, $b; my ($a_raw, $a_ampm) = split /\s+/, $a_end; my ($b_raw, $b_ampm) = split /\s+/, $b_end; my ($a_hour, $a_min) = split /:/, $a_raw; my ($b_hour, $b_min) = split /:/, $b_raw; $a_hour += 12 if ($a_ampm =~ /PM/i and $a_hour < 12); $b_hour += 12 if ($b_ampm =~ /PM/i and $b_hour < 12); $a_hour + ($a_min/60) <=> $b_hour + ($a_min/60); } # END sub by_duration_end ################################## # Clean up the data ################################## sub cleanup { # Clean up data before splitting on tabs local $_ = shift(@_); # Fix some data entry glitches: s/[ ]+/ /g; # multiple spaces s/[ ]+, /, /g; # space before comma s/[ ]+$//g; # trailing space in a field s/[ ]+\t/\t/g; # trailing space in a field s/^[ ]+//g; # leading space in a field s/\t[ ]+/\t/g; # leading space in a field # Convert the FilemakePro special characters. # Convert "smart" quotes to dumb ones. s/\322/"/g; # (double right) aka ² s/\323/"/g; # (double left) aka ³ s/\324/`/g; # (single left) aka Œ s/\325/'/g; # (single right) aka ¹ # Separator for repeating fields is ASCII 29 = \035 octal # Newline within a field is ASCII 11 = \013 octal s/(\035|\013)+(\t|$)/$2/g; # remove leading separators s/(^|\t)(\035|\013)+/$1/g; # remove trailing separators return $_; } # end sub cleanup ################################## sub high_ascii_to_html { local $_ = shift; s/\330/é/g; s/\216/é/g; return $_; } ################################## sub high_ascii_to_tex { local $_ = shift; s/\330/\\'{e}/g; s/\216/\\'{e}/g; return $_; } ################################## # OUTPUT PAGE TYPES ################################## sub create_html_program { # get argument list my %p = my_args(@_); # check argument list for completeness fatal_omissions('create_html_program', \%p, 'filename', 'paperlist_ref', 'sessionlist_ref'); venial_omissions('create_html_program', \%p, 'maintainer', 'maintainertitle', 'window_title'); # scratch variables my $session; my $paper; my $times; my $d; my $t; open_out("$p{'filename'}", $silent); html_head( 'window_title' => "$p{'window_title'}", 'background' => "$p{'background'}", 'bgcolor' => "$p{'bgcolor'}", ); banner("$p{'page_heading_a'}", "$p{'page_heading_b'}", "$p{'banner_icon'}"); running_list(@{$p{'top_links_ref'}}); hrule(4); # Print a disclaimer about the papers print qq(

Links are provided to pdf versions of the papers where available. These pdf files are supplied by the authors. Any problems reading them should be reported to the author, not to the conference organizer. Thank you.


); # Make a List of Session Dates and Times foreach $session ( @{$p{'sessionlist_ref'}} ) { ++$times{$session->{'Date'}}->{$session->{'Start_Time'}}->{$session->{'Time'}}; } # Create a Session List print qq(

Overview of Sessions

\n); hrule(3); foreach $d ( sort keys %times ) { print "", slash_to_day("$d"), "
\n"; foreach $t ( sort by_time keys %{$times{$d}} ) { print qq($t
\n); foreach $s ( @{$p{'sessionlist_ref'}} ) { print qq($s->{'Session'}: $s->{'Title'}
\n) if ($s->{'Date'} eq $d and $s->{'Start_Time'} eq $t); } # END foreach $s br(); } # END foreach $t br(); hrule(3); } # END foreach $d # Group papers by session print qq(

Session Details

\n
\n); foreach $session ( @{$p{'sessionlist_ref'}} ) { my @list; print html_session_heading($session); # format each paper entry foreach $paper (@{$p{'paperlist_ref'}}) { next unless ($paper->{'Session'} eq $session->{'Session'}); push @list, html_program_format($paper); } # end foreach ($paper) print ("

Papers

") if scalar @list > 1; print (join "
", @list) if scalar @list; hrule(3); } # END foreach $session running_list(@{$p{'bottom_links_ref'}}); # Print a disclaimer about the papers print qq(
\n

\nLinks are provided to pdf versions of the papers where available. These pdf files are supplied by the authors. Any problems reading them should be reported to the author, not to the conference organizer.
\nThank you.

\n\n); address("$p{'maintainer'}", "$p{'maintainertitle'}"); close_out(); set_group_and_permissions("$p{'group_id'}", '0664', "$p{'filename'}"); } # end sub create_html_program ################################## sub create_tex_program { # get argument list my %p = my_args(@_); # check argument list for completeness fatal_omissions('create_tex_program', \%p, 'filename', 'paperlist_ref', 'sessionlist_ref'); # scratch variables my $session; my $paper; my %times; my $d; my $s; my $e; my $first; my $f; open_out("$p{'filename'}.tex", $silent); # LaTeX Preamble print qq(\\documentclass[twoside]{article} \\usepackage{conference} \\makeindex \\title{$p{'page_heading_a'}} \\date{$p{'page_heading_c'}} \\author{} \\begin{document} \\pagestyle{headings} \\pagenumbering{roman} \\thispagestyle{plain} \\tableofcontents \\clearpage \\thispagestyle{plain} \\input{ack} \\clearpage\\markboth{}{}\\cleardoublepage \\markboth{}{} \\setcounter{page}{0} \\pagenumbering{arabic} ); # Make a List of Session Dates and Times foreach $session ( @{$p{'sessionlist_ref'}} ) { ++$times->{$session->{'Date'}}->{$session->{'Start_Time'}}->{$session->{'Time'}}; } # Group papers by session # Group by Date foreach $d ( sort keys %{$times} ) { print "\\clearpage\n\\thispagestyle{plain}\n\\section{", slash_to_day("$d"), "}\n"; # Group by Start Time foreach $s ( sort by_time keys %{$times->{$d}} ) { # Group by Duration (just in case they aren't all the same) foreach $e ( sort by_duration_end keys %{ $times->{$d}->{$s} } ) { ($f = $e) =~ s/-/--/; # KLUDGE print "\\filbreak\n\\subsection{$f}\n\n"; $first = 1; foreach $session ( @{$p{'sessionlist_ref'}} ) { my @list; if ($session->{'Date'} eq $d and $session->{'Start_Time'} eq $s and $session->{'Time'} eq $e) { print tex_session_heading($first, $session); $first = 0; print "\\medskip\n"; # format each paper entry foreach $paper (@{$p{'paperlist_ref'}}) { next unless ($paper->{'Session'} eq $session->{'Session'}); push @list, tex_program_format($paper); } # end foreach ($paper) print (join "\n\n\\smallskip\n", @list) if scalar @list; } # END if } # END foreach $session } # END foreach time $e } # END foreach start time $s } # END foreach date $d print "\\clearpage \\markright{Committees} \\input{committees} \\input{$p{'filename'}.ind} \\end{document} "; close_out(); set_group_and_permissions("$p{'group_id'}", '0664', "$p{'filename'}.tex"); } # end sub create_tex_program ################################## # LIST ITEM FORMATS ################################## sub html_session_heading { my $s = shift; return join "", qq(

Session $s->{'Session'}: $s->{'Title'}

\n), qq( \n), if_nonnull(" "), if_nonnull(q( \n"), if_nonnull(q( \n"), if_nonnull(q( \n"), "
", slash_to_day("$s->{'Date'}"), "), $s->{'Time'}, "
), $s->{'Location'}, "
Chair:), $s->{'Chair'}, "

\n", ; } # end sub html_session_heading ################################ sub tex_session_heading { my ($first, $s) = @_; my ($l, $f) = ("", ""); my $chair = idx_name($s->{'Chair'}); return join "", ( $first ? "" : qq(\\filbreak\n) ), qq(\\subsubsection[\\hbox to 2.25em {$s->{'Session'}:\\hfill\\hss} $s->{'Title'}]), qq({$s->{'Session'}: $s->{'Title'}), if_nonnull(" \\newblock(", $s->{'Location'}, ")"), "}\n", if_nonnull("Chair: \\textbf{", $chair, "} "), "\n\n", ; } # end sub tex_session_heading ################################ sub html_program_format { my $rec = shift(@_); my $col; my $title = ( -e "../Papers/$rec->{'FileName'}.pdf" ? qq($rec->{'PaperTitle'}) : qq($rec->{'PaperTitle'}) ); return join "", "\n", if_nonnull(" \n"), if_nonnull("
", $title, "
", "$rec->{'FirstName'} $rec->{'LastName'}", "\n"), if_nonnull(" (", high_ascii_to_html($rec->{'Institution'}), ")\n"), if_nonnull( "
\n
",, $rec->{'Coauthor1'}, "\n"), if_nonnull(' (', $rec->{'Coauthor1Affil'}, ")\n"), if_nonnull( "
\n
",, $rec->{'Coauthor2'}, "\n"), if_nonnull(' (', $rec->{'Coauthor2Affil'}, ")\n"), if_nonnull( "
\n
",, $rec->{'Coauthor3'}, "\n"), if_nonnull(' (', $rec->{'Coauthor3Affil'}, ")\n"), "
", ; } # end sub html_program_format ################################ sub tex_program_format { my $rec = shift(@_); my $col; return join "", '\begin{tabular}{p{\\titlewidth}}', "\n", if_nonnull("{\\slshape ", $rec->{'PaperTitle'}, "}\\\\ \n"), if_nonnull('{\bfseries ', "$rec->{'FirstName'} $rec->{'LastName'}}\\index{$rec->{'LastName'}, $rec->{'FirstName'}}", ''), if_nonnull(' (', $rec->{'Institution'}, ")\n"), if_nonnull( "\\\\\n", idx_name($rec->{'Coauthor1'}), "\n"), if_nonnull(' (', $rec->{'Coauthor1Affil'}, ")\n"), if_nonnull( "\\\\\n", idx_name($rec->{'Coauthor2'}), "\n"), if_nonnull(' (', $rec->{'Coauthor2Affil'}, ")\n"), if_nonnull( "\\\\\n", idx_name($rec->{'Coauthor3'}), "\n"), if_nonnull(' (', $rec->{'Coauthor3Affil'}, ")\n"), '\end{tabular}', "\n\n", ; } # end sub tex_program_format ################################## # Miscellaneous ################################## # Kludge to deal with names where first, last are not separate fields sub idx_name { my $name = shift @_; return "" unless $name; $name =~ s/, Jr/,~Jr/; my @names = split /\s+/, $name; my $l = pop @names; $l =~ s/~/ /; my $f = join " ", @names; return $name .= "\\index{$l, $f}"; } ################################## sub if_nonnull { my ($prefix, $text, $suffix, $sep, $newsep) = (@_, '', ''); $sep ||= "\013"; $newsep ||= "
\n"; if ($text) { $text =~ s/$sep+/$newsep/eg; return "$prefix$text$suffix"; } } # end sub if_nonnull ################################## # HTML subroutines ################################## sub html_head { # make the html header with window title # Get arguments my %p = my_args(@_); # Check argument list for completeness venial_omissions('html_head', \%p, 'window_title'); my $background = ($p{'background'} ? qq(background="$p{'background'}") : ""); my $bgcolor = ($p{'bgcolor'} ? qq(bgcolor="$p{'bgcolor'}") : ""); print < $p{'window_title'} End_of_html_head } # end sub html_head ################################## sub running_list { my @list = @_; my $list; my $spacer = ' · '; $list = join "$spacer", @list; print "
\n· $list ·\n
\n"; } # end sub running_list ################################## sub address { my ($maintainer, $maintainertitle)= @_; print <
This page is maintained by $maintainertitle, and is current as of as $database_mod_date.
End_of_address } # end sub address ################################## sub banner { # make a page banner heading my ($page_heading_a, $page_heading_b, $banner_icon) = @_ ; my $alt; my $img = ""; if ($banner_icon =~ /hss.jpg/) { $alt="The Humanities and Social Sciences";} elsif ($banner_icon =~ /ss.jpg/) { $alt="Social Sciences";} elsif ($banner_icon =~ /th.jpg/ ) { $alt="The Humanities";} else {$alt = "";} $img = qq(California Institute of Technology: $alt\n) if $banner_icon; print < $img

$page_heading_a

$page_heading_b


End_of_banner } # END sub banner ################################## sub br { print "
\n"; } # end sub br ################################## sub p { print "

\n"; } # end sub p ################################## sub end_p { print "

\n"; } # end sub end_p ################################## sub emph { my $string = shift(@_); print "$string"; } # end sub emph ################################## sub bold { my $string = shift(@_); print "$string"; } # end sub bold ################################## sub hrule { my ($size) = @_; print "\n\n\n"; } # end sub hrule ################################## # FILE MANIPULATION ################################## sub open_out { my ($filename, $silent) = (@_, ''); if ( open (OUT, ">$filename") ) {log_msg("\tCreating $filename.") unless $silent ;} else {warn "WHOA!!!! cannot create $filename: $!" ; return;} # store previous handle in global variable $prev_fh = select (OUT); return \*OUT; } # end sub open_out ################################## sub close_out { close (OUT); select ($prev_fh); } # end sub close_out ################################## sub set_group_and_permissions { my ($gid, $permissions, @filelist) = @_ ; # The $< variable contains the current user's user ID. # must use oct function for chmod, see p.148--149 of Camel book chown ($<, $gid, @filelist); chmod (oct($permissions), @filelist); } # end subroutine set_group_and_permissions ################################## sub get_mod_date { # get modification date of $filename my $filename = shift(@_); return '?' unless -e $filename; # Get the file stats from the database file. my ($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size, $atime, $mtime, $ctime, $blksize, $blocks) = stat $filename ; return long_date($mtime); } # end get_mod_date ################################ # Time and date ################################ # Find number of complete days in so many seconds: # Used to convert UNIX time (nonleap seconds since epoch) to a # UNIX date serial. (December 31, 1960 = day 0) sub seconds_to_days { my $seconds = shift(@_) ; return int($seconds/86400); } ################################ sub long_date { my $epoch_seconds = shift (@_); my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime($epoch_seconds); my $Month = $months[$mon]; my $Year = 1900 + $year; return "$Month $mday, $Year"; } # end sub long_date ################################## sub slash_to_day { my ($m, $d, $y) = split /\//, shift @_; --$m; my $epoch_seconds = timelocal(0, 0, 0, $d, $m, $y); my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime($epoch_seconds); return "$days[$wday], $months[$m] $d"; } # END sub slash_to_day ################################## sub weekday { my $epoch_seconds = shift (@_); my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime($epoch_seconds); return $days[$wday]; } ################################## sub time_of_day { my $epoch_seconds = shift (@_); my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime($epoch_seconds); $min = "0$min" if $min < 10; $sec = "0$sec" if $sec < 10; return "$hour:$min.$sec"; } # end sub time_of_day ################################ sub get_time_vars { my $instant = time; my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime($instant); my ($today, $today_serial, $month); $today = long_date($instant); $today_serial = seconds_to_days($instant); $weekday = weekday($instant); $month = ++$mon; return ($today, $today_serial, $wday, $weekday, $month); } # END sub get_time_vars ################################## # LOGGING ################################## # Usage: start_log(logfile => 'faculty', silent => 0); sub start_log { my %p = my_args(@_); venial_omissions('start_log', \%p, 'logfile', 'database'); # set this global flag $silent = $p{'silent'}; # nicknames my $logfile = $p{'logfile'}; my $database = $p{'database'}; unless ($logfile) { warn "$0 error: logfile => filename supplied to start_log. Logging on error.log"; $logfile = 'error'; } # Initalize certain package and private variables ($today, $today_serial, $weekday_num, $weekday, $month) = get_time_vars(); my $prog_mod_date = get_mod_date($0); my $bot_mod_date = get_mod_date("$prog_dir/Conference.pm"); my $user = getpwuid($<); my $now = time_of_day(time); $database_mod_date = get_mod_date("$db_dir/$database"); open (LOGFILE, ">$log_dir/$logfile.log") or warn "Cannot open log file. $!"; print LOGFILE <