[Bioperl-l] Auto-method caller proposal

[Chris Fields]

I completely agree; this would come in particularly handy with the  
EUtilities parameter get/sets.

It would also be handy to have this or something similar handle code  
fragments on the fly, so you could deal with more complex methods:

our %DT = (
      'foo'  => 'my $self=shift; my $self->{\'_foo\'} = $shift if @_;  
return;',
      'bar'  => 'my $self=shift; my $bar = $shift if @_; return  
($self->foo)*$bar if $bar;',
...
);

# in new()

    $self->_set_from_args(\@args,
                          -methods => [qw(id foo bar)],
                          -dispatch_table => \%DT,
                          -create => 1);

If the method exists in the dispatch_table hash then you could have  
more complex subs; all others would be simple get/sets.  Don't know  
how feasible it would be, but maybe something like the following (in  
_set_from_args()):

...
     if ($create) {
         foreach my $method (@{$methods}) {
             $self->can($method) && next;
             no strict 'refs';
             if (exists($dispatch_table{$method})) {
                 my $sub = eval "sub { $dispatch_table{$method} }";
                 $self->throw("Compilation error for $method : $@")  
if $@;
                 *{ref($self).'::'.$method}. = $sub;
             } else {

             # create simple get/setter method

             *{ref($self).'::'.$method} =
                 sub { my $self = shift;
                     if (@_) {
                         $self->{'_'.$method} = shift
                     }
                     return $self->{'_'.$method} || return;
                 };
             }
     }


chris

On Jan 3, 2007, at 12:09 PM, Sendu Bala wrote:

> I propose a method that sets method values based on user-supplied args
> to new(), most likely to be placed in Bio::Root::RootI (given its
> intention to substitute or complement _rearrange for some module
> authors). The method name (_set_from_args) is open to alternative
> suggestions.
>
> A lazy module author (eg. someone doing a run wrapper) might say:
>
> package Bio::Tools::Run::Lazy;
> sub new {
>    my ($class, @args) = @_;
>    my $self = $class->SUPER::new(@args);
>
>    $self->_set_from_args(\@args,
>                          -methods => [qw(id score evalue)],
>                          -create => 1);
>
>    return $self;
> }
> 1;
>
> A user with a tendency to accidentally press shift or forget to use
> dashes could then say:
>
> use Bio::Tools::Run::Lazy;
> my $lazy = Bio::Tools::Run::Lazy->new(-sCore => 5, evalue => 0);
> my $id = $lazy->id # undef, not fatal
> my $score = $lazy->score # 5, $lazy->sCore would be fatal
> my $evalue = $lazy->evalue # 0
>
>
> This has the very slight advantage over AUTOLOAD in that we can
> $lazy->can('id'), and the better advantage over the current run
> wrappers: not every one of them would have to define its own AUTOLOAD
> method and have its own way of dealing with dashed or dashless  
> parameters.
>
>
> For less lazy authors who define all their methods, we can still  
> gain a
> benefit. Instead of the current:
>
> package Bio::Tools::Run::GoodBoy;
> sub new {
>    my ($class, @args) = @_;
>    my $self = $class->SUPER::new(@args);
>
>    my ($id, $score, $evalue) = $self->_rearrange([qw(ID SCORE  
> EVALUE)],
> %args);
>
>    $self->id($id) if defined $id;
>    $self->score($score) if defined $score;
>    $self->evalue($evalue) if defined $evalue;
>
>    return $self;
> }
> # methods...
> 1;
>
> We can have the nicer:
>
> package Bio::Tools::Run::GoodBoy;
> sub new {
>    my ($class, @args) = @_;
>    my $self = $class->SUPER::new(@args);
>
>    $self->_set_from_args(\@args,
>                          -methods => [qw(id score evalue)]);
>
>    return $self;
> }
> # methods...
> 1;
>
>
>
>
> Proposed code (excuse the broken formatting):
>
> =head2 _set_from_args
>
>   Usage     : $object->_set_from_args(\%args, -methods => \@methods)
>   Purpose   : Takes a hash of user-supplied args whos keys match  
> method
> names,
>             : and calls the method supplying it the corresponding  
> value.
>   Example   : $self->_set_from_args(%args, -methods => [qw(sequence id
> desc)]);
>             : Where %args = (-sequence    => $s,
> 	       :                -description => $d,
> 	       :                -ID          => $i);
>   Returns   : n/a
>             : the above _set_from_args calls the following methods:
>             : $self->sequence($s);
>             : $self->id($i);
>             : ( $self->description($i) is not called because
> 'description' wasn't
>             :   one of the given methods )
>   Argument  : \%args          : a hash ref of arguments where keys are
> any-case
>             :                   strings corresponding to method  
> names but
>             :                   optionally prefixed  with hyphens, and
> values are
>             :                   the values the method should be  
> supplied
>             : -methods => []  : (optional) only call methods with  
> names
> in this
>             :                   array ref
>             : -force => bool  : (optional, default 0) call methods  
> that
> don't
>             :                   seem to exist, ie. let AUTOLOAD  
> handle them
>             : -create => bool : (optional, default 0) when a method  
> doesn't
>             :                   exist, create it as a simple getter/ 
> setter
>             :                   (combined with -methods it would  
> create
> all the
>             :                   supplied methods that didn't exist,  
> even
> if not
>             :                   mentioned in the supplied %args)
>
> =cut
>
> sub _set_from_args {
>      my ($self, $args, @own_args) = @_;
>      $self->throw("a hash ref of arguments must be supplied") unless
> ref($args);
>
>      my ($methods, $force, $create);
>      if (@own_args) {
>          ($methods, $force, $create) = $self->_rearrange([qw(METHODS
>                                                              FORCE
>                                                              CREATE)],
> @own_args);
>      }
>
>      my %args = ref($args) eq 'HASH' ? %{$args} : @{$args};
>      my %methods = $methods ? map { lc($_) => $_ } @{$methods} : ();
>
>      if ($create) {
>          foreach my $method (@{$methods}) {
>              $self->can($method) && next;
>
>              # create get/setter method
>              no strict 'refs';
>              *{ref($self).'::'.$method} = sub { my $self = shift;
>                                                if (@_) {
> $self->{'_'.$method} = shift }
>                                                return
> $self->{'_'.$method} || return; };
>          }
>      }
>
>      while (my ($method, $value) = each %args) {
>          $method =~ s/^-+//;
>          $method = $methods{lc($method)} || ($methods ? next :  
> $method);
>
>          unless ($force) {
>              $self->can($method) || next;
>          }
>
>          $self->$method($value);
>      }
> }