On Wed, Jan 27, 2010 at 8:41 PM, Lyle <[email protected]> wrote:
>
> For this I can just export methods to the OrigObj's namespace.
True!
> ExtObj::guts was just so that the new_methods didn't get exported to
> OrigObj, and only the ExtObj method did.
Methods won't get exported by ExtObj unless they're listed in @EXPORT
(or @EXPORT_OK etc.). So you can do without ExtObj::guts, although I
guess its existence might serve to help avoid confusion in that ExtObj
contains a function whereas ExtObj::guts is a class.
> But I don't want a huge object full of methods. It's the grouping into sub
> objects that I'm really after.
> There will only be one $OrigObj, but many $ExtObj, not from the same class,
> each different with different methods.
> ExtObj only exports one method of the same name to OrigObj. That method
> returns an object of the ExtObj::guts class, which contains all the
> new_methods. Only one instance of ExtObj::guts will ever be created and used.
> It's purely to group similar methods together in sub objects, rather than
> having a huge object with lots of methods.
>
> I'm aiming for high cohesion and encapsulation, although methods of
> ExtObj::guts will often have to access $OrigObj. The $extobj object of
> ExtObj::guts, created in the ExtObj class can only be access through the
> $OrigObj->ExtObj method and not directly through other $OrigObj methods.
> (although saying that, I think I might need to wrap "my $extobj;" and the
> following 2 subs in a block??).
OK, so we want $OrigObj->ExtObj->new_methods to invoke 'new_methods'
in the class 'ExtObj::guts' but provide access to $OrigObj within the
method body.
Might not be what you're after, but here's a way with a couple of
ideas that might be useful?
ExtObj.pm
--
package ExtObj;
use strict;
use warnings;
use Carp;
use Scalar::Util qw( blessed weaken );
sub new {
my $class = shift;
my %args = @_;
my $self = bless \%args => $class;
weaken $self->{ OrigObj };
return $self;
}
sub OrigObj {
my $self = shift;
return $self->{ OrigObj };
}
sub new_methods {
my $self = shift;
print "new_methods: $self->{OrigObj}\n";
$self->some_method; # Will automatically call $self->{OrigObj}->some_method
return;
}
sub AUTOLOAD {
my $self = shift;
our $AUTOLOAD;
( my $method = $AUTOLOAD ) =~ s/.*:://ms;
# Automatically delegate to OrigObj if we can
if ( $self->OrigObj && $self->OrigObj->can( $method ) ) {
return $self->OrigObj->$method( @_ );
}
# Ignore calls to DESTROY, Perl generates these because of this AUTOLOAD
if ( $method eq 'DESTROY' ) {
return;
}
my $package = blessed( $self );
croak qq{Can't locate object method "$method" via package "$package"};
}
1;
--
OrigObj.pm
--
package OrigObj;
use strict;
use warnings;
use ExtObj;
my $OrigObj;
sub new {
my $class = shift;
my $self = bless {} => $class;
$self->{ ExtObj } = ExtObj->new( OrigObj => $self );
return $self;
}
sub ExtObj {
my $self = shift;
return $self->{ ExtObj };
}
sub instance {
return $OrigObj ||= __PACKAGE__->new;
}
sub some_method {
my $self = shift;
print "some_method: $self\n";
return;
}
1;
--
Test code:
--
use OrigObj;
my $obj = OrigObj::instance();
$obj->ExtObj->new_methods;
_______________________________________________
BristolBathPM mailing list
[email protected]
http://mailman.bristolbath.org/mailman/listinfo/bristolbathpm
