view release on metacpan or  search on metacpan

lib/Object/Hybrid.pm  view on Meta::CPAN

sub LOAD_ARRAY_MUTABLE_CALLER  { $_[0]->_compile_class($CLASS_TEMPLATE, $_[1]); }

sub LOAD_GLOB_STATIC           { $_[0]->_compile_class($CLASS_TEMPLATE, $_[1]); }
sub LOAD_GLOB_STATIC_CALLER    { $_[0]->_compile_class($CLASS_TEMPLATE, $_[1]); }
sub LOAD_GLOB_MUTABLE          { $_[0]->_compile_class($CLASS_TEMPLATE, $_[1]); }
sub LOAD_GLOB_MUTABLE_CALLER   { $_[0]->_compile_class($CLASS_TEMPLATE, $_[1]); }

sub LOAD_SCALAR_STATIC         { $_[0]->_compile_class($CLASS_TEMPLATE, $_[1]); }
sub LOAD_SCALAR_STATIC_CALLER  { $_[0]->_compile_class($CLASS_TEMPLATE, $_[1]); }
sub LOAD_SCALAR_MUTABLE        { $_[0]->_compile_class($CLASS_TEMPLATE, $_[1]); }
sub LOAD_SCALAR_MUTABLE_CALLER { $_[0]->_compile_class($CLASS_TEMPLATE, $_[1]); }

sub LOAD_HASH_UNTIED           { $_[0]->_compile_class(<<'CLASS',       $_[1]);

package PACKAGE_REPLACE; 
    $INC{INCKEY_REPLACE} ||= 1; 
our @ISA = 'Object::Hybrid::BASE'; 

use Object::Hybrid::Class; # just labeling
use Scalar::Util qw(reftype refaddr);

#sub can { $_[0]->UNIVERSAL::can($_[1]) } 

Object::Hybrid->methods({ 
	tied   => sub { undef },
	fast     => sub { $_[0] },
	self     => sub { $_[0] },
	TIEHASH  => sub { bless {}, ref($_[0])||$_[0] },
	STORE    => sub { $_[0]->{$_[1]} = $_[2] },
	FETCH    => sub { $_[0]->{$_[1]} },
	FIRSTKEY => sub { my $a = scalar keys %{$_[0]}; each %{$_[0]} },
	NEXTKEY  => sub { each %{$_[0]} },
	EXISTS   => sub { exists $_[0]->{$_[1]} },
	DELETE   => sub { delete $_[0]->{$_[1]} },
	CLEAR    => sub { %{$_[0]} = () },
	SCALAR   => sub { scalar %{$_[0]} },
});

CLASS

}

sub LOAD_SCALAR_UNTIED { $_[0]->_compile_class(<<'CLASS', $_[1]);

package PACKAGE_REPLACE; 
    $INC{INCKEY_REPLACE} ||= 1; 
our @ISA = 'Object::Hybrid::BASE'; 

use Object::Hybrid::Class; # just labeling
use Scalar::Util qw(reftype refaddr);

#sub can { $_[0]->UNIVERSAL::can($_[1]) } 

Object::Hybrid->methods({  
	tied   => sub { undef },
	fast      => sub { $_[0] },
	self      => sub { $_[0] },
	TIESCALAR => sub {
		my $class = shift;
		my $instance = shift || undef;
		return bless \$instance => $class;
	},
	FETCH   => sub { ${$_[0]}  },
	STORE   => sub { ${$_[0]} = $_[1] },
});

CLASS

}

sub LOAD_ARRAY_UNTIED { $_[0]->_compile_class(<<'CLASS', $_[1]);

package PACKAGE_REPLACE; 
    $INC{INCKEY_REPLACE} ||= 1; 
our @ISA = 'Object::Hybrid::BASE'; 

use Object::Hybrid::Class; # just labeling
use Scalar::Util qw(reftype refaddr);

#sub can { $_[0]->UNIVERSAL::can($_[1]) } 

Object::Hybrid->methods({ 
	tied      => sub { undef },
	fast      => sub { $_[0] },
	self      => sub { $_[0] },
	TIEARRAY  => sub { bless [], $_[0] },
	FETCHSIZE => sub { scalar @{$_[0]} },
	STORESIZE => sub { $#{$_[0]} = $_[1]-1 },
	STORE     => sub { $_[0]->[$_[1]] = $_[2] },
	FETCH     => sub { $_[0]->[$_[1]] },
	CLEAR     => sub { @{$_[0]} = () },
	POP       => sub { pop(@{$_[0]}) },
	PUSH      => sub { my $o = shift; push(@$o,@_) },
	SHIFT     => sub { shift(@{$_[0]}) },
	UNSHIFT   => sub { my $o = shift; unshift(@$o,@_) },
	EXISTS    => sub { exists $_[0]->[$_[1]] },
	DELETE    => sub { delete $_[0]->[$_[1]] },
	EXTEND    => sub {},
	SPLICE    => sub {
		my $ob  = shift;
		my $sz  = $ob->FETCHSIZE;
		my $off = @_ ? shift : 0;
		$off   += $sz if $off < 0;
		my $len = @_ ? shift : $sz-$off;
		return splice(@$ob,$off,$len,@_);
	},
});

CLASS

}

sub LOAD_GLOB_UNTIED  { $_[0]->_compile_class(<<'CLASS', $_[1]);

package PACKAGE_REPLACE; 
    $INC{INCKEY_REPLACE} ||= 1; 
our @ISA = 'Object::Hybrid::BASE'; 

use Object::Hybrid::Class; # just labeling
use Scalar::Util qw(reftype refaddr);