PGObject-Type-JSON-2.1.1/0000755000175000017500000000000014514125761013646 5ustar chrischrisPGObject-Type-JSON-2.1.1/ignore.txt0000644000175000017500000000020014513152004015647 0ustar chrischrisblib* Makefile Makefile.old Build Build.bat _build* pm_to_blib* *.tar.gz .lwpcookies cover_db pod2htm*.tmp PGObject-Type-JSON-* PGObject-Type-JSON-2.1.1/Makefile.PL0000644000175000017500000000134114513204125015606 0ustar chrischrisuse 5.010; use strict; use warnings; use ExtUtils::MakeMaker; WriteMakefile( NAME => 'PGObject::Type::JSON', AUTHOR => q{Chris Travers }, VERSION_FROM => 'lib/PGObject/Type/JSON.pm', ABSTRACT_FROM => 'lib/PGObject/Type/JSON.pm', ($ExtUtils::MakeMaker::VERSION >= 6.3002 ? ('LICENSE'=> 'BSD') : ()), PL_FILES => {}, PREREQ_PM => { 'PGObject' => 0, 'JSON' => 0, }, BUILD_REQUIRES => { 'Test2::V0' => 0, 'Carp::Always' => 0, }, dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', }, clean => { FILES => 'PGObject-Type-JSON-*' }, ); PGObject-Type-JSON-2.1.1/LICENSE0000644000175000017500000000241714513152004014644 0ustar chrischrisCopyright (c) 2013, Chris Travers All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.PGObject-Type-JSON-2.1.1/lib/0000755000175000017500000000000014514125761014414 5ustar chrischrisPGObject-Type-JSON-2.1.1/lib/PGObject/0000755000175000017500000000000014514125761016051 5ustar chrischrisPGObject-Type-JSON-2.1.1/lib/PGObject/Type/0000755000175000017500000000000014514125761016772 5ustar chrischrisPGObject-Type-JSON-2.1.1/lib/PGObject/Type/JSON.pm0000644000175000017500000001152614514125654020107 0ustar chrischrispackage PGObject::Type::JSON; use 5.010; use strict; use warnings; use PGObject; use JSON; use Carp 'croak'; use Scalar::Util 'blessed'; =head1 NAME PGObject::Type::JSON - JSON wrappers for PGObject =head1 VERSION Version 2.1.1 =cut our $VERSION = '2.1.1'; =head1 SYNOPSIS PGOBject::Type::JSON->register(); Columns of type json will be converted into hashrefs my $obj = PGOBject::Type::JSON->new($hashref); $obj will now serialize to the database as json. =head1 DESCRIPTION This module allows json types or others (specified by custom register) types to be converted from JSON into objects according to their values. This module assumes that encoding will be in UTF8 across the board and is not safe to use with other database encodings. =head1 SUBROUTINES/METHODS =head2 register(registry => 'default', types => ['json']) =cut sub register{ my $self = shift @_; croak "Can't pass reference to register \n". "Hint: use the class instead of the object" if ref $self; my %args = @_; my $registry = $args{registry}; $registry ||= 'default'; my $types = $args{types}; $types = ['json', 'jsonb'] unless defined $types and @$types; for my $type (@$types){ if ($PGObject::VERSION =~ /^1./){ my $ret = PGObject->register_type(registry => $registry, pg_type => $type, perl_class => $self); return $ret unless $ret; } else { PGObject::Type::Registry->register_type( registry => $registry, dbtype => $type, apptype => $self ); } } return 1; } =head2 new($ref) Stores this as a reference. Nulls are now scoped references to a lexically scoped variable. If values other than scalars, arrayrefs, or hashes are passed in, throws an error. =cut sub new { my ($class, $ref) = @_; $ref = null() unless defined $ref; if (not ref $ref){ my $src = $ref; $ref = \$src; } bless $ref, $class; croak 'unsupported reftype' unless $ref->reftype =~ /^(SCALAR|ARRAY|HASH)$/; return $ref; } =head2 from_db serializes from the db. Note that database nulls are preserved distinct from json null's. =cut my $db_null; sub null { \$db_null} my $json_null; sub json_null { \$json_null } sub is_json_null { json_null eq shift }; sub from_db { my ($class, $var) = @_; return $class->new(undef) unless defined $var; return $class->new(json_null) if $var eq 'null'; my $obj = $class->new(JSON->new->allow_nonref->decode($var)); return $obj->reftype eq 'SCALAR' ? $$obj : $obj ; } =head2 to_db returns undef if is_null. Otherwise returns the value encoded as JSON =cut =head2 null Return a null type for storage in the db. =cut =head2 TO_JSON The handler for setting this to the JSON parser =cut sub TO_JSON { my $self = shift; for ($self->reftype){ if ($_ eq 'SCALAR') { return $$self; } if ($_ eq 'ARRAY') { return [@$self]; } if ($_ eq 'HASH') { return { %$self } } } } sub to_db { my $self = shift @_; return undef if $self->is_null; return 'null' if $self->is_json_null; return JSON->new->allow_blessed->convert_blessed->encode($self); } =head2 reftype Returns the reftype of the object (i.e. HASH, SCALAR, ARRAY) =cut sub reftype { my ($self) = @_; my $reftype = "$self"; my $pkg = blessed $self; $reftype =~ s/${pkg}=(\w+)\(.*\)/$1/; $reftype = 'SCALAR' if $reftype eq 'REF'; return $reftype; } =head2 is_null Returns true if is a database null. =cut sub is_null { my $self = shift @_; return 1 if ref $self && ($self eq null); return 0; } =head2 json_null Returns a JSON null =head2 is_json_null Returns true if the value is a JSON null. Else it returns false =head1 AUTHOR Chris Travers, C<< >> =head1 BUGS Please report any bugs or feature requests to C, or through the web interface at L. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. =head1 SUPPORT You can find documentation for this module with the perldoc command. perldoc PGObject::Type::JSON You can also look for information at: =over 4 =item * RT: CPAN's request tracker (report bugs here) L =item * AnnoCPAN: Annotated CPAN documentation L =item * CPAN Ratings L =item * Search CPAN L =back =head1 ACKNOWLEDGEMENTS =head1 LICENSE AND COPYRIGHT Copyright 2013-2023 Chris Travers. This program is released under the following license: BSD =cut 1; # End of PGObject::Type::JSON PGObject-Type-JSON-2.1.1/TODO0000644000175000017500000000007214513152004014322 0ustar chrischris1. Ensure works on Perl 5.8 (development releases here). PGObject-Type-JSON-2.1.1/Changes0000644000175000017500000000144614514125543015144 0ustar chrischrisRevision history for PGObject-Type-JSON 2.1.1 2023-10-11 Subclassing now supported and tested 2.1.0 2023-10-18 Fixes for db vs json nulls We now throw an error if unserializable reference types are passed into new() on the top level. 2.0.3 2023-10-16 Comprehensive fixes for scalars serialized to json 2.0.2 2023-10-16 Some fixes for scalars serialized to JSON 2.0.0 2017-05-15 Perl 5.8 support removed PGObject 2.x supported Support for JSONB added. 1.011.0 2014-03-02 Perl 5.8 support added Fixed test cases base on json hash key ordering 1.010.01 2014-03-01 Minor packaging changes, version number fix for CPAn 1.01 2014-02-28 Minor packaging fixes 1.00 2014-02-28 First version, released on an unsuspecting world. PGObject-Type-JSON-2.1.1/META.yml0000644000175000017500000000111214514125761015112 0ustar chrischris--- abstract: 'JSON wrappers for PGObject' author: - 'Chris Travers ' build_requires: Carp::Always: '0' Test2::V0: '0' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 7.70, CPAN::Meta::Converter version 2.150010' license: bsd meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: PGObject-Type-JSON no_index: directory: - t - inc requires: JSON: '0' PGObject: '0' version: v2.1.1 x_serialization_backend: 'CPAN::Meta::YAML version 0.018' PGObject-Type-JSON-2.1.1/t/0000755000175000017500000000000014514125761014111 5ustar chrischrisPGObject-Type-JSON-2.1.1/t/pod-coverage.t0000644000175000017500000000104614513204125016641 0ustar chrischrisuse strict; use warnings; use Test2::V0; # Ensure a recent version of Test::Pod::Coverage my $min_tpc = 1.08; eval "use Test::Pod::Coverage $min_tpc"; plan skip_all => "Test::Pod::Coverage $min_tpc required for testing POD coverage" if $@; # Test::Pod::Coverage doesn't require a minimum Pod::Coverage version, # but older versions don't recognize some common documentation styles my $min_pc = 0.18; eval "use Pod::Coverage $min_pc"; plan skip_all => "Pod::Coverage $min_pc required for testing POD coverage" if $@; all_pod_coverage_ok(); PGObject-Type-JSON-2.1.1/t/02-serialization.t0000644000175000017500000000457214514125473017402 0ustar chrischrisuse Test2::V0; use PGObject::Type::JSON; use Carp::Always; plan 25; use strict; use warnings; my $nulltest = 'null'; my $undeftest = undef; my $hashtest = '{"foo": 1, "bar": 2}'; my $hashtest2 = '{"bar": 2, "foo": 1}'; my $arraytest = '[1,2,3]'; my $literaltest = 'a123abc"\u0000"'; my $inttest = 123; my ($undef, $null, $hash, $array, $literal, $int); # not allowing coderefs ok(dies { PGObject::Type::JSON->new( sub { 1 } ) }, 'dies on coderef'); # string 'null', should serialize as 'null', not the same as db null ok($null = PGObject::Type::JSON->new(PGObject::Type::JSON->from_db($nulltest)), 'Instantiate null'); ok($null->isa('PGObject::Type::JSON'), "Null is a JSON object"); is($null->reftype, 'SCALAR', 'Null is a scalar'); is($null->to_db, 'null', 'Serializes to db as null'); ok(!$null->is_null, 'Null is not undef'); # undef, db null, should serialize as undef ok($undef = PGObject::Type::JSON->from_db($undeftest), 'Instantiate undef'); ok($undef->isa('PGObject::Type::JSON'), 'Undef isa JSON object'); is($undef->reftype, 'SCALAR', 'Undef is scalar'); is($undef->to_db, undef, 'Serializes to db as undef'); ok($undef->is_null, 'undef is undef'); #hashref, should serialize exactly as it is ok($hash = PGObject::Type::JSON->from_db($hashtest), 'Instantiate hashref'); ok($hash->isa('PGObject::Type::JSON'), "Hashref is a JSON object"); is($hash->reftype, 'HASH', 'Hashref is a HASH'); like($hash->to_db, qr/(\{"bar":2,"foo":1\}|\{"foo":1,"bar":2\})/, 'Serialization of hashtest works'); is($hash->{foo}, 1, 'Hash foo element is 1'); is($hash->{bar}, 2, 'Hash bar element is 2'); #arrayref should serialize as it is ok($array = PGObject::Type::JSON->from_db($arraytest), 'Instantiate arrayref'); is($array->reftype, 'ARRAY', 'Array is ARRAY'); is($array, [1, 2, 3], 'Array is correct array'); is($array->to_db, $arraytest, 'Array serializes to db correctly'); #int ref, should be a scalar ref, serializing as it is is(PGObject::Type::JSON->from_db($inttest), $inttest, 'Instantiate literal int'); is(PGObject::Type::JSON->new($inttest)->to_db, qq($inttest), 'Literal serializes correctly'); #literal ref, should be a scalar ref, serializing as it is is(PGObject::Type::JSON->new($literaltest)->to_db, '"a123abc\"\\\\u0000\""', 'Serialization test'); ok($literal = PGObject::Type::JSON->from_db(PGObject::Type::JSON->new($literaltest)->to_db), $literaltest, 'basic round trip for complex literal'); PGObject-Type-JSON-2.1.1/t/pod.t0000644000175000017500000000034714513204125015053 0ustar chrischris#!perl -T use strict; use warnings; use Test2::V0; # Ensure a recent version of Test::Pod my $min_tp = 1.22; eval "use Test::Pod $min_tp"; plan skip_all => "Test::Pod $min_tp required for testing POD" if $@; all_pod_files_ok(); PGObject-Type-JSON-2.1.1/t/01-registration.t0000644000175000017500000000161714513204125017222 0ustar chrischrisuse Test2::V0; use PGObject; use PGObject::Type::JSON; use strict; use warnings; plan 6; # We can theoretically grab any scalar here and just treat it as a scalar ref # value. This test case is totally arbitrary. # ok(PGObject::Type::JSON->register(), 'default registration'); ok(PGObject::Type::JSON->register(types => ['int8']), 'int8 registration'); ok(PGObject::Type::JSON->register(types => ['int8']), 'custom registry, int8 registration'), ok(PGObject::Type::JSON->register(), 'default types, custom registry'); my $registry; if ($PGObject::VERSION =~ /^1\./){ $registry = PGObject::get_type_registry(); } else { $registry = { map { $_ => PGObject::Type::Registry->inspect($_) } qw(default) }; } for my $reg(qw(default)){ for my $type (qw(int8 json)) { is($registry->{$reg}->{$type}, 'PGObject::Type::JSON'); } } PGObject-Type-JSON-2.1.1/t/00-load.t0000644000175000017500000000030314513204125015415 0ustar chrischris#!perl -T use Test2::V0; plan 1; ok( eval "require PGObject::Type::JSON", $@) || bail_out('Did not load'); diag( "Testing PGObject::Type::JSON $PGObject::Type::JSON::VERSION, Perl $], $^X" ); PGObject-Type-JSON-2.1.1/t/manifest.t0000644000175000017500000000041714513204125016075 0ustar chrischris#!perl -T use strict; use warnings; use Test2::V0; unless ( $ENV{RELEASE_TESTING} ) { plan( skip_all => "Author tests not required for installation" ); } eval "use Test::CheckManifest 0.9"; plan skip_all => "Test::CheckManifest 0.9 required" if $@; ok_manifest(); PGObject-Type-JSON-2.1.1/t/boilerplate.t0000644000175000017500000000236014513204125016570 0ustar chrischris#!perl -T use 5.006; use strict; use warnings; use Test2::V0; plan 3; sub not_in_file_ok { my ($filename, %regex) = @_; open( my $fh, '<', $filename ) or die "couldn't open $filename for reading: $!"; my %violated; while (my $line = <$fh>) { while (my ($desc, $regex) = each %regex) { if ($line =~ $regex) { push @{$violated{$desc}||=[]}, $.; } } } if (%violated) { fail("$filename contains boilerplate text"); diag "$_ appears on lines @{$violated{$_}}" for keys %violated; } else { pass("$filename contains no boilerplate text"); } } sub module_boilerplate_ok { my ($module) = @_; not_in_file_ok($module => 'the great new $MODULENAME' => qr/ - The great new /, 'boilerplate description' => qr/Quick summary of what the module/, 'stub function definition' => qr/function[12]/, ); } not_in_file_ok(README => "The README is used..." => qr/The README is used/, "'version information here'" => qr/to provide version information/, ); not_in_file_ok(Changes => "placeholder date/time" => qr(Date/time) ); module_boilerplate_ok('lib/PGObject/Type/JSON.pm'); PGObject-Type-JSON-2.1.1/MANIFEST0000644000175000017500000000061014514125761014774 0ustar chrischrisChanges ignore.txt lib/PGObject/Type/JSON.pm LICENSE Makefile.PL MANIFEST This list of files README README.md t/00-load.t t/01-registration.t t/02-serialization.t t/boilerplate.t t/manifest.t t/pod-coverage.t t/pod.t TODO META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) PGObject-Type-JSON-2.1.1/META.json0000644000175000017500000000173414514125761015274 0ustar chrischris{ "abstract" : "JSON wrappers for PGObject", "author" : [ "Chris Travers " ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 7.70, CPAN::Meta::Converter version 2.150010", "license" : [ "bsd" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : 2 }, "name" : "PGObject-Type-JSON", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "Carp::Always" : "0", "Test2::V0" : "0" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "requires" : { "JSON" : "0", "PGObject" : "0" } } }, "release_status" : "stable", "version" : "v2.1.1", "x_serialization_backend" : "JSON::PP version 4.16" } PGObject-Type-JSON-2.1.1/README0000644000175000017500000000217614513152004014521 0ustar chrischrisPGObject-Type-JSON This module is a type handler for JSON entities. This is a best effort mapping of types to references. Literal values are handled as literal references. The current limitation is that there is no ability to distinguish between a database NULL and a json value of null which can be distinct in PostgreSQL. Such support is planned for 1.0. INSTALLATION To install this module, run the following commands: perl Makefile.PL make make test make install SUPPORT AND DOCUMENTATION After installing, you can find documentation for this module with the perldoc command. perldoc PGObject::Type::JSON You can also look for information at: RT, CPAN's request tracker (report bugs here) http://rt.cpan.org/NoAuth/Bugs.html?Dist=PGObject-Type-JSON AnnoCPAN, Annotated CPAN documentation http://annocpan.org/dist/PGObject-Type-JSON CPAN Ratings http://cpanratings.perl.org/d/PGObject-Type-JSON Search CPAN http://search.cpan.org/dist/PGObject-Type-JSON/ LICENSE AND COPYRIGHT Copyright (C) 2013 Chris Travers This program is released under the following license: BSD