#!/usr/bin/perl ############################################################################### local $SIG{__DIE__} = sub { my $msg = shift; print "

ERROR: $msg

\n"; }; #local $SIG{__WARN__} = sub { my $msg = shift; print "

WARNING: $msg

\n"; }; #require "/home/httpd/cgi-bin/renice.pl"; require "/var/www/www.letterville.com/htdocs/cgi/cgi-lib.pl"; require "/var/www/www.letterville.com/htdocs/cgi/dbutil.cgi"; require "/var/www/www.letterville.com/htdocs/cgi/utils.cgi"; require "/var/www/www.letterville.com/htdocs/cgi/lists.cgi"; require "/var/www/www.letterville.com/htdocs/cgi/counter.cgi"; ($countAll, $countUniq, $exclAll, $exclUniq) = Count(); @Countries = LoadFile( 'data/countries.cgi' ); # List of Countries and their Abbreviations foreach( @Countries ) { my( $code, $label ) = split( ':', $_, 2 ); $Countries{$code} = $label; # Build a mapping hash from code to label } @Cats = LoadFile( 'data/cats.cgi' ); # List of Categories and their codes foreach( @Cats ) { my( $code, $name ) = split( ':', $_, 2 ); $Cats{$code} = $name; # Build a mapping hash from code to name } ############################################################################### my $PageSize = 15; my $location = 'Location'; my $cats = 'Cats'; $ext = ".sup"; $Title = 'Letterhead Suppliers Around the World'; $ImgBack = "images/logos/head2.gif"; my $Ad = < 
SignGold - 27.9KB jpg

 
EOF $Ad = ""; # Remove SignGold for now. ############################################################################### $query = $ENV{QUERY_STRING}; # All after the query character - '?' $this = $ENV{SCRIPT_NAME}; # Includes path from $droot with leading slash $www = $ENV{REMOTE_ADDR}; &ReadParse(); # Get form data into %in hash ############################################################################### #$focus = qq( OnLoad="document.Search[1].focus()"); $db = MyOpenDb( $suppliers ); $total = $db->{totrec}; # Use this before $Title in

tag below print < $Title EOF $loc = MyOpenDb( $location ); unless( $loc ) { print "

Couldn't open Location list

\n"; } $cat = MyOpenDb( $cats ); unless( $cat ) { print "

Couldn't open Categories list

\n"; } GetInd( 'ID' ); # Main mapping hash as %map ############################################################################### if( $in{Shop} ) # Specific shop was selected from the list { DisplayShop(); print < Back to the Previous Page EOF } else { print <
Sign Up Supplier Please Select/Type Any/All of the following Criteria and select "Search Now..." button.
\n"; if( $in{Country} ) { # Find the full name of the Country my $countryName = $in{Country}; # Default to the country code for( $loc->GoTop(); $loc->ValidPos; $loc->Next() ) { my %Rec = $loc->GetFieldsHash( 'Type', 'ID', 'Label' ); # Select clause if( $Rec{Type} eq 'ALL' && $Rec{ID} eq $in{Country} ) # Where clause { $countryName = $Rec{Label}; last; } } print < EOF if( $in{Country} eq 'USA' ) { BuildLocation( 'USA' ); } elsif( $in{Country} eq 'CAN' ) { BuildLocation( 'CAN' ); } elsif( $in{Country} eq 'AUS' ) { BuildLocation( 'AUS' ); } else { print < EOF } print < EOF } else { BuildLocation( 'ALL' ); } if( !exists $in{Date} || $in{Date} ) # Default to showing them, Date=0 will turn them off { $joinedEntries = < Joined: $joinedEntries                  
Category:
Country:
 $countryName
Restart Searching - Clear
Region: Can be Partial or Full Region name
City: Can be Partial or Full City name
after before YYMMDD EOF } else { $joinedEntries = ""; } print < Name: Matches Supplier Name, Contact Name, Email (type at least 2 chars)
EOF DisplayTable( BuildList() ); } $loc->Close(); $cat->Close(); DisplayFooter(); ############################################################################### sub BuildLocation { my $type = shift; my $name = ($type eq 'ALL') ? 'Country' : 'State'; for( $loc->GoTop(); $loc->ValidPos; $loc->Next() ) { my %Rec = $loc->GetFieldsHash( 'Type', 'ID', 'Label' ); # Select clause if( $Rec{Type} eq $type ) # Where clause { if( $Rec{ID} eq '_' ) # Label for the list (first entry for Type) { print "$Rec{Label}:\n"; } ############################################################################### sub DisplayFooter { print <

