如何检测Perl中调用链中间的方法？

我有一个使用

calc

方法的示例对象：

package A;
sub new {...}
sub calc {
    my ($self, $a, $b) = @_;
    return {first => $a, second => $b, sum => $a + $b}
}

简单用法：

my $result = A->new->calc(1, 2);
print 'Result is ', $result->{sum}; # output: Result is 3

现在，我想添加一个链接方法

log

，以便它输出计算参数并返回结果：

package A;
...
sub calc {
    ...
    return $self->{result} = {...}
}
sub log {
    my $self = shift;
    print sprintf 'a = %d, b = %d', $self->{result}->{first}, $self->{result}->{second};
    return $self->{result};
}

然后像这样使用它：

my $result = A->new->calc(10, 20);
print "Result of calc: ", $result->{sum}; # output: 30

$result = A->new->calc(11, 12)->log; # output: a = 11, b = 12
print 'Result is ', $result->{sum}; # output: Result is 23

我尝试使用带有重载的helper对象，但是我的

calc

可以返回非常不同的结构，比如标量、数组、arrayref、hashref。。。所以，我的助手的目标代码很糟糕，而且有bug

现在，我有两个问题：

我能确定方法在调用链的中间，而不是结束吗？然后我可以从

calc

返回

$self

，而不是返回结果

有没有更优雅的解决方案

---

我认为这是不可能的（如果可能的话，我不想使用它）

链式方法的习惯用法通常用于改变对象的方法。因此，如果您想以这种方式编写它，

calc（）

应该始终返回对象，并且您应该有一个单独的方法来返回结果。这样就很清楚每种方法都在做什么

A->new()->calc(10, 20)->result();
A->new()->calc(10, 20)->log()->result();

无论如何，不是每个人都喜欢链接方法。如果我遇到同样的问题，我可能会在对象上有一个verbose属性：

A->new(verbose => 1)->calc(10, 20);

---

并在执行计算的方法中基于此进行日志记录（可能会节省将所有中间计算提交给私有成员的麻烦）。但是这两种方法都是有效的，并且可能更可取，具体取决于计算。

从功能上实现您想要的功能的最简单方法可能是向对象添加类似于

\u last\u action

属性的内容，并添加一个内部方法来填充该属性。然后，每个计算方法只需要使用表示计算的所需数据调用该填充方法。

->log

方法只需提取并处理数据，您的计算方法可以保持相当干净，只需返回所需的数据。我在下面做过类似的事情

这就是说，您的接口不是最容易使用的，如果处理变得复杂，它会为计算您可能从未使用过的结果增加大量开销（因为您似乎是使用一个非常通用的名为

calc

）的工具来计算所有结果的。不，不可能确定您在呼叫链中的位置

我不完全确定你想在这里实现什么，但以下是我将如何解决我认为你想做的事情。。。请注意，我使用的是

Moose

，因为它（或

Moo

，或

Mouse

）使OO变得更容易，而操作符重载处理了复杂的问题。我还将类设置为不可变的（一旦设置，它就不会改变，取而代之的是一个新对象），因为这通常是一个更干净的接口，更易于维护

package MathHelper;
use Moose;
# our basic math operations
use overload fallback => 1,
    '+'   => 'plus',
    '-'   => 'minus',
    '<=>' => 'compare',
    '0+'  => 'to_number',
    '""'  => 'to_number',
;

# allow for a ->new( $value ) call    
around BUILDARGS => sub {
    my $orig = shift;
    my $self = shift;

    if ( @_ == 1 && !ref $_[0] ) {
        return $self->$orig( value => $_[0] );
    } else {
        return $self->$orig( @_ );
    }
};

has value => (
    is => 'ro',
    default => 0,
    documentation => 'Represents the internal value',
);

has _last => (
    is => 'ro',
    default => undef,
    init_arg => 'last',
    documentation => 'The last calculation performed',
);
sub last {
    my $self = shift;
    return $self->_last if defined $self->_last;
    return 'No last result';
}

sub plus {
    my ( $self, $other, $swap ) = @_;
    my $result = $self->value + $other;
    return __PACKAGE__->new(
        value => $result,
        last => "$self + $other = $result",
    );
}

sub minus {
    my ( $self, $other, $swap ) = @_;
    my $result = $self->value - $other;
    $result = -$result if $swap;
    return __PACKAGE__->new(
        value => $result,
        last => ( $swap ) ? "$other - $self = $result" : "$self - $other = $result",
    );
}

sub compare {
    my ( $self, $other, $swap ) = @_;
    if ( $swap ) {
        return $other <=> $self->value;
    } else {
        return $self->value <=> $other;
    }
}

sub to_number {
    my ( $self ) = @_;
    return $self->value;
}

__PACKAGE__->meta->make_immutable;
1;

---

免责声明：我的代码中可能仍有错误，还有很大的改进空间。。。但这只是一个开始，根据我的经验，这是唯一可行的解决办法。我在

