$titlehead

#!/usr/bin/perl # cal_make.pl # --------------------------------------------------------- # [Unix: first line above, after the `#!`, points to perl.exe] # # Path to the /perlcal/ directory # (MUST end with '/' . On NT/95 servers specify an absolute path, # On UNIX servers specify a relative path from the dir containing this script). $cal_param = 'perlcal/'; # UNIX,Mac,OS/2 ex1 (if /perlcal/ is WITHIN the dir containing this script) #$cal_param = '../perlcal/'; # UNIX,Mac,OS/2 ex2 (if /perlcal/ is AT SAME LEVEL AS the dir containing this script) #$cal_param = '/www/perlcal/'; # NT ex (from system root) #$cal_param = 'd:/www/perlcal/'; # NT ex2 (system is on a different drive) #$cal_param = 'bin/perlcal/'; # VMS ex (assuming server root is default dir) # (Optional) File path to SSI ad banner script #$ads_path = 'd:/www/binsh/ads.pl'; #$ads_path = 'd:/www/cgi-bin/ssirand.exe'; $ads_perl = 1; # 1 if $ads_path is a Perl script, 0 if other. # *** END OF CUSTOMIZATION -- EDITING BELOW IS RESTRICTED -- SEE LICENSE.TXT *** # ****************************************************************************** # # This CGI script is used to generate the PerlCal calendar/scheduler. # # Written Dec 28, 1995 - Randal Pittelli # Major Rev Mar 20, 1996 - " - modified for HTML frames # Mar 14, 1997 - " - ver 1.0 ported to Perl from DCL # May 29, 1997 - " - ver 2.0 # Mar 30, 1998 - " - ver 2.1 # Jun 15, 1998 - " - ver 2.2 # Jan 10, 1999 - " - ver 2.5 # Nov 01, 1999 - " - ver 2.9 # # PerlCal IS COPYRIGHTED 1995-2000: # It may not be copied for distribution or for use, whole or in part, without # written permission from Randal Pittelli. Other Terms & Conditions are stated in license.txt. # $version = '2.98'; # This script can output 8 basic documents: #1. Document showing an event-linked calendar [CAL] #2. Document showing activities on a particular date [DAY]. #3. Document showing activities in a particular week [WEE]. #4. Document showing activities in a particular month or weekday [MON]. #5. Document showing activities in a particular subject-area #6. HTML form for adding events [ADD]. #7. Documents giving instructions on how to operate and update the calendar [INS]. #8. Form to request Update Privileges [JOI]. # # Basic CGI Arguments: # Ex: cal_make.pl?p1=[CAL,ADD,JOI,INS,][&p2=MOD] # SEE Readme.htm for further examples/explanation # # See cal_mod.pl for event file-naming scheme # ----------------------------- # # MAIN PROCEDURE: if (!$?) { # No system error &specific; # Platform/version specific code &getinput; # Get form input (POST or GET) &getcodes; # Get 3-char reserved codes &getparams; # Get customized parameters &gettoday; # Get current date of audience &setup; # Set some vars (some needed in sub privileged) $kill = ($p1 =~ /^$aadd/ || $view_secure && ($p0 || $p1 ne $ainst && $p1 ne $ajoin)) ? 1 : 0; &privileged($kill); $view = ($ctypes[$layout] =~ /\:\=0$/) ? 'view' : 'cal'; &whowhen; # check for filter by who/when &relodit; # set up for reload &doc1a; if (!$p0 && $p1) { # non-template calls &setup2; # Assign doctypes, some constants, titles (needs var from priviliged!) &hed; # HTTP header &head; # Common HTML (non-template) header &doctypes; # Meat &foot; # Common HTML (non-template) footer } else {&template($FORM{p1});} # process template } exit; # END MAIN # ********************************* sub head { local($tmp); $titlehead =~ s/<.*>//g; print "$titlehead\n"; if ($relod) {$bsc = " OnLoad=\"$hometarget\"";} if ($doctype != 6 && $doctype != 10 && !($doctype == 9 && $allow_registration && !$FORM{'success'})) { # doc6 (add form) and request form have JAVASCRIPT first print "\n\n"; } elsif ($relod) {$bsc = "; $hometarget";} } sub foot { local($other,$ver); if ($doctype != 10) { if ($p1 eq $ainst) {print "$common_foot\n$feet";} elsif (!$FORM{banner} && $doctype != 6) {print $common_foot;} } print "\n"; } sub head2 { local($tmplate) = @_; local($tag,$t2); if ((!$p0 || $tmplate) && !$FORM{banner}) { $tmp = ""; if ($doctype == 6 && $FORM{$change_prefs} != 13) {$tag = "";} if ($FORM{usearched} || !$ss || !$FORM{p4}) { if ($logged || !$userpassword2) {$tag .= " $userhost2 ";} elsif ($modify || $cookies{"PerlCal_2"}) {$tag .= "";} if ($p1 eq '---' && $pending) { $tag = "\n$tag"; } elsif ($p1 ne $acal) { $tag = "\n$tag"; } } else { $tag = $tmp; ($titlebody,$t2) = split(/
/,$titlebody); } } $common_head = '' if $FORM{p4} && $ss || $p1 eq $aadd || $p1 eq $ainst || $p1 eq $ajoin; if ($tag || $p1 ne $acal) { print qq@ @; if ($t2) {print "";} print "

$common_head $titlebody

$tag

$t2

"; } } # --------------------------------- # write out HTML from template OR redirect to homepage if !$p1 sub template { local($viewdef) = @_; $tmp = ($p0 eq 'calendar') ? 1 : 0; $frametype = ($p0 eq 'caln') ? 2 : $tmp; $bgvar = $tmp ? $bgcolor_cal : $bgcolor_nav; $relode = ($relod && $hometarget && $frametype == 1) ? "\n\n" : ""; if (!$viewdef) { # otherwise just deleted -> reload if ($modify) {$viewdef = "$aadd$modify";} else {$viewdef = $aview;} } local($modneg) = $modify ? '' : '&p2=MOD'; if ($modify && $p0 eq 'caln') {$p0 .= 'mod';} local(%hold); $hold{BGCOLOR}=$bgvar; $hold{CALNAV} ="$cal_http\?p0=caln$modify$params"; $hold{CALNAVSIZE}=$prefs[28]; $hold{CALSIZE}=$prefs[27]; $hold{HELP} ="$cal_http\?p1=$ainst$modify$params"; $hold{IMG_DIR}=$htm_dir; $hold{LAYOUT} ="$cal_http\?p0=cal$modneg$params"; $hold{POST} ="$cal_http\?p1=$aadd$modify$params"; $hold{REFRESH}=$prefs[9] ? "" : ''; $hold{SEARCH} ="$cal_http\?p1=$aview$modify$params&search=1"; $hold{TITLE} =$cal_org; $hold{VIEW} ="$cal_http\?p1=$viewdef$params"; local(%proc); $proc{AD}=1; $proc{CAL}=1; $proc{CALENDAR}=1; $proc{DATE}=1; $proc{EVENTS}=1; $proc{SUBJS}=1; $proc{USERS}=1; $proc{USERNAME}=1; $tpl = "$cal_param$cal_dir${slash}template$slash$p0$layout.tpl"; open(TP,"<$tpl") || &erred("Couldn't open template $tpl"); &hed; while () {&translate($_);} close(TP); } exit; # --------------------- sub translate { local($r) = @_; local($code,$subc,$afta); if ($frametype == 1) { $r =~ s/<\/BODY>/$common_foot\n$feet<\/BODY>/i if !$prefs[16] && !$meta; if ($relode) {$r =~ s/<\/HEAD>/$relode<\/HEAD>/i;} if ($modify) {$r =~ s/cal_mod\.gif/cal_cal\.gif/;} } if ($r =~ s/^(.*)<<(\w*)( +\w+)?>>(.*)$//) { $code = $2; $subc = $3; $afta = $4; &translate($1) if $1; if (defined $hold{$code}) {print $hold{$code};} elsif ($proc{$code}) {&{$code};} &translate($afta) if $afta; } else {print $r;} } sub AD { &ads($subc); } sub CAL { &auto_imp; } sub CALENDAR { $p1=$acal; &setup2; &doctypes; } sub DATE { if ($prefs[0] == $frametype) {&select_date;} } sub EVENTS { $tmp = ($thismon eq $bstr) ? $aview : "$amon$bstr"; $p1 = (($prefs[0] || $prefs[21]==1) && ($FORM{cyear} || $dr)) ? $tmp : $aview; &setup2; &doctypes; } sub SUBJS { $temp=($subc eq ' SELECT') ? 1 : 0; if ($prefs[11] == $frametype && $prefs[12] == $temp) {&show_subs;} } sub USERNAME { &head2(1); } sub USERS { if (($meta2 || $scheduler) && !$sched_private && $prefs[10] == $frametype) {&select_users;} } # *********************************** sub doctypes { # write out the specified doc # --------------------------------- # Search if ($doctype == 10) {&doc10;} # ---------------------------------- # MAIN or UPDATEABLE calendar (doc type 1) elsif ($doctype == 1) { if (!$prefs[7]) {$prefs[7] = 3;} if ($prefs[7] < 3) {print "\n";} else {print "\n";} print "\n"; &doc1; #Write out the calendar } # ---------------------------------- # Docs 2,3,4,5 (display events for day, week, month, subject, day-subject, or one event) elsif ($doctype < 6) { &head2(0); # print title stuff print "

\n"; $prefs[5] = $FORM{basefont} || $prefs[5]; print "\n"; # Write out the particular doc if ($doctype == 2) {&doc2;} else { print '

'; if ($doctype == 3) {&doc3(6);} # week elsif ($doctype == 4) { if (defined $FORM{wday}) {&doc3(0);} # weekday else {&doc3(3);} # month } elsif ($doctype == 5) {&doc5;} } } # ---------------------------------- # Post form elsif ($doctype == 6) { require $cal_param.'post.pl' || &erred("/perlcal/post.pl not accessible"); &doc6; } # ---------------------------------- else { require $cal_param.'help.pl' || &erred("Sorry: Function is temporarily unavailable

\n"); # Mod Instructions if ($doctype == 7) {&help_mod;} # Intro instructions elsif ($doctype == 8) {&help_ins;} # Updater Request Form OR verify request submitted. elsif ($doctype == 9) {&help_upd;} } } # end [doctypes] # ******************************* # Get the form input (POST or GET) sub getinput { if ($ARGV[0] && !$ENV{CONTENT_LENGTH} && !$ENV{QUERY_STRING}) {$buffer = $ARGV[0];$argv0=1;} else { if ($ENV{CONTENT_LENGTH}) {read(STDIN, $buffer, $ENV{CONTENT_LENGTH});} # form if ($buffer && $ENV{QUERY_STRING}) {$ENV{QUERY_STRING} .= '&';} $buffer = "$ENV{QUERY_STRING}$buffer"; # form + inline } # split name-value pairs local(@pairs) = split(/&/, $buffer); foreach $pair (@pairs) { ($name, $value) = split(/=/, $pair); $value =~ tr/+/ /; $value =~ s/%([a-fA-F0-9]{2})/pack("c", hex($1))/eg; $value =~ s/\r\n/\n/g; $FORM{$name} .= $value; } } # ************************************** sub getparams { $params=''; $conf = "${cal_param}calparam.pl"; # Get cal parameters require $conf || &erred("SERVER ERROR: Couldn't REQUIRE $conf

\n"); require "${cal_param}secure.pl" || &erred("SERVER ERROR: Couldn't REQUIRE secure.pl

\n"); } # *********************** sub auto_imp { local($out) = "$cal_http?p1=$acal$modify$params"; if ($auto_import) { opendir(DIR,"$cal_param$cal_dir${slash}import") || return $out; @tmp = grep(/\.dat$/i,readdir(DIR)); closedir(DIR); if ($#tmp >= 0) {$out = "$update_http?p1=$acal$modify$params&import=2";} } print $out; } # ************************************************* sub setup { local($other,$ver,$w,$h); $p1 = $FORM{shide} ? $FORM{shide} : $FORM{p1}; # main command $p0 = ($p1 eq $acal) ? 'calendar' : $FORM{p0}; # template base-name if (!$p1 && !$p0) {$p0 = 'cal';} $p2 = $FORM{p2}; # modify (update) mode? $p0 =~ s/\.{2,}//; $p1 =~ s/\.{2,}//; if (length($FORM{p3}) >= 21) {$edit = $FORM{p3};} $modify = $p2 ? '&p2=MOD' : ''; # Set some constants $htm = 'HTML'; if ($ENV{SCRIPT_NAME} !~ /^\//) {$ENV{SCRIPT_NAME} = '/'.$ENV{SCRIPT_NAME};} $cal_http = $ENV{SCRIPT_NAME}; if ($cal_http !~ /http:/i) {$server = $ENV{SERVER_URL} || "http://$ENV{HTTP_HOST}";} ($update_http = $cal_http) =~ s/cal_make\./cal_mod\./i; @mstring=("January","February","March","April","May","June","July","August","September","October","November","December"); @wstring=("Sunday","Monday","Tuesday","Wednesday","Thursday","Friday","Saturday"); # event listings @wstrings=("Sundays","Mondays","Tuesdays","Wednesdays","Thursdays","Fridays","Saturdays"); # plural (event listings by weekday) @days1 = ('Su','M','Tu','W','Th','F','Sa'); # small calendars @days2 = ('Sun','Mon','Tue','Wed','Thu','Fri','Sat'); # big calendars if ($bullet) { if ($bullet =~ /,/) { ($bullet,$w,$h) = split (/,/,$bullet); $bullet = $w && $h ? "" : ""; } else {$bullet = "";} } $arrow = ''; $spacer = $htm_dir.'spacer.gif'; $edir = "$cal_param$cal_dir${slash}entries$slash"; $pdir = "$cal_param$cal_dir${slash}entries${slash}pending$slash"; $affil = "$cal_param$cal_dir${slash}affil.lst"; $cname = $scheduler ? 'Schedule' : 'Calendar'; if (!$scheduler && $meta) { $sched = "$cal_param$cal_dir${slash}meta.lst"; $meta2 = (-e $sched) ? 1 : 0; } else {$sched = "$cal_param$cal_dir${slash}sched.lst";} $user_dir = "$cal_param$cal_dir${slash}users$slash"; # DAY page $thead[2] = $cal_org; $tbody[2] = ''; # # WEEk page $thead[3] = $cal_org; $tbody[3] = ''; # # MONth page $thead[4] = $cal_org; $tbody[4] = ''; # # ADD page $thead[6] = "Post an Event on the $cal_org"; $tbody[6] = "Post an Event on the $cal_org"; # # (MOD) INStruction page $thead[7] = "$cal_org Help"; $tbody[7] = "Updating the $cal_org"; # # INStructions page $thead[8] = "$cal_org Help"; $tbody[8] = "Using the $cal_org"; # # JOIn form $thead[9] = "$cal_org User Registration"; $tbody[9] = "$cal_org Registration"; # # SEARCH $thead[10] = "$cal_org Search"; $tbody[10] = "$cal_org Search"; # *** DO NOT EDIT **** if ($custom) { $ver = "C"; $other = "$ownername, R. Pittelli"; } $feet = qq|
PerlCal $version$ver © 2000 $other |; } # *** DO NOT EDIT ABOVE *** # ******************************* sub setup2 { # follows &privileged local($curr); $wtit = $prefs[22] ? 28 : 38; if (!$meta2 && !$scheduler || !$prefs[10] || $sched_private) {$wtit += 10;} if ($FORM{pending}) { $edir = $pdir; $pending = '&pending=1'; } if ($FORM{bgcolor}) { $FORM{bgcolor} =~ s/^#?/#/; $bgcolor =~ s/background ?= ?["'][^'"]+['"]//i; $bgcolor =~ s/bgcolor ?= ?["'][^'"]+['"]/bgcolor="$FORM{bgcolor}"/i; } if ($FORM{search}) { $doctype=10; $titlehead=$thead[10]; $titlebody=$tbody[10]; return; } if ($p1 eq $aview) {$p1 = $prefs[3];} # Generate the appropriate titles for the output doc $all_dates=0; $gcd=substr($p1,0,3); if ($p1 eq $acal) { # Main CALendar $doctype=1; @cdate = @sdate; if (!$dir_list[0]) {&doc1b;} # get ALL events for relevant subjs } elsif ($gcd =~ /^$aadd/) { # ADD form $doctype=6; $cyear = 1900 + $tdate[5]; if (!$edit) { # add $titlehead=$thead[6]; $titlebody= $userid[7] ? "Submit an Event for Administrative Approval" : $tbody[6]; } else { # edit $tmp=''; if ($edit !~ /\./) {$tmp='.HTML';} &getevent("$edit$tmp",-1); $titlehead="Edit $type"; $titlebody= $pending ? "Edit Pending $type" : "Edit $type"; } } elsif ($p1 eq $ainst && $modify) { # MODify INStructions $doctype=7; $titlehead=$thead[7]; $titlebody=$tbody[7]; } elsif ($p1 eq $ainst && !$modify) { # Usage INStructions $doctype=8; $titlehead=$thead[8]; $titlebody=$tbody[8]; } elsif ($p1 eq $ajoin) { # JOIn form $doctype=9; $titlehead=$thead[9]; $titlebody=$tbody[9]; } else { # $p1 equals DAY*, WEE*, MON*, XXX, or subject if (($scheduler || $meta2) && $who) {$titlebody = $scheduler ? "${who}Schedule
" : "${who}Events
";} $dat=substr($p1,3,8); if (!$dat && $gcd ne $aday && $gcd ne $aweek && $gcd ne $amon) { # def range implied @cdate = @sdate; $dat = $cstr; $range = 1; } if ($dat > 999) {$zdat=$dat;} # specified else { # current date/week/month @cdate = @tdate; $all_dates=1; $curr=1; if ($dat) { $ndays = $gcd eq $aday ? int($dat) : ''; # allows for showing e.g. x+30 days -> DAY30 (<= 999) else !$ndays $nweeks = $gcd eq $aweek ? int($dat) : ''; # " " e.g. WEE02 $nmonths = $gcd eq $amon ? int($dat) : ''; # " " e.g. MON02 } else { if ($gcd eq $amon && $prefs[15]) {$cdate[3] = 1;} if ($gcd eq $aweek) { # find beginning of this week $dd=$cdate[6] - $prefs[8]; if ($dd < 0) {$dd += 7;} local(@zdate)=localtime(&timelocal((@cdate)[0..5]) + $date_correct - $dd*86400); $zyear = 1900 + $zdate[5]; $zmon=$zdate[4]+1; if ($zmon < 10) {$zmon = '0'.$zmon;} $zday=$zdate[3]; if ($zday < 10) {$zday = '0'.$zday;} $zdat=$zyear.$zmon.$zday; #Comparison date if ($prefs[15]) {@cdate = @zdate;} } } $cyear = 1900 + $cdate[5]; $cmon=$cdate[4]+1; if ($cmon < 10) {$cmon = '0'.$cmon;} $cday=$cdate[3]; if ($cday < 10) {$cday = '0'.$cday;} $dat=$cyear.$cmon.$cday; #Comparison date if ($gcd ne $aweek) {$zdat=$dat;} } $year=substr($zdat,0,4); $mon=substr($zdat,4,2); $day=substr($zdat,6,2); $mname=$mstring[$mon-1]; $date = &getdate($mname,$day,$year,0,$prefs[4]); if (!$curr) {@cdate=localtime(&timelocal((0,0,12,$day,$mon-1,$year-1900)) + $date_correct);} $wday=$wstring[$cdate[6]]; if ($gcd eq $aday && !$ndays) { # a day's events $doctype=2; $titlehead=$thead[2]." - ".$date; $titlebody .= $tbody[2].&getdate($mname,$day,$year,$wday,$prefs[4]); } elsif ($gcd eq $aweek || $gcd eq $aday) { # a week's events $doctype=3; if ($ndays || $nweeks) { # e.g. DAY30 $tmp = $titlebody ? '' : 'Events '; $temp = $ndays == 366 ? "Year" : "$ndays Days"; $titlehead=$ndays ? "$thead[3] - Events for the next $temp" : "$thead[3] - Events for the next $nweeks Weeks"; $titlebody .= $ndays ? "${tmp}for the next $temp" : "${tmp}for the next $nweeks Weeks"; } else { # true week $titlehead="$thead[3] - Week of $date"; $titlebody .= "Week of $date"; if ($all_dates && !$prefs[15]) {$titlebody .= "\n\n\n
from Today";} } } elsif ($gcd eq $amon) { # a month $doctype=4; $datem="$mname $year"; if (defined $FORM{wday}) { $tmp = ($FORM{wday} + $prefs[8])%7; $titlehead="$thead[4] - $wstrings[$tmp], $datem"; $titlebody .= "$wstrings[$tmp], $datem"; } else { if ($nmonths) { $tmp = $titlebody ? '' : 'Events '; $titlehead="$thead[4] - Events for the next $nmonths Months"; $titlebody .= "${tmp}for the next $nmonths Months"; } else { $titlehead="$thead[4] - $datem"; $titlebody .= $datem; if ($all_dates && !$prefs[15]) {$titlebody .= "\n\n\n
from Today";} } } } else { # SUBJECT AREA (or single event) $doctype=5; if ($gcd ne '---') { # if NOT all Subj Areas for (0..$#pr) { # get Subj Area name $sub = $_; last if $pr[$sub] eq $gcd; } $head=$ti[$sub] || $hd[$sub]; } ($tmp = $p1) =~ s/\..*//; if (length($tmp) == 19) { $estr = substr($p1,11,8); $range = 2; } if ($range) { # range of dates (1: cookie; 2: online form ... begin day = 01 or today; end day = 01 or today+1 ONLY!) $head = "$who$head"; $year2=substr($estr,0,4); $mon2=substr($estr,4,2); if ($range == 1 && $mon2==1) {$year2 -= 1;} $endday = ($estr-1 == $tstr) ? 'Today' : "$mstring[$mon2-2] $year2"; if (($range == 1 && !$prefs[15] && $year == $tyear && $mon == $tmon) || ($range == 2 && $dat == $tstr)) { $dat = $tstr; if ($range == 2 && $endday eq 'Today') {$date = 'Today';} elsif ($year == $year2 && ($mon == $mon2-1 || $prefs[2] == 1)) {$date = "$mname $year from Today";} else {$date = "Today through $endday";} } elsif ($year == $year2) { if ($mon == $mon2-1 || $prefs[2] == 1) {$date = "$mname $year";} else {$date = "$mname through $endday";} } else {$date = "$mname $year through $endday";} } # end range else { # 1 day only $date = $FORM{p4} ? &getdate($mname,$day,$year,substr($wday,0,3),$prefs[4]) : &getdate($mname,$day,$year,$wday,$prefs[4]); $doctype=2; if (length($p1) < 21) {$head = "$who$head";} else { # 1 event only $ss =~ s/[\\\/\:]//g; $ss =~ s/\.\.//g; $ss = ($p1 =~ /\./) ? $p1 : $p1.'.HTML'; &getevent($ss,0); $type = $type || $FORM{p4}; $head = $FORM{usearched} || !$ss || !$FORM{p4} ? "$head $type" : "$hd[$sub] $type"; if ($FORM{p4}) { $date = "Beginning $date" if $type eq 'Series'; $date .= '
* Pending Approval' if ($userid[7] || $pending) && $p2 ne "Deleted"; } if ($scheduler || $meta2) { ($tmp = $p1) =~ s/^.{21}\.?//; if (!$tmp) {$pto = "All ${cname}s";} else { $tmp =~ s/_/\./g; $tmp =~ tr/A-Z/a-z/; open(LUSER,"<$sched"); while () { if ($_ =~ /\t$tmp[\n\t]/i) { ($pto,$tmp) = split(/\t/,$_); last; } } close(LUSER); } $head .= "
$pto"; } } # end 1 event } # end 1 day if ($gcd eq '---') { $gcd = '\w{3}'; if ($head) { $head = "${head}Events" if $head !~ /Events/i; $head .= "
"; } $head = ($all_dates && !$prefs[15]) ? 'All Events' : "$head$date"; $date = ''; } if ($FORM{pending} && $p1 eq '---') { $titlehead='Pending Events'; $titlebody='Pending Events'; $prefs[18] = 0; } else { $titlehead="$head $date"; if ($range) {$titlebody = "$head\n\n\n
$date";} elsif ($FORM{p4}) {$titlebody = "$head\n
$date";} else {$titlebody = "$head\n\n\n
$date";} } } # end subj } # end $p1 = DAY*, WEE*, MON*, or subj } # --------------------- sub gettoday { $relative_time *= 3600; @tdate=localtime(time + $relative_time); # Current date of audience $tdate[2] = 12; # set time to noon (daylight savings bug) $tyear = 1900 + $tdate[5]; $tmon = $tdate[4] + 1; if ($tmon < 10) {$tmon = "0".$tmon;} $tday = $tdate[3]; # day if ($tday < 10) {$tday = "0".$tday;} $tstr = $tyear.$tmon.$tday; # CURRENT! $thismon = $tyear.$tmon."01"; } # ------------------ sub relodit { # controls reloading after change prefs/delete/add/logon # $relod not defined yet... if ($FORM{urelod}) {$relod = $FORM{urelod};} if (defined $FORM{qui} && $FORM{$pref_changed} != 4) { $relod = 5; $hometarget = $FORM{viewurl} ? "if (parent.frames['view']) {parent.view.location.href='$FORM{viewurl}';}" : "if (parent.frames['view']) {parent.view.location.href='$cal_http?p1=$aview$modify$params';}"; if ($prefs[11] == 2) {$hometarget .= "if (parent.frames['nav']) {parent.nav.location.href='$cal_http?p0=caln$modify$params'}";} } elsif ($relod == 4) { # NAV & CAL $hometarget = "if (self.name != 'cal' && parent.frames['cal']) {parent.cal.location.href='$cal_http?p1=$acal$modify$params';} if (parent.frames['nav']) {parent.nav.location.href='$cal_http?p0=caln$modify$params'}"; } elsif ($relod == 3) { # NAV only $hometarget = "if (parent.frames['nav']) {parent.nav.location.href='$cal_http?p0=caln$modify$params'}"; } elsif ($relod == 2) { # whole calendar $hometarget = "if (parent.name == 'calhome') {parent.location.href='$cal_http?p0=cal$modify$params'} else {self.location.href='$cal_http?p0=cal$modify$params'}"; } else { # CAL only $hometarget = "if (self.name != 'cal' && parent.frames['cal']) {parent.cal.location.href='$cal_http?p1=$acal$modify$params'}"; } } # ------------------- sub whowhen { %quilist = (); $private = ''; if ($prefs[0] || $prefs[21]==1 || $scheduler || $meta2) { # check for selection of begin-date and/or user-database/meta local(@tmp); @tmp = split(/:/,$cookies{"${cookie_base}_4_$userhost"}); if (($prefs[0] || $prefs[21]==1) && $FORM{cyear} < 2) {$dr = $tmp[0];} # begin-date if ($scheduler || $meta2) { # ...user-database/meta if (defined $FORM{usearch_qui}) {$qui = $FORM{usearch_qui};} # searching schedule, won't write cookie (no $FORM{'qui'}) elsif (defined $FORM{qui}) {$qui = $FORM{qui};} # setting schedule, writes cookie elsif (defined $tmp[1] && !$sched_private && ($scheduler || $meta2)) {$qui = $tmp[1];} # read from cookie elsif ($scheduler && $userhost ne $administrator) {$qui = $userhost; $who = (split(/,/,$userid[2]))[1]." ".(split(/,/,$userid[2]))[0]." 's ";} if (!defined $qui && $meta2 && !$scheduler) {$qui = '-';} if (!$qui && $FORM{$pref_changed} != 4) {$who = "Shared ";} elsif (!$who || $qui eq '-') { ($tmp=$qui) =~ s/_/\./g; open(LUSER,"<$sched"); while () { if ($FORM{$pref_changed} == 4 || $qui eq '-' || $_ =~ /\t$tmp[\t\n]/i) { $_ =~ s/\n//; ($who,$tmp,$private) = split(/\t/,$_); $quilist{$tmp} = $who; last if $private && $FORM{$pref_changed} == 4 || $FORM{$pref_changed} != 4 && $qui ne '-'; if ($private && !$logged) { $tmp =~ s/\./_/; $tmp =~ tr/a-z/A-Z/; $privy{$tmp} = 1; $private = 0; } } } close(LUSER); if ($qui eq '-') {$who = "";} elsif ($scheduler) { @temp = split(/,/,$who); $who = "$temp[1] $temp[0]'s "; } else {$who .= ' ';} } ($tmp = $qui) =~ tr/a-z/A-Z/; if ($private && !$logged) {&logonform("Please Logon $regi",$pvar,'');} elsif ($qui eq '-') {$htm = '\w+';} else {$htm = $tmp ? "(HTML|$tmp)" : "HTML";} } } } # ******************************************** # doc1 pre-processing of DATE (since cookie must be written BEFORE http header) # + info to process templates with subj areas, etc. sub doc1a { @sdate = @tdate; # sdate = STARTING date, def = today if (($prefs[0] || $prefs[21]==1) && ($FORM{cyear} || $dr)) { if ($FORM{cyear} > 1) { $sdate[4]=$FORM{cmon}; $sdate[5]=$FORM{cyear} - 1900; } elsif (substr($dr,0,4) > 0) { $sdate[4]= substr($dr,4,2) - 1; $sdate[5]= substr($dr,0,4) - 1900; } } if ($FORM{cyear} && $FORM{cyear} < 2) {&prevnext1;} # Parse begin date $cyear = 1900 + $sdate[5]; $cmon = $sdate[4] + 1; if ($cmon < 10) {$cmon = "0".$cmon;} $cstr="$cyear$cmon$tday"; # doesn't change outside $bstr=$cyear.$cmon."01"; # begin of month for start, doesn't change if ($prefs[0] || $prefs[21]==1) { # if allowing selection of begin date if ($FORM{cyear} || $dr) { if ($cstr < $tstr) {$prefs[15] = 1;} $cstr=$bstr; } $tmp = $prefs[2] + $cmon - 1; $mod = $tmp%12; $estr = $bstr + 10000*($tmp-$mod)/12 + ($mod-$cmon+1)*100; if (!$dr || $FORM{cyear} && $FORM{cyear} < 2) {$dr=$bstr.$estr;} } else {$estr=$bstr + $years_show*10000;} # doesn't change if (!$cookie_saved && ($FORM{cyear} || defined $FORM{qui})) { &write_cookie("${cookie_base}_4_$userhost", "$dr:$qui", 0, 0); $cookie_saved = 1; } } # ---------------- sub doc1b { # get events for doc1 and/or show_subs local($i,$w,$h); opendir(DIR,$edir); @dir_list = grep(/^\w{3}\d{18}\.$htm$/i,readdir(DIR)); closedir(DIR); &assoc_subjects; @dir_list = grep(defined $subjects{substr($_,0,3)},@dir_list); foreach $t (keys %privy) {@dir_list = grep(!/\.$t$/,@dir_list);} if ($need_sort) {@dir_list = sort bydate @dir_list;} if ($prefs[11] && !$prefs[12] || $prefs[17] > 2) {&icons;} } # ***************** sub icons { if ($bl[0]) { for (0..$#bl) { ($i,$w,$h) = split(/,/,$bl[$_]); if ($i) { if ($i !~ /\//) {$i = "$htm_dir$i";} $tmp = $ti[$_] || $hd[$_]; $tmp =~ s/<\/?[^>]*>//g; $tmp =~ s/\&/\+/g; $bull{$pr[$_]} = $w && $h ? " $tmp " : " $tmp "; } } } $icons = 1; } # ************************************ # Main calendar and updateable calendar sub doc1 { local(@w,@odate,@wdate,@most)=(); local($mm,$dd,$ddd,$ww,$fsize,$vgap,$temp,$tmp,$pad,$pad2,$num_today,$wid,$hei,$twid,$wkline); local($show_end)= $prefs[17] > 2 ? 1 : 0; # show end of calendar as empty date cells (0=>end table) $grpsize = 2; $cpad=3; # mod if cellspacing changes if ($prefs[19] =~ s/\%//) { $twid = ' WIDTH='.7*$prefs[19].'%'; $prefs[19] = '14%'; } $wid=" width=$prefs[19]"; # number or % $prefs[20] = int($prefs[20]); $hei=" height=$prefs[20]"; # number # begin date -> 1st of begin month $cdate[3]=1; # mday=1 $csecs=&timelocal((@cdate)[0..5]) + $date_correct; if (!$date_color && $modify) { if ($bgcolor_cal =~ / text *= *[\"']?(\#?\w{6})/i) {$date_color = "COLOR=$1";} } if (!$prefs[26]) {$weekstr = '';} else { if ($prefs[17] != 1 && $prefs[17] != 2 && $weekstr2 =~ /height *= *(\d+)/i) {$tmp = $1;} if ($prefs[17] == 1 || $prefs[17] == 2 || $prefs[20] > $tmp+2*$cpad+1) { $weekstr = $weekstr2; $weekstr_nul = $weekstr_nul2; } if (!$weekstr_nul) {$weekstr_nul = $weekstr;} if ($weekstr) { chop($weekstr); chop($weekstr_nul); if (!$prefs[24]) { $weekstr .= $prefs[17] ? ' hspace=7 vspace=2' : ' hspace=3'; $weekstr_nul .= $prefs[17] ? ' hspace=7 vspace=2' : ' hspace=3'; } } } local($tcols) = $prefs[17] > 2 && $weekstr || !$prefs[24] ? 8 : 7; @days = $prefs[17] ? @days2 : @days1; if (!$prefs[24]) {$days[5] .= ' ';} if ($prefs[8]) {for (1..$prefs[8]) {push(@days,shift(@days));}} $msize = $prefs[17] ? 5 : $prefs[7]+1; $fsize0 = ""; # no link $fsize = ""; # link $pad = $prefs[20] < 20 ? 0 : 1; if ($prefs[7] < 3 && $prefs[24]) {$pad += 1;} $pad2 = $pad; if ($prefs[17]) { $pad += 1; $wheight = $ie ? $prefs[20] : $prefs[20]-2*$cpad; } if ($prefs[24]) { $vgap = $prefs[20] < 20 ? $prefs[24] + 6 : $prefs[24] + 3; $vgap += 2 if $ie; $vgap = "
"; } if ($prefs[17] == 1 || $prefs[17] == 2) { #Subjs in cells $n2 = ($prefs[17] == 1) ? $#pr+1 : int(($#pr+2)/2); for ($i=0; $i<$n2; $i++) {$wkline.="
"} } $pyear=$cyear; #Previous values $pmon=$cmon; $ddd=0; #days since beginning (we're on the beginning day) print "
\n" if $prefs[16]; # ----------- MONTHLOOP: for ($mm=1; $mm <= $prefs[2]; $mm++) { # arbitrary stop val $firstofmonth=1; if ($prefs[24]) { print "\n"; # start weeks link table if ($prefs[17] < 3) { print "
" if !$prefs[16]; print "\n"; } else {print "
\n" if $prefs[25] || $mm == 1;} $mname=$mstring[$pmon-1]; $chead="$mname $pyear"; if (!$prefs[24]) {$chead = " $chead";} $sstr=$pyear.$pmon; # Any events for the month? $fname=0; for (@dir_list) { if (/^.{3}$sstr/) { $fname=1; last; } } # Print Month if ($mm == 1 && $prefs[21] == 1) { &prevnext2('',$pmon-1); if ($ie) {print "";} else {print "$nextdat";} } else {print "";} # Print weekdays if ($prefs[24]) {print "\n";} else {print "\n";} $tmp = $wid; @odate=localtime($csecs + $ddd*86400); $n = $odate[6]-$prefs[8]; if ($n < 0) {$n += 7;} foreach (0..6) { if ($_ == 6 && $prefs[17] > 2 && $weekstr) {$tmp = ' colspan=2';} $temp = (7-$n+$_)%7+1; print "$days[$_]\n"; } if (!$prefs[24] && ($prefs[17] <= 2 || !$weekstr)) {print "";} print "\n"; # Loop over weeks # ------- # WEEKLOOP: for $ww (1..6) { # at MOST $most[$ww]=0; if ($dd == 7 || $dd == 0) {$wevent=0;} # initialize $hite = $hei; if ($prefs[24]) {print "\n";} else {print "\n";} # ------- # DAYLOOP: for ($dd = 0; $dd < 7; $dd++) { # The date we want to output @odate=localtime($csecs + $ddd*86400); # Parse output date into year month day components $oyear = 1900 + $odate[5]; $omon=$odate[4]+1; if ($omon < 10) {$omon = "0".$omon;} $oday=$odate[3]; if ($oday < 10) {$oday = "0".$oday;} $oweekday=$wstring[$odate[6]]; $tmp = $odate[6] - $prefs[8]; if ($tmp < 0) {$tmp += 7;} if ($firstofmonth) { # 1st day of month $yr_begin=(localtime(&timelocal((0,0,12,1,0,$odate[5]))))[6]; $wnum[$ww] = int(($odate[7]+1 - ($odate[6]+7-$prefs[8])%7 + ($yr_begin+7-$prefs[8])%7 - 1)/7)+1; $firstofmonth=0; for ($i=0; $i<$tmp; $i++) {print "$fsize \n";} $dd=$tmp; if ($mm == 1) { # if 1st week of 1st month (save date for beg. of week (use in week links) $osecs=&timelocal((@odate)[0..5]) + $date_correct - $dd*86400; @wdate=localtime($osecs); $wyear = 1900 + $wdate[5]; $wmon=$wdate[4]+1; if ($wmon < 10) {$wmon = "0".$wmon;} $wday=$wdate[3]; if ($wday < 10) {$wday = "0".$wday;} $wdat = $wyear.$wmon.$wday; } # end [1st week of 1st month] } # end [1st day of month] elsif (!$dd) { # not first day of month, but first of week $wnum[$ww] = $wnum[$ww-1]+1; $wdat=$oyear.$omon.$oday; } # ----------- if ($oyear > $pyear || ($oyear == $pyear && $omon > $pmon)) { # Gone to the next month: end month table; begin week links # Check week for links if ($dd == 7 || ($mm == $prefs[2] && $dd)) { &chkweek; ++$ww; } if (($show_end || !$prefs[24]) && $dd && $dd < 7) {for (1..7-$dd) {print "";}} if ($mm == $prefs[2] && $dd) { if ($prefs[17] > 2 && $weekstr) {print "";} elsif (!$prefs[24] && $prefs[17] <= 2) {print "";} } if (!$prefs[24] && $mm != $prefs[2]) {print "";} if ($prefs[24]) { print "
$prevdat ";} else {print "
$prevdat";} } else {print "
";} if ($fname && $mm == 1 && $pmon eq $tmon && $pyear eq $tyear && !$prefs[15]) {print "$chead";} elsif ($fname) {print "$chead";} else {print "$chead";} if ($mm == 1 && $prefs[21] == 1) { if ($ie) {print " $nextdat