[ Main Page | New Supplier Registration | Bulletin Board | Events | Advertising ]

$Ad
Copyright © 1997 Letterville.com The Letterhead Webiste

 CGI and Database Programming in Perl5 by Piotr Pytlik; Copyright © 1997, Double P Software

EOF } ############################################################################### sub BuildList { GetInd( 'Country' ); my @list; if( $in{Country} ) # Start with the list of matches for Country { @list = @{$Indexes{Country}{$in{Country}}}; } else # If no country selected then start with ALL entries { for( keys %{$Indexes{Country}} ) { #@list = ListOr( \@list, \@{$Indexes{Country}{$_}} ); } } if( $in{Cat} && $in{Cat} ne "00" ) # But if Searching, narrow it down based on matching names { my @listCat = (); GetInd( 'Cat' ); foreach $key ( keys %{$Indexes{Cat}} ) { if( $key =~ /$in{Cat}/i ) # Case insensitive pattern search { @listCat = ListOr( \@listCat, \@{$Indexes{Cat}{$key}} ); } } @list = @list > 0 ? ListAnd( \@list, \@listCat ) : @listCat; } if( $in{State} ) # But if Searching, narrow it down based on matching names { my @listState = (); GetInd( 'State' ); foreach $key ( keys %{$Indexes{State}} ) { if( $key =~ /$in{State}/i ) # Case insensitive pattern search { @listState = ListOr( \@listState, \@{$Indexes{State}{$key}} ); } } @list = @list > 0 ? ListAnd( \@list, \@listState ) : @listState; } if( $in{City} ) # Allow to type a query string to match the city { my @listCity = (); GetInd( 'City' ); foreach $key ( sort keys %{$Indexes{City}} ) { if( $key =~ /$in{City}/i ) # Case insensitive pattern search { @listCity = ListOr( \@listCity, \@{$Indexes{City}{$key}} ); } } @list = @list > 0 ? ListAnd( \@list, \@listCity ) : @listCity; } if( $in{Find} ) # But if Searching, narrow it down based on matching names { my @listFound = (); foreach $index ( qw( Name FName LName Email ) ) # Search those fields { GetInd( $index ); foreach $key ( sort keys %{$Indexes{$index}} ) { foreach $word ( split( ' ', $in{Find} ) ) # Search for each word provided separately { if( $key =~ /$word/i ) # Case insensitive pattern search { @listFound = ListOr( \@listFound, \@{$Indexes{$index}{$key}} ); } } } } @list = @list > 0 ? ListAnd( \@list, \@listFound ) : @listFound; } if( $in{After} || $in{Before} ) # If requested a limit on date range then narrow the list even further { my @listDate = (); GetInd( 'Joined' ); $in{After} += 19000000 if $in{After} && $in{After} < 1000000; # Dates in database use full year as 1997 $in{Before} += 19000000 if $in{Before} && $in{Before} < 1000000; # And then month and day as two-digit each for( keys %{$Indexes{Joined}} ) { next if( $in{After} && int($_) < int($in{After}) ); # If requested After but date is before then skip next if( $in{Before} && int($_) > int($in{Before}) ); # If requested Before but date is after then skip @listDate = ListOr( \@listDate, \@{$Indexes{Joined}{$_}} ); } @list = @list > 0 ? ListAnd( \@list, \@listDate ) : @listDate; } return @list; } ############################################################################### sub DisplayTable { my @list = @_; # Passes the list of Shop IDs to display return unless $db; print "
\n"; # Now process some page handling, multiple pages can be navigated to with this technique. my $Total = @list; my $Pages = int( ($Total + $PageSize - 1) / $PageSize ); my $Page = $in{Page} || 1; $query =~ s/&Page=(\d*|all)//; # Remove the old page parameter from query so it can be re-added below safely. my $from = ($in{Page} - 1) * $PageSize + 1; $from = 1 if $from < 1; my $to = $from + $PageSize - 1; $to = $Total if $to > $Total; my $nav; if( $Page > 1 ) { $nav .= qq(|< First Page | ); my $prev = $Page - 1; $nav .= qq(<< Previous Page); } $nav .= " [Page $Page of $Pages] " if( $Pages > 1 ); if( $Page < $Pages ) { $nav .= ' | ' if $nav; my $next = $Page + 1; $nav .= qq(Next Page >> | ); $nav .= qq(Last Page >|); } $nav .= qq( | All Pages) if( $Pages > 1 ); if( $in{Page} =~ /^all$/i ) # Selecting All pages overrides all calculations. { $nav = ""; $from = 1; $to = $Total; } if( $Total > 0 ) { print <Found a total of $Total matching entries ($Pages page[s] - $PageSize entries each)
$nav

