File Coverage

blib/lib/JSON/T.pm

Criterion	Covered	Total	%
statement	32	86	37.2
branch	3	16	18.7
condition	1	13	7.6
subroutine	9	22	40.9
pod	9	9	100.0
total	54	146	36.9

use 5.010;
use strict;
use warnings;
use utf8;

package JSON::T;

use overload '""' => \&_to_string;

BEGIN
{
	$JSON::T::AUTHORITY = 'cpan:TOBYINK';
	$JSON::T::VERSION   = '0.104';
}

our ($JSLIB, @Implementations);

sub _load_lib
{
	unless ($JSLIB)
	{
		local $/ = undef;
		$JSLIB = ;
	}
}

BEGIN
{
	push @Implementations, qw/
		JSON::T::SpiderMonkey
		JSON::T::JE
	/;
}

{
	no warnings 'redefine';
	sub DOES
	{
		my ($class, $role) = @_;
		return $role if $role eq 'XML::Saxon::XSLT2';
		return $class->SUPER::DOES($role);
	}
}

sub new
{
	my $class = shift;
	my ($transformation_code, $transformation_name) = @_;
	$transformation_name ||= '_main';

	if ($class eq __PACKAGE__)
	{
		require Module::Runtime;
		IMPL: for my $subclass (@Implementations)
		{
			next IMPL unless eval { Module::Runtime::use_module($subclass) };
			$class = $subclass;
			last IMPL;
		}
	}

	if ($class eq __PACKAGE__)
	{
		require Carp;
		Carp::croak("cannot load any known Javascript engine");
	}

	my $self = bless {
		code      => $transformation_code ,
		name      => $transformation_name ,
		messages  => [],
	}, $class;

	$self->init;
	$self->engine_eval($transformation_code);

	$self;
}

sub init
{
	my $self = shift;

	_load_lib;
	$self->engine_eval($JSLIB);

	$self;
}

sub engine_eval { require Carp; Carp::croak("must be implemented by subclass") }
sub parameters  { require Carp; Carp::carp("not implemented by subclass") }

sub _accept_return_value
{
	my $self = shift;
	my ($value) = @_;

	$self->{return_value} = $value;
}

sub _last_return_value
{
	my $self = shift;

	$self->{return_value};
}

sub _to_string
{
	my $self = shift;

	return 'JsonT:#'.$self->{'name'};
}

sub _json_backend
{
	my $self = shift;

	$self->{'json_backend'} ||= eval {
		require Cpanel::JSON::MaybeXS;
		'Cpanel::JSON::MaybeXS';
	};
	$self->{'json_backend'} ||= do {
		require JSON::PP;
		'JSON::PP';
	};

	$self->{'json_backend'};
}

