perl oo dynamic methods

Question

I'd like to define methods inside a class dynamically. I'm writing a tracer, somewhat more complex than the skeleton below, its also state aware but that is not relevant to my problem. I've written a TraceSlave class with trace method that calls sprintf, replaces newlines with text \n, all good and nice.

Basically I'd like to instantiate my trace as:

my @classes = qw(debug token line src match);
my $trace = Tracer->new(\@classes);

And I should be able to call the dynamically defined methods of trace as:

$trace->debug("hello, world");
$trace->match("matched (%s)(%s)(%s)(%s)(%s)", $1, $2, $3, $4, $5);

So my Tracer class would look like:

package Tracer;
  sub new {
    my $class = shift;
    my $self = {};
    my @traceClasses = @{$_[0]};
    bless $self, $class;
    for (@traceClasses) {
# This next line is wrong, and the core of my question
      $self->$_ = new TraceSlave($_, ...)->trace
    } # for (@traceClasses)
  }

Well it doesn't because that doesn't compile. Basically I want to define methods of the Tracer instance, as the trace method of instances of TraceSlave; in a loop.

I could do it with AUTOLOAD, or eval but that's just wrong. What's the right way?

Here's the TraceSlave for completeness. It's fine

package TraceSlave;
  sub new {
    my $self = { header => $_[1], states => $_[2], stateRef => $_[3] };
    bless $self, $_[0];
    return $self;
  } # new()

  sub trace {
    my $self = shift;
    my @states = @{$self->{states}};
    if ($states[${$self->{stateRef}}]) { # if trace enabled for this class and state
      my @args;
      for (1..$#_) { ($args[$_-1] = $_[$_]) =~ s/\n/\\n/g; } # Build args for sprintf, and replace \n in args
      print $self->{header}.sprintf($_[0], @args)."\n";
    }
  } # trace()

Answer 1

@Unk In answer to Unk's little code snippet above.

  foreach my $tc (@classes) { # loop over all trace classes, and create a slave for each class
    my $states = $self->{states}->{$tc} = [];
    $slave = TraceSlave->new( "$tc:"." "x($maxlen-length($tc)), $states, $stateRef );
    no strict 'refs';
    *{"${class}::$tc"} = sub { $slave->trace(@_[1..$#_]); }
  } # foreach my $tc (@classes)
  bless $self, $class;
  return $self;
} # new()

This is certainly much cleaner. I don't need to have slaves in the Tracer $self any more.

However I should be able to replace the entire sub with:

*{"${class}::${tc}"} = $slave->trace;

which of course doesn't work because I need a reference to $slave->trace, the code above would just call it. Sadly I also don't understand the use of the glob, or indeed much of the reference stuff on the lvalue. In my defence I can do anything with pointers in C or references in javascript, but perl references are quite a meal. Still learning.

I think OO is the right approach because the the tracer has lots of private data, specifically which trace classes are on for which state, and of course the header for each trace class. Nested objects is also right if I could get the simple assignment above working.

All this is part of me writing a make system for my VHDL project. I forced myself to do it in perl because I thought it was about time I learned the language properly rather than writing 10 line duct tapes.

I now realise *{"${class}::${tc}"} = \&trace->slave probably could never work. Would the first argument be the Tracer instance, or the TraceSlave instance? To work it would have to be TraceSlave instance, but this is a method defined in the Tracer class. Of course I could stick the slaves back in the Tracer $self, but that would make things more not less complicated.

I guess it now does what I want as simply as possible.

Answer 2

Ignoring the specifics of the 'tracer' problem, is it correct that you simply want to be able to dynamically create methods for a given package? What about this?

sub new {
    my ($class, $trace_classes) = @_;

    # ...

    foreach my $tc (@$trace_classes) {
        no strict 'refs';
        *{"${class}::${tc}"} = sub {
            my $self = shift;
            # ...
        };
    }

    return $self;
}

Although it seems very strange to do that in a new! So maybe I've missed the point

Answer 3

If you modify the symbol table of your package to add methods to the class, you cannot have two instances with different semantics of a same named method. Using AUTOLOAD in this case seems perfectly fine to me.

regards, matthias

Answer 4

Well I've finished my little module, and learnt an awful lot about references. I am defining methods dynamically, but using eval which I consider very dirty. However nobody seems to have a better idea so here it is.

The line that creates the dynamic methods is just after the comment: # Very dirty creation of dynamic method, surely there's a better way?

So I'd still be interested in hearing of a better way. As somebody said I could use Moose, but Moose would just have done an eval for me anyway.

#!/usr/bin/perl
use strict;
use warnings;

package TraceSlave;
  sub new {
    my $self = { header => $_[1], states => $_[2], stateRef => $_[3] };
    bless $self, $_[0];
    return $self;
  } # new()

  sub trace {
    my $self = shift;
    if ($self->{states}->[${$self->{stateRef}}]) {  # if trace enabled for this class and state
      my @args;
      for (1..$#_) { ($args[$_-1] = $_[$_]) =~ s/\n/\\n/g; } # Build args for sprintf, and replace \n in args
      print $self->{header}.sprintf($_[0], @args)."\n";
    }
  } # trace()

package Tracer;
  sub new {
    my ($class, $classList, $stateCount, $stateRef) = @_;
    my $self = { states => {}, slaves => [], count => $stateCount };
    my @classes = split(/\s+/, $classList);
    my $maxlen = 0;

    for (@classes) { # loop over all trace classes to find longest
      my $len = length($_);
      $maxlen = $len if $len > $maxlen;
    }
    $maxlen++; # Add a space

    for (0..$#classes) { # loop over all trace classes, and eval create a slave for each class
      my $tc = $classes[$_];
      my $states = $self->{states}->{$tc} = [];
      for (0..$stateCount) { $states->[$_] = 0; }
      $self->{slaves}[$_] = TraceSlave->new( "$tc:"." "x($maxlen-length($tc)), $states, $stateRef );
# Very dirty creation of dynamic method, surely there's a better way?
      eval("sub $tc { ".'$self=shift; $self->{slaves}['.$_.']->trace(@_); }');
    } # for (0..$#classes)
    bless $self, $class;
    return $self;
  } # new()

  sub _onOff { # switch on traces
    my ($self, $onOff, $classList, $statesRef) = @_;
    my @classes = split(/\s+/, $classList);
    my $count = $self->{count};

    for (@classes) { # loop over all supplied trace classes and switch on/off for state list
      my $states = $self->{states}->{$_};
      if ($statesRef) { for (@$statesRef) { $states->[$_] = $onOff; } }
      else { for (0..$count) { $states->[$_] = 1; } } # switch on for all states is no state list
    } # for (0..$#classes)
  } # on()

  sub on {
    my $self = shift;
    $self->_onOff( 1, @_ );  
  }

  sub off {
    my $self = shift;
    $self->_onOff( 0, @_ );  
  }
1;

Answer 5

Whenever I start getting into runtime munging of classes I just start using MOP and Moose. So if I'm reading this right, you want something along the lines of

package Tracer;
use strict;
use warnings;
use Moose;
use TraceSlave;

has 'classes' => ( is => 'ro', isa => 'ArrayRef[Str]', required => 1 );

### This is to allow ->new(\@classes) invocation instead of just
### using ->new( classes => \@classes) for invocation
around BUILDARGS => sub {
  my $orig  = shift;
  my $class = shift;

  if ( @_ == 1 && ref $_[0] eq 'ARRAY' ) {
    return $class->$orig( classes => $_[0] );
  }
  else {
    return $class->$orig(@_);
  }
};

sub BUILD {
  my $self = shift;
  for my $class (@{$self->classes}) {
    my $tracer = TraceSlave->new($class, ...);
    $self->meta->add_method( $class => sub { $tracer->trace(@_) } );
  }
}

Though I'm fairly certain this just does the same thing under the hood and ends up being a string eval. I haven't dug into the MOP internals at all. (I'm also not 100% certain this is correct code or the best way to do things with Moose, so buyer beware. :) )

Answer 6

I usually use string eval to define subroutines:

for my $method (@classes) {
    eval "sub $method { 'TraceSlave'->new('$method', ...)->trace }";
}