Hash-AsObject-0.13/0040755000076500007650000000000011307736012013754 5ustar nkuitsenkuitseHash-AsObject-0.13/Changes0100644000076500007650000000430611307735747015265 0ustar nkuitsenkuitse# Change log for Perl module Hash::AsObject --- version: 0.13 date: 09 Dec 2009 changes: - oops, forgot to include test for infinite recursion --- version: 0.12 date: 09 Dec 2009 changes: - fixed infinite recursion when subclassed (rt.cpan.org #52597) note: Thanks to Skye Shaw for reporting this with a patch --- version: 0.11 date: 16 Feb 2009 changes: - include MANIFEST in release (rt.cpan.org #32612) --- version: 0.10 date: 20 Jan 2008 changes: - enable subclassing (rt.cpan.org #32140) - can() now returns a code ref, not 1 (rt.cpan.org #32141) - define autoloaded methods without using string eval (rt.cpan.org #32146) note: Thanks to Florian Ragwitz for finding and reporting these bugs --- version: 0.09 date: 01 Apr 2007 changes: - Fix documentation bugs (reported by Ricardo Signes and Thomas Linden) note: version 0.08 was never released because of a technical glitch --- version: 0.07 date: 02 Mar 2007 changes: - Improve documentation of special methods - can() and isa() are now (semi-)special again --- version: 0.06 (unreleased) date: 05 Mar 2006 changes: - > Fixed typo in isa (was calling UNIVERSAL::can instead of UNIVERSAL::isa) --- version: 0.05 date: 28 Apr 2004 changes: - > Fixed handling of VERSION, can, import, isa --- version: 0.04 date: 11 Mar 2004 changes: - > Changed name to Hash::AsObject --- version: 0.03 date: 25 Sep 2003 changes: - > Added support for Hash::ObjectLike->new( foo => 123, bar => 456 ) flavor in addition to Hash::ObjectLike->new( {foo => 123, bar => 456} ) - > Fixed: $obj->AUTOLOAD resulted in Hash::ObjectLike::AUTOLOAD being redefined - > Improved handling of $obj->DESTROY --- version: 0.02 date: 10 Sep 2003 changes: - > To speed things up, AUTOLOAD() now defines accessor methods, which means it's only called once for each key. - > Revised tests to catch a silly coding mistake (blessing things into main). - > Added test for $foo->bar($myhash)->baz - > Documented the fact that hashes stored into a Hash::ObjectLike are always blessed as a result. --- version: 0.01 date: 09 Sep 2003 changes: - Basic functionality, all in AUTOLOAD(). Hash-AsObject-0.13/lib/0040755000076500007650000000000011307736012014522 5ustar nkuitsenkuitseHash-AsObject-0.13/lib/Hash/0040755000076500007650000000000011307736012015405 5ustar nkuitsenkuitseHash-AsObject-0.13/lib/Hash/AsObject.pm0100644000076500007650000002417711307736001017443 0ustar nkuitsenkuitsepackage Hash::AsObject; use strict; use vars qw($VERSION $AUTOLOAD); $VERSION = '0.13'; sub VERSION { return $VERSION unless ref($_[0]); scalar @_ > 1 ? $_[0]->{'VERSION'} = $_[1] : $_[0]->{'VERSION'}; } sub can { # $obj->can($method) # $cls->can($method) die "Usage: UNIVERSAL::can(object-ref, method)" unless @_ == 2; my ($invocant, $method) = @_; # --- Define a stub method in this package (to speed up later invocations) my $cls = ref($invocant) || $invocant; no strict 'refs'; return sub { my $v; if (scalar @_ > 1) { $v = $_[0]->{$method} = $_[1]; return undef unless defined $v; } else { $v = $_[0]->{$method}; } if (ref($v) eq 'HASH') { bless $v, $cls; } else { $v; } }; } sub import { return unless ref($_[0]); scalar @_ > 1 ? $_[0]->{'import'} = $_[1] : $_[0]->{'import'}; } sub AUTOLOAD { my $invocant = shift; my $key = $AUTOLOAD; # --- Figure out which hash element we're dealing with if (defined $key) { $key =~ s/.*:://; } else { # --- Someone called $obj->AUTOLOAD -- OK, that's fine, be cool # --- Or they might have called $cls->AUTOLOAD, but we'll catch # that below $key = 'AUTOLOAD'; } # --- We don't need $AUTOLOAD any more, and we need to make sure # it isn't defined in case the next call is $obj->AUTOLOAD # (why the %*@!? doesn't Perl undef this automatically for us # when execution of this sub ends?) undef $AUTOLOAD; # --- Handle special cases: class method invocations, DESTROY, etc. if (ref($invocant) eq '') { # --- Class method invocation if ($key eq 'import') { # --- Ignore $cls->import return; } elsif ($key eq 'new') { # --- Constructor my $elems = scalar(@_) == 1 ? shift # $cls->new({ foo => $bar, ... }) : { @_ } # $cls->new( foo => $bar, ... ) ; return bless $elems, $invocant; } else { # --- All other class methods disallowed die "Can't invoke class method '$key' on a Hash::AsObject object"; } } elsif ($key eq 'DESTROY') { # --- This is tricky. There are four distinct cases: # (1) $invocant->DESTROY($val) # (2) $invocant->DESTROY() # (2a) $invocant->{DESTROY} exists and is defined # (2b) $invocant->{DESTROY} exists but is undefined # (2c) $invocant->{DESTROY} doesn't exist # Case 1 will never happen automatically, so we handle it normally # In case 2a, we must return the value of $invocant->{DESTROY} but not # define a method Hash::AsObject::DESTROY # The same is true in case 2b, it's just that the value is undefined # Since we're striving for perfect emulation of hash access, case 2c # must act just like case 2b. return $invocant->{'DESTROY'} # Case 2c -- autovivify unless scalar @_ # Case 1 or exists $invocant->{'DESTROY'}; # Case 2a or 2b } # --- Handle the most common case (by far)... # --- All calls like $obj->foo(1, 2) must fail spectacularly die "Too many arguments" if scalar(@_) > 1; # We've already shift()ed $invocant off of @_ # --- If someone's called $obj->AUTOLOAD if ($key eq 'AUTOLOAD') { # --- Tread carefully -- we can't (re)define &Hash::AsObject::AUTOLOAD # because that would ruin everything return scalar(@_) ? $invocant->{'AUTOLOAD'} = shift : $invocant->{'AUTOLOAD'}; } else { my $cls = ref($invocant) || $invocant; no strict 'refs'; *{ "${cls}::$key" } = sub { my $v; if (scalar @_ > 1) { $v = $_[0]->{$key} = $_[1]; return undef unless defined $v; } else { $v = $_[0]->{$key}; } if (ref($v) eq 'HASH') { bless $v, $cls; } else { $v; } }; unshift @_, $invocant; goto &{ "${cls}::$key" }; } } 1; =head1 NAME Hash::AsObject - treat hashes as objects, with arbitrary accessors/mutators =head1 SYNOPSIS $h = Hash::AsObject->new; $h->foo(123); print $h->foo; # prints 123 print $h->{'foo'}; # prints 123 $h->{'bar'}{'baz'} = 456; print $h->bar->baz; # prints 456 =head1 DESCRIPTION A Hash::AsObject is a blessed hash that provides read-write access to its elements using accessors. (Actually, they're both accessors and mutators.) It's designed to act as much like a plain hash as possible; this means, for example, that you can use methods like C to get or set hash elements with that name. See below for more information. =head1 METHODS The whole point of this module is to provide arbitrary methods. For the most part, these are defined at runtime by a specially written C function. In order to behave properly in all cases, however, a number of special methods and functions must be supported. Some of these are defined while others are simply emulated in AUTOLOAD. =over 4 =item B $h = Hash::AsObject->new; $h = Hash::AsObject->new(\%some_hash); $h = Hash::AsObject->new(%some_other_hash); Create a new L. If called as an instance method, this accesses a hash element 'new': $h->{'new'} = 123; $h->new; # 123 $h->new(456); # 456 =item B This method cannot be used to access a hash element 'isa', because Hash::AsObject doesn't attempt to handle it specially. =item B Similarly, this can't be used to access a hash element 'can'. =item B $h->{'AUTOLOAD'} = 'abc'; $h->AUTOLOAD; # 'abc' $h->AUTOLOAD('xyz') # 'xyz' Hash::AsObject::AUTOLOAD recognizes when AUTOLOAD is begin called as an instance method, and treats this as an attempt to get or set the 'AUTOLOAD' hash element. =item B $h->{'DESTROY'} = []; $h->DESTROY; # [] $h->DESTROY({}) # {} C is called automatically by the Perl runtime when an object goes out of scope. A Hash::AsObject can't distinguish this from a call to access the element $h->{'DESTROY'}, and so it blithely gets (or sets) the hash's 'DESTROY' element; this isn't a problem, since the Perl interpreter discards any value that DESTROY returns when called automatically. =item B When called as a class method, this returns C<$Hash::AsObject::VERSION>; when called as an instance method, it gets or sets the hash element 'VERSION'; =item B Since L doesn't export any symbols, this method has no special significance and you can safely call it as a method to get or set an 'import' element. When called as a class method, nothing happens. =back The methods C and C are special, because they're defined in the C class that all packages automatically inherit from. Unfortunately, this means that you can't use L to access elements 'can' and 'isa'. =head1 CAVEATS No distinction is made between non-existent elements and those that are present but undefined. Furthermore, there's no way to delete an element without resorting to C<< delete $h->{'foo'} >>. Storing a hash directly into an element of a Hash::AsObject instance has the effect of blessing that hash into Hash::AsObject. For example, the following code: my $h = Hash::AsObject->new; my $foo = { 'bar' => 1, 'baz' => 2 }; print ref($foo), "\n"; $h->foo($foo); print ref($foo), "\n"; Produces the following output: HASH Hash::AsObject I could fix this, but then code like the following would throw an exception, because C<< $h->foo($foo) >> will return a plain hash reference, not an object: $h->foo($foo)->bar; Well, I can make C<< $h->foo($foo)->bar >> work, but then code like this won't have the desired effect: my $foo = { 'bar' => 123 }; $h->foo($foo); $h->foo->bar(456); print $foo->{'bar'}; # prints 123 print $h->foo->bar; # prints 456 I suppose I could fix I, but that's an awful lot of work for little apparent benefit. Let me know if you have any thoughts on this. =head1 BUGS Autovivification is probably not emulated correctly. The blessing of hashes stored in a Hash::AsObject might be considered a bug. Or a feature; it depends on your point of view. =head1 TO DO =over 4 =item * Add the capability to delete elements, perhaps like this: use Hash::AsObject 'deleter' => 'kill'; $h = Hash::AsObject->new({'one' => 1, 'two' => 2}); kill $h, 'one'; That might seem to violate the prohibition against exporting functions from object-oriented packages, but then technically it wouldn't be exporting it B anywhere since the function would be constructed by hand. Alternatively, it could work like this: use Hash::AsObject 'deleter' => 'kill'; $h = Hash::AsObject->new({'one' => 1, 'two' => 2}); $h->kill('one'); But, again, what if the hash contained an element named 'kill'? =item * Define multiple classes in C? For example, there could be one package for read-only access to a hash, one for hashes that throw exceptions when accessors for non-existent keys are called, etc. But this is hard to do fully without (a) altering the underlying hash, or (b) defining methods besides AUTOLOAD. Hmmm... =back =head1 VERSION 0.06 =head1 AUTHOR Paul Hoffman =head1 CREDITS Andy Wardley for L, which was my inspiration. Writing template code like this: [% foo.bar.baz(qux) %] Made me yearn to write Perl code like this: foo->bar->baz($qux); =head1 COPYRIGHT Copyright 2003-2007 Paul M. Hoffman. All rights reserved. This program is free software; you can redistribute it and modify it under the same terms as Perl itself. Hash-AsObject-0.13/Makefile.PL0100644000076500007650000000037211076371562015735 0ustar nkuitsenkuitseuse ExtUtils::MakeMaker; WriteMakefile( 'NAME' => 'Hash::AsObject', 'AUTHOR' => 'Paul Hoffman ', 'VERSION_FROM' => 'lib/Hash/AsObject.pm', 'LICENSE' => 'perl', 'PREREQ_PM' => {}, ); Hash-AsObject-0.13/MANIFEST0100644000076500007650000000037411146241516015107 0ustar nkuitsenkuitseChanges lib/Hash/AsObject.pm Makefile.PL MANIFEST This list of files MANIFEST.SKIP META.yml README t/00versions.t t/01constructor.t t/02get-and-set.t t/03class-methods.t t/04chain.t t/05trickery.t t/06can.t t/07inherit.t t/99pod-coverage.t t/99pod.t Hash-AsObject-0.13/MANIFEST.SKIP0100644000076500007650000000022111146241511015636 0ustar nkuitsenkuitseCVS \.cvsignore$ \.DS_Store$ blib blibdirs pm_to_blib ^Makefile$ ^Makefile\.(old|bak)$ ^MANIFEST\.bak$ Hash-AsObject-\d+ ^\.podge ^_darcs \.swp$ Hash-AsObject-0.13/META.yml0100644000076500007650000000072111307736012015222 0ustar nkuitsenkuitse--- #YAML:1.0 name: Hash-AsObject version: 0.13 abstract: ~ author: - Paul Hoffman license: perl distribution_type: module configure_requires: ExtUtils::MakeMaker: 0 requires: {} no_index: directory: - t - inc generated_by: ExtUtils::MakeMaker version 6.46 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 Hash-AsObject-0.13/README0100644000076500007650000000111510024177324014627 0ustar nkuitsenkuitseNAME Hash::AsObject - hashes with accessors/mutators SYNOPSIS $h = Hash::AsObject->new({'foo'=>123}); $foo = $h->foo; # 123 $h->bar(456); $bar = $h->bar; # 456 $bar = $h->{'bar'}; # 456 DESCRIPTION See the POD documentation in lib/Hash/AsObject.pm, or use perldoc. INSTALL Install it in the usual way: perl Makefile.PL make make test [sudo] make install COPYRIGHT Copyright 2003-2004 Paul M. Hoffman. All rights reserved. This program is free software; you can redistribute it and modify it under the same terms as Perl itself. Hash-AsObject-0.13/t/0040755000076500007650000000000011307736012014217 5ustar nkuitsenkuitseHash-AsObject-0.13/t/00versions.t0100644000076500007650000000144010024160624016403 0ustar nkuitsenkuitse#!/usr/bin/perl use strict; use warnings; use Test::More; eval "use YAML"; plan 'skip_all', "Can't check prerequisites in META.yml - YAML not installed" if $@; my @modules = qw(); eval { my $meta = YAML::LoadFile('META.yml'); my $prereqs = $meta->{'requires'}; push @modules, keys %$prereqs if ref($prereqs) eq 'HASH'; }; plan 'tests' => 1; if ($@) { fail( "An error occurred while fetching prerequisites from META.yml: $@" ) } print STDERR "\n# Reporting module versions in case there are test failures\n" if scalar @modules; foreach (@modules) { no strict 'refs'; eval "require $_"; my $version = $@ ? 'not installed' : ${ "${_}::VERSION" } || 'unknown'; print STDERR sprintf("# %s - %s\n", $_, $version); } ok( 1, 'report versions' ); Hash-AsObject-0.13/t/01constructor.t0100644000076500007650000000133610024160523017123 0ustar nkuitsenkuitse#!/usr/bin/perl -w use strict; use warnings; use Test::More 'tests' => 6; use_ok( 'Hash::AsObject' ); my $h0 = { 'one' => 1, 'two' => 2, 'three' => 3, }; my ($h1, $h2, $h3, $h4, $h5); $h1 = Hash::AsObject->new( ); $h2 = Hash::AsObject->new( { } ); $h3 = Hash::AsObject->new( %$h0 ); $h4 = Hash::AsObject->new( { %$h0 } ); $h5 = Hash::AsObject->new( $h0 ); isa_ok( $h1, 'Hash::AsObject', 'object made from thin air' ); isa_ok( $h2, 'Hash::AsObject', 'object made from an empty hash' ); isa_ok( $h3, 'Hash::AsObject', 'object made from a list' ); isa_ok( $h4, 'Hash::AsObject', 'object made from an anonymous hash' ); isa_ok( $h5, 'Hash::AsObject', 'object made from an existing hash' ); Hash-AsObject-0.13/t/02get-and-set.t0100644000076500007650000000205710402726316016660 0ustar nkuitsenkuitse#!/usr/bin/perl -w use strict; use warnings; use Test::More 'tests' => 12; use_ok( 'Hash::AsObject' ); my $h0 = { 'one' => 1, 'two' => 2, 'three' => 3, }; my ($h1, $h2, $h3, $h4, $h5); $h1 = Hash::AsObject->new( ); $h2 = Hash::AsObject->new( { } ); $h3 = Hash::AsObject->new( %$h0 ); $h4 = Hash::AsObject->new( { %$h0 } ); $h5 = Hash::AsObject->new( $h0 ); is_deeply( $h1, {}, 'empty' ); is_deeply( $h2, $h1, 'empty and equal' ); @$h1{keys %$h0} = @$h2{keys %$h0} = values %$h0; is_deeply( $h1, $h0, 'full' ); is_deeply( $h2, $h1, 'full and equal' ); is_deeply( $h3, $h1, 'full and equal again' ); is_deeply( $h4, $h1, 'full and equal yet again' ); my ($foo, $bar); is( $h0->foo('foo'), 'foo', 'set scalar' ); is( $h0->foo, 'foo', 'get scalar' ); is_deeply( $h0->bar($h1), $h1, 'set hash' ); is_deeply( $h0->bar, $h1, 'get hash' ); # --- Make sure invocations with more than one arg fail eval { $h0->foo(1, 2) }; ok( $@ eq '', 'fail when more than one arg' ); Hash-AsObject-0.13/t/03class-methods.t0100644000076500007650000000075510024160523017312 0ustar nkuitsenkuitse#!/usr/bin/perl -w use strict; use warnings; use Test::More 'tests' => 5; use_ok( 'Hash::AsObject' ); eval { Hash::AsObject->foo }; like( $@, qr/Can't invoke class method/, 'forbidden class method call' ); eval { Hash::AsObject->import }; is( $@, '', 'allowed class method call' ); eval { my $htemp = Hash::AsObject->new; eval { $htemp->DESTROY('all monsters') }; is( $@, '', '$obj->DESTROY($foo)' ); eval { $htemp->DESTROY }; is( $@, '', '$obj->DESTROY' ); }; Hash-AsObject-0.13/t/04chain.t0100644000076500007650000000164610024160523015627 0ustar nkuitsenkuitse#!/usr/bin/perl -w use strict; use warnings; use Test::More 'tests' => 10; use_ok( 'Hash::AsObject' ); my $h = Hash::AsObject->new( 'foo' => { 'bar' => { 'baz' => 123, }, 'qux' => [ 1, 2, 3 ], }, ); isa_ok( $h->foo, 'Hash::AsObject', 'hash' ); isa_ok( $h->foo->bar, 'Hash::AsObject', 'nested hash' ); is( $h->foo->bar->baz, 123, 'get scalar in nested hash' ); is( $h->foo->bar->baz(456), 456, 'set scalar in nested hash' ); is_deeply( $h->foo->qux, [1,2,3], 'get array in nested hash' ); my $people = { 'Frodo' => 'ring bearer', 'Gollum' => 'a bitter end' }; my $people_again = $h->foo->bar->baz($people); is( ref($people), 'Hash::AsObject', 'stored hash has been reblessed' ); is( $people, $people_again, 'stored hash retains its identity' ); is( $h->people(undef), undef, 'undef an element' ); ok( exists($h->{'people'}), 'element still exists' ); Hash-AsObject-0.13/t/05trickery.t0100644000076500007650000000342010572132420016375 0ustar nkuitsenkuitse#!/usr/bin/perl -w use strict; use warnings; use Test::More 'tests' => 50; my $method; use_ok( 'Hash::AsObject' ); # --- Make sure invocations as class methods with no args fail foreach $method (qw/AUTOLOAD DESTROY can isa/) { eval { Hash::AsObject->$method }; isnt( $@, '', "invoke '$method' as a class method w/o args" ); } # --- But can() and isa() as class methods with an arg should succeed my $retval; eval { $retval = Hash::AsObject->can('can') }; is( $@, '', "try to can('can')" ); ok( $retval, 'it can' ); eval { $retval = Hash::AsObject->isa('UNIVERSAL') }; is( $@, '', "try to isa('UNIVERSAL')" ); ok( $retval, "it isa" ); # --- VERSION(), import(), and new shouldn't fail foreach $method (qw/VERSION import new/) { eval { Hash::AsObject->$method }; is( $@, '', "invoke '$method' as a class method" ); } my $h = Hash::AsObject->new; isa_ok( $h, 'Hash::AsObject' ); # --- Make sure methods that are usually special aren't actually treated specially in Hash::AsObject foreach $method (qw/AUTOLOAD DESTROY VERSION import new/) { is( $h->$method(456), 456, "set element '$method'" ); is( $h->$method, 456, "get element '$method'" ); delete $h->{$method}; is( $h->$method, undef, "get non-existent element '$method'" ); ok( !exists $h->{$method}, "don't autovivify method '$method'" ); is( $h->$method(undef), undef, "set undefined element '$method'" ); is( $h->$method, undef, "get undefined element '$method'" ); ok( $h->can($method), "make sure $method() is defined" ); } # --- Miscellanea is( Hash::AsObject::VERSION(), $Hash::AsObject::VERSION, 'class method VERSION() return val' ); ok( UNIVERSAL::isa($h, 'Hash::AsObject'), 'UNIVERSAL::isa called as a function' ); Hash-AsObject-0.13/t/06can.t0100644000076500007650000000120110740667677015326 0ustar nkuitsenkuitseuse strict; use warnings; use Test::More tests => 8; use_ok( 'Hash::AsObject' ); my $o = Hash::AsObject->new({ 'a' => 42 }); my $a = $o->can('a'); my $b = $o->can('b'); is( ref($a), 'CODE', 'can returns a code ref if the key exists' ); is( ref($b), 'CODE', 'can returns a code ref if the key doesn\'t exist' ); is( $a->($o), 42, 'use can to invoke getter' ); is( $a->($o, 99), 99, 'use can to invoke setter' ); is( $a->($o, 99), 99, 'setter invoked using can worked' ); is( $b->($o, 23), 23, 'use can to invoke setter (key doesn\'t exist)' ); is( $b->($o), 23, 'use can to invoke getter' ); Hash-AsObject-0.13/t/07inherit.t0100644000076500000000000000077411307717606015632 0ustar nkuitsewheeluse strict; use warnings; use diagnostics; use Test::More tests => 4; use_ok( 'Hash::AsObject' ); package Hash::AsObject::Foo; @Hash::AsObject::Foo::ISA = qw(Hash::AsObject); *Hash::AsObject::Foo::AUTOLOAD = \&Hash::AsObject::AUTOLOAD; my $foo = *Hash::AsObject::Foo::AUTOLOAD; # Suppress "used only once" warning package main; my $hash = Hash::AsObject::Foo->new; is( ref($hash), 'Hash::AsObject::Foo', 'blessing' ); is( $hash->abc('123'), 123, 'set scalar' ); is( $hash->abc, 123, 'get scalar' ); Hash-AsObject-0.13/t/99pod-coverage.t0100644000076500007650000000031710313535274017142 0ustar nkuitsenkuitseuse strict; use warnings; use Test::More; $| = 1; eval "use Test::Pod::Coverage 1.00"; plan 'skip_all' => "Test::Pod::Coverage 1.00 required for testing POD coverage" if $@; all_pod_coverage_ok(); Hash-AsObject-0.13/t/99pod.t0100644000076500007650000000025610313535003015341 0ustar nkuitsenkuitseuse strict; use warnings; use Test::More; $| = 1; eval "use Test::Pod 1.00"; plan 'skip_all' => "Test::Pod 1.00 required for testing POD" if $@; all_pod_files_ok();