Geek asks and answers

How to create (or not) class instance methods at build time based on input?

How to create a class so that some methods exist in the instance only if certain values ​​were passed to the constructor?

Perhaps a more general way to ask the question: how can I add a method to an existing instance of the class?

+5
source share
6 answers

You can attach an anonymous sub object to the flag:

use strict;
use warnings;
package Object;
sub new {
   my $class = shift;
   my $self = bless {}, $class;
   my %args = @_; 
   if ($args{method}) {
       $self->{method} = sub { print "hello\n" }
   }   
   return $self;
}

sub method {
    my $self = shift;
    if (not defined $self->{method}) {
        warn "Not bound\n";
        return;
    }   
    $self->{method}->();
}
1;

for use:

use Object;
my $obj1 = Object->new(method=>1);
$obj1->method();
my $obj2 = Object->new();
$obj2->method();

You can extend this to several methods using the same interface.

+3
source

You can use Moose to apply the role at runtime.

package My::Class;
use Moose;

has foo => ( isa => 'Str', is => 'ro', required => 1 );

sub BUILD {
  my $self = shift;

  if ($self->foo eq 'bar') {
    My::Class::Role->meta->apply($self);
  }  
}

no Moose;

package My::Class::Role;
use Moose::Role;

sub frobnicate {
  my $self = shift;

  print "Frobnicated!\n";
}

no Moose;

my $something = My::Class->new( foo => 'bar' );
print $something, "\n";
$something->frobnicate;
my $something_else = My::Class->new( foo => 'baz' );
print $something_else, "\n";
$something_else->frobnicate;

gives:

Moose::Meta::Class::__ANON__::SERIAL::1=HASH(0x2fd5a10)
Frobnicated!
My::Class=HASH(0x2fd2c08)
Can't locate object method "frobnicate" via package "My::Class" at testmoose.pl line 32.
+2
source

AUTOLOAD . foo , $self->{foo} exists

sub AUTOLOAD {
    my $methodname = $AUTOLOAD;
    if ($methodname eq "foo" && exists($_[0]->{foo})){
          goto &fooimplementationsub;
    }
    return;
}


*PACKAGE::method = sub { 
    #code here
};

, , , .

, , / eval

eval <<EOF
sub foo { 
    #code here
};
EOF

, , , , .

+1

- , - - globs. .

, , .

package WeirdClass;

sub new {
  my ($class, $name, $code) = @_;
  if ($name) {
    no strict;
    *{__PACKAGE__ . "::$name"} = $code;
  }
  bless {} => $class;
}

:

my $object = WeirdClass->new(foo => sub {say "foo"});
$object->foo(); # prints "foo\n";

:

my $another_object = WeirdClass->new();
$another_object->foo; # works too.

, :

package BetterClass;

sub new {
  my ($class, %args) = @_;
  bless \%args => $class;
}

# destructor will be called at cleanup, catch with empty implementation
sub DESTROY {}; 

sub AUTOLOAD {
  my $self = shift;
  (my $method = our $AUTOLOAD) =~ s/.*://; #  $AUTOLOAD is like "BetterClass::foo"

  # check if method is allowed
  die "forbidden method $method" unless $self->{can}{$method};

  # mock implementations
  given ($method) {
    say "foo" when "foo";
    say "bar" when "bar";
    when ("add") {
      my ($x, $y) = @_;
      return $x + $y;
    }
    default { die "unknown method $method" }
  }
}

:

my $o = BetterClass->new(can => { foo => 1, bar => 0});
$o->foo;
my $p = BetterClass->new(can => {bar => 1, add => 1});
$p->bar;
say $p->add(5, 6);

, .

: can()

AUTOLOAD can, :

my %methods;
BEGIN {
  %methods = (
    foo => sub {say "foo"},
    bar => sub {say "bar"},
    add => sub {
      my ($self, $x, $y) = @_;
      $x + $y;
    },
  );
}

can:

# save a reference to the origional `can` before we override
my $orig_can;
BEGIN{ $orig_can = __PACKAGE__->can("can") }

sub can {
  my ($self, $meth) = @_;

  # check if we have a special method
  my $code = $methods{$meth} if ref $self and $self->{can}{$meth};
  return $code if $code;

  # check if we have a normal method
  return $self->$orig_can($meth);
}

AUTOLOAD

my ($self) = @_; # do not `shift`
(my $method = our $AUTOLOAD) =~ s/.*://;
my $code = $self->can($method) or die "unknown method $method";
goto &$code; # special goto. This is a AUTOLOAD idiom, and avoids extra call stack frames
+1

. AUTOLOAD, , .

, , - , , - , :

sub Foo {
    my $self       = shift;
    my $parameter  = shift;

    if ( $self->Class_type ne "Foo" ) {
        croak qq(Invalid method 'Foo' on object @{[ref $self]});
    }
    print "here be dragons\";
    return "Method 'Foo' successfully called";
}

Foo, Foo.

( , ) , .

, , .

package My_class;

sub new {
    my $class      = shift;
    my $class_type = shift;

    my $self = shift;

   if ( $class_type eq "Foo" ) {
      bless $self, "My_class::Foo";
   }
   else {
     bless $self, $class;
   }

package My_class::Foo;
use base qw(My_class);

sub Foo {
    my $self = shift;
    return "Foo Method successfully called!";
}

, My_class::Foo My_class use base . , My_class My_class::Foo. My_class::Foo Foo.

( new), $class_type. Foo, bless My_class::Foo.

, , , .

Question. 1129. .

1174 1176 , , . Question (. use base qw(Question); package. Question::Date Question::Regex Format. Question::Words Force.

, .

+1

, , .

Perl . , - , . , .

:

  • , , , . , , .

  • . .

If you really want to add methods to separate instances, then you will need to make sure that each instance is the only instance of the class just received for each object. It becomes more difficult to organize, doubly, if you want to avoid memory leaks and clean up classes when DESTROYed objects . Nevertheless, this would make it possible to actually use the methods for each instance.

Since it is very unlikely that you really need this third option, it is much better to go with one of the first.

+1
source

More articles:


All Articles