EOF } my $nr = 0; foreach $shop ( @list ) # And now display all matching entries within this page's range. { next if( ++$nr < $from ); last if( $nr > $to ); print < # Shop Name www Contact Name Phone City / Country EOF $db->GoTo( $map{$shop} ); my %Rec = $db->GetFieldsHash( qw( URL Company FName LName Phone City Country) ); my $url = $Rec{'URL'} ? 'web' : ' '; my $shopname = $Rec{Company} || "[$Rec{FName} $Rec{LName}]"; print <$nr $shopname $url $Rec{'FName'} $Rec{'LName'} $Rec{'Phone'} $Rec{'City'} $Rec{'Country'} EOF } print "\n" if $nr; if( $nav ) { print "

$nav

\n"; } print "
\n"; $db->Close(); } ############################################################################### sub DisplayShop { unless( exists $map{$in{Shop}} ) { print <

Sorry, there is no Supplier with ID = $in{Shop}!

Please Try Again

EOF return; } return unless $db; $db->GoTo( $map{$in{Shop}} ); my %Rec = $db->GetFieldsHash(); my $update = qq(PLEASE UPDATE IT); my $email = $Rec{'Email'}; if( $email && $email ne 'NONE' ) { if( $email =~ s/^!\s*(.*)/$1/ ) { $email = "$1 THIS EMAIL BOUNCED $update"; } else { $email = "$email"; } } else { $email = "EMAIL IS MISSING $update"; } my $url = $Rec{'URL'}; if( $url ) { $url =~ s|^http://||; # Prevent duplicate http:// prefix on old entries. $url = "$url"; } $Rec{Info} =~ s/\n/
/g; my $shopname = $Rec{'Company'} || "[$Rec{FName} $Rec{LName}]"; print < $Title

$shopname

EOF print < EOF print < EOF print < EOF print < EOF print < EOF my $cats; my $countcats = 0; if( length( $Rec{'Cats'} ) ) { foreach( split( '', $Rec{'Cats'} ) ) # Stored as string of single characters { $_ = unpack( "H2", $_ ); next if $_ eq '00'; $cats .= "$Cats{$_}
\n"; $countcats += 1; } } if( $countcats > 1 ) { print <\n\n"; if( length( $Rec{'Info'} ) > 0 ) { $_ = $Rec{'Info'}; s#((http|mailto|ftp|news):[^\s\<]+)#$1#; print < EOF } print < 0; EOF print < EOF print <
Contact:

$Rec{'FName'} $Rec{'LName'}
Email:

$email
Web Page:

$url
Phone:

$Rec{'Phone'}
Toll Free Phone:

$Rec{'TollFree'}
Fax: $Rec{'Fax'}
 
Address: $Rec{'Address'}
City, State, ZIP: $Rec{'City'}, $Rec{'State'}, $Rec{'Zip'}
Country:

$Countries{$Rec{'Country'}}
 
Categories selected for this business:
$cats EOF } elsif( $countcats == 1 ) { print "
Business Category:$cats"; } print "
 
Business Description:
$_
We offer Letterhead Website Members a $Rec{'Discount'}% discount.
Ad Message: $Rec{'AdMsg'}
 
Member Since: $Rec{'Joined'}
EOF $db->Close(); } ############################################################################### # Formats the data from any field with the type 'D' = Date sub TypeMap_D { my( $yyyy, $mm, $dd ) = unpack( 'A4A2A2', $_[0] ); $mm = (Jan,Feb,Mar,Apr,May,Jun,Jul,Aug,Sep,Oct,Nov,Dec)[$mm-1]; return "$dd-$mm-$yyyy"; } ############################################################################### sub FieldMap_Phone { my $phone = shift; return $phone; $phone =~ s/\D//g; $phone = "519$phone" if( length( $phone ) == 7 ); return "(".substr($phone,0,3).") ".substr($phone,3,3)."-".substr($phone,6,4) if $phone; } ############################################################################### sub MyOpenDb { my $name = shift; my $db = new Pdb( 'data' ); if( $db->Open( $name ) ) { if( $name eq 'Suppliers' ) { $db->{TypeMap}{D} = "main::TypeMap_D"; $db->{FieldMap}{Phone} = "main::FieldMap_Phone"; $db->{FieldMap}{Fax} = "main::FieldMap_Phone"; } return $db; } else { return undef; } } ###############################################################################