—use
v5.14;
use
warnings;
package
Jasonify v0.20.045;
# ABSTRACT: Just Another Serialized Object Notation library.
### 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
overload
'bool'
=>
'bool'
,
'""'
=>
'as_string'
,
#'cmp' => \&compare,
;
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
overload
'0+'
=>
'as_num'
,
'neg'
=>
'negate'
,
#'<=>' => \&compare,
;
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
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
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__
=pod
=encoding UTF-8
=head1 NAME
Jasonify - Just Another Serialized Object Notation library.
=head1 SYNOPSIS
use Jasonify;
my $jasonify = Jasonify->new( ... ); # See OPTIONS below
$jasonify = $jasonify->set( ... ); # See OPTIONS below
print $jasonify->encode( ... ); # ...
# Or
Jasonify->set( ... ); # See OPTIONS below
print Jasonify->encode( ... ); # ...
=head1 DESCRIPTION
C<Jasonify> is very similar to L<JSON>,
except that it's easier to use, has better defaults and options.
=head1 OPTIONS
=head2 Encode options
=over
=item I<list_sep> => B<', '>
=item I<beautify> => B<undef>
=back
=head2 Undefify options
=over
=item I<null> => B<'null'>
How C<undef> is encoded.
=back
=head2 Booleanify options
=over
=item I<false> => B<'false'>
=item I<true> => B<'true'>
How the boolean values are encoded.
=back
=head2 Stringify options
=over
=item I<quote> => B<'"'>
Use double-quoted strings in all cases.
=item I<longstr> => B<-1>
All strings are to be considered long, and encoded accordingly.
=item I<econde2> => { ... }
=over
=item I<[[:cntrl:]]> => sprintf( '\\u00%02x', ord($_) )
=item I<"\x{2028}", "\x{2029}"> => sprintf( '\\u%04x', ord($_) )
=item I<"\b"> => B<'\b'>
=item I<"\t"> => B<'\t'>
=item I<"\n"> => B<'\n'>
=item I<"\r"> => B<'\r'>
=item I<'"'> => B<'\"'>
=item I<'\\'> => B<'\\\\'>
=item I<byte> => B<'\\u00%02x'>
=item I<utf> => B<16>
=item I<wide> => B<'\\u%04x'>
=back
Special characters, and how they are encoded.
=back
=head2 Numify options
=over
=item I<infinite> => B<"Infinifty">,
=item I<-infinite> => B<"-Infinifty">,
=item I<nonnumber> => B<"NaN">,
How to encode the values for infinity, negative infinity, and not-a-number.
=back
=head2 Lvalueify options
=over
=item I<lvalue> => B<'$lvalue'>
Encode C<lvalue>s as simple strings.
=back
=head2 Vstringify options
=over
=item I<vformat> => B<'\\u%0*v4x'>
=item I<vsep> => B<'\\u'>
Encode vstrings as a series of 4-character hex digits separated by C<'\u'>.
=back
=head2 Arraryify options
=over
=item I<array_ref> => B<'[$_]'>
A reference to an C<ARRAY> is encoded in this manner.
=back
=head2 Hashify options
=over
=item I<hash_ref> => B<'{$_}'>
A reference to a C<HASH> is encoded in this manner.
=item I<pair> => B<'$key : $value'>
Pairs are encoded in this manner.
=item I<keysort> => B<\&Datify::keysort>
The function used to sort entries in a hash.
=item I<keyfilter> => B<undef>
How to filter items in a C<HASH>.
=item I<keyfilterdefault> => B<1>
How to interpret filtered items in a C<HASH>.
=back
=head2 Objectify options
=over
=item I<json_method> => B<'TO_JSON'>
The method to search for to see if an object has a specific representation
for itself.
=item I<object> => B<'$data'>
Objects are decomposed using this.
If you wanted to decompose objects with the class name in addition to
the internal representation of the data, then you may want to use
C<'{$class_str : $data}'>.
=item I<overloads> => B<[ '""', '0+' ]>
If objects have overloaded these, use them to decompose the object.
=item I<tag> => B<undef>
To enable tag output, set this to C<'($class_str)$data'>.
=item I<tag_method> => B<'FREEZE'>
The method to search for to see if an object should be represented in the
tag format.
=back
=head2 Ioify options
=over
=item I<io> => B<'null'>
How IO objects will be decomposed.
=back
=head2 Codeify options
=over
=item I<code> => B<'null'>
How C<CODE> references will be decomposed.
=back
=head2 Refify options
=over
=item I<reference> => B<'$_'>
References will be ignored, and the actual value will be encoded.
=item I<dereference> => B<'$referent$place'>
When referring to a location in the reference, decompose with this.
=back
=head2 Formatify options
=over
=item I<format> => B<'null'>
How a C<FORMAT> will be encoded.
=back
=head1 METHODS
=head2 C<< new( ... ) >>
Create a C<Jasonify> object with the following options.
See L</OPTIONS> for a description of the options and their default values.
=head2 exists( name, name, ... )
Determine if values exists for one or more settings.
Can be called as a class method or an object method.
=head2 C<get( name, name, ... )>
Get one or more existing values for one or more settings.
If passed no names, returns all parameters and values.
Can be called as a class method or an object method.
=head2 C<< set( name => value, name => value, ... ) >>
Change the L</OPTIONS> settings.
When called as a class method, changes default options.
When called as an object method, changes the settings and returns a
new object.
See L</OPTIONS> for a description of the options and their default values.
B<NOTE:> When called as a object method, this returns a new instance
with the values set, so you will need to capture the return if you'd like to
persist the change:
$jasonify = $jasonify->set( ... );
=head2 C<booleanify( value )>
Returns the string that represents the C<true> or C<false> interpretation
of C<value>.
If C<value> is a scalar reference, calls itself with C<value> dereferenced.
Will return the value for C<undefify> if C<value> is not defined.
=head2 C<keyify( value )>
Returns value as a key.
NOTE: Numbers are always quoted when used as keys.
=head2 C<objectify( value )>
Returns value as an object.
Goes through a series of checks to format the object appropriately:
If a handler has been defined for the object with
L</C<< add_handler( $class => \&code_ref ) >>>, then use that.
If L</tag> has been enabled, and the object has a method that corresponds
to L</tag_method>, then that is used.
If the object has a method that corresponds to L</json_method>,
then that is used.
If the object has overloaded any of
L<< /I<overloads> => B<[ '""', '0+' ]> >>, then use that to represent
the C<$data> portion of the object.
If the object has an C<_attrkeyvals> method,
then that will be used to gather the elements of the object.
If the object has none of those things, then the object is inspected
and handled appropriately.
=head2 C<regexpify( value, delimiters )>
Simply calls out to L</stringify>.
=head2 C<vstringify( value )>
A representation of the VString.
If L</vformat> is specified, as a series of four digit hex values
separated by C<'\\u'>.
If L</vformat> is false, as a regular via L</stringify>.
=head2 C<scalarify( value )>
This is the method called by L</encode( value, ... )>
TODO:
Returns value as a scalar. If value is not a reference, performs some magic
to correctly print vstrings and numbers, otherwise assumes it's a string.
If value is a reference, hands off to the correct function to create
the string.
Handles reference loops.
=head2 C<decode( value, ... )>
Decode one or more string representations of C<JSON>.
B<NOTE:> This method is not implemented yet,
it is a placehold for future implementations.
=head2 C<encode( value, ... )>
Encode one or more values to C<JSON> formatted strings.
Can be called as a class or object method.
=head2 C<boolean( value )>
If passed a C<value>, returns the boolean for that value.
If passed no C<value>, retunrs the name of the class representing booleans.
Also aliased as C<bool( value )>.
See L</Jasonify::Boolean>.
=head2 C<literal( value )>
If passed a C<value>, returns a representation of that value that,
when encoded, will be exactly that C<value>.
If passed no C<value>, returns the name of the class representing literals.
See L</Jasonify::Literal>.
=head2 C<number( value, ... )>
If passed in a single C<value>, returns a representation of that value that,
when encoded, will be exactly that C<value>.
If passed in two or more C<value>s, returns a representation of that value
when passed through to C<sprintf()>.
If passed no C<value>, returns the name of the class representing numbers.
See L</Jasonify::Number>.
=head2 C<string( value )>
If passed a C<value>, returns a representation of that value that,
when encoded, will be exactly that C<value> as a string.
See L</Jasonify::Literal>.
=head1 BUGS
Please report any bugs or feature requests on the bugtracker website
When submitting a bug or request, please include a test-file or a
patch to an existing test-file that illustrates the bug or desired
feature.
=head1 TODO
=over
=item *
Implement C<decode()>.
=back
=head1 SEE ALSO
L<JSON>, L<Datify>
=head1 VERSION
This document describes version v0.20.045 of this module.
=head1 AUTHOR
Bob Kleemann <bobk@cpan.org>
=head1 COPYRIGHT AND LICENSE
This software is Copyright (c) 2019 by Bob Kleemann.
This is free software, licensed under:
The Artistic License 2.0 (GPL Compatible)
=cut