luke devon wrote:
Hi,
Hello,
I am using perl script to handle some function of squid redirector
program . Actually its working fine. But after some time , that
functions goes off. That's meant
VALUE-A doesnt comes in to the request.
I checked the DB , it also fine.
CPU also nothing
Can some body help me please ?
#!/usr/bin/perl
use DBI;
use strict;
use warnings;
# no buffered output, auto flush
$|=1;
my ($dbh,$sth,$dbargs,$VALUE-A,$VALUE-B,$query);
$dbh = DBI->connect("dbi:mysql:List;localhost","root","") || "Error Opening
DataBase: $DBI::errstr\n";
If DBI->connect() fails you are storing the string "Error Opening
DataBase: $DBI::errstr\n" in the $dbh variable but you never display
that string.
my $dbh = DBI->connect("dbi:mysql:List;localhost","root","") or die
"Error Opening DataBase: $DBI::errstr\n";
if (!$dbh->err()) {
If DBI->connect() fails then $dbh will not contain a valid DBI object
but a string which doesn't have an err() method.
while (<STDIN>) {
chomp;
my ($url, $x, $ip) = split(/ /);
Probably better written as:
while ( <STDIN> ) {
my ( $url, $x, $ip ) = split;
$ip = substr($ip, 0, (length($ip)-2));
Instead of copying the string $ip just modify it in place:
substr $ip, -2, 2, '';
$query = "SELECT * from ACCOUNT where someField = '" . $ip ."' order by
xxx_yyy desc";
$sth = $dbh->prepare($query);
$sth->execute();
if (my $ref = $sth->fetchrow_hashref()) {
$VALUE-A = $ref->{'CallingStationId'};
$VALUE-B = $ref->{'AcctSessionId'};
}else{
$VALUE-A = "NA";
}
if (!($url =~ m#xxxyyyy#)) {
Or perhaps:
if ( $url !~ /xxxyyyy/ ) {
if ($url =~ m#\?#) {
$url .= "&xxxyyyy=" . $VALUE-A . "-" . $ip . "-" . $VALUE-B;
} else {
$url .= "?xxxyyyy=" . $VALUE-A . "-" . $ip . "-" . $VALUE-B;
}
print $url."\n";
} else {
print "\n";
}
}
}else {
print "\n";
}
$sth->finish();
$dbh->commit();
$dbh->disconnect();
If DBI->connect() fails then $dbh will not contain a valid DBI object
but a string which doesn't have a commit() or a disconnect() method.
John
--
Perl isn't a toolbox, but a small machine shop where you
can special-order certain sorts of tools at low cost and
in short order. -- Larry Wall
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
http://learn.perl.org/
