test.pl

#!perl

use strict;
use warnings;

use Test::More;
use Data::Dumper;

=pod

Hmm, can Perl do Java/Jackson style annotations?

https://github.com/FasterXML/jackson-annotations/wiki/Jackson-Annotations

Yes, yes it can ... ;)

=cut

{	
	package JSONinator;
	use strict;
	use warnings;

	use MOP;
	use JSON::MaybeXS;

	sub new {
		my ($class, $JSON) = @_;
		bless {
			JSON => $JSON // JSON::MaybeXS->new,
		} => $class;
	}

	sub collapse {
		my $self    = shift;
		my $object  = shift;
		my $klass   = MOP::Class->new( name => ref $object );
		my @methods = grep { 
			!($_->is_required) 
				&&
			$_->has_code_attributes('JSONProperty')
		} $klass->all_methods;

		my %data;
		foreach my $m ( @methods ) {
			my $name = $m->name;
			$data{ $name } = $object->$name();
		}

		return $self->{JSON}->encode( \%data );
	}

	sub expand {
		my $self    = shift;
		my $klass   = MOP::Class->new( name => shift );
		my $json    = $self->{JSON}->decode( shift );
		my @methods = grep {
			!($_->is_required) 
				&&
			$_->has_code_attributes('JSONProperty')
		} $klass->all_methods;

		my $object = $klass->name->new;
		foreach my $m ( @methods ) {
			my $name = $m->name;
			$object->$name( $json->{ $name } );
		}

		return $object;
	}

	package JSONinator::Annotations;
	use strict;
	use warnings;

	my %_mappings;
	sub FETCH_CODE_ATTRIBUTES  { @{ $_mappings{ 0+$_[1] } } }
	sub MODIFY_CODE_ATTRIBUTES {
		my (undef, $code, @attrs) = @_;
		$_mappings{ 0+$code } = \@attrs;
		();
	}

}

{	
	package Person;

	use strict;
	use warnings;

	use UNIVERSAL::Object;

	our @ISA; BEGIN { @ISA = ('UNIVERSAL::Object', 'JSONinator::Annotations') }
	our %HAS; BEGIN {
		%HAS = (
			first_name => sub { "" },
			last_name  => sub { "" },
		)
	}

	sub first_name : JSONProperty {
		my $self = shift;
		$self->{first_name} = shift if @_;
		$self->{first_name};
	}

	sub last_name : JSONProperty {
		my $self = shift;
		$self->{last_name} = shift if @_;
		$self->{last_name};
	}
}

my $JSON = JSONinator->new( JSON::MaybeXS->new->pretty->canonical );

my $p = Person->new( first_name => 'Bob', last_name => 'Smith' );
warn Dumper $p;

my $json = $JSON->collapse( $p );
warn Dumper $json;

my $obj = $JSON->expand( Person => $json );
warn Dumper $obj;

done_testing;