=encoding utf8

=head1 NAME

Module::Generic::Hash - Hash Manipulation Object Class

=head1 SYNOPSIS

    my $h = Module::Generic::Hash->new({
        first_name => 'John',
        last_name => 'Doe',
        age => 30,
        email => 'john.doe@example.com',
    });

    # or

    my $h = Module::Generic::Hash->new(
        first_name => 'John',
        last_name => 'Doe',
        age => 30,
        email => 'john.doe@example.com',
    );

    my $keys = $h->keys # Module::Generic::Array returned
    $h->keys->length # e.g. 10
    $keys->pop # See Module::Generic::Array
    print( $h->as_string, "\n" );
    # Produces:
    {
    "age" => 30,
    "email" => "john.doe\@example.com",
    "first_name" => "John",
    "last_name" => "Doe"
    }

    $h->json({ pretty => 1 });
    # Produces
    {
    "age" : 30,
    "email" : "john.doe@example.com",
    "first_name" : "John",
    "last_name" : "Doe"
    }
    # Or
    $h->json
    # Produces
    {"age":30,"email":"john.doe@example.com","first_name":"John","last_name":"Doe"}
    # Adding a key and value as usual:
    $h->{role} = 'customer';
    $h->defined( 'role' ) # True
    $h->delete( 'role' ) # Removes and returns 'customer'
    $h->each(sub
    {
        my( $k, $v ) = @_;
        print( "Key $k has value '$v'\n" );
    });
    exists( $h->{age} );
    # same as
    $h->exists( 'age' );
    # Same as $h->foreach(sub{ #.. });
    $h->for(sub{
        my( $k, $v ) = @_;
        print( "Key $k has value '$v'\n" );
    });
    $h->length # Returns a Module::Generic::Number
    my $hash2 =
    {
        address =>
        {
        line1 => '1-2-3 Kudan-minami, Chiyoda-ku',
        line2 => 'Big bld 7F',
        postal_code => '123-4567',
        city => 'Tokyo',
        country => 'jp',
        },
        last_name => 'Smith',
    };
    my $h2 = Module::Generic::Hash->new( $hash2 );
    $h->merge( $hash2 );
    # same as $h->merge( $h2 );
    $h > $h2 # True
    $h gt $h2 # True
    $h >= $h2 # True
    $h2 < $h # True
    $h2 lt $h # True
    $h2 <= $h # True
    3 < $h # True

    # Merge $hash2 into $h, but without overwriting existing entries
    $h->merge( $hash2, { overwrite => 0 });
    # Otherwise, bluntly overwriting existing entries, if any
    $h->merge( $hash2 );

    # Same copy
    my $h3 = $h->clone;

    my $vals = $h->values; # Returns a Module::Generic::Array
    # Must return an empty list to prevent the entry from being added to the result, as per perlfunc documentation, see map
    my $vals = $h->values(sub{
        ref( $_[0] ) ? () : $_[0];
    }, { sort => 1 });

    # Using reference as key is ok too.
    my $h = Module::Generic::Hash->new;
    # Enable the use of reference or objects as hash keys
    $h->key_object(1);
    # or
    local $Module::Generic::Hash::KEY_OBJECT = 1;
    my $h = Module::Generic::Hash->new;

    # Now, we can use reference or object as hash keys
    my $array = [qw( John Paul Jack Peter )];
    my $ref = { name => 'John Doe' };
    my $code = sub{1};
    my $scalar = \'Hello'
    my $glob = \*main;
    my $foo = Foo::Bar->new;
    $h->{ $array } = 'array';
    $h->{ $ref } = 'hash';
    $h->{ $code } = 'code';
    $h->{ $scalar } = 'scalar';
    $h->{ $glob } = 'glob';
    $h->{ $foo } = 'object';

=head1 VERSION

    v1.5.1

=head1 DESCRIPTION

The purpos of this class/package is to provide a lightweight object-oriented approach to hash manipulation and to enable the use of any type of hash key, including regular string and reference, such as array reference, hash reference, anonymous subroutine, scalar reference, filehandle and objects.

If you want to store keys as reference, just make sure to instantiate the object first and set the method C<key_object> to a true value, before adding keys as reference, because perl regular hash will transform any reference into a string to be used as a key.

Thus the following would not work as you would expect:

    my $ref = {};
    my $array = [qw( John Paul Jack Peter )];
    $ref->{ $array } = 'my array';
    local $Module::Generic::Hash::KEY_OBJECT = 1;
    my $h = Module::Generic::Hash->new( $ref );

