On 5/17/07, Tom Metro <[EMAIL PROTECTED]> wrote:
> Greg London wrote:
> > Evals and typeglobs will let you do it.
> > If you don't like that sort of thing (I don't),
> > you can use a module I wrote called SymbolTable
> > which hides all the ugliness for you.
>
> Thanks Greg for taking the time to ponder this, but I believe using
> SymbolTable will just provide a nicer syntax for doing this:
>
> *Module::Under::Test::method2 = sub { ... };
>
> as I previously mentioned. This approach fails to pass this test:
>
> my $mut1 = Module::Under::Test->new();
> *Module::Under::Test::method2 = sub { ... };
> $mut1->method2(); # modified behavior
>
> my $mut2 = Module::Under::Test->new();
> $mut2->method2(); # original behavior
>
> As the call to $mut2->method2() will still invoke the modified behavior,
> because the class, rather than the instance, was modified. (But I think
> you got this, as indicated by your second reply.)
He didn't quite handle that correctly, but there is a solution to that
problem as well. (All code is untested and may not compile.)
sub replace_sub_for_instance {
my ($object, $subroutine_name, $new_subroutine) = @_;
no strict 'refs';
my $old_subroutine = \&$subroutine_name
or die "Subroutine $subroutine_name not found";
my $object_name = refaddr($object);
*$subroutine_name = sub {
my $self = $_[0];
if (refaddr($self) eq $object_name) {
goto $new_subroutine;
}
else {
goto $old_subroutine;
}
};
}
Note that I was careful not to capture the object of interest in the
subroutine because I didn't want to mess up a DESTROY.
> > Hm, not a sub{}.
> > You'd have to insert a sub that would check the
> > reference of the instance and compare it to the one you
> > want to bypass. If they're equal, skip. if not equal
> > then call method2. something like.....
> >
> > my $instance_to_skip = $mut;
> > my $intercept_method2 = sub {
> > my $obj=shift(@_);
> > if($obj eq $instance_to_skip) {
> > return;
> > } else {
> > return ($obj->method2(@_)); # ...
> > }
> > };
> >
> > then assign symboltable for your class so that method2
> > is replaced with $intercept_method2.
Note that the above code does NOT work because after the symbol table
is replaced, method2 goes to the wrong place. You have to capture and
work with subroutine methods.
> If I wanted to interject my own layer of indirection at the instance
> level, and was willing to modify the class under test, I'd probably opt
> for an AUTOLOAD method that translated all method calls into calls that
> would execute a sub ref from the object's hash under a key of the same
> name as the method. Then the exact same thing as is possible in
> JavaScript could be done:
>
> $obj->{method2} = sub { ... };
>
> But this is not a trivial change - either from a code complexity or
> performance perspective - to impose on the module under test. If this is
> the only option, then dealing with a bit of syntax ugliness (creating a
> subclass) in the test class is far preferable.
The main problem that I see with subclasses is what happens if there
is code that checks ref($object) against some pattern. If you know
the code and know that that doesn't happen, then I'd strongly
recommend subclassing. But I've seen code where you can't rely on
that.
Also note that AUTOLOAD and inheritance do NOT play well together.
That's another reason to avoid that solution.
> Browsing further on CPAN turns up Class::Unique:
> http://search.cpan.org/~friedo/Class-Unique-0.03/lib/Class/Unique.pm
>
> which accomplishes the equivalent with this constructor:
>
> sub new {
> my $class = shift;
> my $obj = { };
>
> my $unique_class = $class . '::' . refaddr $obj;
>
> {
> no strict 'refs';
> @{ $unique_class . '::ISA' } = ( $class );
> }
>
> # so we don't have to rely on ref()
> $obj->{$PKG} = $unique_class;
> return bless $obj, $unique_class;
> }
>
> It interjects the address of the object into the class name, then
> creates a subclass using that modified name, and returns an object
> blessed into the subclass. That way each instance has a unique namespace
> in the symbol table. Of course to pull this off your class needs to be a
> subclass of Class::Unique.
This problem is fixable.
sub give_object_unique_subclass {
my $object = shift;
my $class = ref($object);
my $unique_class = $class . "::" . refaddr($object);
{
no strict 'refs';
@{ $unique_class . '::ISA' } = ( $class );
}
bless($object, $unique_class);
}
The only big drawbacks to this are that code that checks ref can
break, and we might break code that depends on the stringification of
$object. (Think inside-out objects.)
> If your class under test is properly designed to allow subclassing, you
> should be able to something like:
>
> my $subclass = __PACKAGE__ . '::test_method1::Module::Under::Test';
> my $mut = Module::Under::Test::new($subclass);
> {
> no strict 'refs';
> @{ $subclass . '::ISA' } = ( 'Module::Under::Test' );
> *{ $subclass . '::method2' } = sub { ... };
> }
>
> But if new() is declared in a superclass, that breaks. And besides, this
> is just creating an uglier, stranger looking subclass. Though it does
> let you get around the limitations of the package statement.
New being declared in a superclass isn't a problem. The problem is if
new hasn't been written to allow subclassing.
> Class::Unique references Class::Prototyped, which simulates a
> prototype-style OO model, as used by JavaScript, in Perl. Schwern's
> Class::Object (incomplete) and Class::Classless are other
> implementations of the same idea. All of these approaches, like
> Class::Unique, require that your code be implemented as a subclass, so
> they aren't ideal for bolting-on to an existing module.
Right.
> > http://backpan.cpan.org/authors/id/G/GS/GSLONDON/SymbolTable-0.02.readme
> > I'm pretty sure it still works.
>
> Is there a reason why you referenced an older version? There seems to be
> a slightly newer version in the current repository:
>
> http://search.cpan.org/~gslondon/Symbol-Table-1.01/Table.pm
>
>
> > Symbol::Table - An easy interface to symbol tables (no eval(), no
> > *typeglobs )
> >
> > use Symbol::Table;
> >
> > # constructor takes two arguments,
> > # (1) which TYPE of symbols (PACKAGE,CODE,SCALAR,ARRAY,HASH)
> > # and (2) what package namespace do you wish to examine
> > # (default value for arguments are 'PACKAGE' and current package
> > namespace)
> > # the return value is a symbol table object.
> > my $st_pkg = Symbol::Table->New('PACKAGE', 'main');
>
> So instead of:
> *Module::Under::Test::method2 = sub { ... };
>
> I'd do:
> use Symbol::Table;
> my $st = Symbol::Table->New('CODE', 'Module::Under::Test');
> $st->{method2} = sub { ... };
>
> Not exactly a win from a conciseness perspective.
Nor a win for those of us who've bothered to learn how to work with
the symbol table who are then faced with learning a new API.
[...]
Cheers,
Ben
_______________________________________________
Boston-pm mailing list
[email protected]
http://mail.pm.org/mailman/listinfo/boston-pm
