initial module creationSTARTSTAFF_0_3

1 files changed, 234 insertions, 0 deletions

diff --git a/shift.cgi b/shift.cgi
new file mode 100755
index 0000000..7f9bcd6
--- /dev/null
+++ b/shift.cgi
@@ -0,0 +1,234 @@
+#!/usr/bin/perl -w
+#!/usr/bin/perl -Tw
+# (Text::Template can't do -T, but no user input is used dangerously)
+#
+# $Id: shift.cgi,v 1.1 2000-05-11 11:27:32 ivan Exp $
+#
+# Copyright (C) 2000 Adam Gould
+# Copyright (C) 2000 Michal Migurski
+# Copyright (C) 2000 Ivan Kohler
+# All rights reserved.
+#
+# This program is free software; you can redistribute it and/or modify it under
+# the same terms as Perl itself.
+
+###
+# user-servicable parts
+###
+
+$template_file = '/home/ivan/staffsheet/table.html';
+$data_directory = '/home/ivan/staffsheet/data';
+$mail_smtpserver = 'localhost'; # set blank to disable
+$mail_from = 'ivan-misconfigured-shift-from@420.am';
+$mail_subject = 'Your shift has been replaced';
+@mail_cc = (
+  'ivan-misconfigured-shift-cc@420.am',
+  'ivan-misconfigured-shift-cc2@420.am'
+);
+$mail_footer = <<END;
+
+Sorry, I don't have any more information.  The person who installed the 
+staff sheet didn't customize this message.
+
+END
+
+###
+# end of user-servicable parts
+###
+
+use strict;
+use vars qw( $template_file $data_directory $mail_smtpserver $mail_from
+             $mail_subject @mail_cc $mail_footer
+             $cgi $template %shifthash %warning @messages );
+use subs qw( form inputbox );
+use Fcntl ":flock";
+use CGI 2.15;
+use CGI::Carp qw(fatalsToBrowser);
+use Text::Template;
+use Mail::Internet;
+use Mail::Header;
+use Date::Format;
+
+$cgi = new CGI;
+
+$template = new Text::Template (
+  TYPE   => 'FILE',
+  SOURCE => $template_file,
+) or die "Can't create template for $template_file: $Text::Template::ERROR";
+
+# fill in new data if provided
+%warning = ();
+@messages = ();
+if ( $cgi->param() ) {
+
+  # kludge - grep for inputbox("field") in template to find valid form fields
+  # (DON'T get them from form submission - that's insecure!)
+  open (TEMPLATE_FILE,"<$template_file")
+    or die "Can't open template for $template_file: $!";
+  my @form_fields =
+    map { /inputbox\s*\(\s*([\'\"])(.*)\1\s*\)/; $2 }
+      #grep { /inputbox\s*\(\s*([\'\"])(.*)\1\s*\)/ }
+      grep { /inputbox\s*\(\s*([\'\"])(.*)\1\s*\);?\s*\}/ }
+        <TEMPLATE_FILE>;
+  close TEMPLATE_FILE;
+
+  #changed fields
+  #foreach $_ ( @form_fields ) {
+  #  warn "${_}_old undefined!" unless defined $cgi->param($_. '_old');
+  #  warn "${_}_new undefined!" unless defined $cgi->param($_. '_new');
+  #}
+  my @diff_fields =
+    grep { $cgi->param($_. '_old') ne $cgi->param($_. '_new') } @form_fields;
+
+  if ( @diff_fields ) {
+
+    local $SIG{HUP} = 'IGNORE';
+    local $SIG{INT} = 'IGNORE';
+    local $SIG{QUIT} = 'IGNORE';
+    local $SIG{TERM} = 'IGNORE';
+    local $SIG{TSTP} = 'IGNORE';
+    local $SIG{PIPE} = 'IGNORE';
+
+    #open(LOCKFILE,">>$data_directory/.lock")
+    open(LOCKFILE,"+<$data_directory/.lock")
+      or open(LOCKFILE,">>$data_directory/.lock")
+      or die "Can't open $data_directory/.lock: $!";
+    flock(LOCKFILE,LOCK_EX); #blocks until we have the lock
+    seek(LOCKFILE, 0, 0);
+    print LOCKFILE "$$     \n"; #superfluous
+
+    get_data();
+
+    foreach my $field ( @diff_fields ) {
+      $shifthash{$field}='' unless defined $shifthash{$field};
+      if ( $shifthash{$field} eq $cgi->param($field. '_old') ) {
+        if ( $cgi->param($field. "_new") =~
+               /\b(\w[\w\-\.\+]*\@(([\w\.\-]+\.)+\w+))\b/
+             || $cgi->param($field. "_new") =~ /^\s*$/
+        ) {
+          open(FILE,">$data_directory/.new.$field")
+            or die "Can't open file $data_directory/$field: $!";
+          print FILE $cgi->param($field. "_new");
+          close FILE;
+          rename "$data_directory/.new.$field", "$data_directory/$field";
+          $warning{$field} = '';
+          if (
+            $mail_smtpserver
+            && $shifthash{$field} =~ /\b(\w[\w\-\.\+]*\@(([\w\.\-]+\.)+\w+))\b/
+          ) {
+            my $to = $1;
+            my $header = Mail::Header->new( [
+              "From: $mail_from",
+              "To: $to",
+              "Cc: ". join(", ", @mail_cc),
+              "Sender: $mail_from",
+              "Reply-To: $mail_from",
+              "Date: ". time2str("%a, %d %b %Y %X %z", time),
+              "Subject: $mail_subject",
+            ] );
+            my $msg = Mail::Internet->new(
+              'Header' => $header,
+              'Body'   => [ map "$_\n",
+                "Hi,",
+                "",
+                "The \"$field\" shift you signed up for has been changed to",
+                '"'. $cgi->param($field. "_new"). '"',
+                "",
+                split("\n", $mail_footer),
+              ],
+            );
+            #send later - don't want to block on smtp while we have the lock
+            push @messages, $msg;
+          }
+        } else {
+          $warning{$field} = 
+            "WARNING: you tried to sign up for <B>$field</B>, but your entry ".
+            "<B>\"". $cgi->param($field. '_new').
+            "</B>\" does not contain a valid email address."
+          ;
+        }
+      } elsif ( $shifthash{$field} eq $cgi->param($field. '_new') ) {
+        #somebody else made the same change (or you hit reload); no need to warn
+        $warning{$field} = '';
+      } else {
+        $warning{$field} =
+          "WARNING: you tried to change <B>$field</B> from \"<B>".
+          $cgi->param($field. '_old').
+          "</B>\" to \"<B>".
+          $cgi->param($field. "_new").
+          "</B>\", but in the meantime someone changed it to: "
+        ;
+      }
+    }
+
+    flock(LOCKFILE,LOCK_UN);
+    close LOCKFILE;
+
+  }
+
+}
+
+get_data();
+
+my $text = $template->fill_in()
+  or die "Can't fill in template for $template_file: $Text::Template::ERROR";
+
+print $cgi->header, $text;
+
+$ENV{SMTPHOSTS} = $mail_smtpserver;
+$ENV{MAILADDRESS} = $mail_from;
+foreach my $msg ( @messages ) {
+  $msg->smtpsend;
+}
+
+# subroutines
+
+sub get_data {
+  opendir DATA_DIR, $data_directory
+    or die "Can't open directory $data_directory: $!";
+  %shifthash = map {
+    open(FILE, "<$data_directory/$_")
+      or die "Can't open file $data_directory/$_: $!";
+    my $value = scalar(<FILE>) || '';
+    close FILE;
+    chomp $value;
+    ( $_ => $value );
+  } grep { ! /^\.{1,2}(lock)?$/ } readdir(DATA_DIR);
+  closedir DATA_DIR;
+}
+
+# subroutines for the template
+
+sub form {
+ $cgi->start_form;
+}
+
+sub inputbox {
+  my $field = shift;
+  return $shifthash{$field} || "&nbsp;"
+    if defined $cgi->param('__MAGIC') && $cgi->param('__MAGIC') eq 'print';
+  $shifthash{$field}='' unless defined $shifthash{$field};
+  $warning{$field}='' unless defined $warning{$field};
+  #"$field ".
+  $cgi->hidden(
+    -name    => $field. '_old',
+    -default => $shifthash{$field},
+    -force   => 1,
+  ).
+  $warning{$field}.
+  $cgi->textfield(
+    -name    => $field. '_new',
+    -default => $shifthash{$field},
+    -force   => 1,
+    -size    => 15,
+  );
+}
+
+sub warnings {
+  join "<BR>", map {
+    "$warning{$_}<b>$shifthash{$_}</b>"
+  } grep {
+    $warning{$_}
+  } keys %warning;
+}
+