[Bioperl-l] Annotation proposal

[Matthew Pocock]

I've knocked together a proof-of-concept for this - it doesn't do data 
or method inheritance, specialization etc., but it does do inner 
classes. This makes for much better interface abstraction than the 
standard perl module aproaches. The code is below.

Matthew Pocock wrote:

> 
> Something along the lines of a perl object with a data hash and a 
> functions hash may work out - you use the AUTOLOAD method to pull out 
> the apropreate function and execute it, and the function grabs the data 
> hash for it's stoorage (implemented as a blessed 2-element list?). ISA 
> can be over-ridden easily enough (in the instance-method case), as can 
> CAN. One benefit of this is that the subs that make up an object can be 
> closures so that you can create the equivalent of inner classes.
> 
> Anybody bored enough to join me in playing with this?
> 
> Matthew
> 

package FluffyObject;

use strict;

use vars qw/$AUTOLOAD/;

sub AUTOLOAD {
     my ($meth_name) = $AUTOLOAD =~ /::([^:]*)/;
     my $self = shift @_;
     my $meth_ref = $self->[1];
     my $sub = $meth_ref->{$meth_name};
     if(!defined $sub) {
         $sub = $meth_ref->{'AUTOLOAD'};
     }
     return $sub->($self, @_);
}

sub CAN {
     my ($thingy, $method) = @_;
     my $can;
     $can = $thingy->SUPER::CAN($method);
     if(!defined $can) {
         my $meth_hash = $thingy->METHODS;
         $can = $meth_hash->{$method};
     }
     return $can;
}

sub new {
     my $class = shift;
     my ($methods, $data) = (shift, shift);
     my %meth_hash = %$methods;
     my %data_hash = %$data;
     my $self = [\%data_hash, \%meth_hash];

     bless $self, $class;

     my $new = $self->METHODS->{'new'};
     if(defined $new) {
         $new->($self, @_);
     }

     return $self;
}

sub METHODS {
     my $self = shift;
     return $self->[1];
}

sub DATA {
     my $self = shift;
     return $self->[0];
}

package main;

my $obj = FluffyObject->new(
{
     hello => sub { print "Hello World\n" },
     by => sub { print "By\n" },
     incCounter => sub { shift->DATA->{counter}++ },
     printCounter => sub { print shift->DATA->{counter}; print "\n" },

     getInnerClass => sub {
         my $obj = shift;
         FluffyObject->new(
         {
             dumpThings => sub {
                 my $self = shift;
                 my $obj = $self->DATA->{obj};
                 print "In $self\n";
                 $obj->printCounter;
                 $obj->incCounter;
                 $obj->printCounter;
             }
         },
         {
             obj => $obj
         }
         );
     }
},
{
     counter => 5
}
);

$obj->hello;
$obj->by;
$obj->printCounter;
$obj->incCounter;
$obj->printCounter;
my $inner = $obj->getInnerClass;
$inner->dumpThings;