$w[$ww-1] $w[$ww-1]
"; for ($i=1; $i<$ww; $i++) { # one for each week if (!$prefs[17]) {print "\n";} else { print "\n"; } } } } print ""; # Spacer at bottom of calendar if ($prefs[16]) {print "
$vgap

$w[$i]
$w[$i] $fsize
"; print "\n
$wkline
";} # horizontal elsif (!$prefs[24]) { if ($prefs[25] || $mm == $prefs[2]) {print "
";} } elsif (!$dd || $mm == $prefs[2] || $prefs[17] > 2) {print "

";} elsif (!$prefs[17]) { # subjs not in calendar + empty cell(s) in last week $space = $prefs[20]+$prefs[25]+$prefs[24]; print " "; } else { # BIG calendar + empty cell(s) in last week print qq|
$wkline
|; } if ($prefs[16]) { # horizontal if ($mm == $prefs[2]) {print '';} else {print '';} } elsif ($prefs[24]) {print "\n";} # ------ DONE WRITING MONTH last MONTHLOOP if $mm == $prefs[2]; $pyear=$oyear; #Previous values $pmon=$omon; next MONTHLOOP; } # END Done with this month # ------------ # Add date $sstr="$oyear$omon$oday"; @d_list = grep(/^.{3}$sstr/,@dir_list); $daynum=int($oday); $celltd = " 2) {$most[$ww] = $tmp if $most[$ww] < $tmp;} # for end-week vert spacing $daynum = "$fsize$daynum$num_today"; } else {$daynum = "$fsize0$daynum";} if ($dd) {$hite="";} print "$celltd$hite>"; # ------------ if ($d_list[0]) { # event exists for this day ++$wevent; if (!$prefs[17]) { # no titles/subjs on each date print "$daynum"; } else { # print stuff on each date print "$daynum
"; if ($prefs[17] == 1 || $prefs[17] == 2) { # subjs $line=''; print '

'; $fname = join(' ',@d_list); # join today's events for (0..$#pr) { $tmp = $pr[$_].$sstr; if ($fname =~ /$tmp/i) { # event exists for this subject/sender $line.= "$hd[$_]
\n"; } else {$line.="$hd[$_]
\n";} if ($_ == $n2-1) { print "\n"; $line=''; } } print "\n

$line

"; } else { # titles print ""; if ($prefs[17] == 3) {print "";} foreach(@d_list) { if (&getevent($_,-2)) { $_ =~ s/\.HTML$//; $tmp = substr($_,0,3); $temp = $bull{$tmp} ? "$bull{$tmp}" : ''; if ($prefs[17] == 4) {print qq@ @;} else {print qq@ @;} } } print "



$temp	$all[4]
$temp	$time
$temp	$all[4]

"; if ($dd == 6 && $prefs[17] > 2 && $weekstr) { &chkweek; print "$w[$ww]"; } print "\n"; } } # end [print titles/subjs on each date] } # end [event exists for this day] else { # no events on this day # ------------ if ($modify) {$daynum = "$daynum";} if ($prefs[17] != 1 && $prefs[17] != 2) { print "$daynum\n"; if ($dd == 6 && $prefs[17] > 2 && $weekstr) { &chkweek; print "$w[$ww]"; } } else { print "$daynum
\n"; $line=''; for (0..$#pr) { $line=$line.$hd[$_]."
"; if ($_ == $n2-1) { print "\n"; $line=''; } } print "\n

$line

\n"; } } # end [no events for day] # ---------- # Finished with day ++$ddd; #days since beginning date } # END DAYLOOP!!!!!!!! # ---------- # Finished with week &chkweek; if (!$prefs[24] && $prefs[17] <= 2) {print "$w[$ww]\n";} print "\n"; } # END WEEKLOOP!!!!!!!!!!!!!!! } # END MONTHLOOP!!!!!!!!!!!!!! # ---------- } # Return to finish html file # ******************************** # check week for events sub chkweek { if ($weekstr) { if (!$wevent) {$w[$ww] = "$weekstr_nul alt='Week $wnum[$ww]'>";} else {$w[$ww] = "$weekstr alt='Week $wnum[$ww]'>";} } elsif (!$prefs[24]) {$w[$ww] = ' ';} } sub prevnext1 { # prev/next month SET $sdate[4] += $FORM{cyear}; if ($sdate[4] == -1) { $sdate[4] = 11; $sdate[5] -= 1; } elsif ($sdate[4] == 12) { $sdate[4] = 0; $sdate[5] += 1; } } sub prevnext2 { # prev/next month BUTTONS local($r,$monnum) = @_; # reload local($wi,$he); local($monpre) = $monnum == 0 ? 12 : $monnum; local($monnex) = $monnum == 11 ? 1 : $monnum+2; local($hs) = ($prefs[21] == 1) ? 6 : 5; # space ($tmp,$wi,$he) = split(',',$prev_month); if ($wi) {$temp = " $mstring[$monpre-1] [Month $monpre]

";} elsif ($tmp) {$temp = " $tmp ";} else {$temp = ' < ';} $prevdat = "$temp"; ($tmp,$wi,$he) = split(',',$next_month); if ($wi) {$temp = " $mstring[$monnex-1] [Month $monnex]

";} elsif ($tmp) {$temp = " $tmp ";} else {$temp = ' > ';} $nextdat = "$temp"; } # ------------------------ sub select_users { # select menu for users/metas local($relod); local($ispac) = "

" if $ie; if ($prefs[11] == 2 && (!$prefs[12] || $prefs[13])) {$relod="&urelod=3";} print qq@ "; } # -------------------------------- sub select_users2 { # write list of users/metas (AFTER \n"; } # *********************** sub select_date { # print out form for date selection local($relod,$y1,$y2); local($ispac) = "

" if $ie; if ($prefs[0]) { if ($prefs[11] == 2 && (!$prefs[12] || $prefs[13])) {$relod="&urelod=3";} print qq@"; } } # ************************ sub show_subs { # print out Subj Area list local($ispac) = "

