In article
<[EMAIL PROTECTED]>,
[EMAIL PROTECTED] (Ilya Sterin) wrote:
> Well post the script and we can look. Please eliminate the parts that are
> not relevant if you script is big.
it's about 255 lines of code incuding comments.. I'll remove the
comments from the file to shorten it a bit. The linewrapping will suck
but I'll try and clean it up a bit.
it's *considerably* streamlined from my first hackish attempts at
writing cgi scripts and from working with the original CSV/Tab-delimited
tables using DBD::CSV and more recently DBD::AnyData. I'm damned proud
of how far I've come in the year since I started working with Perl, and
situations like this just <gross understatement>annoy me</gross
understatement>.
Your help will be most greatly appreciated.
I'm starting to wonder how much of a threat to Perl the PHP crowd really
is, and how much of a resource hog mod_perl is compared with the
embedded PHP in Apache, and why, if PHP is based on Perl, there could be
such a huge disparity in performance.
> These benchmarks are a bunch of crap. There are 900 times more bytes
> transfered. The files look way to much different in sizes. So we are yet
> to see an exact comparison:-)
definitely. I *KNOW* how hard I've worked on streamlining this code, and
I'll be damned if someone can hack together a php script that does
things in half the time, and with fewer memory resources used, much less
what that so-called-benchmark shows.
the code:
#!/usr/bin/perl -T
#### search.cgi
use warnings;
use strict;
use CGI qw/:standard :html3 *table *div *form
-no_xhtml escapeHTML unescapeHTML/;
# do these get left out if you use CGI->compile(':all')
# and in particular with mod_perl and Apache::DBI?
# security sanity check.
$CGI::POST_MAX = 1024 * 16; # max 16k POSTs
$CGI::DISABLE_UPLOADS++; # no uploads
$ENV{'PATH'} = '/bin:/usr/bin:';
delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};
use CGI::Carp qw(fatalsToBrowser set_message);
BEGIN {
sub handle_errors {
my $msg = join( br(), @_);
print header,
start_html( "CGI/Perl Script Error" ),
h2( "aCk!"),
p( "I must be currently beta-testing some changes, so
E-mail me, ",
a({-href=>'mailto:[EMAIL PROTECTED]'},
"fuzzbuster"),
", about this if it persists for very long.",
),
hr,
p( "Got an error: $msg" ),
end_html;
}
set_message(\&handle_errors);
};
use DBI;
my $dbiuser = 'nalicity';
my $dbipass = 'password';
my $map_db = 'maps';
my $download_url = 'http://www.planetunreal.com/dl/nc.asp?nalicity/';
my @types = (qw/empty unknown unknown unknown unknown unknown utdm
utassault utdomination utctf utother/);
my $newStyle = <<'EOS';
table, caption, th, td { background: #1E2B4A; font-family: "Trebuchet
MS", "Sapir Sans", sans-serif; font-size: 12pt; }
body { font-family: "Trebuchet MS", "Sapir Sans",
sans-serif; font-size: 12pt; }
EOS
my %files_list = (
'7' => 'UT Assault Maps',
'9' => 'UT Capture The Flag Maps',
'6' => 'UT DeathMatch Maps',
'8' => 'UT Domination maps',
'10' => 'UT Other Maps'
);
sub size_calc ($)
{
my $mapsize = shift;
($mapsize <= 1024)
? return $mapsize . "k"
: return sprintf('%.2f', ($mapsize/1024)) . "MB";
};
sub checkrating ($$$)
{
my($rating, $reviewfile, $id) = @_;
if ( $rating == -1 )
{
return "N/A";
}
else
{
if ($reviewfile eq "-1")
{
return
a({-href=>"http://nalicity.beyondunreal.com/testbed/review.php?Id=${id}";,
-target=>"review"},
b($rating),
);
}
else
{
return
a({-href=>"http://nalicity.beyondunreal.com/testbed/reviews/${reviewfile}
.html", -target=>"review"},
b($rating),
);
}
}
};
sub create_dbi_table ($)
{
my $displayselect = shift;
my $dbh = DBI->connect("DBI:mysql:database=nalicity;host=localhost",
$dbiuser, $dbipass, {RaiseError => 1})
or die("Cannot connect to database - $!");
END { $dbh->disconnect if $dbh }
my $sth = $dbh->prepare($displayselect) or die $dbh->errstr;
$sth->execute;
my $rowcount = $sth->rows;
unless( $rowcount )
{
print Tr( td({-colspan=>3, -align=>'center', }, b("No Match
Found") ));
return '';
}
print Tr( td({-colspan=>3, -align=>'center', }, b("Found $rowcount
matches") ));
my( $type, $id, $filename, $title, $size, $reviewfile, $rating,
$rated, $oldtype );
$sth->bind_columns(\$type, \$id, \$filename, \$title, \$size,
\$reviewfile, \$rating);
while ( $sth->fetch )
{
# in english: If oldrating is empty, or different from the
# previous rating AND the rating is now < 0
if ( !defined($rated) or ($rated != $rating and $rating < 0) )
{
# then check to see whether we're rated or unrated and print
# an appropriate header for that section
if ($rating < 0)
{
print Tr( td({-colspan=>3, -align=>'center', }, b(
u("Unrated Maps")) )),
Tr(
th({-align=>"center"}, "Map Name"),
th({-align=>"right"}, "Size"),
th({-align=>"center"}, "Rating"),
);
$oldtype = -1; #re-set oldtype ;)
}
else
{
print Tr( td({-colspan=>3, -align=>'center', }, b(
u("Rated Maps")) )),
Tr(
th({-align=>"center"}, "Map Name"),
th({-align=>"right"}, "Size"),
th({-align=>"center"}, "Rating"),
);
};
};
# okay so we have nice section headers..
# how about some type section headers for the unrated section?
if ( $rating == -1 and $type != $oldtype )
{
print Tr( td({-colspan=>3, -align=>'center'},
$files_list{$type} ) );
}
$filename= unescapeHTML($filename);
print Tr(
td({-align=>"left", -valign=>"top"},
a({-href=>"${download_url}$types[${type}]/${filename}.zip",
-target=>"_new"}, $title ),
),
td({-align=>"right", -valign=>"top"},
size_calc($size),
),
td({-align=>"center", -valign=>"top",},
checkrating($rating, $reviewfile, $id),
),
), "\n";
# adjust loop vars for prettyprint
$rated = $rating;
$oldtype = $type;
};
die $sth->errstr if $sth->err;
}
my $search_obj = escapeHTML( param('searchfor') ) || '';
# un-taint the search object
$search_obj =~ m/([ a-zA-Z-_\[\]\{\}0-9]+)/;
$search_obj = $1;
if (!param() && cgi_error()) {
print header(-status=>cgi_error());
goto FINISH;# don't call exit 0; !!! (unless you LIKE killing your
perl process over and over, ass-hat) :P
}
my $expires = (localtime(time + 30));
print header({'head'=>meta( {-http_equiv=>'Expires', -content=>$expires
} )}),
start_html({-Title=>"FuzzBuster's NaliCity Quick Search!",
-Style=>{-Code=>$newStyle},
-bgcolor=>'#003366',
-text=>'white',
-"link"=>'#ffff99',
-vlink=>'yellow'});
print start_form,
div({-align=>'center'},
h3("Map Search"),
p("Enter the name of a map title or file to search for:"),
textfield(-name=>'searchfor',
-default=>'',
-size=>30,
-maxlength=>68,
-override=>1),
br,
submit(-name=>'Submit', -value=>'Submit'),
),
end_form, hr;
if ( $search_obj eq '' )
{
# skip the database query
print end_html;
goto FINISH;
}
my $query = "SELECT Type, ID, FileName, Title, Size, ReviewFile,
ROUND(Rating, 2)
FROM $map_db
WHERE FileName LIKE '%$search_obj%' OR Title LIKE
'%$search_obj%'
ORDER BY Rating DESC, Type, FileName";
print start_div({-align=>"center"}),
start_table({-border=>"0", -cellpadding=>"0", -cellspacing=>"2",
-width=>"300"});
create_dbi_table($query);
print end_table,
end_div,
hr,
end_html;
FINISH:
# end of code
If anyone is interested I can provide particulars on the maps table in
the MySQL database as well.
--
Scott R. Godin | e-mail : [EMAIL PROTECTED]
Laughing Dragon Services | web : http://www.webdragon.net/
