尝试访问 perl 中哈希常量列表中的哈希

Question

好的，这是我当前有效的代码，但我需要以不同的方式访问每个错误散列，以便与程序的其他部分兼容。这是我的错误列表库： 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;

这是我的 Error.pm 文件。调用新方法访问并输出新的错误信息，其余要么是getter，要么在新方法中调用。

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;

我还将包括我的测试（我在运行这个程序中测试错误输出）。这也显示了如何调用错误。在系统代码中，它会这样调用：

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;

我正在尝试更改它，以便我可以将每个错误称为：

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

Answer 1

在 new 中，这是你的（来自你的测试）：

$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);

这不是我认为你想要的：

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

即使 code 和 UNABLE_TO_PING_SWITCH_ERROR 是标量 and/or 哈希引用，这也应该是正确的。

您需要更改 new 以确定第一个 one/two 个参数是否为散列引用 and/or 它后面有偶数个参数。

Answer 2

您的构造函数希望您将以下参数传递给它：标量、散列。然后在代码中将标量用作 hashref

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

当你用

调用它时

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

这正是正在发生的事情，一切都很好。如果你想称它为

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

那么您将向它传递一个完整的散列，其中包含偶数个元素。首先没有哈希引用（标量）。目前的构造函数应该给你一个关于分配给散列的奇数元素的列表的错误，因为它首先将标量字符串 'code' 放入 $error 然后尝试分配剩余的列表， UNABLE.., ... 到哈希。 las，其余部分现在有 odd 个元素，这些元素不适用于散列。请记住，(a => 'A', b => 'B') 与 ('a', 'A', 'b', 'B') 相同，当删除 a 后，其余部分不再是散列。

如果你想以这种方式调用它并在你的构造函数中进行相同的处理，你需要更改构造函数以首先从提交的哈希中获取键 'code' 的值（到$error) 并从中删除该元素，以便可以将其余元素分配给 %args，以供以后处理。一些示例代码是

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

delete从散列中删除元素，和returns它。

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.

您还可以通过预处理 @_ 一旦 $class 被 shift 编辑，您也可以支持这两种调用约定。如果它不首先包含 hashref，则执行上述操作（或类似操作），否则不需要。您当前的处理保持原样。例如

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

此时您可以添加更多检查。以上可以做不同的，我尽量保持清楚。

尝试访问 perl 中哈希常量列表中的哈希

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

methods

perl

constants

hash-of-hashes