" if $ie; local($count,$future,$stitle,$scode); local($start) = (!$prefs[15] && $thismon eq $bstr) ? $tstr : $cstr; local($grpsize) = 2; # for bulleted only if (!$dir_list[0]) {&doc1b;} if (!$prefs[0] && $prefs[21] != 1 && !$prefs[15]) {$future="Future";} if ($prefs[12]) { # pull-down if (($scheduler || $meta2) && $prefs[10] && !$sched_private) { print qq@"; } else { # bullet-list if ($prefs[11] == 1) {print "\n$future Events by Subject\n

\n";} print ""; for $gg (0..$#pr) { $linkit=0; $prf=$pr[$gg]; $head=$ti[$gg] || $hd[$gg]; @temper = grep(/^$prf\d{18}\.$htm$/,@dir_list); for (@temper) { $tmp = substr($_,3,8); next if $tmp < $start; if ($estr > $tmp) {++$linkit;} if (!$prefs[13] || $estr <= $tmp) {last;} } $tmp = ($bl[0]) ? $bull{$prf} : $bullet; if ($linkit) { #add a link for this item if ($prefs[13]) {$count = " ($linkit)";} print qq@@; } else {print "\n";} } print "
$tmp $head$count
$tmp $head
"; } # end bullet-list } # ********************************** sub list_sub { # show event's subj area local($url,$size,$dense) = @_; $subnom = $ti[$subjects{$prf}]; if (!$preview && !defined $FORM{usearched} && !$FORM{banner} && !$FORM{pending}) { $temp = "$subnom"; $tmp = "$bull{$prf}"; } else { $temp = "$subnom"; $tmp = $bull{$prf}; } if ($bl[0]) { if (!$dense) {print "";} print ""; if (!$dense) {print "
[ $tmp $temp ]
";} } elsif ($dense) {print "$temp";} elsif ($subnom) {print "[$temp]
";} } # ********************************** # All events on the given date # (or all events for one subject on that date; or just one event) sub doc2 { local($norelod); @d_list=(); &assoc_subjects; &icons if !$icons; if (!$subj_color && ($ss || defined $FORM{usearched}) && $bgcolor =~ / link *= *[\"']?(\#?\w{6})/i) {$subj_color = "COLOR=$1";} if ($ss) { # Show *particular* event, to preview if (-e "$edir$ss") {@d_list = ($ss);} $preview = $FORM{p4} ? 1 : 0; $norelod = 1; } else { opendir(DIR,$edir); if ($gcd ne $aday) { # Show one subject for this date (BIG cal) @d_list = grep(/^$gcd$dat\d{10}\.$htm$/i,readdir(DIR)); @d_list = grep(defined $subjects{substr($_,0,3)},@d_list); @d_list = sort bydate @d_list; $prefs[6] = 0; } else { # Show everything on this date @d_list = grep(/^\w{3}$dat\d{10}\.$htm$/i,readdir(DIR)); @d_list = grep(defined $subjects{substr($_,0,3)},@d_list); @d_list = sort bysubject @d_list; @d_list = sort bydate @d_list; } closedir(DIR); } foreach $t (keys %privy) {@d_list = grep(!/\.$t$/,@d_list);} if ($#d_list > 0) {$norelod = 1;} # ------ if ($prefs[18] && !$ss && !$FORM{banner}) { print "

"; if ($#d_list >= 0) { &tabulate1(0); &tabulate2(0,0); &tabulate3; } } else { if ($modify && (!$preview || $FORM{usearched})) { print qq@

@; } else {print "

";} print "

\n" unless $preview; for (@d_list) { if (!$ss) {next if !&getevent($_,0);} $fname=$_; &askdelet($fname,$norelod,0); &whichcal(0) if !$ss || $preview; if ($prefs[6]) { $prf = substr($fname,0,3); &list_sub("$cal_http?p1=$prf$modify$params",$prefs[5]-1,0); } &prnt; print "

\n" if !$ss; } # next file print "\n" unless $preview; } # -------- &chk_none; } # ********************************************** # Events for the week (6) or month (3) or weekday (0), or fixed n days/weeks/months, depending upon $cindex (and $ndays/$nweeks/$nmonths) sub doc3 { local($cindex) = @_; local(@found); local($norelod,$begin); local($incr) = 1; @d_list=(); $fname = ''; opendir(DIR,$edir); if ($cindex != 6) {@found = grep(/^\w{3}$year$mon\d{12}\.$htm$/i,readdir(DIR));} else {@found = grep(/^\w{3}\d{18}\.$htm$/i,readdir(DIR));} closedir(DIR); &assoc_subjects; &icons if !$icons; @found = grep(defined $subjects{substr($_,0,3)},@found); @found = sort bysubject @found; @found = sort bydate @found; foreach $t (keys %privy) {@found = grep(!/\.$t$/, @found);} # Get date in secs. $csecs=&timelocal(0,0,12,$cdate[3],$cdate[4],$cdate[5]) + $date_correct; if ($cindex) {$wstop = $ndays ? $ndays : 7 - ($cdate[6]+7-$prefs[8])%7;} else { $wstop = 5; $incr = 7; } if ($FORM{banner} && !$subj_color && $bgcolor_cal =~ / link *= *[\"']?(\#?\w{6})/i) {$subj_color = "COLOR=$1";} for ($dd=0; $dd < 1000; $dd++) { # loop through days, $ndays < 1000 # get date @cdate=localtime($csecs+$dd*$incr*86400); $tmp = (($cindex == 3) ? $cdate[$cindex] : $wstop); last if $dd >= $tmp; $cyear = 1900 + $cdate[5]; $cmon=$cdate[4]+1; if ($cmon < 10) {$cmon = "0".$cmon;} $cday=$cdate[3]; if ($cday < 10) {$cday = "0".$cday;} $dat=$cyear.$cmon.$cday; @d_list = grep(/^.{3}$dat/,@found); if ($#d_list > 0 || $fname) {$norelod = 1;} # ----- if ($prefs[18] && !$FORM{banner}) { if (!$begin && $d_list[0]) { &tabulate1(0); $begin = 1; } &tabulate2(0,$wstring[$cdate[6]]); } else { $first_event=1; #1st event for current day for (@d_list) { # loop through found next if !&getevent($_,0); $fname=$_; if ($first_event || $FORM{banner}) { # print date $fstr = &getdate($mstring[$cdate[4]],$cday,$cyear,$wstring[$cdate[6]],$prefs[4]); if ($dates_color) {$fstr="$fstr";} print "$fstr

\n"; if ($modify) {print qq@

@;} print "

