File Coverage

blib/lib/Jasonify.pm

Criterion	Covered	Total	%
statement	136	159	85.5
branch	98	152	64.4
condition	6	9	66.6
subroutine	46	58	79.3
pod	10	13	76.9
total	296	391	75.7

use v5.14;
use warnings;

package Jasonify v0.20.052;
# ABSTRACT: Just Another Serialized Object Notation library.


use Carp             ();           #qw( carp );
use Datify v0.20.052 ();
use Scalar::Util     ();           #qw( blessed looks_like_number reftype );
use String::Tools  qw( subst );    #qw( );

use parent 'Datify';




### Accessor ###




### Setter ###




__PACKAGE__->set(
    # Varify/Encode options
    #name     => '',
    #assign   => undef,
    #list     => undef,
    list_sep => ', ',
    beautify => undef,
);



__PACKAGE__->set(
    # Undefify options
    null  => 'null',
);



__PACKAGE__->set(
    # Booleanify options
    false => 'false',
    true  => 'true',
);



__PACKAGE__->set(
    # Stringify options
    quote  => '"',
    #quote1 => undef,
    quote2 => '"',
    #q1     => undef,
    #q2     => undef,
    #sigils => undef,
    longstr => -1,
    #encode1 => undef,
    encode2 => {
        map( { $_ => sprintf( '\\u%04x', $_ ) }
            0x00 .. 0x1f, 0x7f,    # Control characters (C0)
            0x80 .. 0x9f,          # Control characters (C1)
            0x2028, 0x2029,        # Characters not allowed by Javascript
        ),
        # Special cases
        map( { ord( eval qq!"$_"! ) => $_ } qw( \b \t \n \r \" \\\\ ) ),
        utf  => 16,
        byte => '\\u00%02x',
        wide => '\\u%04x',
    },
    #qpairs  => undef,
    #qquotes => undef,
);



__PACKAGE__->set(
    # Numify options
    infinite  => '"Infinity"',
    -infinite => '"-Infinity"',
    nonnumber => '"NaN"',
    #num_sep  => undef,
);



__PACKAGE__->set(
    # Lvalueify options
    lvalue    => '$lvalue',
);



__PACKAGE__->set(
    # Vstringify options
    vformat => '"\\u%0*v4x"',
    vsep    => '\\u',
);


#=option Regexpify options
#
#=over
#
#=item ...
#
#=back
#
#=cut
#
#__PACKAGE__->set(
#    # Regexpify options
#    #quote3  => undef,
#    #q3      => undef,
#    #encode3 => undef,
#);



__PACKAGE__->set(
    # Arrayify options
    array_ref => '[$_]',
);



__PACKAGE__->set(
    # Hashify options
    hash_ref         => '{$_}',
    pair             => '$key : $value',
    keysort          => \&Datify::keysort,
    keyfilter        => undef,
    keyfilterdefault => 1,
    #keywords         => undef,
);



__PACKAGE__->set(
    # Objectify options
    json_method => 'TO_JSON',
    object      => '$data',
    #object      => '{$class_str : $data}',
    overloads   => [qw( "" 0+ )],
    tag         => undef,
    #tag         => '($class_str)$data',
    tag_method  => 'FREEZE',
);



__PACKAGE__->set(
    # Ioify options
    io => 'null',
);



__PACKAGE__->set(
    # Codeify options
    code     => 'null',
    #codename => undef,
    #body     => undef,
);



__PACKAGE__->set(
    # Refify options
    reference   => '$_',
    dereference => '$referent$place',
    #nested      => undef,
);



__PACKAGE__->set(
    # Formatify options
    format => 'null',
);



# Override Datify::booleanify() for SCALAR refs
sub booleanify {
    my $self = &Datify::self;
    local $_ = shift if @_;
    return $self->undefify unless defined;
    return $self->booleanify($$_) if 'SCALAR' eq ref;
    return $_ ? $Jasonify::Boolean::true : $Jasonify::Boolean::false;
}



# Override Datify::keyify() to appropriately stringify all keys
sub keyify {
    my $self = &Datify::self;
    local $_ = shift if @_;

    return Scalar::Util::looks_like_number($_)
        ? (
            defined( $_ <=> 0 )
                ? (
                      $_ ==  "Infinity" ? $Jasonify::Number::inf
                    : $_ == "-Infinity" ? $Jasonify::Number::ninf
                    :                     $self->stringify($_)
                )
                : $Jasonify::Number::nan
        )
        : $self->stringify($_);
}

sub _objectify_via {
    my $self   = shift;
    my $object = shift;

    if ( my $method_name = shift ) {
        return $object->can($method_name);
    }
    return;
}
sub _objectify_via_tag {
    my $self   = shift;
    my $object = shift;

    my $tag_method = $self->get('tag') && $self->get('tag_method');
    return $self->_objectify_via( $object => $tag_method );
}
sub _objectify_via_json {
    my $self   = shift;
    my $object = shift;

    return $self->_objectify_via( $object => $self->get('json_method') );
}



# Override Datify::objectify() to appropriately stringify objects
sub objectify {
    my $self   = &Datify::self;
    my $object = shift;

    return $self->scalarify($object)
        unless defined( my $class = Scalar::Util::blessed($object) );

    my $object_str = $self->get('object');

    my $data;
    if (0) {
    } elsif ( my $code = $self->_find_handler($class) ) {
        return $self->$code($object);
    } elsif ( my $tag = $self->_objectify_via_tag($object) ) {
        $object_str = $self->get('tag');
        $data = $self->arrayify( $object->$tag('JSON') );
    } elsif ( my $to_json = $self->_objectify_via_json($object) ) {
        $data = $self->scalarify( $object->$to_json() );
    } elsif ( my $method = $self->overloaded($object) ) {
        $data = $self->scalarify( $object->$method() );
    } elsif ( my $attrkeyvals = $object->can('_attrkeyvals') ) {
        # TODO: Look this up via meta-objects and such.
        $data = $self->hashify( $object->$attrkeyvals() );
    } else {
        $data = Scalar::Util::reftype $object;

        $data
            = $data eq 'ARRAY'  ? $self->arrayify(  @$object )
            : $data eq 'CODE'   ? $self->codeify(    $object )
            : $data eq 'FORMAT' ? $self->formatify(  $object )
            : $data eq 'GLOB'   ? $self->globify(    $object )
            : $data eq 'HASH'   ? $self->hashify(    $object )
            : $data eq 'IO'     ? $self->ioify(      $object )
            : $data eq 'REF'    ? $self->scalarify( $$object )
            : $data eq 'REGEXP' ? $self->regexpify(  $object )
            : $data eq 'SCALAR' ? $self->scalarify( $$object )
            :                     $self->undefify;
    }

    return subst(
        $object_str,
        class_str => $self->stringify($class),
        class     => $class,
        data      => $data,
    );
}



# Override Datify::regexpify() to appropriately stringify regular expressions
sub regexpify {
    my $self = &Datify::self;
    local $_ = shift if @_;

    return $self->stringify($_);
}

# Override Datify::varify so that it throws an error
sub varify;



# Override Datify::vstringify so that it encodes a vstring as appropriate
sub vstringify {
    my $self = &Datify::self;
    local $_ = shift if @_;

    # Encode as a vstring    if vformat has     been specified
    # or as a regular string if vformat has not been specified
    return $self->get('vformat')
        ? $self->SUPER::vstringify($_)
        : $self->stringify($_);
}



# Override Datify::scalarify to properly handle all of the various types
sub _scalarify {
    my $self = &Datify::self;
    local $_ = shift if @_;

    return $self->undefify unless defined $_;

    if ( defined( my $blessed = Scalar::Util::blessed($_) ) ) {
        return
              $blessed eq 'Regexp' ? $self->regexpify($_)
            :                        $self->objectify($_);
    }

    my $ref = Scalar::Util::reftype $_;
    if ( not $ref ) {
        # Handle GLOB, LVALUE, and VSTRING
        my $ref2 = ref \$_;
        return
              $ref2 eq 'GLOB'    ? $self->globify($_)
            : $ref2 eq 'LVALUE'  ? $self->lvalueify($_)
            : $ref2 eq 'VSTRING' ? $self->vstringify($_)
            : $ref2 eq 'SCALAR' && Scalar::Util::looks_like_number($_)
                                 ? $self->numify($_)
            :                      $self->stringify($_)
            ;
    }

    return
          $ref eq 'ARRAY'   ? $self->arrayify(@$_)
        : $ref eq 'CODE'    ? $self->codeify($_)
        : $ref eq 'FORMAT'  ? $self->formatify($_)
        : $ref eq 'GLOB'    ? $self->globify($$_)
        : $ref eq 'HASH'    ? $self->hashify($_)
        : $ref eq 'IO'      ? $self->ioify($_)
        : $ref eq 'LVALUE'  ? $self->booleanify($$_)
        : $ref eq 'REF'     ? $self->refify($$_)
        : $ref eq 'REGEXP'  ? $self->regexpify($_)     # ???
        : $ref eq 'SCALAR'  ? $self->booleanify($$_)
        : $ref eq 'VSTRING' ? $self->booleanify($$_)
        :                     $self->objectify($_)     # ???
        ;
}



# TODO
sub decode;



sub encode {
    my $self = &Datify::self;
    return unless @_;

    my @return = map { $self->scalarify($_) } @_;

    $self->_cache_reset();

    return @_ == 1 ? $return[0] : @return;
}



sub boolean {
    &Datify::class;
    return @_ ? Jasonify::Boolean::bool( $_[-1] ) : 'Jasonify::Boolean';
}
*bool = \&boolean;



sub literal {
    &Datify::class;
    return @_ ? Jasonify::Literal->new( $_[-1] ) : 'Jasonify::Literal';
}



sub number {
    &Datify::class;
    my $count = scalar @_;
    return
          $count >= 2 ? Jasonify::Number->formatted(@_)
        : $count == 1 ? Jasonify::Number->number(shift)
        :              'Jasonify::Number'
        ;
}



sub string {
    &Datify::class;
    return @_ ? Jasonify::Literal->string( $_[-1] ) : 'Jasonify::Literal';
}

### Private Methods & Settings ###
### Do not use these methods & settings outside of this package,
### they are subject to change or disappear at any time.
sub _settings() { \state %SETTINGS }

__PACKAGE__->set(
    _cache_hit  => 1,   # Sets the caching to use the final representation
                        # or die if that doesn't exist
);


package
    Jasonify::Literal;

use Scalar::Util ();    #qw( looks_like_number );

use overload
    'bool' => 'bool',
    '""'   => 'as_string',
    ;

our $null  = bless \do { my $null  = Jasonify->get('null')  }, __PACKAGE__;
our $false = bless \do { my $false = Jasonify->get('false') }, __PACKAGE__;
our $true  = bless \do { my $true  = Jasonify->get('true')  }, __PACKAGE__;

sub Jasonify::jasonify_literalify { $_[1]->as_string }
# OR
#Jasonify->add_handler( sub { $_[1]->as_string } );

sub null()  { $null  }
sub false() { $false }
sub true()  { $true  }

sub new {
    my $class   = &Datify::class;
    my $literal = shift;
    return $null  unless defined($literal);
    return $false unless length( $literal);
    return bless \$literal, $class;
}
sub string {
    @_ = ( shift, Jasonify->stringify(@_) );
    goto &new;
}
#sub comment {
#    $_[0]->new(
#        "# " . join( "\n# ", map { split /\n/ } @_[ 1 .. $#_ ] ) . "\n" );
#}

sub as_string { ${ $_[0] } }
sub bool {
    my $literal = ${ $_[0] };
    return
           $literal ne $$null
        && $literal ne $$false
        && $literal ne '""'
        && $literal ne '"0"'
        && !( Scalar::Util::looks_like_number($literal) && $literal == 0 );
}

package
    Jasonify::Number;

use Scalar::Util ();    #qw( looks_like_number );

use overload
    '0+'  => 'as_num',
    'neg' => 'negate',

    '<=>' => 'comparen',
    'cmp' => 'compares',
    ;
use parent -norequire => 'Jasonify::Literal';

our $nan  = bless \do { my $nan  = Jasonify->get('nonnumber') }, __PACKAGE__;
our $inf  = bless \do { my $inf  = Jasonify->get( 'infinite') }, __PACKAGE__;
our $ninf = bless \do { my $ninf = Jasonify->get('-infinite') }, __PACKAGE__;

sub Jasonify::jasonify_numberify { $_[1]->as_string }
# OR
#Jasonify->add_handler( sub { $_[1]->as_string } );

sub nan()  { $nan  }
sub inf()  { $inf  }
sub ninf() { $ninf }

my $number_regex = do {
    my $digit09 = '[0123456789]';
    my $digit19 =  '[123456789]';
    my $integer = "(?:0|$digit19+$digit09*)";
    my $decimal = "(?:\.$digit09+)";
    qr/-?$integer$decimal?(?:[Ee][+-]?$integer)?/;
};

sub comparen { ( $_[2] ? -1 : +1 ) * (    $_[0]->as_num <=> $_[1] ) }
sub compares { ( $_[2] ? -1 : +1 ) * ( ${ $_[0] }       cmp $_[1] ) }
sub as_num { eval ${ $_[0] } }
sub negate {
    my $num = ${ $_[0] };
    return
          $num eq $$nan  ? $nan
        : $num eq $$inf  ? $ninf
        : $num eq $$ninf ? $inf
        :                  $_[0]->number( $num =~ s/\A(-?)/$1 ? '' : '-'/er )
        ;
}
sub number {
    my $class = &Datify::class;
    my $num   = shift;
    Carp::croak( "Not a number ", $num )
        unless ( Scalar::Util::looks_like_number($num) );

    return
          not( defined( $num <=> 0 ) ) ? $nan
        : $num ==  'Infinity'          ? $inf
        : $num == '-Infinity'          ? $ninf
        : $num =~ /\A$number_regex\z/  ? $class->new($num)
        :   Carp::croak( "Malformed number ", $num );
}

sub formatted { return shift()->number( sprintf( shift(), @_ ) ) }
sub integer   { return shift()->formatted( '%d', shift() ) }
sub float     { return shift()->formatted( '%f', shift() ) }

package
    Jasonify::Boolean;

use Scalar::Util ();    #qw( blessed );

use overload
    'bool' => 'value',
    '0+'   => 'value',
    '""'   => 'as_string',

    '<=>' => 'compare',
    'cmp' => 'compare',

    '!'   => 'negate',
    ;

our $false = bless \do { my $false = 0 }, __PACKAGE__;
our $true  = bless \do { my $true  = 1 }, __PACKAGE__;

sub Jasonify::jasonify_booleanify { $_[1]->as_string }
# OR
#Jasonify->add_handler( sub { $_[1]->as_string } );

sub false() { $false }
sub true()  { $true  }

sub value { ${ $_[0] } }
sub as_string {
    ${ $_[0] } ? $Jasonify::Literal::true : $Jasonify::Literal::false;
}

sub compare { ( $_[2] ? -1 : +1 ) * ( ${ $_[0] } <=> ${ bool( $_[1] ) } ) }

sub negate { bool($_[0]) ? $false : $true }

sub bool($) {
    is_bool( $_[0] )
        ? $_[0]
        : ref( $_[0] ) eq 'SCALAR'
            ? ${ $_[0] } ? $true : $false
            :    $_[0]   ? $true : $false
        ;
}
sub is_bool($) { Scalar::Util::blessed( $_[0] ) && $_[0]->isa(__PACKAGE__) }

1;

__END__