Instead, do either:

    my $array = [qw( John Paul Jack Peter )];

    my $h = Module::Generic::Hash->new;
    $h->key_object(1);
    # or
    local $Module::Generic::Hash::KEY_OBJECT = 1;
    my $h = Module::Generic::Hash->new;

    # then
    $h->{ $array } = 'my array';

or:

    my $array = [qw( John Paul Jack Peter )];
    local $Module::Generic::Hash::KEY_OBJECT = 1;
    my $h = Module::Generic::Hash->new( $array => 'my array' );

This uses perl core functions only and L<Clone> for cloning. This module's methods act as a wrapper to them.

Because the object is overloaded, you can use the variable with comparison perl operators, such as :

    $h > 3 # True
    $h <= 3 # False
    # etc...

You can also compare two hashes reliably, such as :

    $h1 eq $h2 # True

But if you use C<==>, it will compare the hash size, i.e. the number of keys

    $h1 == $h2

Which could be true if both hashes have the same number of keys (C<==>), but may not be true if they are not the same (C<eq>)

Otherwise, the hash can be accessed like a regular hash. For example :

    print( "Customer is $h->{first_name} $h->{last_name}\n" );

=head1 METHODS

=head2 new

Provided with a hash reference, some optional parameters and this returns a new object.

Possible optional parameters are:

=over 4

=item * C<debug>

Provided with an integer and this actives or deactivates debugging messages. Nothing meaningful happens below 3

=back

=head2 as_hash

Returns the hash object as a regular hash reference. It copies all the keys and their values into a new anonymous hash and returns it.

Optionally, it takes an hash or hash reference of options. If the option C<strict> is provided with a true value, then instead of returning the current object, it returns a simple hash reference containing a copy of the current object data.

=head2 as_json

Returns a json representation of the hash by calling L</json>

=head2 as_string

Return a string version of the hash as produced by L<Data::Dumper>

    print( "$h\n" );
    # or
    print( $h->as_string, "\n" );

    # Produces
    {
    "age" => 30,
    "email" => "john.doe\@example.com",
    "first_name" => "John",
    "last_name" => "Doe"
    }

=head2 chomp

Performs a L<perlfunc/chomp> on the entire hash values and returns the current object it was called with.

Qyoting from L<perlfunc>: "If variable is a hash, it chomps the hash's values, but not its keys".

=head2 clone

Produce a deep clone of the hash and return a new object. This uses L<Clone/"clone"> to achieve that.

=head2 debug

Sets or gets the debug level

=head2 defined

Provided with a hash key and this returns true if there is a value defined for this key. See L<perlfunc/"defined">

=head2 delete

Provided with a hash key and this remove the hash entry and return the previous value, exactly as L<perlfunc/"delete"> does. Returns C<undef> if the key does not exist:

    my $value = $h->delete( "role" ); # Returns "customer" if it existed

=head2 dump

Returns a string representation of the hash. This uses L<Data::Dumper> to produce the result.

=head2 each

Provided with with a reference to a subroutine, this will do a loop using L<perlfunc/"each"> and this will call the code, passing it the hash key and its value.

If the code returns false, it will exit the L<perlfunc/"while"> loop.

To exit the loop, return C<undef()>, for example:

    $a->each(sub
    {
        my( $k, $v ) = @_;
        return if( $key eq $not_this_one );
        print( "ok, this one\n" );
    });

=head2 exists

Given a hash key, this will return true or false depending if the hash key exists. This uses L<perlfunc/"exists">.

=head2 for

This is simply an alias for L</foreach>

=head2 foreach

Same as L<perlfunc/"foreach">, given a reference to a subroutine, and this will execute foreach and call the code providing it as arguments the hash key and value. For convenience, C<$_> is also available and represent the 2nd argument, i.e. the value.

To exit the loop, return C<undef()>, for example:

    $a->foreach(sub
    {
        my( $k, $v ) = @_;
        return if( $key eq $not_this_one );
        print( "ok, this one\n" );
    });

=head2 get

Provided with an hash key and this will return whatever value was set.

    $a->get( 'last_name' ); # Return 'Doe' maybe?

See L</set> for the opposite method, i.e. setting a key value.

=head2 has

Returns true if the given value exists in the hash. This is effectively an alias for L</exists>

=head2 is_empty

Returns true if the hash object contains no data, or false otherwise.

=head2 json