\n" if !$FORM{banner}; $first_event=0; } &askdelet($fname,$norelod,0); &whichcal(0); if ($prefs[6]) { $prf = substr($fname,0,3); &list_sub("$cal_http?p1=$prf$modify$params",$prefs[5]-1,0); } &prnt; print "

\n"; } # end [loop through d_list] if (!$first_event && !$FORM{banner}) {print "\n\n";} } # end else # ----- } # end [loop through days] &tabulate3 if ($prefs[18] && $fname); &chk_none; } # **************************** # All events within a Subj Area on or after given date, until $estr (end date) sub doc5 { local(@date,@tmp); local($norelod,$open); @d_list=(); opendir(DIR,$edir); @tmp = grep(/^$gcd\d{18}\.$htm$/i,readdir(DIR)); closedir(DIR); @tmp = sort bydate @tmp; foreach $t (keys %privy) {@tmp = grep(!/\.$t$/,@tmp);} $prevdat=0; if ($p1 eq '---') { &assoc_subjects; &icons if !$icons; } if ($FORM{pending}) {@d_list = @tmp;} else { foreach (@tmp) { $dstr=substr($_,3,8); next if $dstr < $dat; # skip if before last if $dstr >= $estr; # end if past push(@d_list,$_); } } undef @tmp; # ---- if ($prefs[18] && !$FORM{banner}) { if ($#d_list >= 0) { &tabulate1(0); &tabulate2(0,0); &tabulate3; } } else { foreach (@d_list) { next if !&getevent($_,0); $fname=$_; if ($prevdat) {$norelod = 1;} $dstr=substr($_,3,8); if ($dstr != $prevdat) { # print date if new $cyear=substr($dstr,0,4); @date=localtime(&timelocal((0,0,12,substr($dstr,6,2),substr($dstr,4,2)-1,$cyear-1900)) + $date_correct); $fstr = &getdate($mstring[$date[4]],$date[3],$cyear,$wstring[$date[6]],$prefs[4]); if ($dates_color) {$fstr="$fstr";} if ($prevdat) {print "\n"; $open=0;} print "$fstr

