I
it_says_BALLS_on_your forehead
It seems that something about the way the Perl profiler gathers
information from my script is breaking my code. The errors are
inconsistent, both in type, and location.:
bash-3.00$ alias
alias prof='perl -d
Prof'
alias tmon='dprofpp'
bash-3.00$
bash-3.00$ prof fork_titan.pl
Not a CODE reference at /export/home/a352626/titanapp/bin/fork_tools.pl
line 17, <$fh> line 755.
total processing time: 0.745739
## here is fork_tools.pl line 17
my $parsed_sHdr = parse_header( $shdr_ref, 'sHdr' );
....
sub parse_header {
my ( $header, $source ) = @_;
my $hdr = $$header;
# I think this may be the culprit, but why did it work without the
profiler
# and why does it die at different lines?
$hdr =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
...
# Success!! without Profiler
bash-3.00$ fork_titan.pl
total processing time: 173.586135
bash-3.00$ prof fork_titan.pl
Argument "main::get_facs" isn't numeric in subroutine entry at
fork_titan.pl line 66, <$fh> line 762.
Not a CODE reference at fork_titan.pl line 66, <$fh> line 762.
total processing time: 0.748186
## here is line 66
my $row_facs_ref = get_facs($FAC_FIELD,
$fields[$FAC_FIELD], \%index);
### and the sub
sub get_facs {
my ($field, $hdr, $index) = @_;
my $prefix = $field == $index->{chdr} ? 'CHDR: ' : 'SHDR: ';
if ($prefix eq 'CHDR') {
$hdr = substr($hdr, index($hdr, 'Cookie:%20'), index($hdr,
'%0d%0a%0d%0a'));
}
my %token;
# Grab the FC, SC, and MC from the header and store it in a hash
while ($hdr =~ m/(?<=%20)([FSM]C)=(?>([^;%\ ]+))(?:[;%\ ]|$)/g) {
$token{$1} = $2;
}
return \%token;
}
bash-3.00$ prof fork_titan.pl
Argument "main::get_fac_field_source" isn't numeric in subroutine entry
at fork_titan.pl line 63, <$fh> line 764.
Not a CODE reference at fork_titan.pl line 63, <$fh> line 764.
total processing time: 0.766146
bash-3.00$
## line 63
my $FAC_FIELD = get_fac_field_source(\%index,
$fields[$index{'shdr'}], $fields[$index{'chdr'}]);
### sub
sub get_fac_field_source {
my ($index, $sHdr, $cHdr) = @_;
# NOTE: assumption is that there will never be FC's or SC's without
an MC
return $index->{'shdr'} if index( $sHdr, '%20MC=' ) != -1;
return $index->{'chdr'} if index( $cHdr, '%20MC=' ) != -1;
return -1;
}
information from my script is breaking my code. The errors are
inconsistent, both in type, and location.:
bash-3.00$ alias
alias prof='perl -d
alias tmon='dprofpp'
bash-3.00$
bash-3.00$ prof fork_titan.pl
Not a CODE reference at /export/home/a352626/titanapp/bin/fork_tools.pl
line 17, <$fh> line 755.
total processing time: 0.745739
## here is fork_tools.pl line 17
my $parsed_sHdr = parse_header( $shdr_ref, 'sHdr' );
....
sub parse_header {
my ( $header, $source ) = @_;
my $hdr = $$header;
# I think this may be the culprit, but why did it work without the
profiler
# and why does it die at different lines?
$hdr =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
...
# Success!! without Profiler
bash-3.00$ fork_titan.pl
total processing time: 173.586135
bash-3.00$ prof fork_titan.pl
Argument "main::get_facs" isn't numeric in subroutine entry at
fork_titan.pl line 66, <$fh> line 762.
Not a CODE reference at fork_titan.pl line 66, <$fh> line 762.
total processing time: 0.748186
## here is line 66
my $row_facs_ref = get_facs($FAC_FIELD,
$fields[$FAC_FIELD], \%index);
### and the sub
sub get_facs {
my ($field, $hdr, $index) = @_;
my $prefix = $field == $index->{chdr} ? 'CHDR: ' : 'SHDR: ';
if ($prefix eq 'CHDR') {
$hdr = substr($hdr, index($hdr, 'Cookie:%20'), index($hdr,
'%0d%0a%0d%0a'));
}
my %token;
# Grab the FC, SC, and MC from the header and store it in a hash
while ($hdr =~ m/(?<=%20)([FSM]C)=(?>([^;%\ ]+))(?:[;%\ ]|$)/g) {
$token{$1} = $2;
}
return \%token;
}
bash-3.00$ prof fork_titan.pl
Argument "main::get_fac_field_source" isn't numeric in subroutine entry
at fork_titan.pl line 63, <$fh> line 764.
Not a CODE reference at fork_titan.pl line 63, <$fh> line 764.
total processing time: 0.766146
bash-3.00$
## line 63
my $FAC_FIELD = get_fac_field_source(\%index,
$fields[$index{'shdr'}], $fields[$index{'chdr'}]);
### sub
sub get_fac_field_source {
my ($index, $sHdr, $cHdr) = @_;
# NOTE: assumption is that there will never be FC's or SC's without
an MC
return $index->{'shdr'} if index( $sHdr, '%20MC=' ) != -1;
return $index->{'chdr'} if index( $cHdr, '%20MC=' ) != -1;
return -1;
}