package Hash::AsObject;

use strict;
use vars qw($VERSION $AUTOLOAD);

$VERSION = '0.09';

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;
    return 1;  # We can `do' anything
}

sub import {
    return
        unless ref($_[0]);
    scalar @_ > 1 ? $_[0]->{'import'} = $_[1] : $_[0]->{'import'};
}

# sub isa {
# 
#     # $obj->isa($class)
#     # $cls->isa($class)
# 
#     return UNIVERSAL::isa(@_);
#     
#     # Hash::AsObject::isa()
#     return unless scalar @_;
#     
#     my $invocant = shift;
#     
#     # Hash::AsObject->isa($foo, $etc)
#     # $obj->isa($other, $etc)
#     die "Too many arguments" if scalar(@_) > 1;
#     
#     my $iref = ref($invocant);
#     
#     # Hash::AsObject->isa
#     # Hash::AsObject::isa($class_name_or_other_scalar)
#     die "Too few arguments" unless $iref or scalar @_;
#     
#     # Hash::AsObject->isa($foo)
#     if ($iref) {
#         if (scalar @_) {
#             # $obj->isa(...)
#         } else {
#             # $obj->isa
#         }
#     } else {
#         return UNIVERSAL::isa($invocant, @_);
#     }
#     # $obj->isa('Hash::AsObject')
#     # $obj->isa($other)
# 
#     # XXX Not quite right XXX
#     return __PACKAGE__->isa($_[0])
#         unless ref $_[0];     # Hash::AsObject::isa($class_name_or_other_scalar)
# 
#     # --- The most likely case:
#     # $obj->isa($cls);        -- most likely case
#     # $cls->isa($other_cls);  -- OK, this might happen
#     # Hash::AsObject::isa($non_scalar, ...);  -- unlikely!!
#     return ref($_[0])->isa($_[1])
#         if scalar @_ > 1;
#     # $obj->isa;        -- not very likely
#     return $_[0]->{'isa'} if exists $_[0]->{'isa'};
#     return undef;
# }

sub AUTOLOAD {
    my $self = 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($self) 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, __PACKAGE__;
        } 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) $self->DESTROY($val)
        #       (2) $self->DESTROY()
        #           (2a) $self->{DESTROY} exists and is defined
        #           (2b) $self->{DESTROY} exists but is undefined
        #           (2c) $self->{DESTROY} doesn't exist
        #     Case 1 will never happen automatically, so we handle it normally
        #     In case 2a, we must return the value of $self->{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 $self->{'DESTROY'}          # Case 2c -- autovivify
        unless
            scalar @_                      # Case 1
            or exists $self->{'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 $self 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(@_) ? $self->{'AUTOLOAD'} = shift : $self->{'AUTOLOAD'};
    } else {
        # --- Define a stub method in this package (to speed up later invocations)
        my $src = <<"EOS";
sub Hash::AsObject::$key {
    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, 'Hash::AsObject';
    } else {
        \$v;
    }
#    return ref(\$v) eq 'HASH' ? bless(\$v, 'Hash::AsObject') : \$v;
}
EOS
        eval $src;
        die "Couldn't define method Hash::AsObject::$key -- $@"
            if $@;
        unshift @_, $self;
        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.