\n"; if ($modify && !$FORM{pending}) {print qq@

@;} print "

\n"; $open=1; $prevdat=$dstr; } &askdelet($fname,$norelod,0); &whichcal(0); if ($p1 eq '---' && ($prefs[6] || $FORM{pending})) { $prf = substr($fname,0,3); &list_sub("$cal_http?p1=$prf$modify$params",$prefs[5]-1,0); } &prnt; print "

\n"; # print event file } # end [loop through files] if ($open) {print "\n";} } # ----- &chk_none; } # ------------------------ sub chk_none { # in case no events if (!$fname) { print "\n"; if ($pending && !$ss) {print "No pending events.

\n";} elsif ($p2 eq "Deleted") {print "$FORM{p4} Deleted.";} else {print "No scheduled events.

\n";} print "\n"; } } # ------------- sub whichcal { # show cal for event local($format) = @_; local($ext,$tmp); if ($FORM{pending} || ($meta2 || $scheduler) && $prefs[10] && !$sched_private && ($format || $qui eq '-')) { ($ext = $fname) =~ s/.+\.//; if ($ext eq 'HTML') {$tmp = "All";} else { $ext =~ tr/A-Z/a-z/ if $scheduler; $tmp = $quilist{$ext}; if (!$format) {print "$tmp
";} } if ($format) {print "$tmp ";} } } # ----------- sub tabulate1 { local($srch) = @_; if ($d_list[0]) { $tmp = $prefs[5]+1; $uqui = "&usearch_qui=$FORM{usearch_qui}" if ($scheduler && !$sched_private && defined $FORM{usearch_qui}); $datsub = $srch ? "$dat$estr" : ''; print ""; if ($modify) {print "";} if ($doctype != 2) {print "";} print qq@ @; if ($modify && !$srch) {print "";} if (($doctype != 5 || $p1 eq '---') && $prefs[6]) { $temp = $bl[0] ? ' colspan=2' : ''; print "Subject"; } if (($meta2 || $scheduler) && $prefs[10] && !$sched_private) {print "";} if ($prefs[22]) {print "";} print ""; $less = $prefs[5]-1; } } sub tabulate2 { local($srch,$dy) = @_; $srch = $srch ? '&usearched=1' : ''; local($d,$pd,$dyy); $dyy = $dy; if ($d_list[0]) { foreach (@d_list) { next if !&getevent($_,1); $fname = $_; $pd = $d; $d = substr($_,9,2)."-".substr($mstring[int(substr($_,7,2))-1],0,3)."-".substr($_,5,2); $dstr = substr($_,3,8); $p = ''; if ($d eq $pd) { $day = ''; $date = ''; if ($modify) {$p = '';} } else { if ($doctype !=2) { if (!$dyy) { @date=localtime(&timelocal((0,0,12,substr($dstr,6,2),substr($dstr,4,2)-1,substr($dstr,0,4)-1900)) + $date_correct); $dy = $wstring[$date[6]]; } $day = "".substr($dy,0,3).""; $date = "$d"; } if ($modify) {$p = "";} } $onam = substr($_,0,21); if ($meta2 || $scheduler && !$sched_private) { $_ =~ /(\..+)$/; $ext = $1 eq ".HTML" ? "" : $1; } print "$p"; if ($doctype != 2) {print "";} print qq@ @; if ($modify && !$srch) { &askdelet($fname,$norelod,1); print ""; } if (($doctype != 5 || $p1 eq '---') && $prefs[6]) { $prf = substr($fname,0,3); &list_sub("$cal_http?p1=$prf$datsub$modify$params$uqui$srch",$prefs[5]-1,1); print ""; } &whichcal(1); if ($prefs[22]) {print "";} print "\n"; } # next file print "\n"; } } sub tabulate3 { print "