sub transform
{
	my $self = shift;
	my ($input) = @_;

	if (ref $input)
	{
		require Scalar::Util;
		if (Scalar::Util::blessed($input) and $input->isa('JSON::JOM::Node'))
		{
			$input = $self->_json_backend->new->convert_blessed(1)->encode($input);
		}
		else
		{
			$input = $self->_json_backend->new->encode($input);
		}
	}

	my $name = $self->{'name'};
	my $rv1  = $self->engine_eval("return_to_perl(JSON.transform($input, $name));");

	($self->_last_return_value // '') . ''; # stringify
}

sub transform_structure
{
	my $self = shift;
	my ($input, $debug) = @_;

	my $output = $self->transform($input);
	eval 'use Test::More; Test::More::diag("\n${output}\n");'
		if $debug;

	$self->_json_backend->new->decode($output);
}

*transform_document = \&transform_structure;

# none of this is useful, but provided for XML::Saxon::XSLT2 compat.
sub messages
{
	return;
}

sub media_type
{
	my $self = shift;
	my ($default) = @_;

	$default;
}

*version        = \&media_type;
*doctype_system = \&media_type;
*doctype_public = \&media_type;
*encoding       = \&media_type;

1;

#
# Don't include __END__ here because we
# have a __DATA__ section below the pod!
#

=pod

=encoding utf-8

=head1 NAME

JSON::T - transform JSON using JsonT

=head1 SYNOPSIS

 my $jsont = slurp('foo/bar.js');
 my $input = slurp('foo/quux.json');
 my $JSONT = JSON::T->new($jsont);
 print $JSONT->transform($input);

=head1 DESCRIPTION

This module implements JsonT, a language for transforming JSON-like
structures, analogous to XSLT in the XML world.

JsonT is described at L. JsonT is
a profile of Javascript; so JsonT needs a Javascript engine to actually
work. This module provides the engine-neutral stuff, while L
and L provide the necessary glue to hook it up to
a couple of Javascript engines.

JSON::T::JE uses the pure Perl Javascript implementation L.

JSON::T::SpiderMonkey uses L which in turn is
backed by Mozilla's libjs C library.

This module tries to provide a similar API to L.

=head2 Constructor

=over 4

=item C<< new($code, $name) >>

Constructs a new JSON::T transformation. $code is the JsonT Javascript
code. As a JsonT file can contain multiple (potentially unrelated)
transformations, the name of the particular transformation you want to
use should also be provided. If $name is omitted, then the name "_main"
is assumed.

If you wish to use a particular Javascript implementation, you can
use, for example:

  JSON::T::SpiderMonkey->new($code, $name)

Otherwise

  JSON::T->new($code, $name)

will try to pick a working implementation for you.

=back

=head2 Methods

=over 4

=item C<< parameters(param1=>$arg1, param2=>$arg2, ...) >>

Sets global variables available to the Javascript code. All arguments
are treated as strings.

=item C<< transform($input) >>

Run the transformation. The input may be a JSON string, a JSON::JOM::Node
or a native Perl nested arrayref/hashref structure, in which case it will be
stringified using the JSON module's to_json function. The output (return value)
will be a string.

=item C<< transform_structure($input) >>

Like C, but attempts to parse the output as a JSON string and
return a native Perl arrayref/hashref structure. This method will fail
if the output is not a JSON string.

=item C<< DOES($role) >>

Like L's DOES method, but returns true for:

  JSON::T->DOES('XML::Saxon::XSLT2')

as an aid for polymorphism.

=back

The following methods also exist for compatibility with XML::Saxon::XSLT2,
but are mostly useless:

=over

=item C<< transform_document >>

=item C<< messages >>

=item C<< media_type >>

=item C<< version >>

=item C<< doctype_system >>

=item C<< doctype_public >>

=item C<< encoding >>

=back

=head2 Javascript Execution Environment

JSON::T is a profile of Javascript, so is evaluated in an execution
environment. As this is not a browser environment, many global objects
familiar to browser Javascript developers are not available. (For example,
C, C, C, etc.)

A single global object called "JSON" is provided with methods
C and C compatible with the well-known json2.js
library (L), and a method
C that provides a Javascript JsonT
implementation.

A function C is provided which prints to Perl's
STDOUT stream.

=head1 SUBCLASSING

Two subclasses are provided: L and L,
but if you need to hook L up to another Javascript engine, it is
relatively simple. Just create a Perl class which is a subclass of L.
This subclass must implement two required methods and should implement
one optional method.

=over

=item C<< init >>

Will be passed a newly created object (let's call it C<< $self >>). It is
expected to initialise a Javascript execution context for C<< $self >>, and
define two Javascript functions: C (which acts as a shim
to C<< $self->_accept_return_value() >>) and C (which acts
as a shim to C). It must then call C<< SUPER::init >>.

=item C<< engine_eval >>

Will be passed an object (C<< $self >>) and a Javascript string. Must evaluate
the string in the object's Javascript execution context.

=item C<< parameters >>

This one is optional to implement it. If you don't implement it, then users
will get a warning message if they try to call C<< parameters >> on your
subclass.

Will be passed an object (C<< $self >>) and a hash of parameters, using the
following format:

  (
    name1  => 'value1',
    name2  => [ type2 => 'value2' ],
    name3  => [ type3 => 'value3', hint => 'hint value' ],
  )

This should have the effect of setting:

  var name1 = 'value1';
  var name2 = 'value2';
  var name3 = 'value3';

in the object's Javascript execution context. Parameter types and additional
hints may be used to set the correct types in Javascript.

=back

You are unlikely to need to do anything else when subclassing.

If you wish C<< JSON::T->new >> to know about your subclass, then push
its name onto C<< @JSON::T::Implementations >>.

=head1 BUGS

Please report any bugs to L.

=head1 SEE ALSO

Specification: L.

Related modules: L, L, L,
L, L.

JOM version: L, L.

=head1 AUTHOR

Toby Inkster [e-mail].

This module is embeds Stefan Goessner's Javascript implementation of
JsonT (version 0.9) to do the heavy lifting.

=head1 COPYRIGHT AND LICENCE

Copyright 2006 Stefan Goessner.

Copyright 2008-2011, 2013-2014 Toby Inkster.

Licensed under the Lesser GPL:
L.

=head1 DISCLAIMER OF WARRANTIES

THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.

=cut

# Here's the Javascript...

__DATA__