如何在Perl中检测到该方法位于调用链的中间？

时间：2014-07-25 22:08:13

标签： perl chaining

我有一个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 ......所以，我的助手的目标代码非常糟糕且错误。

现在，我有两个问题：

  1. 我可以确定方法是在调用链的中间，而不是结束吗？然后我可以从$self返回calc而不是结果。
  2. 有更优雅的解决方案吗？

4 个答案:

答案 0 :(得分：2)

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

链式方法的习惯用法通常与改变对象的方法一起使用。因此，如果您想以这种方式编写它，calc()应始终返回该对象，您应该有一个单独的方法来返回结果。然后清楚每种方法正在做什么。

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

不管怎样，不是每个人都是链接方法的粉丝。如果我正在接近同样的问题，我可能会在对象上有一个详细的属性：

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

并根据执行计算的方法中的日志进行记录（可能会节省将所有中间计算提交给私有成员的麻烦）。但要么是有效的，要么根据计算可能更好。

答案 1 :(得分：1)

所以你希望calc方法返回一个hashref，除了，当它被称为：

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

......在这种情况下，它需要返回$object本身？

我的第一个想法是，这绝对是一个API。

我的第二个想法是你应该能够用Want完成这个任务。但是我的良好品味使我无法提供代码样本。

答案 2 :(得分：0)

在功能上执行所需操作的最简单方法可能是向对象添加类似_last_action属性的内容，并添加内部方法来填充该属性。然后，每个计算方法只需要使用您需要的数据调用该填充方法来表示计算。 ->log方法只需要拉出并处理该数据，您的计算方法可以保持相当干净，只需返回所需内容。我在下面做过类似的事情。

也就是说，你的界面不是最容易使用的，如果你的处理变得复杂，它会增加很多开销来计算你可能永远不会使用的结果（因为你好像用一个非常通用的名字来计算它） calc）。不，不可能确定你在调用链中的距离。

我不完全确定你在这里想要达到的目标，但是这就是我如何解决我认为你想要做的事情......并注意我使用Moose因为它（或{{ 1}}或Moo）使OO变得更容易，操作符重载处理错综复杂。我也使类不可变（一旦设置它不会改变，你得到一个新的对象），因为这通常是一个更清洁的界面，更容易维护。

Mouse

一个小测试程序：

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;

输出：

#!/usr/bin/env perl
use Modern::Perl;
use MathHelper;

my $ten = MathHelper->new( 10 );
my $twenty = MathHelper->new( 20 );
my $thirty = $ten + $twenty;

say "\$ten is $ten";
say "\$twenty is $twenty";
say "\$thirty is $thirty [".$thirty->last."]";

my $tmp = $twenty - $ten;
say "\$ten - \$twenty = $tmp [".$tmp->last."]";

$tmp = $twenty - 3;
say "\$twenty - 3 = $tmp [".$tmp->last."]";

$tmp = $ten - $twenty;
say "\$twenty - \$ten = $tmp [".$tmp->last."]";

$tmp = 3 - $twenty;
say "3 - \$twenty = $tmp [".$tmp->last."]";

say "\$ten is equal to 10" if 10 == $ten;
say "\$ten is smaller than \$twenty" if $ten < $twenty;
say "\$twenty is larger than \$ten" if $twenty > $ten;
say "\$ten + \$twenty is equal to \$thirty" if $ten + $twenty == $thirty;
say "\$ten + \$twenty - 1 is not equal to \$thirty" if $ten + $twenty - 1 != $thirty;

免责声明：我的代码可能仍然存在错误，并且还有很大的改进空间......但它是一个开始，而且根据我的经验，这是唯一可行的解​​决方案。我在$ten is 10 $twenty is 20 $thirty is 30 [10 + 20 = 30] $ten - $twenty = 10 [20 - 10 = 10] $twenty - 3 = 17 [20 - 3 = 17] $twenty - $ten = -10 [10 - 20 = -10] 3 - $twenty = -17 [3 - 20 = -17] $ten is equal to 10 $ten is smaller than $twenty $twenty is larger than $ten $ten + $twenty is equal to $thirty $ten + $twenty - 1 is not equal to $thirty 生产中使用了非常相似的内容（该代码有多个内部值，但$work和months）。

答案 3 :(得分：0)

方法无法检测它是否是一连串调用中的最后一个调用 - 并且有充分理由：$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;

    此处，{<1}}将在记录结果的方法之前调用。这可以使用两种策略来实现：

    第一个解决方案是在对象中保留内部标志。此标志将由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
相关问题
最新问题