I'm using the Web Developer Server Suite - Community Edition pretty
much out of the box on WindowsXP. This script worked fine on a LAMP
system although I am not sure what Apache modules were loaded. I am
beginning to wonder if I am missing some configuration to allow:
if (param('admin') eq "y")
ERROR
Software error:
Undefined subroutine &main::param called at C:/www/vhosts/localhost/
cgi-bin/stafio.pl line 33.
SCRIPT
#!C:/www/perl/bin/perl.exe
use CGI::Carp qw(fatalsToBrowser);
# organizational In/Out board
# configuration data
require 'C:/www/perl/lib/datapath/stafio.ph';
# turn debugging output on and off with parameter
#$debugging = (param('debug')) ? 1 : 0;
#print header;
# Do refresh and css in header as is proper
#print start_html(-title=>"Staff In/Out for $Organization",
#-style=>{'src'=>"C:/www/Apache22/manual/style/css/manual.css"},
#-head=>meta({-http_equiv=>'refresh',-content=>'60'})
#);
# get user information into memory
%users = &get_users();
if (param('admin') eq "y")
{
# admin interface. add/delete users
if (param('apswd'))
{
# got a password. validate it
if (param('apswd') eq $AdminPass)
{
# good password, check for add or delete
if (param('userID'))
{
&put_a_user( param('userID'),
param('pswd'),
param('name'),
param('extension'),
param('location'),
param('return'),
param('email'),
param('locstring'),
param('aim'));
%users = &get_users();
&display_inOut_board( %users );
}
else
{
@val = param('delme');
foreach (@val)
{
$FILE = "$Datapath/$_.$Ext";
unlink( $FILE );
}
%users = &get_users();
&display_inOut_board( %users );
}
}
else
{
# report invalid administrative password
print <<"EOF"
<H1>Invalid Password</H1>
The password entered is incorrect. Use your browser's back
function
to try again.
EOF
}
}
else
{
# put up form to do something, including getting admin password
&admin( );
}
}
else
{
if (param('userID'))
{
if (param('pswd'))
{
# we were sent a password, validate it and change status
if (isValidPswd($users{param('userID')}{'pswd'},param('pswd')))
{
# change status
&put_a_user( param('userID'),
$users{param('userID')}{'pswd'},
$users{param('userID')}{'name'},
$users{param('userID')}{'extension'},
param('location'),
param('return'),
$users{param('userID')}{'email'},
param('locstring'),
$users{param('userID')}{'aim'} );
%users = &get_users();
&display_inOut_board( %users );
}
else
{
# report invalid password
print <<"EOF"
<H1>Invalid Password</H1>
The password entered is incorrect. Use your browser's back
function
to try again.
EOF
}
}
elsif (param('newpswd'))
{
if (param('newpswd2'))
{
# we've got new password, confirm and rewrite
if (isValidPswd($users{param('userID')}
{'pswd'},param('oldpswd')))
{
# check new passwords match
if (param('newpswd') eq param('newpswd2'))
{
# rewrite user record
&put_a_user( param('userID'),
param('newpswd'),
param('name'),
param('extension'),
param('location'),
param('return'),
param('email'),
param('aim') );
%users = &get_users();
&display_inOut_board( %users );
}
else
{
# report mismatched new passwords
print <<"EOF"
<H1>Mismatched New Passwords</H1>
The new passwords do not match. Use your browser's back
function
to try again.
EOF
}
}
else
{
# report invalid password
print <<"EOF"
<H1>Invalid Password</H1>
The old password is incorrect. Use your browser's back function
to try again.
EOF
}
}
else
{
# put up form to get a new password for the user
&change_password( param('userID'),
$users{param('userID')}{'pswd'},
$users{param('userID')}{'name'},
$users{param('userID')}{'extension'},
$users{param('userID')}{'location'},
$users{param('userID')}{'return'},
$users{param('userID')}{'email'},
$users{param('userID')}{'aim'} );
}
}
else
{
# no password, just a userID, so we need to put up a form
# to let user change location and return
&change_status(param('userID'), $users{param('userID')}
{'email'});
}
}
else
{
&display_inOut_board( %users );
}
} #end if (admin)...else
print end_html;
exit;
### subroutines ###
sub admin
# administration form, add/delete users
{
# my( ) = @_;
## Add a user
print start_form(-method=>"post", -action=>"stafio.pl");
print <<"EOF";
<INPUT TYPE="hidden" NAME="admin" VALUE="y">
<INPUT TYPE="hidden" NAME="do" VALUE="add">
<TABLE>
<TR><TH>Add a User</TH><TD>Admin Password:<INPUT TYPE="password"
NAME="apswd" VALUE="" SIZE=20 MAXLENGTH=20></TD></TR>
<TR><TD ALIGN=RIGHT>User ID</TD><TD><INPUT TYPE="text" NAME="userID"
VALUE="$userID" SIZE=25></TD></TR>
<TR><TD ALIGN=RIGHT>User Name</TD><TD><INPUT TYPE="text" NAME="name"
VALUE="$name" SIZE=25></TD></TR>
<TR><TD ALIGN=RIGHT>Phone Extension</TD><TD><INPUT TYPE="text"
NAME="extension" VALUE="$extension" SIZE=10></TD></TR>
<TR><TD ALIGN=RIGHT>AIM Address</TD><TD><INPUT TYPE="text"
NAME="aim" VALUE="$aim" SIZE=25></TD></TR>
<TR><TD ALIGN=RIGHT>Email Address</TD><TD><INPUT TYPE="text"
NAME="email" VALUE="$email" SIZE=25></TD></TR>
<TR><TD ALIGN=RIGHT>Password</TD><TD><INPUT TYPE="password"
NAME="pswd" VALUE="" SIZE=20 MAXLENGTH=20></TD></TR>
<TR><TD ALIGN=RIGHT>Location</TD><TD> <SELECT NAME="location">
EOF
foreach( @Locations )
{
print "<OPTION> $_\n";
}
print <<"EOF";
</SELECT></TD></TR>
<TR><TD ALIGN=RIGHT>Other Location Text</TD><TD><INPUT TYPE="text"
NAME="locstring" VALUE="" SIZE=25></TD></TR>
<TR><TD ALIGN=RIGHT>Return by</TD><TD><INPUT TYPE="text"
NAME="return" VALUE="" SIZE=10></TD></TR>
</TABLE>
<INPUT TYPE="submit" NAME="submit" VALUE=" OK ">
</FORM>
EOF
## Delete a user
print start_form(-method=>"post", -action=>"stafio.pl");
print <<"EOF";
<INPUT TYPE="hidden" NAME="admin" VALUE="y">
<INPUT TYPE="hidden" NAME="do" VALUE="del">
<TABLE>
<TR><TH>Delete</TH><TD>Admin Password:<INPUT TYPE="password"
NAME="apswd" VALUE="" SIZE=20 MAXLENGTH=20></TD></TR>
EOF
foreach $usr ( sort keys %users )
{
print <<"EOF";
<tr>
<TD><INPUT TYPE=CHECKBOX NAME="delme" VALUE="$usr"></TD><TD>
$users{$usr}{'name'}</TD>
</tr>
EOF
}
print <<"EOF";
</TABLE>
<INPUT TYPE="submit" NAME="submit" VALUE=" OK ">
</FORM>
EOF
} # end admin
sub change_password
# user gets a form to change password
{
my ($userID, $pswd, $name, $extension, $location, $return, $email,
$aim) = @_;
print h1("Change Password");
print start_form(-method=>"post", -action=>"stafio.pl");
print <<"EOF";
<INPUT TYPE="hidden" NAME="userID" VALUE="$userID">
<INPUT TYPE="hidden" NAME="name" VALUE="$name">
<INPUT TYPE="hidden" NAME="extension" VALUE="$extension">
<INPUT TYPE="hidden" NAME="aim" VALUE="$aim">
<INPUT TYPE="hidden" NAME="location" VALUE="$location">
<INPUT TYPE="hidden" NAME="return" VALUE="$return">
<INPUT TYPE="hidden" NAME="email" VALUE="$email">
<TABLE>
<TR><TD ALIGN=RIGHT>Old Password</TD><TD><INPUT TYPE="password"
NAME="oldpswd" VALUE="" SIZE=20 MAXLENGTH=20></TD></TR>
<TR><TD ALIGN=RIGHT>New Password</TD><TD><INPUT TYPE="password"
NAME="newpswd" VALUE="" SIZE=20 MAXLENGTH=20></TD></TR>
<TR><TD ALIGN=RIGHT>Confirm Password</TD><TD><INPUT TYPE="password"
NAME="newpswd2" VALUE="" SIZE=20 MAXLENGTH=20></TD></TR>
</TABLE>
<INPUT TYPE="submit" NAME="submit" VALUE=" OK ">
</FORM>
EOF
} # end change_password
sub change_status
# user gets form to change location and/or return time
{
my ($userID, $email) = @_;
print h1("Change Status");
print "<a href=\"stafio.pl?userID=$userID&newpswd=1\">Change
Password</a>\n";
print start_form(-method=>"post", -action=>"stafio.pl");
print <<"EOF";
<INPUT TYPE="hidden" NAME="userID" VALUE="$userID">
<INPUT TYPE="hidden" NAME="email" VALUE="$email">
<TABLE>
<TR><TD ALIGN=RIGHT>User</TD><TD><B>$userID<B></TD></TR>
<TR><TD ALIGN=RIGHT>Password</TD><TD><INPUT TYPE="password"
NAME="pswd" VALUE="" SIZE=20 MAXLENGTH=20></TD></TR>
<TR><TD ALIGN=RIGHT>Location</TD><TD> <SELECT NAME="location">
EOF
foreach( @Locations )
{
print "<OPTION> $_\n";
}
print <<"EOF"
</SELECT></TD></TR>
<TR><TD ALIGN=RIGHT>Other Location Text</TD><TD><INPUT TYPE="text"
NAME="locstring" VALUE="" SIZE=25></TD></TR>
<TR><TD ALIGN=RIGHT>Return by</TD><TD><INPUT TYPE="text"
NAME="return" VALUE="" SIZE=10></TD></TR>
</TABLE>
<INPUT TYPE="submit" NAME="submit" VALUE=" OK ">
</FORM>
EOF
} # end change_status
sub display_inOut_board
# display table of user data
{
my %users = @_;
#
# print "<meta http-equiv=\"Refresh\" content=\60\">\n";
# print "</HEAD>\n";
#
#
print "<center>\n";
print h1("$Organization Staff I/O Board");
# print h1("$Organization"),
# h2("In / Out Board" );
print <<"EOF";
<table width="90%">
<tr>
<th>Name</th>
<th width=12>Extension</th>
<th>Location</th>
<th>Returning</th>
<th>AIM</th>
</tr>
EOF
foreach $usr ( sort keys %users )
{
print <<"EOF";
<tr>
<td><a href="mailto:$users{$usr}{'email'}">$users{$usr}{'name'}</
a></td>
<td align=center>$users{$usr}{'extension'}</td>
<td><a href="stafio.pl?userID=$usr">$users{$usr}{'location'}</a></
td>
<td align=center>$users{$usr}{'return'}</td>
<td align=center>$users{$usr}{'aim'}</td>
</tr>
EOF
}
#
print "</table>\n";
print "<BR>\n";
print h2("<A HREF=\"http://www.xxxxxxx/\";>Staff directory</A>\n");
#
print "</center>\n";
} # end display_inOut_board
sub get_a_user
# retrieve data for one user
{
my( $file ) = @_;
my ($userID, $pswd, $name, $extension, $loc, $time, $email, $aim);
$FILE = "$Datapath/$file";
open( IN, "<$FILE" )
|| &try_later(1);
foreach( <IN> )
{
($userID) = ($file =~ /(.*)\.$Ext/);
($pswd, $name, $extension, $loc, $time, $email, $aim) =
split( $Delim, $_ );
}
close( IN );
return( $userID, $pswd, $name, $extension, $loc, $time, $email,
$aim );
} # end get_a_user
sub get_users
# get user data into a hash of hashes, keyed on userID
{
my( %u ) = ();
my ( @files, $file, $userID, $pswd, $name, $extension, $loc, $time,
$email, $aim );
opendir DATADIR, $Datapath
|| &try_later(2);
@files = grep /$Ext$/, readdir DATADIR;
closedir DATADIR;
foreach $file (@files)
{
( $userID, $pswd, $name, $extension, $loc, $time, $email, $aim ) =
&get_a_user( $file );
$u{$userID}{'pswd'} = $pswd;
$u{$userID}{'name'} = $name;
$u{$userID}{'extension'} = $extension;
$u{$userID}{'location'} = $loc;
$u{$userID}{'return'} = $time;
$u{$userID}{'email'} = $email;
$u{$userID}{'aim'} = $aim;
}
return( %u );
} # end get_users
sub isValidPswd
# validate password against userID
# return 1 (true) if password is valid
{
my( $u, $p ) = @_;
my( $return ) = 0;
if ($p eq $BossPass)
{
$return = 1;
}
else
{
$return = ($u eq $p) ? 1 : 0;
}
return( $return );
} # end isValidPswd
sub put_a_user
# write new data for one user
{
my( $userID, $pswd, $name, $extension, $loc, $return, $email,
$locstr, $aim ) = @_;
$locstr =~ tr/ / /s;
$locstr = "unknown" unless (length( $locstr ) > 1);
$loc = $locstr if ($loc eq "Other");
$return = " - " unless ($return);
$FILE = "$Datapath/$userID.$Ext";
open( OUT, ">$FILE")
|| &try_later(3);
print OUT "$pswd$Delim$name$Delim$extension$Delim$loc$Delim$return
$Delim$email$Delim$aim";
close( OUT );
} # end put_a_user
sub try_later
# minimal error handling
{
local($errnum) = @_;
print h2("Unable to open $FILE for reading: $!") if $errnum == 1;
print h2("Unable to find data files: $!") if $errnum == 2;
print h2("Unable to open $FILE for writing: $!") if $errnum == 3;
print h2("Please try again later.");
print end_html;
exit;
} # end try_later
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
http://learn.perl.org/
