#! /usr/bin/perl
# gen_dir - generate Historical League's membership list in various
# output formats
use DBI;
use strict;
my ($dsn, $dbh);
my (%attr) = ( RaiseError => 1 );
$dsn = "dbi:mysql:samp_db;mysql_read_default_file=$ENV{HOME}/.my.cnf";
$dbh = DBI->connect ($dsn, undef, undef, \%attr);
# FORMAT_BANQUET_ENTRY
sub format_banquet_entry
{
printf "%s\n", format_name ($_[0]);
}
# FORMAT_BANQUET_ENTRY
# RTF_INIT
sub rtf_init
{
print "{\\rtf0\n";
print "{\\fonttbl {\\f0 Times;}}\n";
print "\\plain \\f0 \\fs24\n";
}
# RTF_INIT
# RTF_CLEANUP
sub rtf_cleanup
{
print "}\n";
}
# RTF_CLEANUP
# FORMAT_RTF_ENTRY
sub format_rtf_entry
{
my ($entry_ref) = shift;
my ($address);
printf "\\b Name: %s\\b0\\par\n", format_name ($entry_ref);
$address = "";
$address .= $entry_ref->{street} if $entry_ref->{street};
$address .= ", " . $entry_ref->{city} if $entry_ref->{city};
$address .= ", " . $entry_ref->{state} if $entry_ref->{state};
$address .= " " . $entry_ref->{zip} if $entry_ref->{zip};
print "Address: $address\\par\n" if $address;
print "Telephone: $entry_ref->{phone}\\par\n" if $entry_ref->{phone};
print "Email: $entry_ref->{email}\\par\n" if $entry_ref->{email};
print "Interests: $entry_ref->{interests}\\par\n"
if $entry_ref->{interests};
print "\\par\n";
}
# FORMAT_RTF_ENTRY
# HTML_INIT
sub html_init
{
print "\n";
print "\n";
print "US Historical League Member Directory\n";
print "\n";
print "\n";
print "US Historical League Member Directory
\n";
}
# HTML_INIT
# HTML_CLEANUP
sub html_cleanup
{
print "\n";
print "\n";
}
# HTML_CLEANUP
# FORMAT_HTML_ENTRY
sub format_html_entry
{
my ($entry_ref) = shift;
my ($address);
# encode characters that are special in HTML
foreach my $key (keys (%{$entry_ref}))
{
$entry_ref->{$key} =~ s/&/&/g;
$entry_ref->{$key} =~ s/\"/"/g;
$entry_ref->{$key} =~ s/>/>/g;
$entry_ref->{$key} =~ s/Name: %s
\n", format_name ($entry_ref);
$address = "";
$address .= $entry_ref->{street} if $entry_ref->{street};
$address .= ", " . $entry_ref->{city} if $entry_ref->{city};
$address .= ", " . $entry_ref->{state} if $entry_ref->{state};
$address .= " " . $entry_ref->{zip} if $entry_ref->{zip};
print "Address: $address
\n" if $address;
print "Telephone: $entry_ref->{phone}
\n" if $entry_ref->{phone};
print "Email: $entry_ref->{email}
\n" if $entry_ref->{email};
print "Interests: $entry_ref->{interests}
\n"
if $entry_ref->{interests};
print "
\n";
}
# FORMAT_HTML_ENTRY
# SWITCHBOX-1
# switchbox containing formatting functions for each output format
my (%switchbox) =
(
"banquet" => # functions for banquet list
{
"init" => undef, # no initialization needed
"entry" => \&format_banquet_entry,
"cleanup" => undef # no cleanup needed
},
"rtf" => # functions for RTF format
{
"init" => \&rtf_init,
"entry" => \&format_rtf_entry,
"cleanup" => \&rtf_cleanup
},
"html" => # functions for HTML format
{
"init" => \&html_init,
"entry" => \&format_html_entry,
"cleanup" => \&html_cleanup
}
);
# SWITCHBOX-1
# SWITCHBOX-2
# make sure one argument was specified on the command line
@ARGV == 1
or die "Usage: gen_dir format_type\nAllowable formats: "
. join (" ", sort (keys (%switchbox))) . "\n";
# determine proper switchbox entry from argument on command line
# if no entry was found, the format type was invalid
my ($func_hashref) = $switchbox{$ARGV[0]};
defined ($func_hashref)
or die "Unknown format: $ARGV[0]\nAllowable formats: "
. join (" ", sort (keys (%switchbox))) . "\n";
# SWITCHBOX-2
# MAIN-BODY
# issue query
my ($sth) = $dbh->prepare (qq{
SELECT * FROM member ORDER BY last_name, first_name
});
$sth->execute ();
# invoke initialization function if there is one
&{$func_hashref->{init}} if defined ($func_hashref->{init});
# fetch and print entries if there is an entry formatting function
if (defined ($func_hashref->{entry}))
{
while (my $entry_ref = $sth->fetchrow_hashref ("NAME_lc"))
{
# pass entry reference to formatting function
&{$func_hashref->{entry}} ($entry_ref);
}
}
$sth->finish ();
# invoke cleanup function if there is one
&{$func_hashref->{cleanup}} if defined ($func_hashref->{cleanup});
# MAIN-BODY
$dbh->disconnect ();
exit (0);
sub format_name
{
my ($entry_ref) = shift;
my ($name);
$name = $entry_ref->{first_name} . " " . $entry_ref->{last_name};
if ($entry_ref->{suffix}) # there is a name suffix
{
# no comma for suffixes of I, II, III, etc.
$name .= "," unless $entry_ref->{suffix} =~ /^[IVX]+$/;
$name .= " " . $entry_ref->{suffix} if $entry_ref->{suffix};
}
return ($name);
}