Date

Day

Time

Title

${cname}

Creator

$date

$day

$all[2]

@; print " - " if $all[3]; print qq@

$all[3]

$all[4]

$all[6]

"; } # ******************************************************* # SEARCH sub doc10 { local($today) = $tmon.$tday; local(@ust); local($swidth) = $ie ? 32 : 28; local($tbody) = $titlebody; local($sstring,$byear,$eyear); $titlebody=''; if (!$FORM{usearch_mo1}) { $FORM{usearch_mo1} = substr($cstr,4,4) unless $cmon == $tmon && $cyear == $tyear; $FORM{usearch_yr1} = substr($bstr,0,4); $FORM{usearch_mo2} = substr($estr,4,4); $FORM{usearch_yr2} = substr($estr,0,4); if ($FORM{usearch_mo2} eq '0101') { $FORM{usearch_mo2} = '1301'; --$FORM{usearch_yr2}; } $FORM{usearch_type} = $cookies{"${cookie_base}_6_$userhost"} || 0; $ust[$FORM{usearch_type}] = ' SELECTED'; } elsif ($FORM{usearch_type} < 10) {$ust[$FORM{usearch_type}] = ' SELECTED';} ($sstring = $FORM{usearch_string}) =~ s/"/"/g; $tmp = ($purge-$purge%12)/12+1; if ($FORM{usearch_yr1} <= $tyear) { $byear=$FORM{usearch_yr1}-$tmp; $eyear=$FORM{usearch_yr2} > $tyear+$years_show ? $FORM{usearch_yr2} : $tyear+$years_show; } else { $byear=$tyear-$tmp; $eyear=$FORM{usearch_yr2} > $FORM{usearch_yr1}+$years_show ? $FORM{usearch_yr2} : $FORM{usearch_yr1}+$years_show; } print qq@ @; &head2; print qq@ $tbody

