Trying to access a hash in a constant list of hashes in perl

Question

Okay so this is my current code which works, but I need to access each error hash in a different way in order to be compatible with other parts of the program. Here is my Error list library: Type.pm

package ASC::Builder::Error::Type;
  use strict;
  use warnings;
  use parent 'Exporter';

  # Export the list of errors
  our @EXPORT_OK = qw/
  UNABLE_TO_PING_SWITCH_ERROR
  /;
  # List of error messages
  use constant code => {

      CABLING_CHECK_TOR_INCORRECT_CABLING_ERROR => {
          category => 'Cabling Error',
          template => "ToR cabling is not correct at T1.The uplinks must be cabled to exactly one t1 device group",
          tt => { template => 'disabled'},
          fatal => 1,
          wiki_page =>'http://www.error-fix.com/',
      },
      UPDATE_IMAGE_ERROR => {
          category => 'Imaging Error',
          template => "Cannot determine switch model",
          tt => { template => 'disabled'},
          fatal => 1,
          wiki_page =>'http://www.error-fix.com/',
      },
      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 => 'http://www.error-fix.com/',
      },
      UNKNOWN_CLIENT_CERT_ID_ERROR => {
          category => 'Services Error',
          template => "Unknown client certificate id: %s",
          context => qw(cert_id),
          tt => { template => 'disabled'},
          fatal => 1,
          wiki_page =>'http://www.error-fix.com/',
      },
  # Add errors to this library
  };
  1;

Here is my Error.pm file. The new method is called for accessing and outputting a new error message and the rest are either getters or are called in the new method.

package ASC::Builder::Error;

  use strict;
  use warnings;
  use parent 'Exporter';
  our @EXPORT_OK = qw/new/;

  # 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( ref $self eq 'HASH' && %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);

      }
      return bless $self, $class;
  }


  # Accessor for category
  sub category {
      return shift->{category};
  }
  # Accessor for message
  sub template {
      return shift->{template};
  }
  # Accessor for context
  sub context {
      return shift->{context};
  }
  # Accessor for template option
  sub tt {
      return shift->{tt}{template};
  }
  # Accessor for fatal
  sub is_fatal {
      return shift->{fatal};
  }
  # Accessor for wiki_page
  sub wiki_page {
      return shift->{wiki_page};
  }
  # Accessor for args. args are a hash ref of context parameters that are
  # passed in as a list at construction
  sub args {
      return shift->{args};
  }
  # Builds the message string from the template. maps the input params from new
  # into context key

  #sub message {
  #    my ($self) = @_;
  #    return sprintf $self->template,
  #             map { $self->args->{$_} } @{ $self->context };
  #}
  sub message {
      return shift->{message};
  }
  # Stringifies the error to a log message (for SB dashboard), including the
  # category, message, and wiki_page.
  sub stringify {
      my $self = @_;
      return sprintf ("%s: %s\nMore info: %s",$self->{category}, $self->{message}, $self->{wiki_page});
  }
  1;

I will also include my test (where I am running this program & testing the error output). This also shows how an error is called. In the systems code it would be called like so:

ASC::Builder:Error->new(UNABLE_TO_PING_SWITCH_ERROR, switch_ip => 192.192.0.0, timeout => 30);

Error.t

#!/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 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( code => $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;

I am trying to change it so that I can call each error something like:

ASC::Builder:Error->new(code => UNABLE_TO_PING_SWITCH_ERROR, switch_ip => 192.192.0.0, timeout => 30);

Answer 1

Your constructor expects that you pass it the following arguments: scalar, hash. The scalar is then used in the code as a hashref

my ($class, $error, %args) = @_;
my $self = $error;
# If the error contains  [...]
if (ref $self eq 'HASH' && %args) 

When you call it with

ASC::Builder:Error->new(UNABLE_TO_PING_SWITCH_ERROR, ...

that is exactly what is happening and all is well. If you want to call it as

ASC::Builder:Error->new(code => UNABLE_TO_PING_SWITCH_ERROR, ...

then you'd be passing a whole hash to it, with an even number of elements. There is no hashref (scalar) first. The constructor as it stands should give you an error about a list with odd number of elements assigned to hash, as it will first take the scalar string 'code' into $error and then attempt to assign the remaining list, UNABLE.., ... to a hash. Alas, that rest now has an odd number of elements what doesn't work for a hash. Remember that (a => 'A', b => 'B') is the same as ('a', 'A', 'b', 'B'), and when a is removed the rest can't be a hash any more.

If you want to call it that way and have the processing in your constructor the same, you'd need to change the constructor to first fetch the value of the key 'code' from the submitted hash (into $error) and remove that element from it, so that the rest can then be assigned to %args, for later processing. Some example code would be

my ($class, %args) = @_;
my $self = delete $args{code};
# Now %args contains what is needed by existing code

The delete removes the element from hash, and returns it.

delete EXPR
Given an expression that specifies an element or slice of a hash, delete deletes the specified elements from that hash so that exists() on that element no longer returns true. Setting a hash element to the undefined value does not remove its key, but deleting it does; see exists.
[...]
In list context, returns the value or values deleted, or the last such element in scalar context.

You can also support both calling conventions, by pre-processing @_ once $class has been shift-ed from it. If it does not contain a hashref first, you do the above (or something like it), otherwise you need not. Your current processing stays as it is. For example

my $class = shift;
my ($self, %args);
if (ref $_[0] eq 'HASH') {
    $self = shift @_;
    %args = @_;
}
else {     
    %args = @_;        
    $self = delete $args{code};     
}

You can add more checking at this point. The above can be done differently, I tried to keep it clear.

Answer 2

In new, this is what you have (from your test):

$error = code; # Scalar or Hash Reference (depending on scope of code constant)
%args = (UNABLE_TO_PING_SWITCH_ERROR, switch_ip => 192.192.0.0, timeout => 30);

Which is not what I think you want to have:

$args{UNABLE_TO_PING_SWITCH_ERROR} = 'switch_ip';
$args{'192.192.0.0'} = 'timeout';
$args{30} = undef;

This should be true even with code and UNABLE_TO_PING_SWITCH_ERROR being either scalars and/or a hash references.

You need to alter new to determine if the first one/two arguments are hash references and/or there is an even number of arguments after it.