##----------------------------------------------------------------------------
## Module Generic - ~/lib/Module/Generic/JSON.pm
## Version v0.1.0
## Copyright(c) 2025 DEGUEST Pte. Ltd.
## Author: Jacques Deguest <jack@deguest.jp>
## Created 2025/03/24
## Modified 2025/03/24
## All rights reserved
## 
## This program is free software; you can redistribute  it  and/or  modify  it
## under the same terms as Perl itself.
##----------------------------------------------------------------------------
package Module::Generic::JSON;
BEGIN
{
    use strict;
    use warnings;
    use parent qw( Module::Generic );
    use vars qw( @EXPORT @EXPORT_OK $AUTOLOAD $DEBUG $VERSION );
    use JSON ();
    use Scalar::Util ();
    our @ISA         = qw( Module::Generic );
    our @EXPORT      = qw( from_json to_json encode_json decode_json );
    our @EXPORT_OK   = qw( new_json );
    our %EXPORT_TAGS = ();
    our $VERSION = 'v0.1.0';
};

use strict;
use warnings;

sub import
{
    my $this = shift( @_ );
    $this->export_to_level( 1, undef, ( @_, @EXPORT ) );
}

sub init
{
    my $self = shift( @_ );
    $self->{_init_strict_use_sub} = 1;
    my $opts = $self->_get_args_as_hash( @_ );
    # try-catch
    local $@;
    my $j = eval{ JSON->new };
    if( $@ )
    {
        return( $self->error( "Error instantiating a JSON object: $@" ) );
    }
    my $equi =
    {
        order   => 'canonical',
        ordered => 'canonical',
        sorted  => 'canonical',
        sort    => 'canonical',
    };

    foreach my $opt ( keys( %$opts ) )
    {
        my $ref;
        $ref = $j->can( exists( $equi->{ $opt } ) ? $equi->{ $opt } : $opt ) || do
        {
            warn( "Unknown JSON option '${opt}'\n" ) if( $self->_warnings_is_enabled( 'Module::Generic' ) );
            next;
        };

        eval
        {
            $ref->( $j, $opts->{ $opt } );
        };
        if( $@ )
        {
            if( $@ =~ /perl[[:blank:]\h]+structure[[:blank:]\h]+exceeds[[:blank:]\h]+maximum[[:blank:]\h]+nesting[[:blank:]\h]+level/i )
            {
                my $max = $j->get_max_depth;
                return( $self->error( "Unable to set json option ${opt}: $@ (max_depth value is ${max})" ) );
            }
            else
            {
                return( $self->error( "Unable to set json option ${opt}: $@" ) );
            }
        }
        delete( $opts->{ $opt } );
    }
    $self->{_json} = $j;
    # Pass the rest to our parent init for properties unique to our module.
    $self->SUPER::init( %$opts ) || return( $self->pass_error );
    return( $self );
}

# cache
my $JSON;

sub decode_json($)
{
    my $rv = eval
    {
        ( $JSON ||= __PACKAGE__->new->utf8 )->decode( @_ );
    };
    if( $@ )
    {
        return( $JSON->error( $@ ) );
    }
    return( $rv );
}

sub encode_json($)
{
    my $rv = eval
    {
        ( $JSON ||= __PACKAGE__->new->utf8 )->encode( @_ );
    };
    if( $@ )
    {
        return( $JSON->error( $@ ) );
    }
    return( $rv );
}

sub to_json($@)
{
    if( ref($_[0]) eq __PACKAGE__ or
        ( @_ > 2 and $_[0] eq __PACKAGE__ ) )
    {
        return( __PACKAGE__->error( "to_json should not be called as a method." ) );
    }

    my $opts = {};
    if( @_ == 2 and ref($_[1]) eq 'HASH' )
    {
        $opts = $_[1];
    }
    my $json = __PACKAGE__->new( %$opts ) ||
        return( __PACKAGE__->pass_error );
    return( $json->encode( $_[0] ) );
}


sub from_json($@)
{
    if( ref( $_[0] ) eq __PACKAGE__ or $_[0] eq __PACKAGE__ )
    {
        return( __PACKAGE__->error( "from_json should not be called as a method." ) );
    }

    my $opts = {};
    if( @_ == 2 and ref($_[1]) eq 'HASH' )
    {
        $opts = $_[1];
    }
    my $json = __PACKAGE__->new( %$opts ) ||
        return( __PACKAGE__->pass_error );
    return( $json->decode( $_[0] ) );
}

sub new_json
{
    my $self = __PACKAGE__->new( @_ );
    $self->debug( $DEBUG );
    return( $self );
}