This returns a L<JSON> representation of the hash. You can provided optionally an hash reference of parameters.

All parameters supported by L</JSON> can be used here.

For example:

    my $json = $h->json({ pretty => 1, canonical => 1 });
    # pretty only will trigger canonical to be true
    my $json = $h->json({ pretty => 1 });

This would yield something like:

    {
    "age" : 30,
    "email" : "john.doe@example.com",
    "first_name" : "John",
    "last_name" : "Doe"
    }

Otherwise, you would get a more terse result, such as :

    {"age":30,"email":"john.doe@example.com","first_name":"John","last_name":"Doe"}

When pretty is enabled, it will automatically also enable C<canonical>, C<indent> and C<relaxed> unless those are explicitly specified:

    my $json = $h->json({ pretty => 1, canonical => 0 });

For simplicity, you can also use, as alias to C<canonical>, C<sort>, C<sorted>, C<order> or C<ordered>

It returns the JSON encoded data as a L<scalar object|Module::Generic::Scalar>

=head2 key_object

Sets or gets the boolean value as to whether this hash should allow the use of reference as keys. Default is false.

When false, any reference used as key, will be converted to a string by perl, since perl natively does not recognise reference as keys.

=head2 keys

Returns the hash keys as a L<Module::Generic::Array> object.

Also note that if you have a multi-level hash, this will return only the first level keys, just like L<perlfunc/"keys"> would do.

    printf( "%d hash keys found\n", $h->keys->length );

And even, chaining through different objects :

    if( $h->keys->length->is_positive )
    {
        # Do something
    }

This returns the keys as an L<Module::Generic::Array> object, then returns the size of the array as a L<Module::Generic::Number> object.

=head2 length

This returns the number of keys in the hash, as a L<Module::Generic::Number> object.

=head2 map

Provided with a code reference and this calls L<perlfunc/map> and pass the code reference the hash key and its value.

It returns a regular list, i.e. not an object, just like perl's L<perlfunc/map> would do. Returns an empty list if the code reference is invalid:

    my @pairs = $h->map(sub
    {
        my( $k, $v ) = @_;
        return( "$k=$v" );
    }); # e.g., ("first_name=John", "last_name=Doe")

=head2 map_array

Does the same as L</map> above, except it returns a new array as a L<Module::Generic::Array> object.

    my $pairs = $h->map_array(sub
    {
        my( $k, $v ) = @_;
        return( "$k=$v" );
    }); # e.g., ["first_name=John", "last_name=Doe"]

=head2 map_hash

Does the same as L</map> above, except it returns a new L<Module::Generic::Hash> object.

For this to work properly, the code reference needs to return a key-value pair.

    my $new_h = $h->map_hash(sub
    {
        my( $k, $v ) = @_;
        return( uc($k) => $v );
    }); # e.g., { FIRST_NAME => "John", LAST_NAME => "Doe" }

=head2 md5

    my $h = Module::Generic::Hash->new({ name => 'John Doe', age => 30 });
    $h->md5; # 5930d8375b3aae2d2d063ad44142f297
    $h->{location} = 'Tokyo';
    $h->md5; # 1febee55cacfea22bb586dfc7eb61b7e

Returns the MD5 checksum of the underlying hash reference, useful for detecting changes. This uses L<Digest::MD5>, which is a core perl module and loaded dynamically, and L<JSON::XS> (already a dependency), to ensure consistent checksums by sorting keys. It returns an error if those modules cannot be loaded.

You can also call this method as C<md5_checksum>.

=head2 md5_checksum

This is an alias for L</md5>

=head2 md5_hex

This is an alias for L</md5>

=head2 merge

Provided with an hash reference and an optional hash of parameters and this will mergge the given hash with hash in our object. It does so recursively and prevents looping by using L<Scalar::Util/"refaddr">.

Currently the only parameter possible is I<overwrite>. By default this is set to a true value, and you can provide this argument to specifically indicates you do not want the hash key value to be overwriten.

=head2 remove

Just an alias for L</delete>

=head2 reset

This simply empty the hash. See also L</"undef"> for the same result.

=head2 set

Provided with a key and a value, and this adds it to the hash, possibly overwriting any previous entry.

See L</get> for the opposite method, i.e. to get the key value.

=head2 size

Alias method for L</length>

=head2 undef

This simply empty the hash. See also L</"reset"> for the same result.

=head2 values

This returns the values of the hash as a L<Module::Generic::Array>, but please note that jsut like the L<perlfunc/"values">, it only provides the first level values.

