Just when you thought it was safe to get back in the water... another variation on the theme of Abigail-II's inside out objects!
First a quick example. Declare classes like this...
package Carpet;
use base qw(Class::InsideOut); # base class that does the work
use Class::InsideOut::Accessor; # filter that generates accessors
use Class::InsideOut::YAML; # allow YAML serialisation
sub new {bless [], shift};
{
# declare object attributes
my (%width, %height) : Field;
sub area {
my $self = shift->self; # get the hash key for $self
$width{$self} * $height{$self};
};
}
{
# another object attribute, note the scoping
my %unit_price : Field;
sub price {
my $self = shift;
$self->area * $unit_price{$self->self};
};
};
# note, we are forced to use methods since the hashes are scoped
# to the blocks enclosing the methods - now *that's* private :-)
sub display {
my $self = shift;
my ($width, $height, $area, $unit_price, $price) = ($self->width,
$self->height, $self->area, $self->unit_price, $self->price);
print "$width x $height ($area sq m) @ \$$unit_price = \$$price\n"
+;
};
# note lack of DESTROY method - all done automagically
Use them like this...
use Carpet;
use YAML;
my $o = Carpet->new;
$o->width(10);
$o->height(10);
$o->unit_price(1.00);
my $o2 = Load(Dump($o)); # serialisation with YAML
$o2->width(15);
$o2->unit_price(0.85);
$o->display;
$o2->display;
print "difference = \$", abs($o->price - $o2->price), "\n";
To produce...
10 x 10 (100 sq m) @ $1 = $100
15 x 10 (150 sq m) @ $0.85 = $127.5
difference = $27.5
If you don't know what inside out objects are, take a look at this thread started by Abigail-II, Yet Another Perl Object Model (Inside Out Objects) and A different OO approach.
So what does this variation give you:
- No hand-rolled DESTROY methods for each class. All the DESTROY functionality is handled in Class::InsideOut::DESTROY. This means you are free to write your own class DESTROY methods, as long as you remember to do a $self->NEXT::DESTROY at the end.
- No new() function in the base class, so you can mix it into "normal" perl objects with no worries.
- You get direct access to the hashes that store the attributes inside the class - so you get nice compile time errors if you make a typing mistake.
- Hashes used as object attributes are clearly indicated by the ":Field" attribute - making them easy to differentiate from other uses of hashes in the class. Self documenting code is good.
- Because of the way the base class handles the DESTROY you can actually have object attributes hashes have a tighter scope than the whole class!
- You don't have to have accessor functions generated for you if you don't want to - it's a separate source filter. Private attributes can stay private.
- Object serialisation with YAML (if you want it). I freely admit that I did it this way because I wanted to look at YAML in more detail for some time and this seemed as good an excuse as any :-)
- Everything works with overloading operations and reblessing objects.
- DESTROY and serialisation work even if you bless your object into a different class hierarchy!
... and the downside:
- The flexible DESTROY is slower than the hand-rolled ones.
- The source filter for auto-generating accessor functions is, well, a source filter. There are probably some cases it doesn't handle 100%... the regexes used haven't been tested much.
- The YAML serialisation is a bit of a hack because YAML.pm is not re-enterant - which is a pain.
- It should present better warnings when you try and create accessors with the same name as an existing accessor sub.
- ... more ? ...
Finally, the code. After my annoying comments on other peoples implementations I thought it only fair that people had the chance to hassle me in return :-) Everything apart from serialisation & accessor generation is in the first 30 29 lines.
It's interesting to compare this with demerphq's "Yet Another Perl Object Model (Inside Out Objects)". Almost the same goals. Very different implementations.
You can download a gziped tar archive from http://www.quietstars.com/perl/ if you find that more convenient.
lib/Class/InsideOut.pm
#! /usr/bin/perl
use strict;
use warnings;
package Class::InsideOut;
use Attribute::Handlers;
use NEXT;
use Scalar::Util 1.09 qw(blessed refaddr);
our $VERSION = 0.01;
sub self { refaddr shift };
my %Values;
sub Field : ATTR(HASH) {
my ($class, $symbol, $hash) = @_;
my $values = $Values{$class} ||= [];
push @{$values}, $hash;
};
sub DESTROY {
my $self = $_[0];
my $id = $self->self;
while ( my ($class, $values) = each %Values ) {
delete $_->{$id} foreach (@$values);
};
$self->NEXT::DESTROY()
};
package Class::InsideOut::YAML;
sub yaml_dump {
my $item = shift;
my $class = ref $item;
my $self_id = $item->self;
my $inverted = {};
while (my ($class, $values) = each %Values) {
my $class_fields = $inverted->{$class} ||= [];
foreach my $field (@$values) {
push @$class_fields, $field->{$self_id};
};
delete $inverted->{$class} unless @$class_fields;
};
my $ynode = YAML::Node->new({}, "perl/$class");
$ynode->{class} = $class;
$ynode->{object} = bless Storable::dclone($item), 'Class::InsideOu
+t::Frozen';
$ynode->{inverted} = $inverted;
return($ynode);
};
sub yaml_load {
my $ynode = shift;
my $self = bless $ynode->{object}, $ynode->{class};
my $inverted = $ynode->{inverted};
my $self_id = $self->self;
while (my ($class, $values) = each %$inverted) {
my $i = 0;
foreach my $value (@$values) {
$Values{$class}->[$i++]->{$self_id} = $value;
};
};
return(bless $self, $ynode->{class});
};
1;
lib/Class/InsideOut/Accessor.pm
#! /usr/bin/perl
package Class::InsideOut::Accessor;
use strict;
use warnings;
use Filter::Simple;
our $VERSION = 0.01;
sub add_accessor {
my $name = shift;
qq[sub $name {
my \$self = shift->self;
\@_ ? \$$name\{\$self\} = shift : \$$name\{\$self\};
};];
};
FILTER {
s [
( \b (my|our) \s* %(\w+) \s* : \s* Field \s* ; )
] [ $1 . add_accessor($3) ]gxse;
s [
( \b (my|our) \s* \( \s* ( .*? ) \s* \) \s* : \s* Field ; )
] [
$1 . join(
'', map {add_accessor(substr($_,1))} split(/\s*,\s*/, $3)
);
]gxse;
};
1;
lib/Class/InsideOut/YAML.pm
package Class::InsideOut::YAML;
use YAML::Node;
use Storable ();
use Class::InsideOut; # where the implementation is
use base qw(Exporter);
our $VERSION = 0.01;
our @EXPORT = qw(yaml_load yaml_dump);
1;
Have fun :-)
Updates:
Redundant line removed from DESTROY method. Spotted by John M. Dlugosz
Re: Class::InsideOut - yet another riff on inside out objects.
by John M. Dlugosz (Monsignor) on Dec 18, 2002 at 22:14 UTC
|
Without regard to how it's actually implemented, I want to say that I like the idea of using the :Field attribute to declare instance data.
As for the source filter, I wonder if maybe you could use AUTOLOAD to generate the accessors when/if they are first used? The :Field attrib would store a reference to the hash and its name, and the generator would look it up to see if that name existed, without worrying about the scope of the underlying declared hash.
A benifit of the inside-out approach in general is that names of instance data can be reused in derived classes without conflict.
I don't understand your DESTROY. You define $class on one line to be my blessed class, then define it again on the next line to be every key in the Values hash. Isn't this going to destroy all classes? That is, don't you want a single $values=$Values{$class}, rather than iterating over all $Values?
—John | [reply] |
|
As for the source filter, I wonder if maybe you could use AUTOLOAD to generate the accessors when/if they are first used? The :Field attrib would store a reference to the hash and its name, and the generator would look it up to see if that name existed, without worrying about the scope of the underlying declared hash.
The problem is in getting the name of the hash.
If it's a global var then you can get at it via the GLOB Attribute::Handlers passes you. Which is easy.
Unfortunately all you get for a lexical variable is the string 'LEXICAL'. Since at the point the handler is called the variable isn't in the pad yet, you cannot get at it with PadWalker either.
As far as I can see the only way of getting the name for a lexically scoped hash is to use a source filter - but if anybody has a sneakier solution I'd love to hear it :-)
I did briefly consider :
my %foo : Field; # no accessor
our %foo : Field; # accessor created automatically
but I couldn't really find a justification for overloading the meaning of our/my in this way.
I don't understand your DESTROY. You define $class on one line to be my blessed class, then define it again on the next line to be every key in the Values hash. Isn't this going to destroy all classes? That is, don't you want a single $values=$Values{$class}, rather than iterating over all $Values?
The line is redundent - hangover from an earlier version. Well spotted. I've removed it.
You don't want to just look at $Values{$class}, since you need to destroy inherited attributes too. So the DESTROY method deletes all instances of a particular object in all classes.
Why the overkill? Why not just check the @ISA hierarchy for the object? Because it might have been blessed into another class (e.g. when implementing a series of state classes).
Have a test script, just to reassure:
use Test::More tests => 3;
use strict;
use warnings;
{
package Foo;
use base qw(Class::InsideOut);
sub new { bless {}, shift };
my %foo :Field;
sub foo {
my $self = shift->self;
@_ ? $foo{$self} = shift : $foo{$self};
};
sub Num_objects { scalar(keys(%foo)) };
package Bar;
use base qw(Class::InsideOut);
};
{
my $o1 = Foo->new;
$o1->foo(1);
{
my $o2 = Foo->new;
$o2->foo(2);
bless $o2, 'Bar';
is( Foo->Num_objects, 2, '2 objects' );
};
is( Foo->Num_objects, 1, '1 object' );
};
is( Foo->Num_objects, 0, '0 objects' );
Produces
1..3
+
ok 1 - 2 objects
+
ok 2 - 1 object
+
ok 3 - 0 objects
You could make it more efficient (e.g. overload bless and keep track of what classes an object has been and only examine those hierarchies) - but I thought I'd keep it simple for now!
| [reply] [d/l] [select] |
|
If you need to go hunting for lexicals then you start with PadWalker. If the lexical you are looking for isn't immediately visible then you might also use Devel::Caller to get the code references for other places in the calling stack. You'd then use PadWalker on those references to check for otherwise inaccessible lexicals. Eventually every lexical exists in some scope that itself is visible either from the symbol table or via the calling stack.
Fun Fun Fun in the Fluffy Chair
| [reply] |
|
|
|
|
|
|
I think I have something for you.
I've been raking my brain for ways of having the attribute routine somehow register something like a hook whose call is delayed so that by the time the hook is triggered, the hash is on the pad. I hadn't been able to come up with any approach so far.
The idea I just came up with is simple: tie. :-)
Tie the attribute hash temporarily. The first access to it will trigger a call whence PadWalker can hopefully locate it. The rest is details - create an accessor closure in the appropriate package and untie the hash.
Unfortunately I'm not of much help since 5.6.1 manages the pads differently and I can't write test code to confirm this. But you should be able to make something of it.
Makeshifts last the longest.
| [reply] |
|
|
|
|
|
The problem is in getting the name of the hash.
I was thinking that a reference to the hash is passed to the attribute handler. I see now that the problem isn't finding the hash, but deciding on the name of the accessor to go with it! I suppose that's a flaw/oversight of the attribute stuff.
Isn't there a way to get a symbol's name given a ref? Maybe it only works for functions or when debug mode is enabled...? But I thought I read about that somewhere.
Update: I was thinking of the *whatever{NAME} syntax, which needs a glob not a ref.
| [reply] [d/l] |
|
|
You don't want to just look at $Values{$class}, since you need to destroy inherited attributes too.
Isn't that going to be done by that class's DESTROY method? That is, the "next" call will do it.
So the DESTROY method deletes all instances of a particular object in all classes.
I see, that won't wipe out everything, just all the attributes of that object since instance keys are unique.
| [reply] |
|
|
|
Re: Class::InsideOut - yet another riff on inside out objects.
by Aristotle (Chancellor) on Dec 19, 2002 at 16:15 UTC
|
In general, I like your approach - a lot.
One thing that annoyed me is the $self->self meme. Confusing, IMO, and not efficient either. I toyed around with the idea of wrapping subs in some way, but haven't come up with any really consistent and watertight semantics. :-/ The only possibility would be to tie all field hashes to a class that autocasts any refs used as keys into their refaddr before using them but that doesn't perform any better. Overloading the stringification on the reference might help, but will neither perform better nor work reliably if someone else overloads the same operation. So there really seems to be no other way than to remind everyone to use $self->self everywhere. Though I'd probably call that $self->_id instead. Or maybe an attribute Self? Not sure yet.. gonna have to look into that.
That aside, here's my take on the base class - minus refaddr cause it doesn't work on 5.6.1. What I do is quite simple: store the hashref to the pad :-). Then all that AUTOLOAD has to do is trawl through the pad hashrefs and look for a matching attribute.
#!/usr/bin/perl
use strict;
use warnings;
package Class::InsideOut;
use NEXT;
use Attribute::Handlers;
use PadWalker qw(peek_my);
use Data::Dumper;
use vars qw($AUTOLOAD);
my (@Field, %Pad);
sub Field : ATTR(HASH) {
my ($class, $symbol, $hash) = @_;
push @Field, $hash;
my $pad = peek_my(3);
$Pad{$class}->{$pad} = peek_my(3);
}
sub AUTOLOAD {
my $self = $_[0];
my ($class, $field) = $AUTOLOAD =~ /^(.*)::(.*)$/;
$field = "%".$field;
my @field = grep exists $_->{$field}, values %{$Pad{$class}};
if(@field) {
$field = $field[0];
no strict 'refs';
*{$AUTOLOAD} = sub {
my $self = shift;
@_ ? $field->{$self} = shift : $field->{$self};
};
goto &{$AUTOLOAD};
}
else {
warn "\@field is empty";
return $self->NEXT::AUTOLOAD;
}
}
sub DESTROY {
my $self = $_[0];
delete $_->{$self} for @Field;
$self->NEXT::DESTROY()
}
1;
And some test code:
package Foo::Bar;
use base qw(Class::InsideOut);
use Data::Dumper;
my (%foo, %bar, %baz): Field;
package main;
my $x = bless [], 'Foo::Bar';
$x->foo("bar!\n");
print $x->foo(), "\n";
__END__
bar!
I don't know if it's watertight, though. In particular, how well will it work if I call an accessor for a superclasses' field on a subclass?
Makeshifts last the longest. | [reply] [d/l] [select] |
|
In general, I like your approach - a lot.
<blush />
One thing that annoyed me is the $self->self meme.
Me to, but like you I cannot see a way round it. I've just renamed it self_id in my local version.
That aside, here's my take on the base class - minus refaddr cause it doesn't work on 5.6.1.
Are you sure? It's basically the same implementation as the one here.
What I do is quite simple: store the hashref to the pad :-). Then all that AUTOLOAD has to do is trawl through the pad hashrefs and look for a matching attribute.
Falls over completely on 5.8.0. Probably because of this :-)
I like your use of an array to store the class hashes in. Makes the logic easier to understand. Might be a problem in the context of serialisation - since the position of the hash depends on the load order of the classes used by your application. You could always store a class->position mapping I guess.
I don't know if it's watertight, though. In particular, how well will it work if I call an accessor for a superclasses' field on a subclass?
There's the begining of a test suite in the version at http://www.quietstars.com/perl/ if you're interested.
| [reply] |
|
Falls over completely on 5.8.0.
:((
I did not think about serialization at all when I moved to an array - there was a very simple reason for that - my first step was, since you're not using the $class in your while in DESTROY, to make that
delete $_->{id} for map @$_, values %Values;
At that point I blinked, looked hard at the entire source I had in front of me, which didn't include ::YAML, and saw there was nothing to ever make use of the key - obviously an oversight. I haven't looked at the ::YAML code at all yet (not the least reason being I haven't dealt with at YAML at all yet either) so I'm not sure if that will work, but a simple way out might be an extra hash keyed on the refaddr of the fieldhashref and storing arrays of classnames. I'm just pulling straws out of thin air here though.
Makeshifts last the longest.
| [reply] [d/l] |
|
Hmm, I think we are getting away from the real issue. Finding a way to hook up lexicals with attributes is not the real point, though interesting in itself. The real point is to make a succinct way to declare instance data.
So, don't use an attributed declaration. Instead, use a syntax like: field ('name', options); that will create the underlying hash itself, rather than the caller making one.
The underlying hash can either be "hands off", or there can be a way to get to it (return value from that call?) if you really want to support it.
{ # extra scope
$xx= field qw/xx private/;
sub something
{
# I use that instance data internally.
# ...
... $$xx{$id} ...
}
Being private, no access method is autogenerated, and the returned ref is the only way to get to it.
—John | [reply] [d/l] [select] |
|
| [reply] |
|
|
This would work, but has a couple of minor issues:
- We've added another layer of indirection. Means that direct access is a little slower.
- We have to mention the "name" of the object attribute twice (the xx in $$xx and qw/xx private/.
- It's more work if you don't want the accessors.
If we want to name an object attribute explicitly we could do it with a modified :Field attribute. For example, something like this wouldn't be hard to implement.
my %foo : Field; # no accessor
my %foo : Field(as foo); # create accessor named foo
While easy to implement, it still has the duplication of names... which offends :-)
| [reply] [d/l] [select] |
|
|
|
|
Re: Class::InsideOut - yet another riff on inside out objects.
by demerphq (Chancellor) on Jan 05, 2003 at 22:47 UTC
|
Wow. Dont know how I missed this node. Cool. ++
I dont have much time for a comprehensive response right now but I wanted to
point out that using YAML is a mistake. It is one of the least accurate dumpers out there. Furthermore the author is well aware of the problems in his code and has deliberately chosen to ignore them. (One instance of this is clearly documented in the modules POD, others I have discussed with him by email.) Don't bother with it for any mildly non-trivial data storage as you will eventually get bitten by its failings. If the author took the time he has use to hype the module to make it robust then it might be worth using. However IMO it currently isnt.
Cheers,
--- demerphq
my friends call me, usually because I'm late....
| [reply] |
Re: Class::InsideOut - yet another riff on inside out objects.
by Courage (Parson) on Dec 24, 2002 at 17:25 UTC
|
Just a simple question:
Does your approach supports inheritance? multiple inheritance?
Does Abigail-II's approach supports multiple inheritance?
Thank you for good idea, it's really interesting.
Courage, the Cowardly Dog | [reply] |
|
use strict;
use warnings;
use Class::InsideOut::Accessor;
{
package Square;
use base qw(Class::InsideOut);
my (%x, %y, %size) : Field;
sub new { bless [], shift };
};
{
package Coloured;
use base qw(Class::InsideOut);
my %colour : Field;
};
{
package ColourSquare;
use base qw(Square Coloured);
};
my $o = ColourSquare->new;
$o->x(10);
$o->y(12);
$o->size(6);
$o->colour("red");
print "the colour is ", $o->colour;
Does Abigail-II's approach supports multiple inheritance?
Yes (and my method is Abigail-II's method with some syntactic sugar and a different DESTROY mechanism).
The advantage of doing it this way is that some kinds of problems caused by the traditional hash mechanism disappear because it is guaranteed that there is no sharing of attributes between classes.
One of the problems of using a traditional hash is that if two different classes use the same hash key to index an attribute then you cannot directly inherit from both of them (because they try and use the same bit of the hash for different purposes). You can use things like Class::Delegation to get around this problem, but it is more work - and tracking down the bug can take time.
Of course, all this depends on what you mean by multiple inheritance! Some languages (e.g. Eiffel) have a far more flexible approach to MI than languages like C++, Java & Perl.
For example, Class::InsideOut doesn't support inheriting from a class multiple times and having multiple copies of the attribute. But this isn't supported in the perl hash-style object implementation either.
If you're interested in multiple inheritance I would spend some time introducing yourself to inheritance in Eiffel (this page has some pointers) which is the most comprehensive model of MI I've come across in any language. It's quite hard to do some things in perl that are trivial in Eiffel.... Hmmm... might be worth a meditation at some later date... | [reply] [d/l] |
|
First off multiple code inheritance is supported any way you do OO in Perl.
As far as this is concerned it is basically Abigail's approach and yes, it supports multiple data inheritance flawlessly. In contrast, that's anywhere from difficult to an outright pain with the traditional hashref based approach.
Makeshifts last the longest.
| [reply] |
|
| [reply] |
|
Looks like I lied slightly - I've just found what I think is a bug in Attribute::Handlers that can cause Class::InsideOut to fail if you have multiple inheritence and custom DESTROY methods in the subclasses.
<sigh>
NOTE: this has nothing to do with a problem in Abigail's technique - just the use of Attribute::Handlers to implement the field declaration.
| [reply] |
|
|