.
.
#!/usr/local/bin/perl
# mailformdb.pl - k.mcmanus@gre.ac.uk 20021110
# Perl CGI program: generates a mailing list form
use CGI qw(:standard);
%oslabels = (
Win9x => 'Windoze 95/98/ME',
WinNT => 'Windoze NT',
Win2k => 'Windoze 2000',
WinXP => 'Windoze XP',
Unix => 'Unix',
MacOS => 'Mac OS',
MacOSX => 'Mac OS X',
VMS => 'Open VMS'
);
@osvalues = keys %oslabels;
@platforms = split(' ',param('Platforms'));
print
header(-type => 'text/html',
-expires => '+2h',
-charset => 'UTF-8'),
start_html(-title => 'Mailing list form',
-style => {-src => '../comp1037/perl/mailform.css'}),
h2('Join our product mailing list'),
h4('(MySQL CGI.pm version)'),
start_form(-action => 'maillistdb.pl'),
"\n Title ", textfield('Title', '', 8, 16),
"\n Initials ", textfield('Initials', '', 6, 12),
"\n Surname ", textfield('Surname', '', 32, 64), br, br,
"\n Email ", textfield('Email', '', 32, 64), br, br,
"\n Your computer platform(s):", br,
checkbox_group(-name => 'Platforms',
-values => \@osvalues,
-defaults=>\@platforms,
-linebreak => 'true',
-labels => \%oslabels), br, br,
submit('Sub', 'Add Details'), ' ',
reset('Reset Form'),' ',
end_form,
hr, end_html;
Things to notice about mailformdb.pl
#!/usr/local/bin/perl
# maillistdb.pl - k.mcmanus@gre.ac.uk 20021111
# Mail list using a MySQL database
use strict;
use DBI;
use DBD::mysql;
use CGI qw(:standard);
my $URLform = 'http://stuweb.cms.gre.ac.uk/~mkg01/cgi-bin/mailformdb.pl';
my $URLlist = 'http://stuweb.cms.gre.ac.uk/~mkg01/cgi-bin/maillistdb.pl';
print header(-type => 'text/html',
-expires => 'now',
-charset => 'UTF-8');
if ( $ENV{HTTP_REFERER} !~ $URLform && $ENV{HTTP_REFERER} !~ $URLlist ) {
print
start_html(-head => meta( {'http-equiv' => 'Refresh',
'content' => "0; URL=$URLform"} )),
end_html;
exit;
}
print
start_html(-title => 'Results from mailing list program maillistdb.pl',
-style => {'src' => 'mailform.css'});
my $title = param('Title');
my $initials = param('Initials');
my $surname = param('Surname');
my $email = param('Email');
my @plats = param('Platforms');
my $strValid = "";
my $platforms = "";
foreach (@plats) { $platforms .= "$_ " }
if ( $ENV{HTTP_REFERER} =~ $URLlist && param('yesButton') =~ 'Yes' ) {
my $dbh = DBI->connect( "DBI:mysql:mailList", 'web', 'web' );
my $statement = "INSERT INTO mlist
(title, initials, surname, email, platforms)
VALUES
('$title', '$initials', '$surname', '$email', '$platforms')";
$dbh->do( $statement );
$dbh->disconnect;
print
"Thank you for completing the registration form $title $initials $surname", br,
end_html;
exit;
}
print
startform,
hidden(-name => 'Title', -default => '$title'),
hidden(-name => 'Initials', -default => '$initials'),
hidden(-name => 'Surname', -default => '$surname'),
hidden(-name => 'Email', -default => '$email'),
hidden(-name => 'Platforms', -default => '$platforms');
if ( $title !~ /[a-zA-Z ]/ ) { $strValid = ' Title' . br }
if ( $initials !~ /[a-zA-Z ]/ ) { $strValid = $strValid . ' Initials' . br }
if ( $surname !~ /[a-zA-Z -']/ ) { $strValid = $strValid . ' Surname' . br }
if ( $email !~ /^([\w\.\-])+\@(([a-zA-Z0-9\-])+\.)+([a-zA-Z0-9]{2,4})+$/ ) { $strValid = $strValid . ' Email' . br }
if ( !@plats ) { $strValid = $strValid . ' Platform(s)' . br }
print
h2('Information received from the mail list form'),
"\n Title: ", $title, br,
"\n Initials: ", $initials, br,
"\n Surname: ", $surname, br,
"\n Email: ", $email, p,
"\n Platforms: ", br;
foreach ( @plats ) { print " ", $_, br }
if ( $strValid ) {
print
br, 'The following details have not been entered correctly:', br, br,
$strValid, br, br,
'Please go back and correct them', br, br,
button(-name => 'backButton',
-value => 'Back',
-onCLick => "document.forms[0].action=\"$URLform\";submit()"), br, br;
} else {
print
br, 'Please confirm that the above details are correct', br,
submit(-name => 'yesButton',
-value => 'Yes',
-onCLick => "document.forms[0].action=\'$URLlist\';submit()"), ' ',
button(-name => 'noButton',
-value => 'No',
-onCLick => "document.forms[0].action=\"$URLform\";submit()"), br, br;
}
print endform, end_html;
Things to notice about maillistdb.pl
A handy perl tool for looking at the MySQL mail list database
#!/usr/local/bin/perl
# mlistView.pl - k.mcmanus@gre.ac.uk 20040207
# Mail list viewer for a MySQL database
use strict;
use lib '/home/mkg01/include';
use mkg01db qw( mdbConnect );
use DBI;
use DBD::mysql;
use CGI qw(:standard);
print
header(-type =>'text/html',
-expires => '+2h',
-charset => 'UTF-8'),
start_html(-title => 'MySQL Mailing List',
-style => {'src' => '../php/mailform.css'}), "\n",
h1('MySQL Mailing List'), "\n";
my $SQL = 'SELECT * FROM mlist';
my $dbh = mdbConnect();
my $sth= $dbh->prepare($SQL);
$sth->execute();
print "<table bgcolor=\"#ddeeff\">";
my $i = 0;
while (my @row = $sth->fetchrow_array) {
$i++;
print "<tr><td bgcolor=\"#eeddff\">$i</td>";
foreach (@row) {
print "<td> $_</td>";
}
print "</tr>\n";
}
print "</table>";
$dbh->disconnect;
print end_html, "\n";
Things to notice about mlistView.pl
To complete the picture we need to have a quick look at the mkg01db module
# mkg01db.pm k.mcmanus@gre.ac.uk 20021201
# Module to access mkg01 mysql database
package mkg01db;
use Exporter;
@ISA = qw(Exporter);
@EXPORT = qw( mdbConnect );
use DBI;
use DBD::mysql;
sub mdbConnect {
my $mkg01dbh = DBI->connect
( 'DBI:mysql:mdb_mkg01:studb.cms.gre.ac.uk', 'mkg01', 'mysecret');
return $mkg01dbh;
}
Which requires no explanation but the file permissions required to protect mysecret require use of access control lists...
bukowski -->getfacl mkg01db.pm # file: mkg01db.pm # owner: mkg01 # group: student user::rw- user:httpd:r-- #effective:r-- group::--- #effective:--- mask:r-- other:---
Stuck over access control lists? Try the unix web pages
.
.