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
lmpx.com only provides a reader for public news (NNTP) servers. It is not
affiliated with the servers or forums shown here and is not responsible for
the content of articles, which is written by their respective authors.