sub AUTOLOAD
{
    my $self;
    $self = shift( @_ ) if( Scalar::Util::blessed( $_[0] ) && $_[0]->isa( 'Module::Generic::JSON' ) );
    my @args = @_;
    my( $class, $meth, $code );
    $class = ref( $self ) || $self;
    $meth = $AUTOLOAD;
    if( CORE::index( $meth, '::' ) != -1 )
    {
        my $idx = rindex( $meth, '::' );
        $class = substr( $meth, 0, $idx );
        $meth  = substr( $meth, $idx + 2 );
    }


    if( $self )
    {
        my $j = $self->{_json} || return( $self->error( "No JSON object could be found! This should not happen." ) );
        if( $code = $j->can( $meth ) )
        {
            local $@;
            my $wantlist = wantarray();
            my @rv = eval{ ( $wantlist // '' ) ? ( $code->( $j, scalar( @args ) ? @args : () ) ) : scalar( $code->( $j, scalar( @args ) ? @args : () ) ) };
            if( $@ )
            {
                return( $self->error( $@ ) );
            }
            if( Scalar::Util::blessed( $rv[0] ) && $rv[0]->isa( 'JSON' ) )
            {
                return( $self );
            }
            else
            {
                return( ( $wantlist // '' ) ? @rv : $rv[0] );
            }
        }
        else
        {
            return( $self->error( "Unknown JSON method '${meth}'" ) );
        }
    }
    elsif( $code = JSON->can( $meth ) )
    {
        local $@;
        my @rv = eval
        {
            $code->( scalar( @args ) ? @args : () );
        };
        if( $@ )
        {
            return( __PACKAGE__->error( $@ ) );
        }
        return( wantarray() ? @rv : $rv[0] );
    }
    else
    {
        die( "Unknown class function '${meth}' in JSON" );
    }
}

1;
# NOTE: POD
__END__

=encoding utf-8

=head1 NAME

Module::Generic::JSON - A thin and reliable wrapper around JSON

=head1 SYNOPSIS

    use Module::Generic::JSON;
    my $j = Module::Generic::JSON->new(
        utf8         => 1,
        pretty       => 1,
        canonical    => 1,
        relaxed      => 1,
        allow_nonref => 1,
    ) || die( Module::Generic::JSON->error );
    $j->encode( $some_ref ) || die( $j->error );

Or

    my $j = Module::Generic::JSON->new;
    $j->utf8->pretty->canonical->relaxed->allow_nonref->encode( $some_ref ) ||
        die( $j->error );

Or, even simpler:

    use Module::Generic::JSON qw( new_json );
    my $j = new_json(
        utf8         => 1,
        pretty       => 1,
        canonical    => 1,
        relaxed      => 1,
        allow_nonref => 1,
    ) || die( Module::Generic::JSON->error );
    $j->encode( $some_ref ) || die( $j->error );

=head1 VERSION

    v0.1.0

=head1 DESCRIPTION

This is a thin and reliable wrapper around the otherwise excellent L<JSON> class. Its added value is:

=over 4

=item * Allow the setting of all the JSON properties upon object instantiation

As mentioned in the synopsis, you can do:

    my $j = Module::Generic::JSON->new(
        utf8         => 1,
        pretty       => 1,
        canonical    => 1,
        relaxed      => 1,
        allow_nonref => 1,
    ) || die( Module::Generic::JSON->error );

instead of:

    my $j = Module::Generic::JSON->new;
    $j = $j->utf8->pretty->canonical->relaxed->allow_nonref;

=item * No fatal exception that would kill your process inadvertently.

This is important in a web application where you do not want some module killing your process, but rather you want the exception to be handled gracefully.

Thus, instead of having to do:

    local $@;
    my $ref = eval{ $j->decode( $payload ) };
    if( $@ )
    {
        # Like returning a 500 or maybe 400 HTTP error
        bailout_gracefully( $@ );
    }

you can simply do:

    my $ref = $j->decode( $payload ) || bailout_gracefully( $j->error );

=item * Upon error, it returns an L<exception object|Module::Generic::Exception>

=item * All methods calls are passed through to L<JSON>, and any exception is caught, and handled properly for you.

=back

For L<class functions|/"CLASS FUNCTIONS"> too, you can execute them safely and catch error, if any, by calling C<< Module::Generic::JSON->error >>, so for example:

    decode_json( $some_data ) || die( Module::Generic::JSON->error );

=head1 CONSTRUCTOR

=head2 new

This takes an hash or an hash reference of options and it returns a new L<Module::Generic::JSON> object.

The options provided must be supported by L<JSON>.

Upon error, this sets an L<error object|Module::Generic::JSON>, and returns C<undef> in scalar context, or an empty list in list context.

=head1 METHODS

See the documentation for the module L<JSON> for more information, but below are the known methods supported by L<JSON>

=head2 allow_blessed

=head2 allow_nonref

=head2 allow_tags

=head2 allow_unknown

=head2 ascii

=head2 backend

=head2 boolean

=head2 boolean_values

=head2 canonical

=head2 convert_blessed

=head2 decode

=head2 decode_prefix

=head2 encode

=head2 filter_json_object

=head2 filter_json_single_key_object

=head2 indent

=head2 is_pp

=head2 is_xs

=head2 latin1

=head2 max_depth

=head2 max_size

=head2 pretty

=head2 property

=head2 relaxed

=head2 space_after

=head2 space_before

=head2 utf8

=head1 CLASS FUNCTIONS

=head2 decode_json

=head2 encode_json

=head2 from_json

=head2 to_json

=head1 AUTHOR

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

=head1 SEE ALSO

L<JSON>, L<Module::Generic::Exception>

=head1 COPYRIGHT & LICENSE

Copyright(c) 2025 DEGUEST Pte. Ltd.

All rights reserved.

This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.

=cut