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

Question

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

错误.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

您的构造函数希望您将以下参数传递给它：标量、哈希。然后在代码中将标量用作 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, ...

那么您将向它传递一个完整的哈希，其中包含偶数个元素。首先没有 hashref（标量）。现有的构造函数应该给你一个关于分配给散列的奇数个元素的列表的错误，因为它首先将标量字符串'code' 放入$error，然后尝试将剩余列表UNABLE.., ... 分配给一个哈希。唉，剩下的现在有一个 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 从哈希中删除元素，并返回它。

删除 EXPR
给定一个指定哈希的元素或切片的表达式，delete 从该哈希中删除指定的元素，以便该元素上的 exists() 不再返回 true。将哈希元素设置为未定义值不会删除其键，但删除它会；看到存在。
[...]
在列表上下文中，返回已删除的一个或多个值，或标量上下文中的最后一个此类元素。

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

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

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

Answer 2

在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 是标量和/或哈希引用，这也应该是正确的。

您需要更改 new 以确定第一个/两个参数是否是哈希引用和/或它之后是否有偶数个参数。