package Hash::Wrap;

# ABSTRACT: create lightweight on-the-fly objects from hashes

use 5.008009;

use strict;
use warnings;

our $VERSION = '0.01';

our @EXPORT = qw[ wrap_hash ];

{
    package Hash::Wrap::Class;
    use parent 'Hash::Wrap::Base';
}


sub _croak {

    require Carp;
    Carp::croak( @_ );
}

sub import {

    my ( $me ) = shift;
    my $caller = caller;

    my @imports = @_;

    push @imports, @EXPORT unless @imports;

    for my $args ( @imports ) {

        if ( ! ref $args ) {
            _croak( "$args is not exported by ", __PACKAGE__, "\n" )
              unless grep { /$args/ } @EXPORT;

            $args = { -as => $args };
         }

        elsif ( 'HASH' ne ref $args ) {
            _croak( "argument to ", __PACKAGE__, "::import must be string or hash\n")
              unless grep { /$args/ } @EXPORT;
        }

        my $name = exists $args->{-as} ? delete $args->{-as} : 'wrap_hash';

        my $sub = _generate_wrap_hash( $me, $name, { %$args } );

        no strict 'refs'; ## no critic
        *{"$caller\::$name"} = $sub;
    }

}

# default constructor
sub _wrap_hash ($) { ## no critic (ProhibitSubroutinePrototypes)
    my $hash = shift;

    if ( ! 'HASH' eq ref $hash ) {
        require Carp;
        croak( "argument to wrap_hash must be a hashref\n" );
    }
    bless $hash, 'Hash::Wrap::Class';
}

sub _generate_wrap_hash {

    my ( $me ) = shift;
    my ( $name, $args ) = @_;

    return \&_wrap_hash unless keys %$args;

    # closure for user provided clone sub
    my $clone;

    my ( @pre_code, @post_code );

    _croak( "cannot mix -copy and -clone\n" )
      if exists $args->{-copy} && exists $args->{-clone};


    if ( delete $args->{-copy} ) {
        push @pre_code, '$hash = { %{ $hash } };';
    }
    elsif ( exists $args->{-clone} ) {

        if ( 'CODE' eq ref $args->{-clone} ) {
            $clone = $args->{-clone};
            push @pre_code, '$hash = $clone->($hash);';
        }
        else {
            require Storable;
            push @pre_code, '$hash = Storable::dclone $hash;';
        }

        delete $args->{-clone};
    }

    my $class = 'Hash::Wrap::Class';
    if ( defined $args->{-class} ) {

        $class = $args->{-class};

        if ( $args->{-create} ) {

            ## no critic (ProhibitStringyEval)
            eval( qq[ { package $class ; use parent 'Hash::Wrap::Base'; } 1; ] )
              or _croak( "error generating on-the-fly class $class: $@" );

            delete $args->{-create};
        }
        elsif ( !$class->isa( 'Hash::Wrap::Base' ) ) {
            _croak(
                qq[class ($class) is not a subclass of Hash::Wrap::Base\n]
            );
        }

        delete $args->{-class};
    }

    my $construct = 'my $obj = '
      . (
        $class->can( 'new' )
        ? qq[$class->new(\$hash);]
        : qq[bless \$hash, '$class';]
      );

    #<<< no tidy
    my $code =
      join( "\n",
            q[sub ($) {],
            q[my $hash = shift;],
            qq[if ( ! 'HASH' eq ref \$hash ) { _croak( "argument to $name must be a hashref\n" ) }],
            @pre_code,
            $construct,
            @post_code,
            q[return $obj;],
            q[}],
          );
    #>>>

    if ( keys %$args ) {
        _croak( "unknown options passed to ", __PACKAGE__, "::import: ", join( ', ', keys %$args ), "\n" );
    }

    ## no critic (ProhibitStringyEval)
    return eval( $code ) || _croak( "error generating wrap_hash subroutine: $@" );

}


1;

#
# This file is part of Hash-Wrap
#
# This software is Copyright (c) 2017 by Smithsonian Astrophysical Observatory.
#
# This is free software, licensed under:
#
#   The GNU General Public License, Version 3, June 2007
#

=pod

=head1 NAME

Hash::Wrap - create lightweight on-the-fly objects from hashes

=head1 VERSION

version 0.01

=head1 SYNOPSIS

  use Hash::Wrap;

  sub foo {
    wrap_hash { a => 1 };
  }

  $result = foo();
  print $result->a;  # prints
  print $result->b;  # throws

  # create two constructors, <cloned> and <copied> with different
  # behaviors. does not import C<wrap_hash>
  use Hash::Wrap
    { -as => 'cloned', clone => 1},
    { -as => 'copied', copy => 1 };

