#!/usr/local/bin/perl -Tw #------------------------------------------------------------------------------ # memberdir.cgi # # CGI script to display IAP2 members. # # $Id: memberdir.cgi,v 1.11 2002/10/16 10:35:31 mfuhr Exp mfuhr $ #------------------------------------------------------------------------------ use strict; use CGI qw(-nosticky :standard); use CGI::Carp; use Text::CSV; use HTML::Entities; #------------------------------------------------------------------------------ # Definitions. #------------------------------------------------------------------------------ my $member_list = "namelist1.csv"; my $html_header = "header.html"; my $html_footer = "footer.html"; #------------------------------------------------------------------------------ # include_file # # Read a file and print its contents. #------------------------------------------------------------------------------ sub include_file { my @files = @_; local *FILE; foreach my $file (@files) { next unless defined($file); if (open(FILE, $file)) { print ; close FILE; } else { warn "can't open include file $file: $!\n"; } } } #------------------------------------------------------------------------------ # parse_member_list # # Parse the member list file. #------------------------------------------------------------------------------ sub parse_member_list { my ($file) = @_; local *FILE; return unless defined($file); my @members; if (open(FILE, $file)) { my $csv = Text::CSV->new; while () { #------------------------------------------------------------------ # Check if we're reading a tab-separated file or a CSV file. #------------------------------------------------------------------ my $filetype; if (/\t/) { $filetype = "tab"; } else { $filetype = "csv"; } #------------------------------------------------------------------ # Fix special characters. Failure to do this can prevent # Text::CSV from working. #------------------------------------------------------------------ tr/\x92/'/; s/\cK/ - /g; #------------------------------------------------------------------ # Split the line into fields. #------------------------------------------------------------------ my @field; if ($filetype eq "tab") { @field = split(/\t/); } elsif ($filetype eq "csv") { my $status = $csv->parse($_); if ($status != 1) { warn "can't parse $file line $.\n"; next; } @field = $csv->fields(); } #------------------------------------------------------------------ # Add this member to the list. We could have used the field # names from the file's header line, but at least one of those # field names was misspelled when this program was being written. #------------------------------------------------------------------ my $member = { "First" => $field[0], "Last" => $field[1], "Propername"=> $field[2], "Deceased" => $field[3], "Spouse" => $field[4], # company is state field "Company" => $field[5], "Address 1" => $field[6], "City" => $field[7], "Zip" => $field[8], "Pix" => $field[9], "Phone" => $field[10], "Email2" => $field[11], "Email" => $field[12], "Website" => $field[13], "Profile" => $field[14], "DOB" => $field[15], "Pix2" => $field[16], "Phone2" => $field[17], "Record" => $., }; # if (!$member->{"Country"}) { # $member->{"Country"} = "* UNKNOWN *", # } #------------------------------------------------------------------ # Do some sanity checks before adding this member to the list. #------------------------------------------------------------------ my $err = 0; if ($member->{"Phone"} && ($member->{"Phone"} !~ /^\s*$/) && ($member->{"Phone"} !~ /\d{3}/)) { print "ERROR: Record $. has an invalid phone number: ", encode_entities($member->{"Phone"}), "
\n"; ++$err; } if ($member->{"Fax"} && ($member->{"Fax"} !~ /^\s*$/) && ($member->{"Fax"} !~ /\d{3}/)) { print "ERROR: Record $. has an invalid fax number: ", encode_entities($member->{"Fax"}), "
\n"; ++$err; } if ($member->{"Email"} && ($member->{"Email"} !~ /^\s*$/) && ($member->{"Email"} !~ /\S+@\S+/)) { print "ERROR: Record $. has an invalid email address: '", encode_entities($member->{"Email"}), "'
\n"; ++$err; } if ($err) { print "Skipping record $.
\n"; } else { push @members, $member; } } } else { print "ERROR: can't open member list file
\n"; warn "can't open member list $file: $!\n"; } return @members; } #------------------------------------------------------------------------------ # print_search_form # # Print the search form. #------------------------------------------------------------------------------ sub print_search_form { my @members = @_; #-------------------------------------------------------------------------- # Get the first characters of the last names. #-------------------------------------------------------------------------- my @last_name = grep {$_} map {$_->{"Last"}} @members; my %first_char = map {uc(substr($_, 0, 1)) => 1} @last_name; my @first_char = sort keys %first_char; #-------------------------------------------------------------------------- # Get the first characters of the first names. #-------------------------------------------------------------------------- my @last_name2 = grep {$_} map {$_->{"First"}} @members; my %first_char2 = map {uc(substr($_, 0, 1)) => 1} @last_name2; my @first_char2 = sort keys %first_char2; #-------------------------------------------------------------------------- # Get the countries and state/provinces. #-------------------------------------------------------------------------- my %location; foreach my $member (@members) { my $country = $member->{"Country"}; my $state = $member->{"State"}; if ($country) { $location{$country} = 1; if ($state) { $location{"$country - $state"} = 1; } } } my @location = sort keys %location; #-------------------------------------------------------------------------- # Print the links for the last names. #-------------------------------------------------------------------------- print "
\n"; print "\n"; print "\n"; #-------------------------------------------------------------------------- # Print the search form by State. #-------------------------------------------------------------------------- print "\n"; #-------------------------------------------------------------------------- # Print the search form by last name. #-------------------------------------------------------------------------- print "\n", "\n"; #-------------------------------------------------------------------------- # Print the search form for the locations. #-------------------------------------------------------------------------- # print "\n", # "\n", # "\n"; #------------------------------------------------------------------------------ # Control the table #----------------------------------------------------------------------------- # print "\n"; # print "\n"; # print "\n", # "\n"; print "
\n", "Search by initial of last name:
\n"; my $url = url(-relative => 1); foreach my $letter (@first_char) { print "$letter\n"; } #-------------------------------------------------------------------------- # Print the links for the First names. #-------------------------------------------------------------------------- print "
Search by initial of first name:
\n"; foreach my $letter2 (@first_char2) { print "$letter2\n"; } print "
\n", "Search by State:
Use either two letter abreviation
or just first letter of state\n"; print start_form(-method => "GET", -action => $url), textfield(-name => "company", -size => 25, -maxlength => 60), "
\n", submit("State Search"), "\n", end_form, "\n"; print "
\n", "Search by Last name:
Use a few first letters of the last name\n"; print start_form(-method => "GET", -action => $url), textfield(-name => "last", -size => 25, -maxlength => 60), "
\n", submit("Last Name Search"), "\n", end_form, "\n"; print "
\n", # "Search by location:

