r56806 - in /branches/upstream/libhash-asobject-perl: ./ current/ current/lib/ current/lib/Hash/ current/t/
ivan at users.alioth.debian.org
ivan at users.alioth.debian.org
Sun Apr 25 04:23:40 UTC 2010
Author: ivan
Date: Sun Apr 25 04:23:23 2010
New Revision: 56806
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=56806
Log:
[svn-inject] Installing original source of libhash-asobject-perl
Added:
branches/upstream/libhash-asobject-perl/
branches/upstream/libhash-asobject-perl/current/
branches/upstream/libhash-asobject-perl/current/Changes
branches/upstream/libhash-asobject-perl/current/MANIFEST.SKIP
branches/upstream/libhash-asobject-perl/current/META.yml
branches/upstream/libhash-asobject-perl/current/Makefile.PL
branches/upstream/libhash-asobject-perl/current/README
branches/upstream/libhash-asobject-perl/current/lib/
branches/upstream/libhash-asobject-perl/current/lib/Hash/
branches/upstream/libhash-asobject-perl/current/lib/Hash/AsObject.pm
branches/upstream/libhash-asobject-perl/current/t/
branches/upstream/libhash-asobject-perl/current/t/00versions.t
branches/upstream/libhash-asobject-perl/current/t/01constructor.t
branches/upstream/libhash-asobject-perl/current/t/02get-and-set.t
branches/upstream/libhash-asobject-perl/current/t/03class-methods.t
branches/upstream/libhash-asobject-perl/current/t/04chain.t
branches/upstream/libhash-asobject-perl/current/t/05trickery.t
branches/upstream/libhash-asobject-perl/current/t/06can.t
branches/upstream/libhash-asobject-perl/current/t/07inherit.t
branches/upstream/libhash-asobject-perl/current/t/99pod-coverage.t
branches/upstream/libhash-asobject-perl/current/t/99pod.t
Added: branches/upstream/libhash-asobject-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libhash-asobject-perl/current/Changes?rev=56806&op=file
==============================================================================
--- branches/upstream/libhash-asobject-perl/current/Changes (added)
+++ branches/upstream/libhash-asobject-perl/current/Changes Sun Apr 25 04:23:23 2010
@@ -1,0 +1,81 @@
+# Change log for Perl module Hash::AsObject
+
+---
+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().
+
Added: branches/upstream/libhash-asobject-perl/current/MANIFEST.SKIP
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libhash-asobject-perl/current/MANIFEST.SKIP?rev=56806&op=file
==============================================================================
--- branches/upstream/libhash-asobject-perl/current/MANIFEST.SKIP (added)
+++ branches/upstream/libhash-asobject-perl/current/MANIFEST.SKIP Sun Apr 25 04:23:23 2010
@@ -1,0 +1,13 @@
+CVS
+\.cvsignore$
+\.DS_Store$
+blib
+blibdirs
+pm_to_blib
+^Makefile$
+^Makefile\.(old|bak)$
+^MANIFEST(\.bak)?$
+Hash-AsObject-\d+
+^\.podge
+^_darcs
+\.swp$
Added: branches/upstream/libhash-asobject-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libhash-asobject-perl/current/META.yml?rev=56806&op=file
==============================================================================
--- branches/upstream/libhash-asobject-perl/current/META.yml (added)
+++ branches/upstream/libhash-asobject-perl/current/META.yml Sun Apr 25 04:23:23 2010
@@ -1,0 +1,13 @@
+--- #YAML:1.0
+name: Hash-AsObject
+version: 0.10
+abstract: ~
+license: ~
+generated_by: ExtUtils::MakeMaker version 6.32
+distribution_type: module
+requires:
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.2.html
+ version: 1.2
+author:
+ - Paul Hoffman <nkuitse AT cpan DOT org>
Added: branches/upstream/libhash-asobject-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libhash-asobject-perl/current/Makefile.PL?rev=56806&op=file
==============================================================================
--- branches/upstream/libhash-asobject-perl/current/Makefile.PL (added)
+++ branches/upstream/libhash-asobject-perl/current/Makefile.PL Sun Apr 25 04:23:23 2010
@@ -1,0 +1,9 @@
+use ExtUtils::MakeMaker;
+
+WriteMakefile(
+ 'NAME' => 'Hash::AsObject',
+ 'AUTHOR' => 'Paul Hoffman <nkuitse AT cpan DOT org>',
+ 'VERSION_FROM' => 'lib/Hash/AsObject.pm',
+ 'PREREQ_PM' => {},
+);
+
Added: branches/upstream/libhash-asobject-perl/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libhash-asobject-perl/current/README?rev=56806&op=file
==============================================================================
--- branches/upstream/libhash-asobject-perl/current/README (added)
+++ branches/upstream/libhash-asobject-perl/current/README Sun Apr 25 04:23:23 2010
@@ -1,0 +1,37 @@
+NAME
+
+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.
+
Added: branches/upstream/libhash-asobject-perl/current/lib/Hash/AsObject.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libhash-asobject-perl/current/lib/Hash/AsObject.pm?rev=56806&op=file
==============================================================================
--- branches/upstream/libhash-asobject-perl/current/lib/Hash/AsObject.pm (added)
+++ branches/upstream/libhash-asobject-perl/current/lib/Hash/AsObject.pm Sun Apr 25 04:23:23 2010
@@ -1,0 +1,355 @@
+package Hash::AsObject;
+
+use strict;
+use vars qw($VERSION $AUTOLOAD);
+
+$VERSION = '0.10';
+
+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 &$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<DESTROY> 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<AUTOLOAD> 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<new>
+
+ $h = Hash::AsObject->new;
+ $h = Hash::AsObject->new(\%some_hash);
+ $h = Hash::AsObject->new(%some_other_hash);
+
+Create a new L<Hash::AsObject|Hash::AsObject>.
+
+If called as an instance method, this accesses a hash element 'new':
+
+ $h->{'new'} = 123;
+ $h->new; # 123
+ $h->new(456); # 456
+
+=item B<isa>
+
+This method cannot be used to access a hash element 'isa', because
+Hash::AsObject doesn't attempt to handle it specially.
+
+=item B<can>
+
+Similarly, this can't be used to access a hash element 'can'.
+
+=item B<AUTOLOAD>
+
+ $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<DESTROY>
+
+ $h->{'DESTROY'} = [];
+ $h->DESTROY; # []
+ $h->DESTROY({}) # {}
+
+C<DESTROY> 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<VERSION>
+
+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<import>
+
+Since L<Hash::AsObject|Hash::AsObject> 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<can()> and C<isa()> are special, because they're defined in the
+C<UNIVERSAL> class that all packages automatically inherit from. Unfortunately,
+this means that you can't use L<Hash::AsObject|Hash::AsObject> 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<that>, 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<from> 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<Hash/AsObject.pm>? 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 <nkuitse AT cpan DOT org>
+
+=head1 CREDITS
+
+Andy Wardley for L<Template::Stash|Template::Stash>, 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.
+
Added: branches/upstream/libhash-asobject-perl/current/t/00versions.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libhash-asobject-perl/current/t/00versions.t?rev=56806&op=file
==============================================================================
--- branches/upstream/libhash-asobject-perl/current/t/00versions.t (added)
+++ branches/upstream/libhash-asobject-perl/current/t/00versions.t Sun Apr 25 04:23:23 2010
@@ -1,0 +1,39 @@
+#!/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' );
+
Added: branches/upstream/libhash-asobject-perl/current/t/01constructor.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libhash-asobject-perl/current/t/01constructor.t?rev=56806&op=file
==============================================================================
--- branches/upstream/libhash-asobject-perl/current/t/01constructor.t (added)
+++ branches/upstream/libhash-asobject-perl/current/t/01constructor.t Sun Apr 25 04:23:23 2010
@@ -1,0 +1,30 @@
+#!/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' );
+
Added: branches/upstream/libhash-asobject-perl/current/t/02get-and-set.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libhash-asobject-perl/current/t/02get-and-set.t?rev=56806&op=file
==============================================================================
--- branches/upstream/libhash-asobject-perl/current/t/02get-and-set.t (added)
+++ branches/upstream/libhash-asobject-perl/current/t/02get-and-set.t Sun Apr 25 04:23:23 2010
@@ -1,0 +1,46 @@
+#!/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' );
+
Added: branches/upstream/libhash-asobject-perl/current/t/03class-methods.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libhash-asobject-perl/current/t/03class-methods.t?rev=56806&op=file
==============================================================================
--- branches/upstream/libhash-asobject-perl/current/t/03class-methods.t (added)
+++ branches/upstream/libhash-asobject-perl/current/t/03class-methods.t Sun Apr 25 04:23:23 2010
@@ -1,0 +1,22 @@
+#!/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' );
+};
Added: branches/upstream/libhash-asobject-perl/current/t/04chain.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libhash-asobject-perl/current/t/04chain.t?rev=56806&op=file
==============================================================================
--- branches/upstream/libhash-asobject-perl/current/t/04chain.t (added)
+++ branches/upstream/libhash-asobject-perl/current/t/04chain.t Sun Apr 25 04:23:23 2010
@@ -1,0 +1,35 @@
+#!/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' );
+
Added: branches/upstream/libhash-asobject-perl/current/t/05trickery.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libhash-asobject-perl/current/t/05trickery.t?rev=56806&op=file
==============================================================================
--- branches/upstream/libhash-asobject-perl/current/t/05trickery.t (added)
+++ branches/upstream/libhash-asobject-perl/current/t/05trickery.t Sun Apr 25 04:23:23 2010
@@ -1,0 +1,49 @@
+#!/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' );
+
Added: branches/upstream/libhash-asobject-perl/current/t/06can.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libhash-asobject-perl/current/t/06can.t?rev=56806&op=file
==============================================================================
--- branches/upstream/libhash-asobject-perl/current/t/06can.t (added)
+++ branches/upstream/libhash-asobject-perl/current/t/06can.t Sun Apr 25 04:23:23 2010
@@ -1,0 +1,21 @@
+use 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' );
Added: branches/upstream/libhash-asobject-perl/current/t/07inherit.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libhash-asobject-perl/current/t/07inherit.t?rev=56806&op=file
==============================================================================
--- branches/upstream/libhash-asobject-perl/current/t/07inherit.t (added)
+++ branches/upstream/libhash-asobject-perl/current/t/07inherit.t Sun Apr 25 04:23:23 2010
@@ -1,0 +1,20 @@
+use strict;
+use warnings;
+use diagnostics;
+
+use Test::More tests => 2;
+
+use_ok( 'Hash::AsObject' );
+
+package Hash::AsObject::Foo;
+
+ at 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;
+
+is( ref(Hash::AsObject::Foo->new), 'Hash::AsObject::Foo', 'blessing' );
+
+
Added: branches/upstream/libhash-asobject-perl/current/t/99pod-coverage.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libhash-asobject-perl/current/t/99pod-coverage.t?rev=56806&op=file
==============================================================================
--- branches/upstream/libhash-asobject-perl/current/t/99pod-coverage.t (added)
+++ branches/upstream/libhash-asobject-perl/current/t/99pod-coverage.t Sun Apr 25 04:23:23 2010
@@ -1,0 +1,14 @@
+use 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();
+
Added: branches/upstream/libhash-asobject-perl/current/t/99pod.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libhash-asobject-perl/current/t/99pod.t?rev=56806&op=file
==============================================================================
--- branches/upstream/libhash-asobject-perl/current/t/99pod.t (added)
+++ branches/upstream/libhash-asobject-perl/current/t/99pod.t Sun Apr 25 04:23:23 2010
@@ -1,0 +1,13 @@
+use 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();
More information about the Pkg-perl-cvs-commits
mailing list