Browse files

change representation, fix global destruction

Inside out objects -> blessed arrays (props, proto, tie)
No longer make use of tied representation in internals.
  • Loading branch information...
1 parent 11adf84 commit 26835ed04d07d280f9449f38943d447f2132abca @frodwith committed Aug 5, 2011
Showing with 40 additions and 56 deletions.
  1. +3 −1 TODO
  2. +16 −25 lib/Mew.pm
  3. +14 −21 lib/Mew/Object.pm
  4. +2 −8 lib/Mew/{Hash.pm → Tied.pm}
  5. +5 −1 t/destroy.t
View
4 TODO
@@ -7,4 +7,6 @@ do sensible things when the ultimate prototype is not a Mew object
more tests (isa.t, can.t with foreign objects)
docs
- mention that UNIVERSAL methods can screw with you
+ * mention that UNIVERSAL methods can screw with you
+ * talk about problems using the tied-hash syntax during the global
+ destruction phase
View
41 lib/Mew.pm
@@ -22,36 +22,17 @@ our $Object = extend(undef, {});
sub mew { extend($Object, @_) };
-BEGIN {
- my $mk = sub {
- my $h = shift;
- sub {
- my $o = shift;
- my $i = refaddr $o;
- if (@_ > 0) {
- if (my $v = shift) {
- $h->{$i} = $v;
- }
- else {
- delete $h->{$i};
- }
- }
- return $h->{$i};
- };
- };
+sub props { $_[0]->[0] }
- *proto = $mk->(\my %proto);
- *props = $mk->(\my %props);
- *ties = $mk->(\my %ties);
+sub proto {
+ my $o = shift;
+ $o->[1] = shift if @_ > 0;
+ return $o->[1];
}
sub extend {
my ($proto, $props) = kwn @_, 1;
- my $o = do { \my $o };
- bless $o, 'Mew::Object';
- proto($o => $proto);
- props($o => $props);
- return $o;
+ bless [ $props, $proto ], 'Mew::Object';
}
sub own {
@@ -69,4 +50,14 @@ sub pairs {
return @pairs;
}
+sub get {
+ my ($self, $key) = @_;
+ while ($self) {
+ my $h = props($self);
+ return $h->{$key} if exists $h->{$key};
+ $self = Mew::proto($self);
+ }
+ return undef;
+}
+
1;
View
35 lib/Mew/Object.pm
@@ -5,14 +5,14 @@ use strict;
require Scalar::Util;
require Mew;
-require Mew::Hash;
+require Mew::Tied;
use overload
'%{}' => sub {
my $self = shift;
- Mew::ties($self) || do {
- tie my %h, 'Mew::Hash', $self;
- Mew::ties($self => \%h)
+ $self->[2] ||= do {
+ tie my %h, 'Mew::Tied', $self;
+ \%h;
};
},
fallback => 1;
@@ -44,24 +44,21 @@ sub can {
return UNIVERSAL::can($o, $name)
unless eval { $o->isa('Mew::Object') };
- my $ex = eval { exists $o->{$name} };
- # lookup can fail during global destruction, or if someone does
- # something crazy like Sub::Delete-ing Mew::ties or something. If that
- # happens, we'll just say "no, we can't."
- return '' if $@;
- if ($ex) {
- my $prop = $o->{$name};
- my $reft = Scalar::Util::reftype($prop);
- return $prop if $reft && (
- $reft eq 'CODE' || overload::Method($prop, '&{}')
+ my $p = Mew::props($o);
+
+ if (exists $p->{$name}) {
+ my $val = $p->{$name};
+ my $reftype = Scalar::Util::reftype($val);
+ return $val if $reftype && (
+ $reftype eq 'CODE' || overload::Method($val, '&{}')
);
return '';
}
$o = Mew::proto($o);
}
- if (my $loader = $self->{_autoload}) {
+ if (my $loader = Mew::get($self, '_autoload')) {
my $loaded = $self->$loader($name);
return $loaded if $loaded;
}
@@ -83,12 +80,8 @@ sub AUTOLOAD {
sub DESTROY {
my $self = shift;
- if (my $d = $self->can('_destroy')) {
- $self->$d();
- }
- Mew::proto($self, undef);
- Mew::props($self, undef);
- Mew::ties($self, undef);
+ my $d = $self->can('_destroy');
+ $self->$d() if $d;
}
1;
View
10 lib/Mew/Hash.pm → lib/Mew/Tied.pm
@@ -1,4 +1,4 @@
-package Mew::Hash;
+package Mew::Tied;
use warnings;
use strict;
@@ -14,13 +14,7 @@ sub TIEHASH {
sub FETCH {
my ($self, $key) = @_;
- $self = $self->[1];
- while ($self) {
- my $h = Mew::props($self);
- return $h->{$key} if exists $h->{$key};
- $self = Mew::proto($self);
- }
- return undef;
+ Mew::get($self->[1], $key);
}
1;
View
6 t/destroy.t
@@ -20,4 +20,8 @@ undef $o;
is $d, 0;
undef $b;
-is $d, 1;
+
+# This will be 2 now because it will be called for on $b's destruction, and
+# ALSO on $o's destruction ($b will no longer be referencing it as its
+# prototype).
+is $d, 2;

0 comments on commit 26835ed

Please sign in to comment.