"; if (!$sched_private && ($scheduler || $meta2)) { print qq@ "; } print qq@

From:
Through:
$cname:
Subject Area:

Search for

@; # ----------- # now begin SEARCH OUTPUT if (defined $FORM{usearch_string}) { require "${cal_param}search.pl" || &erred("SORRY! Search is unavailable

\n"); &psearch; } else {print"\n";} } # ********************************* sub getlst { local($fil) = @_; local($found); open(lstfile,"<$fil") || return 0; @lines=; close(lstfile) || &erred("SERVER ERROR: Couldn't CLOSE $fil"); $found = 1; } # ************************************ sub getdate { local($month,$date,$year,$day,$d_format) = @_; local($dat); $date = int($date); if (!$d_format) { $dat = "$month $date, $year"; if ($day) {$dat = "$day, $dat";} } elsif ($d_format == 1) { $dat = "$month $date, $year"; if ($day) {$dat .= " ($day)";} } elsif ($d_format == 2) { $dat = "$date $month, $year"; if ($day) {$dat .= " ($day)";} } else { $dat = $date.'-'.substr($month,0,3).'-'.substr($year,2,2); if ($day) {$dat = substr($day,0,3).' '.$dat;} } $out = $dat; } # ********************************** sub getevent { local($path,$vmode) = @_; open(FIL,"<$edir$path") || return 0; $line=; close(FIL) || &erred("SERVER ERROR: Couldn't CLOSE $path in cal_make.pl"); $out = &chkrepeat; &get_time if $vmode != -1; if ($vmode == -2) { # within cal $time = "$time"; $all[4] =~ s/<\/?[^>]*>//g; # if (length($all[4]) > 28) {$all[4] = substr($all[4],0,28)."...";} $all[4] = "$all[4]"; } elsif ($vmode != -1) { # non-editable output if ($prefs[22] && $all[7]) { $all[6] = "$all[6]"; } if (!$vmode) { # 'normal' output $all[4] = "$all[4]"; if ($time) {$time = "$time";} } elsif ($vmode == 1) { # tabulated out (BRIEF) $all[2] = "$all[2]" if $all[2]; $all[3] = "$all[3]" if $all[3]; $all[4] =~ s/<\/?[^>]*>//g; if (length($all[4]) > $wtit) {$all[4] = substr($all[4],0,$wtit)."...";} $all[4] = '... ' if $all[4] !~ /[^ ]/; # so can link/view event $all[4] = "$all[4]"; } } $out; } # ************************ # normal viewing print sub prnt { print "\n"; # userid:address print "$time
" if $time; # time print "$all[4]
"; # title if ($#custom_fields > -1 && $#custom > -1) { # custom fields print "
"; print ''; for (0..$#custom_fields) {print "" if $custom[$_];} print '
$custom_fields[$_]: $custom[$_]
'; } if ($all[5]) { # description $all[5] =~ s/