If an optional reference to a subroutine is provided, the code will be called for each value as its sole argument, and the subroutine can decide what to do with it, possibly altering the value and discarding it by returning the value, possibly altered, or an empty list to indicte this entry shoul be discarded. For example :

    my $vals = $h->values(sub{
        ref( $_[0] ) ? () : $_[0];
    });

This will make sure to get all values, except the ones that are reference (L<perlref>)

To return entries with uppercase first :

    my $vals = $h->values(sub{
        join( ' ', map( ucfirst( lc( $_ ) ), split( /[[:blank:]]+/, $_[0] ) ) );
    });

And if one of the value were C<JohN  DOE>, this would result in C<John Doe>

If the parameter I<sort> is provided, then it will sort the array before returning the values and before executing the reference of the subroutine on each entry.

=head1 SERIALISATION

=for Pod::Coverage FREEZE

=for Pod::Coverage STORABLE_freeze

=for Pod::Coverage STORABLE_thaw

=for Pod::Coverage THAW

=for Pod::Coverage TO_JSON

Serialisation by L<CBOR|CBOR::XS>, L<Sereal> and L<Storable::Improved> (or the legacy L<Storable>) is supported by this package. To that effect, the following subroutines are implemented: C<FREEZE>, C<THAW>, C<STORABLE_freeze> and C<STORABLE_thaw>

    use Storable;
    my $h = Module::Generic::Hash->new( age => 30 );
    my $frozen = Storable::freeze( $h );
    my $thawed = Storable::thaw( $frozen );
    print "Age: ", $thawed->{age}, "\n"; # 30

=head1 THREAD-SAFETY

L<Module::Generic::Hash> is thread-safe for per-object operations, with proper handling of per-object state and external libraries. It supports multi-threaded environments, but care must be taken when sharing objects across threads or modifying global variables.

Key considerations for thread-safety:

=over 4

=item * B<Shared Variables>

The global variable C<$KEY_OBJECT> controls whether references can be used as hash keys. It is not shared by default, so concurrent modifications in threads may cause race conditions. Use C<local> or the L</key_object> method to set it per-object:

    use threads;
    my $h = Module::Generic::Hash->new;
    $h->key_object(1); # Thread-safe per object
    my $ref = [];
    $h->{ $ref } = "array"; # Safe

=item * B<Hash Data>

Hash data is stored in a tied hash (L<Module::Generic::TieHash>), which is per-object and thread-safe for independent operations. Operations like L</merge>, L</json>, and L</clone> operate on local data. However, concurrent modifications to a shared object are not thread-safe without synchronisation:

    use threads;
    my $h = Module::Generic::Hash->new( first_name => "John" );
    lock( $h ); # Synchronize access
    my @threads = map
    {
        threads->create(sub
        {
            lock( $h );
            $h->merge({ last_name => "Doe" }); # Thread-safe with lock
        });
    } 1..5;
    $_->join for( @threads );

For best practices, create per-thread objects to avoid shared state:

     use threads;
     my @threads = map
     {
         threads->create(sub
         {
             my $h = Module::Generic::Hash->new( first_name => "John" );
             $h->merge({ last_name => "Doe" }); # Thread-safe
         });
     } 1..5;
     $_->join for @threads;

=item * B<External Libraries>

Methods like L</json> use L<JSON>, L</clone> uses L<Clone>, and L</dump> uses L<Data::Dumper>, all of which are thread-safe as they operate on per-object state.

=item * B<Serialisation>

Serialisation methods (L</FREEZE>, L</THAW>) operate on per-object state, making them thread-safe:

    use threads;
    use Storable;
    my $h = Module::Generic::Hash->new( age => 30 );
    my $frozen = Storable::freeze( $h ); # Thread-safe

=back

For debugging in threaded environments:

    ls -l /proc/$$/fd  # List open file descriptors

=head1 SEE ALSO

L<Module::Generic::Scalar>, L<Module::Generic::Array>, L<Module::Generic::Boolean>, L<Module::Generic::Number>, L<Module::Generic::Dynamic>

L<Math::BigInt>

=head1 AUTHOR

Jacques Deguest E<lt>F<jack@deguest.jp>E<gt>

=head1 COPYRIGHT & LICENSE

Copyright (c) 2000-2024 DEGUEST Pte. Ltd.

You can use, copy, modify and redistribute this package and associated
files under the same terms as Perl itself.

=cut