=head1 DESCRIPTION

This module provides constructors which create light-weight objects
from existing hashes, allowing access to hash elements via methods
(and thus avoiding typos). Attempting to access a non-existent element
via a method will result in an exception.

Hash elements may be added to or deleted from the object after
instantiation using the standard Perl hash operations, and changes
will be reflected in the object's methods. For example,

   $obj = wrap_hash( { a => 1, b => 2 );
   $obj->c; # throws exception
   $obj->{c} = 3;
   $obj->c; # returns 3
   delete $obj->{c};
   $obj->c; # throws exception

To prevent modification of the hash, consider using the lock routines
in L<Hash::Util> on the object.

The methods act as both accessors and setters, e.g.

  $obj = wrap_hash( { a => 1 } );
  print $obj->a; # 1
  $obj->a( 3 );
  print $obj->a; # 3

Only hash keys which are legal method names will be accessible via
object methods.

=head2 Object construction and constructor customization

By default C<Hash::Wrap> exports a C<wrap_hash> subroutine which,
given a hashref, blesses it directly into the B<Hash::Wrap::Class>
class.

The constructor may be customized to change which class the object is
instantiated from, and how it is constructed from the data.
For example,

  use Hash::Wrap
    { -as => 'return_cloned_object', -clone => 1 };

will create a constructor which clones the passed hash
and is imported as C<return_cloned_object>.  To import it under
the original name, C<wrap_hash>, leave out the C<-as> option.

The following options are available to customize the constructor.

=over

=item C<-as> => I<subroutine name>

This is optional, and imports the constructor with the given name. If
not specified, it defaults to C<wrap_hash>.

=item C<-class> => I<class name>

The object will be blessed into the specified class.  If the class
should be created on the fly, specify the C<-create> option.
See L</Object Classes> for what is expected of the object classes.
This defaults to C<Hash::Wrap::Class>.

=item C<-create> => I<boolean>

If true, and C<-class> is specified, a class with the given name
will be created.

=item C<-copy> => I<boolean>

If true, the object will store the data in a I<shallow> copy of the
hash. By default, the object uses the hash directly.

=item C<-clone> => I<boolean> | I<coderef>

Store the data in a deep copy of the hash. if I<true>, L<Storable/dclone>
is used. If a coderef, it will be called as

   $clone = coderef->( $hash )

By default, the object uses the hash directly.

=back

=head2 Object Classes

An object class has the following properties:

=over

=item *

The class must be a subclass of C<Hash::Wrap::Base>.

=item *

The class typically does not provide any methods, as they would mask
a hash key of the same name.

=item *

The class need not have a constructor.  If it does, it is passed a
hashref which it should bless as the actual object.  For example:

  package My::Result;
  use parent 'Hash::Wrap::Base';

  sub new {
    my  ( $class, $hash ) = @_;
    return bless $hash, $class;
  }

This excludes having a hash key named C<new>.

=back

C<Hash::Wrap::Base> provides an empty C<DESTROY> method, a
C<can> method, and an C<AUTOLOAD> method.  They will mask hash
keys with the same names.

=head1 SEE ALSO

Here's a comparison of this module and others on CPAN.

=over

=item L<Hash::Wrap> (this module)

=over

=item * core dependencies only

=item * only applies object paradigm to top level hash

=item * accessing a non-existing element via an accessor throws

=item * can use custom package

=item * can copy/clone existing hash. clone may be customized

=back

=item L<Object::Result>

As you might expect from a
L<DCONWAY|https://metacpan.org/author/DCONWAY> module, this does just
about everything you'd like.  It has a very heavy set of dependencies.

=item L<Hash::AsObject>

=over

=item * core dependencies only

=item * applies object paradigm recursively

=item * accessing a non-existing element via an accessor creates it

=back

=item L<Data::AsObject>

=over

=item * moderate dependency chain (no XS?)

=item * applies object paradigm recursively

=item * accessing a non-existing element throws

=back

=item L<Class::Hash>

=over

=item * core dependencies only

=item * only applies object paradigm to top level hash

=item * can add generic accessor, mutator, and element management methods

=item * accessing a non-existing element via an accessor creates it (not documented, but code implies it)

=item * C<can()> doesn't work

=back

=item L<Hash::Inflator>

=over

=item * core dependencies only

=item * accessing a non-existing element via an accessor returns undef

=item * applies object paradigm recursively

=back

=item L<Hash::AutoHash>

=over

=item * moderate dependency chain.  Requires XS, tied hashes

=item * applies object paradigm recursively

=item * accessing a non-existing element via an accessor creates it

=back

=item L<Hash::Objectify>

=over

=item * light dependency chain.  Requires XS.

=item * only applies object paradigm to top level hash

=item * accessing a non-existing element throws, but if an existing
element is accessed, then deleted, accessor returns undef rather than
throwing

=item * can use custom package

=back

=item L<Data::OpenStruct::Deep>

=over

=item * uses source filters

=item * applies object paradigm recursively

=back

=item L<Object::AutoAccessor>

=over

=item * light dependency chain

=item * applies object paradigm recursively

=item * accessing a non-existing element via an accessor creates it

=back

=item L<Data::Object::Autowrap>

=over

=item * core dependencies only

=item * no documentation

=back

=back

=head1 BUGS AND LIMITATIONS

You can make new bug reports, and view existing ones, through the
web interface at L<https://rt.cpan.org/Public/Dist/Display.html?Name=Hash-Wrap>.

=head1 AUTHOR

Diab Jerius <djerius@cpan.org>

=head1 COPYRIGHT AND LICENSE

This software is Copyright (c) 2017 by Smithsonian Astrophysical Observatory.

This is free software, licensed under:

  The GNU General Public License, Version 3, June 2007

=cut

__END__


#pod =head1 SYNOPSIS
#pod
#pod
#pod   use Hash::Wrap;
#pod
#pod   sub foo {
#pod     wrap_hash { a => 1 };
#pod   }
#pod
#pod   $result = foo();
#pod   print $result->a;  # prints
#pod   print $result->b;  # throws
#pod
#pod   # create two constructors, <cloned> and <copied> with different
#pod   # behaviors. does not import C<wrap_hash>
#pod   use Hash::Wrap
#pod     { -as => 'cloned', clone => 1},
#pod     { -as => 'copied', copy => 1 };
#pod
#pod =head1 DESCRIPTION
#pod
#pod
#pod This module provides constructors which create light-weight objects
#pod from existing hashes, allowing access to hash elements via methods
#pod (and thus avoiding typos). Attempting to access a non-existent element
#pod via a method will result in an exception.
#pod
#pod Hash elements may be added to or deleted from the object after
#pod instantiation using the standard Perl hash operations, and changes
#pod will be reflected in the object's methods. For example,
#pod
#pod    $obj = wrap_hash( { a => 1, b => 2 );
#pod    $obj->c; # throws exception
#pod    $obj->{c} = 3;
#pod    $obj->c; # returns 3
#pod    delete $obj->{c};
#pod    $obj->c; # throws exception
#pod
#pod
#pod To prevent modification of the hash, consider using the lock routines
#pod in L<Hash::Util> on the object.
#pod
#pod The methods act as both accessors and setters, e.g.
#pod
#pod   $obj = wrap_hash( { a => 1 } );
#pod   print $obj->a; # 1
#pod   $obj->a( 3 );
#pod   print $obj->a; # 3
#pod
#pod Only hash keys which are legal method names will be accessible via
#pod object methods.
#pod
#pod =head2 Object construction and constructor customization
#pod
#pod By default C<Hash::Wrap> exports a C<wrap_hash> subroutine which,
#pod given a hashref, blesses it directly into the B<Hash::Wrap::Class>
#pod class.
#pod
#pod The constructor may be customized to change which class the object is
#pod instantiated from, and how it is constructed from the data.
#pod For example,
#pod
#pod   use Hash::Wrap
#pod     { -as => 'return_cloned_object', -clone => 1 };
#pod
#pod will create a constructor which clones the passed hash
#pod and is imported as C<return_cloned_object>.  To import it under
#pod the original name, C<wrap_hash>, leave out the C<-as> option.
#pod
#pod The following options are available to customize the constructor.
#pod
#pod =over
#pod
#pod =item C<-as> => I<subroutine name>
#pod
#pod This is optional, and imports the constructor with the given name. If
#pod not specified, it defaults to C<wrap_hash>.
#pod
#pod =item C<-class> => I<class name>
#pod
#pod The object will be blessed into the specified class.  If the class
#pod should be created on the fly, specify the C<-create> option.
#pod See L</Object Classes> for what is expected of the object classes.
#pod This defaults to C<Hash::Wrap::Class>.
#pod
#pod =item C<-create> => I<boolean>
#pod
#pod If true, and C<-class> is specified, a class with the given name
#pod will be created.
#pod
#pod =item C<-copy> => I<boolean>
#pod
#pod If true, the object will store the data in a I<shallow> copy of the
#pod hash. By default, the object uses the hash directly.
#pod
#pod =item C<-clone> => I<boolean> | I<coderef>
#pod
#pod Store the data in a deep copy of the hash. if I<true>, L<Storable/dclone>
#pod is used. If a coderef, it will be called as
#pod
#pod    $clone = coderef->( $hash )
#pod
#pod By default, the object uses the hash directly.
#pod
#pod
#pod =back
#pod
#pod =head2 Object Classes
#pod
#pod An object class has the following properties:
#pod
#pod =over
#pod
#pod =item *
#pod
#pod The class must be a subclass of C<Hash::Wrap::Base>.
#pod
#pod =item *
#pod
#pod The class typically does not provide any methods, as they would mask
#pod a hash key of the same name.
#pod
#pod =item *
#pod
#pod The class need not have a constructor.  If it does, it is passed a
#pod hashref which it should bless as the actual object.  For example:
#pod
#pod   package My::Result;
#pod   use parent 'Hash::Wrap::Base';
#pod
#pod   sub new {
#pod     my  ( $class, $hash ) = @_;
#pod     return bless $hash, $class;
#pod   }
#pod
#pod This excludes having a hash key named C<new>.
#pod
#pod =back
#pod
#pod C<Hash::Wrap::Base> provides an empty C<DESTROY> method, a
#pod C<can> method, and an C<AUTOLOAD> method.  They will mask hash
#pod keys with the same names.
#pod
#pod
#pod =head1 SEE ALSO
#pod
#pod Here's a comparison of this module and others on CPAN.
#pod
#pod
#pod =over
#pod
#pod =item L<Hash::Wrap> (this module)
#pod
#pod =over
#pod
#pod =item * core dependencies only
#pod
#pod =item * only applies object paradigm to top level hash
#pod
#pod =item * accessing a non-existing element via an accessor throws
#pod
#pod =item * can use custom package
#pod
#pod =item * can copy/clone existing hash. clone may be customized
#pod
#pod =back
#pod
#pod
#pod =item L<Object::Result>
#pod
#pod As you might expect from a
#pod L<DCONWAY|https://metacpan.org/author/DCONWAY> module, this does just
#pod about everything you'd like.  It has a very heavy set of dependencies.
#pod
#pod =item L<Hash::AsObject>
#pod
#pod =over
#pod
#pod =item * core dependencies only
#pod
#pod =item * applies object paradigm recursively
#pod
#pod =item * accessing a non-existing element via an accessor creates it
#pod
#pod =back
#pod
#pod =item L<Data::AsObject>
#pod
#pod =over
#pod
#pod =item * moderate dependency chain (no XS?)
#pod
#pod =item * applies object paradigm recursively
#pod
#pod =item * accessing a non-existing element throws
#pod
#pod =back
#pod
#pod =item L<Class::Hash>
#pod
#pod =over
#pod
#pod =item * core dependencies only
#pod
#pod =item * only applies object paradigm to top level hash
#pod
#pod =item * can add generic accessor, mutator, and element management methods
#pod
#pod =item * accessing a non-existing element via an accessor creates it (not documented, but code implies it)
#pod
#pod =item * C<can()> doesn't work
#pod
#pod =back
#pod
#pod =item L<Hash::Inflator>
#pod
#pod =over
#pod
#pod =item * core dependencies only
#pod
#pod =item * accessing a non-existing element via an accessor returns undef
#pod
#pod =item * applies object paradigm recursively
#pod
#pod =back
#pod
#pod =item L<Hash::AutoHash>
#pod
#pod =over
#pod
#pod =item * moderate dependency chain.  Requires XS, tied hashes
#pod
#pod =item * applies object paradigm recursively
#pod
#pod =item * accessing a non-existing element via an accessor creates it
#pod
#pod =back
#pod
#pod =item L<Hash::Objectify>
#pod
#pod =over
#pod
#pod =item * light dependency chain.  Requires XS.
#pod
#pod =item * only applies object paradigm to top level hash
#pod
#pod =item * accessing a non-existing element throws, but if an existing
#pod element is accessed, then deleted, accessor returns undef rather than
#pod throwing
#pod
#pod =item * can use custom package
#pod
#pod =back
#pod
#pod =item L<Data::OpenStruct::Deep>
#pod
#pod =over
#pod
#pod =item * uses source filters
#pod
#pod =item * applies object paradigm recursively
#pod
#pod =back
#pod
#pod =item L<Object::AutoAccessor>
#pod
#pod =over
#pod
#pod =item * light dependency chain
#pod
#pod =item * applies object paradigm recursively
#pod
#pod =item * accessing a non-existing element via an accessor creates it
#pod
#pod =back
#pod
#pod =item L<Data::Object::Autowrap>
#pod
#pod =over
#pod
#pod =item * core dependencies only
#pod
#pod =item * no documentation
#pod
#pod =back
#pod
#pod =back