/

/gi; print "
"; print "$all[5]
"; } if ($prefs[22]) { # Creator info print "
"; print "\nPosted by: $all[6]"; # name+email print ", $all[8]" if $all[8]; # affiliation if ($prefs[22] == 2 && !$FORM{banner}) { print ", $all[9] ".&get_time2($all[10],1)." $tzone"; # date+time } print "\n"; } if ($ss && $type eq "Series") {print @series;} # series dates } # ************************** sub get_time { $all[2] = &get_time2($all[2],1); $all[3] = &get_time2($all[3],1); $time = $all[2] && $all[3] ? "$all[2] - $all[3]" : $all[2]; } sub get_time2 { local($t,$pmer) = @_; local($out); if ($t) { if ($prefs[23]) {$out = substr($t,0,2).':'.substr($t,2,2);} else { if ($t >= 1200) { $tmp = substr($t,0,2); if ($t >= 1300) {$tmp -= 12;} $out = "$tmp:".substr($t,2,2); $out .= ' pm' if $pmer; } else { if ($pmer) { if ($t eq '0000') {return 'Midnight';} elsif ($t eq '1200') {return 'Noon';} } $tmp = int(substr($t,0,2)); $tmp = 12 if !$tmp; $out = "$tmp:".substr($t,2,2); $out .= ' am' if $pmer; } } } $out; } # ********************************** # if this event file is just a pointer, get template sub chkrepeat { local($mon,$day,$yr,$ctr,$ctr2); $type = "Event"; chomp($line); (@all[0..11],@custom) = split(/\t/,$line); if (!defined $all[4]) { if (-e "$edir$line") { open(FIL,"<$edir$line") || return 0; $line=; close(FIL) || return 0; $type = "Series"; chomp($line); (@all[0..11],@custom) = split(/\t/,$line); } else {return 0;} } elsif ($all[11]) {$type = "Series";} return 0 if !defined $all[4]; if ($ss && $type eq "Series") { @series = (); local(@all_files) = split(/:/,$all[11]); if ($FORM{p4}) { $ctr = "

"; $ctr2 = ""; } while ($#all_files > 0 && length($all_files[0]) < 17) {shift(@all_files);} push(@series,"

$ctr

"); push(@series,"\n"); for ($i = $#all_files; $i >= 0; $i--) { $mon = substr($all_files[$i],7,2); $day = substr($all_files[$i],9,2); $yr = substr($all_files[$i],3,4); @cdate=localtime(&timelocal((0,0,12,$day,$mon-1,$yr-1900)) + $date_correct); $tmp = &getdate(substr($mstring[$mon-1],0,3),$day,$yr,substr($wstring[$cdate[6]],0,3),$prefs[4]); $tmp =~ s/ / <\/FONT><\/TD>"); } push(@series,"

\nDates in Series:
/g; $tmp =~ s/,//; push(@series,"
$tmp

$ctr2"); } $out = 1; } # ****************** # dir list sorting sub assoc_subjects {for (0..$#pr) {$subjects{$pr[$_]} = $_;}} sub bydate { substr($a,3,16) <=> substr($b,3,16); } sub bysubject { $subjects{substr($a,0,3)} <=> $subjects{substr($b,0,3)}; } # ****************** sub askdelet { local($fname,$noreload,$vmode) = @_; local($relod,$usearched,$prev,$id,$reject); if ($modify) { if ($type eq "Series") { $arr = "$arrow$arrow$arrow"; if (!$ss) {$noreload = 0;} } else {$arr = $arrow;} if (!$noreload && !$FORM{pending}) {$relod = '&urelod=1';} $usearched = "&usearched=1" if $FORM{usearched}; local($zzz) = substr($fname,0,3); local($cal_restrict) = ",$userid[6],"; ($id = $fname) =~ s/^.{21}\.//; # can modify iff logged & (admin or posted event or own event) & (not restricted from calendar/scheduler) & (not restricted from subject area) & (not shared or not userpassword) & (not Pre-approval or viewing pending) if ($logged && ($admin || $all[0] =~ /^$userhost$/i || $fname =~ /\.$userhost3/i) && (!$scheduler && !$meta2 || !$userid[6] || $cal_restrict =~ /,$id,/i) && (!$userid[5] || $userid[5] =~ /$zzz/) && (!$userid[1] || !$userpassword || $all[1] =~ /^$ENV{REMOTE_ADDR}$/i) && (!$userid[7] || $pending)) { ($tmp = $fname) =~ s/\.HTML//i; print "" if !$vmode; if ($admin && $pending && !$ss) {print qq||;} print qq||; if (!$ss || !$FORM{p4}) {print qq||;} if (!$vmode) {print "

$arr

";} } elsif (!$vmode) {print "\n\n

$arr	[$type Cannot Be Modified By Current User]

\n";} else {print " ";} } } # ************************************ sub ads { local($args) = @_; local($pasthed); if (-r $ads_path) { if ($ads_perl) { # Perl if ($args) { $args =~ s/^ //g; local(@pairs) = split(/ /,$args); foreach $pair (@pairs) { ($name, $value) = split(/=/,$pair); $FORM{$name} = $value; } } $ADVNoPrint = 1; require $ads_path; } else { # non-Perl, e.g. CentralAd ($ads_dir = $ads_path) =~ s/\/[^\/]+$//; chdir($ads_dir) if $^O =~ /win32/i; open(AD,"$ads_path$args |"); while() { if (!$pasthed && $_ =~ /^content-type/i) {$pasthed = 1;} else {print $_ if $pasthed;} } close AD; } } } # ************************************************ # 3-char special codes sub getcodes { $acal='CAL'; #main calendar $aday='DAY'; #all events on a given day $aweek='WEE'; #all events on a given week $amon='MON'; #all events in a given month $aadd='ADD'; #Add form $ainst='INS'; #instructions $ajoin='JOI'; #update-request (JOIN) form $aview='XXX'; #display whatever is indicated by $prefs[3] } # ***************************************** sub specific { if( $^O =~ /mac/i ) { # modify dir structure for Macs $slash = ':'; $cal_param =~ s/^([^\/])/:$1/; $cal_param =~ s/\.\.\//:/g; $cal_param =~ s/^\///; $cal_param =~ s/\//:/g; unshift(@INC,':'); $need_sort = 0; # files stored alpha. } else { $slash = '/'; unshift(@INC,'.'); $need_sort = 1; } # require 'timelocal.pl'; use Time::Local; # require $cal_param.'timelocal.pl'; } # ***** EOF