3 # (Text::Template can't do -T, but no user input is used dangerously)
5 # $Id: shift.cgi,v 1.2 2000-07-18 05:43:27 ivan Exp $
7 # Copyright (C) 2000 Adam Gould
8 # Copyright (C) 2000 Michal Migurski
9 # Copyright (C) 2000 Ivan Kohler
10 # All rights reserved.
12 # This program is free software; you can redistribute it and/or modify it under
13 # the same terms as Perl itself.
16 # user-servicable parts
19 $template_file = '/var/www/www.420.am/staff/table.html';
20 $data_directory = '/var/www/www.420.am/staff/data';
21 #$mail_smtpserver = 'localhost'; # set blank to disable
22 $mail_smtpserver = ''; # set blank to disable
23 $mail_from = 'ivan-misconfigured-shift-from@420.am';
24 $mail_subject = 'Your shift has been replaced';
26 'ivan-misconfigured-shift-cc@420.am',
27 'ivan-misconfigured-shift-cc2@420.am'
31 Sorry, I don't have any more information. The person who installed the
32 staff sheet didn't customize this message.
37 # end of user-servicable parts
41 use vars qw( $template_file $data_directory $mail_smtpserver $mail_from
42 $mail_subject @mail_cc $mail_footer
43 $cgi $template %shifthash %warning @messages );
44 use subs qw( form inputbox );
47 use CGI::Carp qw(fatalsToBrowser);
55 $template = new Text::Template (
57 SOURCE => $template_file,
58 ) or die "Can't create template for $template_file: $Text::Template::ERROR";
60 # fill in new data if provided
63 if ( $cgi->param() ) {
65 # kludge - grep for inputbox("field") in template to find valid form fields
66 # (DON'T get them from form submission - that's insecure!)
67 open (TEMPLATE_FILE,"<$template_file")
68 or die "Can't open template for $template_file: $!";
70 map { /inputbox\s*\(\s*([\'\"])(.*)\1\s*\)/; $2 }
71 #grep { /inputbox\s*\(\s*([\'\"])(.*)\1\s*\)/ }
72 grep { /inputbox\s*\(\s*([\'\"])(.*)\1\s*\);?\s*\}/ }
77 #foreach $_ ( @form_fields ) {
78 # warn "${_}_old undefined!" unless defined $cgi->param($_. '_old');
79 # warn "${_}_new undefined!" unless defined $cgi->param($_. '_new');
82 grep { $cgi->param($_. '_old') ne $cgi->param($_. '_new') } @form_fields;
86 local $SIG{HUP} = 'IGNORE';
87 local $SIG{INT} = 'IGNORE';
88 local $SIG{QUIT} = 'IGNORE';
89 local $SIG{TERM} = 'IGNORE';
90 local $SIG{TSTP} = 'IGNORE';
91 local $SIG{PIPE} = 'IGNORE';
93 #open(LOCKFILE,">>$data_directory/.lock")
94 open(LOCKFILE,"+<$data_directory/.lock")
95 or open(LOCKFILE,">>$data_directory/.lock")
96 or die "Can't open $data_directory/.lock: $!";
97 flock(LOCKFILE,LOCK_EX); #blocks until we have the lock
99 print LOCKFILE "$$ \n"; #superfluous
103 foreach my $field ( @diff_fields ) {
104 $shifthash{$field}='' unless defined $shifthash{$field};
105 if ( $shifthash{$field} eq $cgi->param($field. '_old') ) {
106 if ( $cgi->param($field. "_new") =~
107 /\b(\w[\w\-\.\+]*\@(([\w\.\-]+\.)+\w+))\b/
108 || $cgi->param($field. "_new") =~ /^\s*$/
110 open(FILE,">$data_directory/.new.$field")
111 or die "Can't open file $data_directory/$field: $!";
112 print FILE $cgi->param($field. "_new");
114 rename "$data_directory/.new.$field", "$data_directory/$field";
115 $warning{$field} = '';
118 && $shifthash{$field} =~ /\b(\w[\w\-\.\+]*\@(([\w\.\-]+\.)+\w+))\b/
121 my $header = Mail::Header->new( [
124 "Cc: ". join(", ", @mail_cc),
125 "Sender: $mail_from",
126 "Reply-To: $mail_from",
127 "Date: ". time2str("%a, %d %b %Y %X %z", time),
128 "Subject: $mail_subject",
130 my $msg = Mail::Internet->new(
132 'Body' => [ map "$_\n",
135 "The \"$field\" shift you signed up for has been changed to",
136 '"'. $cgi->param($field. "_new"). '"',
138 split("\n", $mail_footer),
141 #send later - don't want to block on smtp while we have the lock
142 push @messages, $msg;
146 "WARNING: you tried to sign up for <B>$field</B>, but your entry ".
147 "<B>\"". $cgi->param($field. '_new').
148 "</B>\" does not contain a valid email address."
151 } elsif ( $shifthash{$field} eq $cgi->param($field. '_new') ) {
152 #somebody else made the same change (or you hit reload); no need to warn
153 $warning{$field} = '';
156 "WARNING: you tried to change <B>$field</B> from \"<B>".
157 $cgi->param($field. '_old').
159 $cgi->param($field. "_new").
160 "</B>\", but in the meantime someone changed it to: "
165 flock(LOCKFILE,LOCK_UN);
174 my $text = $template->fill_in()
175 or die "Can't fill in template for $template_file: $Text::Template::ERROR";
177 print $cgi->header, $text;
179 $ENV{SMTPHOSTS} = $mail_smtpserver;
180 $ENV{MAILADDRESS} = $mail_from;
181 foreach my $msg ( @messages ) {
188 opendir DATA_DIR, $data_directory
189 or die "Can't open directory $data_directory: $!";
191 open(FILE, "<$data_directory/$_")
192 or die "Can't open file $data_directory/$_: $!";
193 my $value = scalar(<FILE>) || '';
197 } grep { ! /^\.{1,2}(lock)?$/ } readdir(DATA_DIR);
201 # subroutines for the template
209 return $shifthash{$field} || " "
210 if defined $cgi->param('__MAGIC') && $cgi->param('__MAGIC') eq 'print';
211 $shifthash{$field}='' unless defined $shifthash{$field};
212 $warning{$field}='' unless defined $warning{$field};
215 -name => $field. '_old',
216 -default => $shifthash{$field},
221 -name => $field. '_new',
222 -default => $shifthash{$field},
230 "$warning{$_}<b>$shifthash{$_}</b>"