[Bioperl-l] Auto-method caller proposal

[Sendu Bala]

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);
     }
}