Gossamer Forum
Home : General : Perl Programming :

Spot the error :-)

Quote Reply
Spot the error :-)
Hi All

Why do I have the following error on the following block? I can't see where I'm going wrong!

Code:
while( my ($url, $id, $name) = $sth->fetchrow_array ) {
$info{$url} = [$id, $name];
my $req = HTTP::Request->new(HEAD => $url); # line 84.
$req->header(Range => "bytes=0-0");
$ua->register($req, $endcon);
}
$dbh->disconnect;
$ua->wait;

$num_dead = $count;

if( !$count ) {
error_html("No dead links found!");
exit;
}

parse_template("$PATH_TEMPLATE/check_links_results.tmpl");

} # line 99.

syntax error at /.../odb_chklinks.pl line 84, near "my "
syntax error at /.../odb_chklinks.pl line 99, near "}"

- wil
Quote Reply
Re: [Wil] Spot the error :-) In reply to
What is the full subroutine?....errors can say they are on a certain line but it can be further up in the code where the actual error is.
Quote Reply
Re: [RedRum] Spot the error :-) In reply to
I'm optimizing my link checker .. here's the full sub.

Code:
BEGIN{ eval { require warnings; import warnings }; $^W = 1 }

use LWP::Parallel::UserAgent qw(:CALLBACK);

use constant FAIL_MESSAGE => <<MESSAGE;
<table width="95%" border="0" cellspacing="0" cellpadding="2">
<tr>
<td width="2%" align="middle">&nbsp;</td>
<td width="6%" bgcolor="#EEEECC"align="right" valign="top">
<font face="Arial, Helvetica, sans-serif" size="2">%s</font>&nbsp;</td>
<td width="58%" bgcolor="#E9EBEF">&nbsp;<font face="Arial, Helvetica, sans-serif" size="2">%s</font></td>
<td width="20%" bgcolor="#FFDDDD">&nbsp;<font face="Arial, Helvetica, sans-serif" size="2">%s</font></td>
<td width="14%" bgcolor="#EEEECC" valign="top" align="center">
<a href="odb.cgi?action=edit_record&id=%s"><img src="/images/icons/edit.gif" width="15" height="15" alt="[ edit ]" border="0">
</a>&nbsp;<a href="odb.cgi?action=del_record&id=%s" onClick="return confirm('Delete record %s?')">
<img src="/images/icons/delete.gif" width="15" height="15" alt="[ delete ]" border="0">
</a>&nbsp;<a href="odb.cgi?action=toggle_live&id=%s"><img src="/images/icons/live%s.gif" border="0"></a>
</td>
</tr>
/table>
<BR>
MESSAGE

#$ref->{id}, $ref->{'name_en'}, "$res_code : $res_msg", $ref->{'id'},
#$ref->{'id'}, $ref->{'id'}, $ref->{'id'}, ($live ? "yes" : "no")

sub check_links_results {

print $query->header;

my $ua = LWP::Parallel::UserAgent->new;
$ua->nonblock(1) if $ua->can("nonblock");
$ua->agent("OpticDB LinkCheck/0.1");
$ua->remember_failures();
my $dbh = connect_to_db();

my $sth = $dbh->prepare(qq[SELECT url_en, id, name_end FROM $DB_MYSQL_NAME]);
$sth->execute();

my ($count, %info) = 0;
my $endcon = sub { return C_ENDCON };
local *LPW::Parallel::UserAgent::on_return = sub {
my ($self, $req, $res, $entry) = @_;
$self->discard_entry($req);
my $code = $res->code();
return if $code >= 100 && $code < 400; # success!
if( $req->method() eq "HEAD" and
$code != 404 and substr($code,0,1) != 5 ) {
$req->method("GET");
$self->register($req, $endcon);
return;
}
++$count;
my ($id, $name) = @{ $info{ $req->url } };
$tmpl_show_record .= sprintf FAIL_MESSAGE,
$id, $name, "$code " . $res->message(),
($id) x 4, ($data_status eq "Live" ? "yes" : "no");
}
while( my ($url, $id, $name) = $sth->fetchrow_array ) {
$info{$url} = [$id, $name];
my $req = HTTP::Request->new(HEAD => $url);
$req->header(Range => "bytes=0-0");
$ua->register($req, $endcon);
}
$dbh->disconnect;
$ua->wait;

$num_dead = $count;

if( !$count ) {
error_html("No dead links found!");
exit;
}

parse_template("$PATH_TEMPLATE/check_links_results.tmpl");
}

- wil
Quote Reply
Re: [Wil] Spot the error :-) In reply to
Here's one:

local *LPW::Parallel::UserAgent::on_return
Quote Reply
Re: [RedRum] Spot the error :-) In reply to
Yep. What about the my business, though?

- wil
Quote Reply
Re: [Wil] Spot the error :-) In reply to
I'm convinced the problem is with this line:

Code:
$info{$url} = [$id, $name];

As anything I do after that, it just complains of syntax errors.

What's wrong wtih the above?

- wil
Quote Reply
Re: [Wil] Spot the error :-) In reply to
ah

Try:

@{$info{$url}} = [$id, $name];
Quote Reply
Re: [RedRum] Spot the error :-) In reply to
Hm.

Same errror. So strange; ...

- wil
Quote Reply
Re: [Wil] Spot the error :-) In reply to
How about:
Code:
};
while( my ($url, $id, $name) = $sth->fetchrow_array ) {

--Philip
Links 2.0 moderator
Quote Reply
Re: [King Junko II] Spot the error :-) In reply to
Damn can't believe I missed that....maybe I do need glasses.

Yeah anonymous subrefs need a ;
Quote Reply
Re: [King Junko II] Spot the error :-) In reply to
Thanks! That did the trick!

- wil