Address Book (HTML::Mason)

% if ($users) { % foreach my $user (@$users) { % my $userdata = $database{$user}; % }
UserNameEmail
<% $user %> <% $userdata->{fullname} %> <% $userdata->{email} %>
% } else { No users in database. % }
User
Full Name
Email

<% $formMessage %>
Jim Mahoney
Last modified: Fri Feb 8 03:29:47 EST 2002

%# =============================================================== <%init> ################################################# # AddressBook3 cgi script. # html interface: HTML::Mason # database : MLDBM tied multi-level database hash # # This one is both perl code / html code in one... # # Database structure is the same as in AddressBook1 # ######################################################## our %database = (); openDatabase(); # Here we only use CGI.pm for processing the forms use CGI; use CGI::Carp qw(fatalsToBrowser); my $cgi = new CGI; # Process form my $formMessage = processFormSubmission($cgi); # Get the list of users my $users = $database{_users}; # --------------------------------------------- # misc subroutines # If the user submits the form, then change the database. sub processFormSubmission { my ($redstart,$redend) = ("

", "

\n"); my ($cgi) = @_; my ($adduser, $user, $fullname, $email) = map {$cgi->param($_) || ''} qw( adduser user fullname email ); if ( $adduser ) { unless ( $user and $fullname and $email) { return $redstart . "OOPS - to add someone to the database, " . "you must supply a value for each of the fields." . $redend; } my $users = $database{_users}; # read list of users from the file push @$users, $user; $database{_users} = $users; # write list of users to the file and # write new user's data to the file. $database{$user} = { fullname => $fullname, email => $email }; } return '' unless $user; return $redstart . "OK, the user '$user' has been added to the databse." . $redend; } # --------------------------------------------- # Database routines. # Open the global %database as an MLDBM tied hash, i.e. a "disk file" hash. # * I'm using the recipe in "CGI Programming in Perl" and flock() for # locking the tied hash. Also, for simplicity I'm simply asking # for a write lock whether I need it on this call or not. # * Do make sure that the permissions on $datafile allow the httpd deamon # to modify it. The "0660" sets the permissions to rw for user/group # if the file is created with this call - and that can only happen # if the directory allows the httpd deamon to create a file. # I've found it's usually easier to run the script from the command # line the first time, which will create the database, and then set # its permissions by hand, with chmod. # * This hash may be a deep data structure. However, to write to # the disk you must assign to the *top* level part of the hash. # Thus $database{this}{that} = 2; won't change the disk file, # but $tmp=$database{this};$tmp->{that}=2;$database{this}=$tmp will. sub openDatabase { my $datafile = 'AddressData.db'; use MLDBM qw (DB_File Storable ); use Fcntl qw( :DEFAULT :flock ); my $db = tie(%database, 'MLDBM', $datafile, O_RDWR|O_CREAT, 0666) or die " Error - unable to connect to $datafile : $!"; my $fd = $db->fd; open DBM, "+<&=$fd" or die "Could not dup DBM for lock: $!"; flock DBM, LOCK_EX; undef $db; } sub closeDatabase { untie %database; } <%cleanup> closeDatabase();