Могу ли я вставить сабвуфер perl в пакет? - PullRequest
2 голосов
/ 07 января 2020

Я хотел бы иметь возможность «вводить» методы в класс на лету, подобно тому, как это происходит с помощниками Мооджилиуса. Примерно так:

my $s = SomeThing->new;

$s->helper(do_this => sub {
               my $self = shift;
               $foo = shift;
           });

$s->do_this('bar');

Я сделал это на некотором расстоянии, но я бы хотел, чтобы подводные лодки, которые получают инъекцию, работали в пространстве имен класса, в который они вводятся, а не в main один. Другими словами, в настоящее время это работает следующим образом:

$s->do_this('bar');

print 'in main:      ', $foo;             

это печатает "бар" - и я бы этого не хотел, в то время как я хотел бы это

print 'in SomeThing: ', $SomeThing::foo;

вместо «bar» печатать

, хотя это работает, но мне кажется неуклюжим

$s->helper(do_this => sub {
               my $self = shift;
               ${(ref $self) . '::foo'} = shift;
           });

$s->do_this('foo');

print 'in SomeThing: ', $SomeThing::foo;  # now this prints "foo"

Пакет, в котором все это происходит, выглядит следующим образом:

package SomeThing {
    use Mojo::Base -base;
    use Carp;

    sub helper {
        my $self = shift;
        my $name = shift || croak "The helper name is required";
        my $sub = shift || sub {};

        my $namespace = __PACKAGE__;
        no strict 'refs';
        { 
            *{"$namespace\::$name"} = $sub
        }
    }
};

Есть ли способ сделать это? Я подозреваю, что очень плохо испортил бы строгость - но я вроде бы пока не хочу сдаваться (и было бы неплохо научиться этому).

Ответы [ 2 ]

2 голосов
/ 07 января 2020

Вы просите изменить пакет, связанный с уже скомпилированным anon sub для поиска переменных. Я не знаю, возможно ли это.

Даже если бы это было возможно, это не то, что вы хотите сделать, потому что ваш код все равно не будет работать. Вам нужно добавить use vars qw( foo ); в файл, в котором находится литерал sub { }. И это в дополнение к использованию our $foo; или use vars qw( $foo ); в Something.pm, если вы получили к нему доступ.

Это довольно волшебно и грязно. И этого легко избежать с помощью аксессуаров. Простая замена

$s->helper(
   do_this => sub {
      my $self = shift;
      $foo = shift;
   },
);

на

$s->helper(
   do_this => sub {
      my $self = shift;
      $self->foo(shift);
   },
);

Если вам также необходимо добавить средство доступа, вы можете использовать следующее:

$s->helper(
   foo => sub {
      shift;
      state $foo;
      $foo = shift if @_;
      $foo
   },
   do_this => sub {
      my $self = shift;
      $self->foo(shift);
   },
);

Как кроме этого, monkey_patch из Mojo :: Util можно использовать вместо helper. (Благодарю @brian d foy за то, что он его поднял.) Он делает то же самое, но у него есть два дополнительных преимущества:

  1. Вам не нужно его поддерживать.
  2. Он устанавливает имя anon sub, так что в трассировках стека вместо __ANON__ используется

Переключение на monkey_patch не решает вашу проблему, но я рекомендую использовать его (или аналогичный) в дополнение к изменению подхода, о котором я упоминал выше.

use Mojo::Util qw(  );
sub helper { shift; Mojo::Util::monkey_patch(__PACKAGE__, @_); }
0 голосов
/ 09 января 2020

Рассмотрим роли .

# role module
package SomeThing::Role::Foo;
use Role::Tiny;
sub foo { 42 }
1;

# user
use strict;
use warnings;
use SomeThing;
use With::Roles;

my $something_with_foo = SomeThing->with::roles('+Foo');
# new subclass of SomeThing, doesn't affect other usage of SomeThing
my $obj = $something_with_foo->new;

# can also dynamically apply to an existing object
my $obj = SomeThing->new->with::roles('+Foo');
print $obj->foo;
...