\n"; # print start_form(-method => "GET", # -action => $url), # scrolling_list(-name => "location", # -values => \@location, # -size => 5, # -multiple => "true"), # "
\n", # submit("Location Search"), "\n", # end_form, "\n"; # print "

\"spacer\"\n"; # print " \"spacer\"\n"; # print "
\n"; print "
\n"; } #------------------------------------------------------------------------------ # print_field # # Print a field. #------------------------------------------------------------------------------ sub print_field { my ($field, $terminator) = @_; if ($field) { my $str = encode_entities($field); $str =~ s/\s/ /g; print $str; if ($terminator) { print $terminator; } } } #------------------------------------------------------------------------------ # print_names # # Print a list of names. #------------------------------------------------------------------------------ sub print_names { my @members = @_; return unless @members; print "
\n"; print "\n"; foreach my $member (@members) { #---------------------------------------------------------------------- # Start this row. #---------------------------------------------------------------------- print "\n", "\n", "\n", "\n"; #---------------------------------------------------------------------- # End the row. #---------------------------------------------------------------------- print "\n"; } print "\n", "
\n"; #---------------------------------------------------------------------- # Print the name. #---------------------------------------------------------------------- print ""; print_field($member->{"First"}," "); print_field($member->{"Last"}," "); print_field($member->{"Propername"}); print "
"; print_field($member->{"Deceased"}); print "

