Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

initial import of CGI::Application::Plugin::JSON to git

  • Loading branch information...
commit e04fbed92fc75fd2547acddbad7d52964beae2b3 0 parents
@mpeters authored
22 Build.PL
@@ -0,0 +1,22 @@
+use strict;
+use warnings;
+use Module::Build;
+use lib './t/lib';
+
+my $builder = Module::Build->new(
+ module_name => 'CGI::Application::Plugin::JSON',
+ license => 'perl',
+ dist_author => 'Michael Peters <mpeters@plusthree.com>',
+ requires => {
+ 'Test::More' => 0,
+ 'CGI::Application' => 4.00,
+ 'JSON::Any' => 1.14,
+ },
+ build_requires => {
+ JSON => '2.02',
+ },
+ create_makefile_pl => 'passthrough',
+ create_readme => 1,
+);
+
+$builder->create_build_script();
21 Changes
@@ -0,0 +1,21 @@
+Revision history for CGI::Application::Plugin::JSON
+
+1.01 Jan 03, 2007
+ - Functionally the same as 1.00, but made some changes to Build.PL
+ so that it installs even if there are no JSON modules but JSON::Any
+ is installed
+
+1.00 Dec 31, 2007
+ - using JSON::Any instead of just JSON so I don't have to worry about
+ API changes and you can use faster JSON implementations (JSON::Syck, JSON::XS)
+ if you have them installed
+
+0.03 Sept 17, 2007
+ - added json_callback() method
+
+0.02 Sept 23, 2006
+ - Tidied up docs and released to CPAN
+
+0.01 Sept 14, 2006
+ - First version, released on an unsuspecting world.
+
12 MANIFEST
@@ -0,0 +1,12 @@
+Build.PL
+Changes
+lib/CGI/Application/Plugin/JSON.pm
+Makefile.PL
+MANIFEST This list of files
+META.yml
+README
+t/00-pod.t
+t/01-pod-coverage.t
+t/02-json.t
+t/lib/MyApp.pm
+TODO
23 META.yml
@@ -0,0 +1,23 @@
+---
+name: CGI-Application-Plugin-JSON
+version: 1.01
+author:
+ - 'Michael Peters <mpeters@plusthree.com>'
+abstract: easy manipulation of JSON headers
+license: perl
+resources:
+ license: http://dev.perl.org/licenses/
+requires:
+ CGI::Application: 4
+ JSON::Any: 1.14
+ Test::More: 0
+build_requires:
+ JSON: 2.02
+provides:
+ CGI::Application::Plugin::JSON:
+ file: lib/CGI/Application/Plugin/JSON.pm
+ version: 1.01
+generated_by: Module::Build version 0.2808
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.2.html
+ version: 1.2
32 Makefile.PL
@@ -0,0 +1,32 @@
+# Note: this file was auto-generated by Module::Build::Compat version 0.03
+
+ unless (eval "use Module::Build::Compat 0.02; 1" ) {
+ print "This module requires Module::Build to install itself.\n";
+
+ require ExtUtils::MakeMaker;
+ my $yn = ExtUtils::MakeMaker::prompt
+ (' Install Module::Build now from CPAN?', 'y');
+
+ unless ($yn =~ /^y/i) {
+ die " *** Cannot install without Module::Build. Exiting ...\n";
+ }
+
+ require Cwd;
+ require File::Spec;
+ require CPAN;
+
+ # Save this 'cause CPAN will chdir all over the place.
+ my $cwd = Cwd::cwd();
+
+ CPAN::Shell->install('Module::Build::Compat');
+ CPAN::Shell->expand("Module", "Module::Build::Compat")->uptodate
+ or die "Couldn't install Module::Build, giving up.\n";
+
+ chdir $cwd or die "Cannot chdir() back to $cwd: $!";
+ }
+ eval "use Module::Build::Compat 0.02; 1" or die $@;
+
+ Module::Build::Compat->run_build_pl(args => \@ARGV);
+ my $build_pkg = eval { require Module::Build }
+ ? 'Module::Build' : 'Module::Build';
+ Module::Build::Compat->write_makefile(build_class => $build_pkg)
117 README
@@ -0,0 +1,117 @@
+NAME
+ CGI::Application::Plugin::JSON - easy manipulation of JSON headers
+
+SYNOPSIS
+ use CGI::Application::Plugin::JSON ':all';
+
+ # add_json_header() is cumulative
+ $self->add_json_header( foo => 'Lorem ipsum...');
+ $self->add_json_header( bar => [ 0, 2, 3, 4 ] );
+ $self->add_json_header( baz => { stuff => 1, more_stuff => 2 } );
+
+ # json_header() is not cumulative
+ $self->json_header( foo => 'Lorem ipsum...');
+
+ # in case we're printing our own headers
+ print "X-JSON: " . $self->json_header_string();
+
+ # clear out everything in the outgoing JSON headers
+ $self->clear_json_header();
+
+ # or send the JSON in the document body
+ $self->json_body( { foo => 'Lorem ipsum', bar => [ 0, 2, 3 ] } );
+
+ # send the JSON back in the document body, but execute it using a Javascript callback
+ $self->json_callback('alert', { foo => 'Lorem ipsum', bar => [ 0, 2, 3 ] } );
+
+DESCRIPTION
+ When communicating with client-side JavaScript, it is common to send
+ data in "X-JSON" HTTP headers or through the document body as
+ content-type "text/x-json".
+
+ This plugin adds a couple of convenience methods to make that just a
+ little bit easier.
+
+HEADER METHODS
+ json_header
+ This method takes name-value pairs and sets them to be used in the
+ outgoing JSON. It is not cummulative and works similarly to
+ "header_props". Use it only if you have all of the values up front. In
+ most cases add_json_header is probably what you want.
+
+ # only the 2nd call will actually set data that will be sent
+ $self->json_header( foo => 'Lorem ipsum...');
+ $self->json_header( bar => [ 0, 2, 3, 4 ] );
+
+ add_json_header
+ This method takes name-value pairs and sets them to be used in the
+ outgoing JSON. It is cummulative and works similarly to "header_add";
+ meaning multiple calls will add to the hash of outgoing values.
+
+ # both 'foo' and 'bar' will exist in the hash sent out
+ $self->json_header( foo => 'Lorem ipsum...');
+ $self->json_header( bar => [ 0, 2, 3, 4 ] );
+
+ clear_json_header
+ This method will remove anything that was previously set by both
+ json_header and add_json_header. This means that no "X-JSON" header will
+ be sent.
+
+ json_header_string
+ This method will create the actual HTTP header string that will be sent
+ to the browser. This plugin uses it internally to send the header, but
+ it might be useful to use directly if you are printing your own HTTP
+ headers (using a "header_type" of "none").
+
+ $self->header_type('none');
+ print $self->json_header_string();
+
+ json_header_value
+ This method will return the values being sent in the JSON header. If you
+ pass in the key of the value you want, you will get just that value.
+ Else all name-value pairs will be returned.
+
+ my $value = $self->json_header_value('foo');
+
+ my %values = $self->json_header_value();
+
+BODY METHODS
+ json_body
+ This method will take the given Perl structure, turn it into JSON, set
+ the appropriate content-type, and then return the JSON.
+
+ return $self->json_body({ foo => 'stuff', bar => [0,1,2,3]} );
+
+ json_callback
+ This method will take the given Perl structure, turn it into JSON, set
+ the appropriate content-type, and then return a Javascript snippet where
+ the given callback is called with the resulting JSON.
+
+ return $self->json_callback('alert', { foo => 'stuff', bar => [0,1,2,3]} );
+
+ # would result in something like the following being sent to the client
+ alert({ foo => 'stuff', bar => [0,1,2,3]});
+
+ to_json
+ This method is just a convenient wrapper around JSON::Any's "encode".
+
+ from_json
+ This method is just a convenient wrapper around JSON::Any's "decode".
+
+AUTHOR
+ Michael Peters, "<mpeters@plusthree.com>"
+
+BUGS
+ Please report any bugs or feature requests to
+ "bug-cgi-application-plugin-viewsource@rt.cpan.org", or through the web
+ interface at
+ <http://rt.cpan.org/NoAuth/ReportBug.html?Queue=CGI-Application-Plugin-J
+ SON>. I will be notified, and then you'll automatically be notified of
+ progress on your bug as I make changes.
+
+COPYRIGHT & LICENSE
+ Copyright 2006 Michael Peters, All Rights Reserved.
+
+ This program is free software; you can redistribute it and/or modify it
+ under the same terms as Perl itself.
+
0  TODO
No changes.
274 lib/CGI/Application/Plugin/JSON.pm
@@ -0,0 +1,274 @@
+package CGI::Application::Plugin::JSON;
+use warnings;
+use strict;
+use JSON::Any;
+use base 'Exporter';
+
+our @EXPORT_OK = qw(
+ to_json
+ from_json
+ json_header
+ json_body
+ json_callback
+ add_json_header
+ clear_json_header
+ json_header_string
+ json_header_value
+);
+
+our %EXPORT_TAGS = ( all => \@EXPORT_OK );
+
+=head1 NAME
+
+CGI::Application::Plugin::JSON - easy manipulation of JSON headers
+
+=cut
+
+our $VERSION = '1.01';
+
+=head1 SYNOPSIS
+
+ use CGI::Application::Plugin::JSON ':all';
+
+ # add_json_header() is cumulative
+ $self->add_json_header( foo => 'Lorem ipsum...');
+ $self->add_json_header( bar => [ 0, 2, 3, 4 ] );
+ $self->add_json_header( baz => { stuff => 1, more_stuff => 2 } );
+
+ # json_header() is not cumulative
+ $self->json_header( foo => 'Lorem ipsum...');
+
+ # in case we're printing our own headers
+ print "X-JSON: " . $self->json_header_string();
+
+ # clear out everything in the outgoing JSON headers
+ $self->clear_json_header();
+
+ # or send the JSON in the document body
+ $self->json_body( { foo => 'Lorem ipsum', bar => [ 0, 2, 3 ] } );
+
+ # send the JSON back in the document body, but execute it using a Javascript callback
+ $self->json_callback('alert', { foo => 'Lorem ipsum', bar => [ 0, 2, 3 ] } );
+
+=head1 DESCRIPTION
+
+When communicating with client-side JavaScript, it is common to send
+data in C<X-JSON> HTTP headers or through the document body as content-type
+C<text/x-json>.
+
+This plugin adds a couple of convenience methods to make that just a
+little bit easier.
+
+=head1 HEADER METHODS
+
+=head2 json_header
+
+This method takes name-value pairs and sets them to be used in the outgoing
+JSON. It is not cummulative and works similarly to C<header_props>. Use it
+only if you have all of the values up front. In most cases L<add_json_header>
+is probably what you want.
+
+ # only the 2nd call will actually set data that will be sent
+ $self->json_header( foo => 'Lorem ipsum...');
+ $self->json_header( bar => [ 0, 2, 3, 4 ] );
+
+=cut
+
+sub json_header {
+ my ($self, %data) = @_;
+ my $private = $self->param('__CAP_JSON') || {};
+ $private->{header} = \%data;
+ $self->param('__CAP_JSON' => $private);
+ return ' '; # so it can be used as the return value from an rm
+}
+
+=head2 add_json_header
+
+This method takes name-value pairs and sets them to be used in the outgoing
+JSON. It is cummulative and works similarly to C<header_add>; meaning multiple
+calls will add to the hash of outgoing values.
+
+ # both 'foo' and 'bar' will exist in the hash sent out
+ $self->json_header( foo => 'Lorem ipsum...');
+ $self->json_header( bar => [ 0, 2, 3, 4 ] );
+
+=cut
+
+sub add_json_header {
+ my ($self, %data) = @_;
+ my $private = $self->param('__CAP_JSON') || {};
+ $private->{header} ||= {};
+ $private->{header} = { %{$private->{header}}, %data };
+ $self->param('__CAP_JSON' => $private);
+ return ' '; # so it can be used as the return value from an rm
+}
+
+=head2 clear_json_header
+
+This method will remove anything that was previously set by both L<json_header>
+and L<add_json_header>. This means that no C<X-JSON> header will be sent.
+
+=cut
+
+sub clear_json_header {
+ my $self = shift;
+ my $private = $self->param('__CAP_JSON') || {};
+ delete $private->{header};
+ $self->param('__CAP_JSON' => $private);
+}
+
+=head2 json_header_string
+
+This method will create the actual HTTP header string that will be sent
+to the browser. This plugin uses it internally to send the header, but
+it might be useful to use directly if you are printing your own HTTP headers
+(using a C<header_type> of C<none>).
+
+ $self->header_type('none');
+ print $self->json_header_string();
+
+=cut
+
+sub json_header_string {
+ my $self = shift;
+ my $private = $self->param('__CAP_JSON') || {};
+ return $self->to_json($private->{header} || {});
+}
+
+=head2 json_header_value
+
+This method will return the values being sent in the JSON header.
+If you pass in the key of the value you want, you will get just that
+value. Else all name-value pairs will be returned.
+
+ my $value = $self->json_header_value('foo');
+
+ my %values = $self->json_header_value();
+
+=cut
+
+sub json_header_value {
+ my ($self, $key) = @_;
+ my $private = $self->param('__CAP_JSON') || {};
+
+ if( defined $private->{header} ) {
+ if( defined $key ) {
+ return $private->{header}->{$key};
+ } else {
+ return %{$private->{header}};
+ }
+ } else {
+ return;
+ }
+}
+
+=head1 BODY METHODS
+
+=head2 json_body
+
+This method will take the given Perl structure, turn it
+into JSON, set the appropriate content-type, and then
+return the JSON.
+
+ return $self->json_body({ foo => 'stuff', bar => [0,1,2,3]} );
+
+=cut
+
+sub json_body {
+ my ($self, $data) = @_;
+ my $private = $self->param('__CAP_JSON') || {};
+ $private->{json_body} = 1;
+ $self->param(__CAP_JSON => $private);
+ return $self->to_json($data);
+}
+
+=head2 json_callback
+
+This method will take the given Perl structure, turn it
+into JSON, set the appropriate content-type, and then
+return a Javascript snippet where the given callback
+is called with the resulting JSON.
+
+ return $self->json_callback('alert', { foo => 'stuff', bar => [0,1,2,3]} );
+
+ # would result in something like the following being sent to the client
+ alert({ foo => 'stuff', bar => [0,1,2,3]});
+
+=cut
+
+sub json_callback {
+ my ($self, $callback, $data) = @_;
+ my $private = $self->param('__CAP_JSON') || {};
+ $private->{json_callback} = 1;
+ $self->param(__CAP_JSON => $private);
+ return $callback . '(' . $self->to_json($data) . ')';
+}
+=head1 MISC METHODS
+
+=head2 to_json
+
+This method is just a convenient wrapper around L<JSON::Any>'s C<encode>.
+
+=cut
+
+sub to_json {
+ my ($self, $data) = @_;
+ return JSON::Any->encode($data);
+}
+
+=head2 from_json
+
+This method is just a convenient wrapper around L<JSON::Any>'s C<decode>.
+
+=cut
+
+sub from_json {
+ my ($self, $data) = @_;
+ return JSON::Any->decode($data);
+}
+
+sub import {
+ my $caller = scalar(caller);
+ $caller->add_callback( postrun => \&_send_headers );
+
+ __PACKAGE__->export_to_level(1, @_);
+}
+
+sub _send_headers {
+ my $self = shift;
+ my $private = $self->param('__CAP_JSON') || {};
+
+ if( defined $private->{header} ) {
+ $self->header_add( '-x-json' => $self->json_header_string );
+ }
+
+ if( defined $private->{json_body} ) {
+ $self->header_add('-type' => 'text/x-json');
+ } elsif ( defined $private->{json_callback} ) {
+ $self->header_add('-type' => 'text/javascript');
+ }
+}
+
+1;
+
+__END__
+
+=head1 AUTHOR
+
+Michael Peters, C<< <mpeters@plusthree.com> >>
+
+=head1 BUGS
+
+Please report any bugs or feature requests to
+C<bug-cgi-application-plugin-viewsource@rt.cpan.org>, or through the web interface at
+L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=CGI-Application-Plugin-JSON>.
+I will be notified, and then you'll automatically be notified of progress on
+your bug as I make changes.
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2006 Michael Peters, All Rights Reserved.
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
4 t/00-pod.t
@@ -0,0 +1,4 @@
+use Test::More;
+eval "use Test::Pod 1.14";
+plan skip_all => "Test::Pod 1.14 required for testing POD" if $@;
+all_pod_files_ok();
4 t/01-pod-coverage.t
@@ -0,0 +1,4 @@
+use Test::More;
+eval "use Test::Pod::Coverage 1.04";
+plan skip_all => "Test::Pod::Coverage 1.04 required for testing POD coverage" if $@;
+all_pod_coverage_ok();
82 t/02-json.t
@@ -0,0 +1,82 @@
+use Test::More;
+use strict;
+use CGI;
+use JSON::Any;
+use lib 't/lib';
+use MyApp;
+
+plan(tests => 21);
+
+$ENV{'CGI_APP_RETURN_ONLY'} = 1;
+
+# 1..5
+# json_header
+{
+ my $app = MyBase::MyApp->new( QUERY => CGI->new({ rm => 'test_json' }) );
+ my $data = _get_json_data($app);
+ is( $data->{foo}, 'blah', 'contains right data for key "foo"' );
+ is( $data->{baz}, 'stuff', 'contains right data for key "baz"' );
+ ok( ! exists $data->{bar}, 'key "bar" is non-existant' );
+}
+
+# 6..12
+# add_json_header
+{
+ my $app = MyBase::MyApp->new( QUERY => CGI->new({ rm => 'test_add' }) );
+ my $data = _get_json_data($app);
+ is( $data->{foo}, 'blah', 'contains right data for key "foo"' );
+ is( $data->{baz}, 'stuff', 'contains right data for key "baz"' );
+ is( $data->{bar}, 'more_stuff', 'contains right data for key "bar"' );
+
+ # check the data values
+ is( $app->json_header_value('foo'), 'blah', 'json_header_value() using key');
+ is_deeply( { $app->json_header_value() }, $data, 'json_header_value() no-key' );
+}
+
+# 13
+# clear_json_header
+{
+ my $app = MyBase::MyApp->new( QUERY => CGI->new({ rm => 'test_clear' }) );
+ my $output = $app->run();
+ my ($json) = ($output =~ /X-JSON: (.*)/i);
+ ok(!$json, 'clear_json_header has no X-JSON header');
+}
+
+# 14-17
+# json_body
+{
+ my $app = MyBase::MyApp->new( QUERY => CGI->new({ rm => 'test_body' }) );
+ my $output = $app->run();
+ my ($json) = ($output =~ /X-JSON: (.*)/i);
+ ok(!$json, 'json_body has no X-JSON header');
+ like($output, qr/Content-type: text\/x-json/i, 'right content type');
+ ($json) = ($output =~ /.*(?={)(.*)/);
+ $json = JSON::Any->decode($json);
+ ok($json, 'has JSON body');
+ is_deeply($json, { foo => 'blah', baz => 'stuff', bar => 'more_stuff'});
+}
+
+# 18-21
+# json_callback
+{
+ my $app = MyBase::MyApp->new( QUERY => CGI->new({ rm => 'test_callback' }) );
+ my $output = $app->run();
+ my ($json) = ($output =~ /X-JSON: (.*)/i);
+ ok(!$json, 'json_callback has no X-JSON header');
+ like($output, qr/Content-type: text\/javascript/i, 'right content type');
+ ($json) = ($output =~ /my_callback\(.*(?={)(.*)\)/);
+ $json = JSON::Any->decode($json);
+ ok($json, 'has JSON structure');
+ is_deeply($json, { foo => 'blah', baz => 'stuff', bar => 'more_stuff'});
+}
+
+# has 2 tests
+sub _get_json_data {
+ my $app = shift;
+ my $output = $app->run();
+ my ($json) = ($output =~ /X-JSON: (.*)/i);
+ ok($json, 'has X-JSON header');
+ my $data = JSON::Any->decode($json);
+ is( ref $data, 'HASH', 'JSON data is a hash');
+ return $data;
+}
64 t/lib/MyApp.pm
@@ -0,0 +1,64 @@
+package MyBase::MyApp;
+use base 'CGI::Application';
+use strict;
+use CGI::Application::Plugin::JSON qw(:all);
+
+sub setup {
+ my $self = shift;
+ $self->run_modes([qw(
+ test_json
+ test_add
+ test_clear
+ test_body
+ test_callback
+ )]);
+
+ $self->start_mode('test_json');
+}
+
+sub test_json {
+ my $self = shift;
+ $self->json_header( foo => 'stuff', bar => 'more_stuff');
+ $self->json_header( foo => 'blah', baz => 'stuff' );
+ return ' ';
+}
+
+sub test_add {
+ my $self = shift;
+ $self->add_json_header( foo => 'stuff', bar => 'more_stuff');
+ $self->add_json_header( foo => 'blah', baz => 'stuff' );
+ return ' ';
+}
+
+sub test_clear {
+ my $self = shift;
+ $self->add_json_header( foo => 'stuff', bar => 'more_stuff');
+ $self->add_json_header( foo => 'blah', baz => 'stuff' );
+ $self->clear_json_header();
+ return ' ';
+}
+
+sub test_body {
+ my $self = shift;
+ return $self->json_body(
+ {
+ foo => 'blah',
+ baz => 'stuff',
+ bar => 'more_stuff',
+ }
+ );
+}
+
+sub test_callback {
+ my $self = shift;
+ return $self->json_callback(
+ 'my_callback',
+ {
+ foo => 'blah',
+ baz => 'stuff',
+ bar => 'more_stuff',
+ }
+ );
+}
+
+1;
Please sign in to comment.
Something went wrong with that request. Please try again.