[Bioperl-l] Auto-method caller proposal

[aaron.j.mackey at gsk.com]

I'm not against this at all, but let's not reinvent a (somewhat-standard) 
wheel: see Class::MethodMaker and accompanying tools.

-Aaron

bioperl-l-bounces at lists.open-bio.org wrote on 01/03/2007 01:09:26 PM:

> 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);
>      }
> }
> _______________________________________________
> Bioperl-l mailing list
> Bioperl-l at lists.open-bio.org
> http://lists.open-bio.org/mailman/listinfo/bioperl-l
>