\n"; #---------------------------------------------------------------------- # Print the Spouse name #---------------------------------------------------------------------- # print "Spouse: "; # print_field($member->{"Spouse"}, "
\n"); # print "
"; if ($member->{"Spouse"}) { my $spouse = $member->{"Spouse"}; print "Spouse: "; print_field($member->{"Spouse"}); } print "
"; #---------------------------------------------------------------------- # Print the address. #---------------------------------------------------------------------- print_field($member->{"Address 1"}, "
\n"); # print_field($member->{"Address 2"}, "
\n"); # print_field($member->{"Address 3"}, "
\n"); print_field($member->{"City"}, " "); print_field($member->{"Company"}, " "); print_field($member->{"Zip"}, "
\n"); # print "E-mail: "; # print_field($member->{"State"}, "
\n"); #---------------------------------------------------------------------- # Print the phone numbers. #---------------------------------------------------------------------- if ($member->{"Phone"}) { print "Phone:\n"; print_field($member->{"Phone"}, "
\n"); } if ($member->{"Phone2"}) { print "Phone:\n"; print_field($member->{"Phone2"}, "
\n"); } # print_field($member->{"Fax"}, " (fax)
\n"); #---------------------------------------------------------------------- # Print the DOB. #---------------------------------------------------------------------- if ($member->{"DOB"}) { print "DOB:\n"; print_field($member->{"DOB"}, "
\n"); } #---------------------------------------------------------------------- # Print the email address. #---------------------------------------------------------------------- if ($member->{"Email"}) { my $email = $member->{"Email"}; print "
Classmate E-mail link.
\n"; } else { print "
\n"; } #---------------------------------------------------------------------- # Print the email2 address. #---------------------------------------------------------------------- if ($member->{"Email2"}) { my $email = $member->{"Email2"}; print "Classmate E-mail link.
\n"; } #---------------------------------------------------------------------- # Print the web site. #---------------------------------------------------------------------- if ($member->{"Website"}) { my $link = $member->{"Website"}; if ($link !~ m!^[^:]+://!) { $link = "http://$link"; } print "$link
\n"; } #print_field($member->{"Record"}, "
\n"); #---------------------------------------------------------------------- # Print the picture. #---------------------------------------------------------------------- print "
\n"; if ($member->{"Pix"}) { my $pix = $member->{"Pix"}; print "\n"; } if ($member->{"Pix2"}) { my $pix2 = $member->{"Pix2"}; print "\n"; } #---------------------------------------------------------------------- # Print the profile. #---------------------------------------------------------------------- if (defined($member->{"Profile"})) { print "
", encode_entities($member->{"Profile"}); } else { print " "; } print "

\n"; } #------------------------------------------------------------------------------ # print_search_results # # Print the results of a search if one was requested. #------------------------------------------------------------------------------ sub print_search_results { my @members = @_; my $last = param("last"); my $first = param("first"); my @location = param("location"); my $company = param("company"); #-------------------------------------------------------------------------- # Check for a search by last or first name. #-------------------------------------------------------------------------- if ($last) { my @matches = grep {$_->{"Last"} && $_->{"Last"} =~ /^$last/io} @members; @matches = sort {uc($a->{"Last"}) cmp uc($b->{"Last"})} @matches; print_names(@matches); } elsif ($first) { my @matches = grep {$_->{"First"} && $_->{"First"} =~ /^$first/io} @members; @matches = sort {uc($a->{"First"}) cmp uc($b->{"First"})} @matches; print_names(@matches); } #-------------------------------------------------------------------------- # Check for a search by location. #-------------------------------------------------------------------------- elsif (@location) { my @loc2 = map {[split(/ - /, uc($_))]} @location; my @matches; foreach my $member (@members) { foreach my $loc (@loc2) { my $country = $loc->[0]; my $state = $loc->[1]; if ($state) { if ($member->{"State"} && uc($member->{"State"}) eq $state) { push @matches, $member; last; } } elsif ($country) { if ($member->{"Country"} && uc($member->{"Country"}) eq $country) { push @matches, $member; last; } } } } @matches = sort {uc($a->{"Last"}) cmp uc($b->{"Last"})} @matches; print_names(@matches); } #-------------------------------------------------------------------------- # Check for a search by company name. #-------------------------------------------------------------------------- elsif ($company) { my @words = map {quotemeta lc $_} split(" ", $company); my @matches; foreach my $member (@members) { my $word_count = 0; my $member_company = lc $member->{"Company"}; foreach my $word (@words) { if ($member_company =~ /\b$word/) { ++$word_count; } } if ($word_count == @words) { push @matches, $member; } } @matches = sort {uc($a->{"Last"}) cmp uc($b->{"Last"})} @matches; print_names(@matches); } } #------------------------------------------------------------------------------ # # Main program starts here. # #------------------------------------------------------------------------------ print header; include_file($html_header); my @members = parse_member_list($member_list); if (@members) { print_search_form(@members); print_search_results(@members); } else { print "ERROR: No members found
\n"; } include_file($html_footer);