view release on metacpan or  search on metacpan

lib/Module/Generic/Hash.pm  view on Meta::CPAN

## 
## This program is free software; you can redistribute  it  and/or  modify  it
## under the same terms as Perl itself.
##----------------------------------------------------------------------------
package Module::Generic::Hash;
BEGIN
{
    use strict;
    use warnings;
    use warnings::register;
    use parent qw( Module::Generic );
    use vars qw( $VERSION $DEBUG $KEY_OBJECT );
    use Clone ();
    use Data::Dumper;
    use JSON;
    use Module::Generic::TieHash;
    use Regexp::Common;
    use Want;
    use overload (
        # '""'    => 'as_string',
        'eq'    => sub { _obj_eq(@_) },
        'ne'    => sub { !_obj_eq(@_) },
        '<'     => sub { _obj_comp( @_, '<') },
        '>'     => sub { _obj_comp( @_, '>') },
        '<='    => sub { _obj_comp( @_, '<=') },
        '>='    => sub { _obj_comp( @_, '>=') },
        '=='    => sub { _obj_comp( @_, '>=') },
        '!='    => sub { _obj_comp( @_, '>=') },
        'lt'    => sub { _obj_comp( @_, 'lt') },
        'gt'    => sub { _obj_comp( @_, 'gt') },
        'le'    => sub { _obj_comp( @_, 'le') },
        'ge'    => sub { _obj_comp( @_, 'ge') },
        'bool'  => sub{$_[0]},
        fallback => 1,
    );
    # Do we allow the use of object as hash keys?
    our $KEY_OBJECT = 0;
    our( $VERSION ) = 'v1.4.0';
};

use strict;
no warnings 'redefine';
require Module::Generic::Array;
require Module::Generic::Number;
require Module::Generic::Scalar;

sub new
{
    my $that = shift( @_ );
    my $class = ref( $that ) || $that;
    
    my %hash = ();
    # This enables access to the hash just like a real hash while still the user an call our object methods
    my $obj = tie( %hash, 'Module::Generic::TieHash', {
        # disable => ['Module::Generic'],
        debug => $DEBUG,
        enable => 0,
        # Should we allow objects to be used as key? Default to false
        key_object => $KEY_OBJECT,
    });
    my $self = bless( \%hash => $class );
    $obj->enable(1);

    if( scalar( @_ ) == 1 )
    {
        my $data = shift( @_ );
        return( $that->error( "I was expecting an hash, but instead got '", ( $data // 'undef' ), "'." ) ) if( Scalar::Util::reftype( $data // '' ) ne 'HASH' );
        my $tied = tied( %$data );
        return( $that->error( "Hash provided is already tied to ", ref( $tied ), " and our package $class cannot use it, or it would disrupt the tie." ) ) if( $tied );
        my @keys = CORE::keys( %$data );
        @hash{ @keys } = @$data{ @keys };
    }
    elsif( scalar( @_ ) > 1 &&
        !( @_ % 2 ) )
    {
        while( @_ )
        {
            $hash{ shift( @_ ) } = shift( @_ );
        }
    }
    elsif( scalar( @_ ) )
    {
        return( $self->error( "Odd number (", scalar( @_ ), ") of hash keys and values provided." ) );
    }

    $obj->enable(0);
    $self->SUPER::init( @_ );
    $obj->enable(1);
    return( $self );
}

# sub as_hash
# {
#     my $self = CORE::shift( @_ );
#     my $hash = {};
#     $self->_tie_object->enable(1);
#     my $keys = $self->keys;
#     @$hash{ @$keys } = @$self{ @$keys };
#     return( $hash );
# }

# We are already an hash, so no need to do anything.
# To convert to a regular hash as needed by JSON, the method TO_JSON can be used.
sub as_hash
{
    my $self = shift( @_ );
    if( @_ )
    {
        my $opts = $self->_get_args_as_hash( @_ );
        if( $opts->{strict} )
        {
            my $ref = { %$self };
            return( $ref );
        }
    }
    return( $self );
}

sub as_json { return( shift->json(@_)->scalar ); }

sub as_string { return( shift->dump ); }