3 # (Text::Template can't do -T, but no user input is used dangerously)
5 # $Id: shift.cgi,v 1.1 2000-05-11 11:27:32 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 = '/home/ivan/staffsheet/table.html';
20 $data_directory = '/home/ivan/staffsheet/data';
21 $mail_smtpserver = 'localhost'; # set blank to disable
22 $mail_from = 'ivan-misconfigured-shift-from@420.am';
23 $mail_subject = 'Your shift has been replaced';
25 'ivan-misconfigured-shift-cc@420.am',
26 'ivan-misconfigured-shift-cc2@420.am'
30 Sorry, I don't have any more information. The person who installed the
31 staff sheet didn't customize this message.
36 # end of user-servicable parts
40 use vars qw( $template_file $data_directory $mail_smtpserver $mail_from
41 $mail_subject @mail_cc $mail_footer
42 $cgi $template %shifthash %warning @messages );
43 use subs qw( form inputbox );
46 use CGI::Carp qw(fatalsToBrowser);
54 $template = new Text::Template (
56 SOURCE => $template_file,
57 ) or die "Can't create template for $template_file: $Text::Template::ERROR";
59 # fill in new data if provided
62 if ( $cgi->param() ) {
64 # kludge - grep for inputbox("field") in template to find valid form fields
65 # (DON'T get them from form submission - that's insecure!)
66 open (TEMPLATE_FILE,"<$template_file")
67 or die "Can't open template for $template_file: $!";
69 map { /inputbox\s*\(\s*([\'\"])(.*)\1\s*\)/; $2 }
70 #grep { /inputbox\s*\(\s*([\'\"])(.*)\1\s*\)/ }
71 grep { /inputbox\s*\(\s*([\'\"])(.*)\1\s*\);?\s*\}/ }
76 #foreach $_ ( @form_fields ) {
77 # warn "${_}_old undefined!" unless defined $cgi->param($_. '_old');
78 # warn "${_}_new undefined!" unless defined $cgi->param($_. '_new');
81 grep { $cgi->param($_. '_old') ne $cgi->param($_. '_new') } @form_fields;
85 local $SIG{HUP} = 'IGNORE';
86 local $SIG{INT} = 'IGNORE';
87 local $SIG{QUIT} = 'IGNORE';
88 local $SIG{TERM} = 'IGNORE';
89 local $SIG{TSTP} = 'IGNORE';
90 local $SIG{PIPE} = 'IGNORE';
92 #open(LOCKFILE,">>$data_directory/.lock")
93 open(LOCKFILE,"+<$data_directory/.lock")
94 or open(LOCKFILE,">>$data_directory/.lock")
95 or die "Can't open $data_directory/.lock: $!";
96 flock(LOCKFILE,LOCK_EX); #blocks until we have the lock
98 print LOCKFILE "$$ \n"; #superfluous
102 foreach my $field ( @diff_fields ) {
103 $shifthash{$field}='' unless defined $shifthash{$field};
104 if ( $shifthash{$field} eq $cgi->param($field. '_old') ) {
105 if ( $cgi->param($field. "_new") =~
106 /\b(\w[\w\-\.\+]*\@(([\w\.\-]+\.)+\w+))\b/
107 || $cgi->param($field. "_new") =~ /^\s*$/
109 open(FILE,">$data_directory/.new.$field")
110 or die "Can't open file $data_directory/$field: $!";
111 print FILE $cgi->param($field. "_new");
113 rename "$data_directory/.new.$field", "$data_directory/$field";
114 $warning{$field} = '';
117 && $shifthash{$field} =~ /\b(\w[\w\-\.\+]*\@(([\w\.\-]+\.)+\w+))\b/
120 my $header = Mail::Header->new( [
123 "Cc: ". join(", ", @mail_cc),
124 "Sender: $mail_from",
125 "Reply-To: $mail_from",
126 "Date: ". time2str("%a, %d %b %Y %X %z", time),
127 "Subject: $mail_subject",
129 my $msg = Mail::Internet->new(
131 'Body' => [ map "$_\n",
134 "The \"$field\" shift you signed up for has been changed to",
135 '"'. $cgi->param($field. "_new"). '"',
137 split("\n", $mail_footer),
140 #send later - don't want to block on smtp while we have the lock
141 push @messages, $msg;
145 "WARNING: you tried to sign up for <B>$field</B>, but your entry ".
146 "<B>\"". $cgi->param($field. '_new').
147 "</B>\" does not contain a valid email address."
150 } elsif ( $shifthash{$field} eq $cgi->param($field. '_new') ) {
151 #somebody else made the same change (or you hit reload); no need to warn
152 $warning{$field} = '';
155 "WARNING: you tried to change <B>$field</B> from \"<B>".
156 $cgi->param($field. '_old').
158 $cgi->param($field. "_new").
159 "</B>\", but in the meantime someone changed it to: "
164 flock(LOCKFILE,LOCK_UN);
173 my $text = $template->fill_in()
174 or die "Can't fill in template for $template_file: $Text::Template::ERROR";
176 print $cgi->header, $text;
178 $ENV{SMTPHOSTS} = $mail_smtpserver;
179 $ENV{MAILADDRESS} = $mail_from;
180 foreach my $msg ( @messages ) {
187 opendir DATA_DIR, $data_directory
188 or die "Can't open directory $data_directory: $!";
190 open(FILE, "<$data_directory/$_")
191 or die "Can't open file $data_directory/$_: $!";
192 my $value = scalar(<FILE>) || '';
196 } grep { ! /^\.{1,2}(lock)?$/ } readdir(DATA_DIR);
200 # subroutines for the template
208 return $shifthash{$field} || " "
209 if defined $cgi->param('__MAGIC') && $cgi->param('__MAGIC') eq 'print';
210 $shifthash{$field}='' unless defined $shifthash{$field};
211 $warning{$field}='' unless defined $warning{$field};
214 -name => $field. '_old',
215 -default => $shifthash{$field},
220 -name => $field. '_new',
221 -default => $shifthash{$field},
229 "$warning{$_}<b>$shifthash{$_}</b>"