$work

的生产中使用了非常类似的东西（尽管该代码有多个内部值，分别是

月

和

年

）。

因此您希望

calc

方法返回一个hashref，除非它被调用为：

$object->calc(...)->some_other_method;

。。。在这种情况下，它需要返回

$object

本身

我的第一个想法是，作为一个API，这绝对是糟糕透顶的

---

我的第二个想法是，你应该能够用自己的力量完成这项任务。但是我的良好品味使我无法提供代码示例。

一个方法不可能检测它是否是调用链中的最后一个调用，并且有很好的理由：

$x->a->-b>-c

的行为应该与

do{my$y=$x->a；my$z=$y->b；$z->c}

的行为相同。我建议您选择不同的API：

• my$result=A->log（$instance->A->b->c）
  
  在这里，日志记录将由一个单独的（类-）方法执行。这是一种更简洁的设计，实现起来也很简单：
  
  sub log :method {
      my ($class, @results) = @_;
      ...;  # print out the results
      return @results;
  }
  
  请勿仅返回部分结果–日志记录不应干扰正常数据流。有一个问题：必须在列表上下文中调用
  ->c
  方法，这就是可能返回多个结果的原因。无法将正确的上下文传播到
  ->c
  方法。为此，我们必须使用闭包：
  

• my$result=$instance->log（sub{$\->a->b->c}）
  
  这可以按如下方式实施：
  
  sub log :method {
      my ($self, $action) = @_;
      local $_ = $self;
      my @results = (wantarray) ? $action->($self) : scalar $action->($self);
      ...;  # perform actual logging
      return (wantarray) ? @results : $results[0];
  }
  
  我认为这是最好的解决方案，因为它不会产生任何令人惊讶的语义
  

• my$result=$instance->a->b->log->c
  
  这里，将在记录结果的方法之前调用
  log
  。这可以使用两种策略来实现：
  
  第一种解决方案是在对象中保留一个内部标志。此标志将由
  log
  设置。当执行下一个方法时，将在返回之前检查标志。如果设置了，将执行以下日志记录：
  
  sub log :method {
      my ($self) = @_;
      $self->{_log_next_call} = 1;
      return $self;
  }
  
  sub _do_logging {
      my ($self, @data) = @_;
      $self->{_log_next_call} = 0;
      ...;  # log the data
  }
  
  sub c {
      ...; # do normal stuff
      $self->_do_logging($result) if $self->{_log_next_call};
      return $result;
  }
  
  这是一个相当合理的实现，但需要对所有可能记录的方法进行更改
  
  另一种实现策略是通过代理对象。代理包装执行实际行为的对象，但它将记录所有访问：
  
  package Proxy {
      sub new {
          my ($class, $obj) = @_;
          return bless \$obj => $class;
      }
  
      # override "DOES" and "can" for correct proxying
  
      sub DOES {
          my ($self, $role) = @_;
          ...;  # validate that $self is an object
          return $$self->DOES($role);
      }
  
      sub can {
          my ($self, $method) = @_;
          ...;  # validate that $self is an object
          my $code = $$self->can($method);
          return undef unless defined $code;
          return sub {
              my @result = (wantarray) ? $code->(@_) : scalar $code->(@_);
              ...;  # log the result
              return (wantarray) ? @result : $result[0];
          };
      }
  
      # the AUTOLOAD method does the actual proxying,
      # although the interesting stuff is done in "can"
      sub AUTOLOAD {
          my $self = shift;
          my $method = our $AUTOLOAD;
          $method =~ s/\A.*:://s;
          my $code = $self->can($method);
          ...;  # throw error if $code is undef
          return $code->($$self, @_);
      }
  }
  
  然后，
  log
  方法将只构建代理：
  
  sub log :method {
      my ($self) = @_;
      return Proxy->new($self);
  }
  
  

---

是的，也许这是个坏主意：）

package Proxy {
    sub new {
        my ($class, $obj) = @_;
        return bless \$obj => $class;
    }

    # override "DOES" and "can" for correct proxying

    sub DOES {
        my ($self, $role) = @_;
        ...;  # validate that $self is an object
        return $$self->DOES($role);
    }

    sub can {
        my ($self, $method) = @_;
        ...;  # validate that $self is an object
        my $code = $$self->can($method);
        return undef unless defined $code;
        return sub {
            my @result = (wantarray) ? $code->(@_) : scalar $code->(@_);
            ...;  # log the result
            return (wantarray) ? @result : $result[0];
        };
    }

    # the AUTOLOAD method does the actual proxying,
    # although the interesting stuff is done in "can"
    sub AUTOLOAD {
        my $self = shift;
        my $method = our $AUTOLOAD;
        $method =~ s/\A.*:://s;
        my $code = $self->can($method);
        ...;  # throw error if $code is undef
        return $code->($$self, @_);
    }
}

sub log :method {
    my ($self) = @_;
    return Proxy->new($self);
}