I can't seem to figure this out, and I couldn't find anything online. So here is my code:
Type.pm
use constant {
UNABLE_TO_PING_SWITCH_ERROR => {
category => 'Connection Error',
template => "Could not ping switch %s in %s seconds.",
context => [ qw(switch_ip timeout) ],
tt => {template => 'disabled'},
fatal => 1,
wiki_page => 'www.error-fix.com/',
},
};
Error.pm The new method outputs the error message in the format shown in stringify
# Method for creating error message
sub new {
my ( $class, $error, %args ) = @_;
# Initialize error with data
my $self = $error;
# If the error contains context parameters... Insert parameters into string template
if(%args) {
foreach my $key (@{ $self->{context} } ) {
# And take the ones we need
$self->{args}->{$key} = $args{$key};
}
my @template_args = map { $self->{args}->{$_} } @{ $self->{context} };
# map/insert arguments into context hash and insert into string template
$self->{message} = sprintf ($self->{template}, @template_args);
$self->stringify;
}
return bless $self, $class;
}
else { return bless $self, $class; }
}
stringify {
my ($self) = @_;
return sprintf("%s : %s\nMore info: %s", $self->category, $self->message, $self->wiki_page);
}
This is the error I am receiving.
# Failed test 'Return the correct message'
# at t/67_Error.t line 47.
# got: undef
# expected: 'Could not ping switch 192.192.0.0 in 30 seconds.'
Can't call method "category" without a package or object reference at Error.pm line 77.
Line 77 is the return statement inside stringify.
If you need any more info or code let me know.
sub new {
my ( $class, $error, %args ) = @_;
# Initialize error with data
my $self = $error;
# If the error contains context parameters... Insert parameters into string template
if($self eq 'HASH' && %args) {
bless $self, $class;
foreach my $key (@{ $self->{context} } ) {
# bless $self, $class;
# And take the ones we need
$self->{args}->{$key} = $args{$key};
}
my @template_args = map { $self->{args}->{$_} } @{ $self->{context} };
# map/insert arguments into context hash and insert into string template
$self->{message} = sprintf ($self->{template}, @template_args);
my $output = _stringify($self->category, $self->message, $self->wiki_page);
bless $output, $class;
return $output;
}
else { return bless $self, $class; }
}
#!/usr/bin/env perl
use lib ('./t/lib');
use strict;
no strict 'refs';
use warnings;
use ASC::Builder::Error;
use ASC::Builder::Error::Type;
use ASC::Builder::Error::Type 'code';
use Test::More;
use Test::Exception;
use LWP::Simple 'head'; # Used to test if wiki link is giving a response
subtest 'Functionality of Error' => sub {
my $example_error = {
category => 'Connection Error',
template => 'Could not ping switch %s in %s seconds.',
context => [ qw(switch_ip timeout) ],
tt => {template => 'disabled'},
fatal => 1,
wiki_page => 'http://www.error-fix.com',
};
# Correct case
{
my $error = ASC::Builder::Error->new( $example_error, timeout => 30, switch_ip => '192.192.0.0' );
isa_ok ($error, 'ASC::Builder::Error');
can_ok ($error, 'category');
is ($error->category(), 'Connection Error', 'Return the correct category');
can_ok ($error, 'template');
is ($error->template(), 'Could not ping switch %s in %s seconds.', 'Return the correct category');
can_ok ($error, 'tt');
is ($error->tt(), 'disabled', 'Return the correct tt template');
can_ok ($error, 'context');
is_deeply($error->context(), ['switch_ip', 'timeout'], 'Return the correct context params');
can_ok ($error, 'is_fatal');
ok($error->is_fatal(), 'Return the correct value');
can_ok ($error, 'message');
is ($error->message(), 'Could not ping switch 192.192.0.0 in 30 seconds.', 'Return the correct message');
can_ok ($error, 'stringify');
is ($error->stringify(), "Connection Error : Could not ping switch 192.192.0.0 in 30 seconds.\nMore info: http://www.error-fix.com", 'stringify creates the correct message');
};
# Too many arguments (this is okay)
lives_ok( sub { ASC::Builder::Error->new($example_error, timeout => 1, switch_ip => 2, extra => 3 ) }, 'Creating with too many arguments lives. (allows for additional context string to be added in the code)' );
};
subtest 'Correctness of Type.pm' => sub {
# These test cases contain all the errors from Type.pm
my @test_cases = (
{
name => 'UNABLE_TO_PING_SWITCH_ERROR',
args => {
switch_ip => '192.192.0.0',
timeout => 30,
},
message => 'Could not ping switch 192.192.0.0 in 30 seconds.',
},
);
foreach my $t (@test_cases) {
subtest $t->{name} => sub {
no strict 'refs'; # Because we need to use variable to get to a constant
ASC::Builder::Error::Type->import($t->{name});
# Create the Error object from the test data
# Will also fail if the name was not exported by Type.pm
my $error;
lives_ok( sub { $error = ASC::Builder::Error->new( &{ $t->{name} },%{ $t->{args} }) }, 'Error can be created');
# See if it has the right values
is ($error->message, $t->{message}, 'Error message is correct');
# Using LWP::Simple to check if the wiki page link is not broken
#ok head($error->wiki_page); #CANT'T GET THIS TEST TO WORK
}
}
};
done_testing;
It is just a getter.
sub message {
return shift->{message};
}
In short: (1) Keyword sub is missing in front of stringify (2) Once that's resolved we see that an unblessed $self attempts to call methods (3) Finally, there is no method category
(1) The absence of sub keyword triggers behavior that throws off diagnostics. The stringify { ... } is simply called as a class method, formally being passed a hashref. Of course, nothing is right with that hashref and we get the early error, identifying it as bogus. From perldiag
Can't call method "%s" without a package or object reference
(F) You used the syntax of a method call, but the slot filled by the object reference or package name contains an expression that returns a defined value which is neither an object reference nor a package name. Something like this will reproduce the error:
$BADREF = 42;
process $BADREF 1,2,3;
$BADREF->process(1,2,3);
The call $self->stringify has nothing to do with it, and is never executed since this is a fatal error. (The exact error message was different for me under v5.10)
(2) When sub keyword is put in its place, we get to the problem: $self invokes a method before being bless-ed. This was observed by ThisSuitIsBlackNot in a comment as well. Now there is no need for speculation of why that even works but we get the expected error
Can't call method "stringify" on unblessed reference at ErrorPack.pm ...
(3) When we first bless the hashref before calling methods on it, we get
Can't locate object method "category" via package "ErrorPack" at ErrorPack.pm ...
As expected, since $self is now an object and there is indeed no method "category". This is fixed by changing calls in printf so to derefence a hashref, not call methods (by adding curlies). Also noted in the answer by bipll.
I don't know how these changes play along with poster's intentions, but with all that
File ErrorPack.pm
package ErrorPack;
use warnings;
use strict;
# Method for creating error message
sub new {
my ( $class, $error, %args ) = @_;
# Initialize error with data
my $self = $error;
bless $self, $class;
# If the error contains context parameters... [...]
if (%args) {
foreach my $key (@{ $self->{context} } ) {
# And take the ones we need
$self->{args}->{$key} = $args{$key};
}
my @template_args = map { $self->{args}->{$_} } @{ $self->{context} };
# map/insert arguments into context hash and insert into string template
$self->{message} = sprintf ($self->{template}, @template_args);
$self->stringify;
}
return $self;
}
sub stringify {
my ($self) = @_;
return sprintf("%s : %s\nMore info: %s", $self->{category},
$self->{message}, $self->{wiki_page});
}
sub prn { print "$_[0]->{category}\n" }
1;
If there are any reasons to not make $self an object before %args processing, issue bless $self, $class; before the call to stringify
and then return $self;.
The script with main::
use warnings;
use strict;
use ErrorPack;
# Taken from testing code that is now posted
my $err = {
category => 'Connection Error',
template => "Could not ping switch %s in %s seconds.",
context => [ qw(switch_ip timeout) ],
tt => {template => 'disabled'},
fatal => 1,
wiki_page => 'www.error-fix.com/',
};
my $eobj = ErrorPack->new($err, timeout => 30, switch_ip => '192.192.0.0');
$eobj->prn();
This prints a line Connection Error, the $eobj can be directly queried for keys, etc.