Changeset 6339

Timestamp:

02/07/08 17:04:00 (5 years ago)

Author:

tokuhirom

Message:

r7466@skinny: tokuhirom | 2008-02-07 17:02:45 +0900
added Sledge::Plugin::JSON::XS

Location:

lang/perl/Sledge-Plugin-JSON-XS/trunk

Files:

• Makefile.PL (modified) (1 diff)
• lib/Sledge/Plugin/JSON/XS.pm (modified) (3 diffs)
• t/01_basic.t (added)

lang/perl/Sledge-Plugin-JSON-XS/trunk/Makefile.PL

@@ -3 +3 @@
 all_from 'lib/Sledge/Plugin/JSON/XS.pm';
 
-requires $_ for (qw/
-/);
+requires 'JSON::XS' => 2.01;
 
 build_requires 'Test::More';
+build_requires 'Class::Accessor';
 build_requires 'YAML';
 use_test_base;

lang/perl/Sledge-Plugin-JSON-XS/trunk/lib/Sledge/Plugin/JSON/XS.pm

@@ -3 +3 @@
 use warnings;
 use 5.00800;
+use JSON::XS;
+
 our $VERSION = '0.01';
+our $ConformToRFC4627 = 0;
+our $ENCODING = 'utf-8';
+
+sub import {
+    my $pkg = caller(0);
+
+    no strict 'refs'; ## no critic.
+    *{"$pkg\::output_json_xs"} = \&_output_json_xs;
+}
+
+sub _output_json_xs {
+    my ($self, $src) = @_;
+
+    my $content_type =
+        ( $self->debug_level && $self->r->param('debug') )
+        ? "text/plain; charset=$ENCODING"
+        : _content_type($self, $ENCODING );
+
+    my $json = encode_json($src);
+    my $output = _add_callback($self, _validate_callback_param($self, ($self->r->param('callback') || '')), $json );
+    $self->r->content_type($content_type);
+    $self->set_content_length(length $output);
+    $self->send_http_header;
+    $self->r->print($output);
+    $self->invoke_hook('AFTER_OUTPUT');
+    $self->finished(1);
+}
+
+sub _content_type {
+    my ($self, $encoding) = @_;
+
+    my $user_agent = $self->r->header_in('User-Agent');
+
+    if ( $ConformToRFC4627 ) {
+        return "application/json; charset=$encoding";
+    } elsif (($user_agent || '') =~ /Opera/) {
+        return "application/x-javascript; charset=$encoding";
+    } else {
+        return "application/javascript; charset=$encoding";
+    }
+}
+
+sub _add_callback {
+    my ($self, $cb, $json) = @_;
+
+    my $output;
+    $output .= "$cb(" if $cb;
+    $output .= $json;
+    $output .= ");"   if $cb;
+
+    return $output;
+}
+
+sub _validate_callback_param {
+   my ($self, $param) = @_;
+   return ( $param =~ /^[a-zA-Z0-9\.\_\[\]]+$/ ) ? $param : undef;
+}
 
 1;
@@ -12 +71 @@
 =head1 NAME
 
-Sledge::Plugin::JSON::XS -
+Sledge::Plugin::JSON::XS - JSON::XS wrapper for Sledge
 
 =head1 SYNOPSIS
 
+  package Your::Pages;
   use Sledge::Plugin::JSON::XS;
+
+  sub dispatch_foo {
+    my $self = shift;
+    $self->output_json_xs({foo => 'bar'});
+  }
 
 =head1 DESCRIPTION
 
-Sledge::Plugin::JSON::XS is
+Sledge::Plugin::JSON::XS is JSON::XS wrapper for Sledge.
+
+Sledge::Plugin::JSON is wrapper for JSON::Syck. but this module uses JSON::XS.
+
+=head1 CODE COVERAGE
+
+    ---------------------------- ------ ------ ------ ------ ------ ------ ------
+    File                           stmt   bran   cond    sub    pod   time  total
+    ---------------------------- ------ ------ ------ ------ ------ ------ ------
+    .../Sledge/Plugin/JSON/XS.pm  100.0  100.0  100.0  100.0    n/a  100.0  100.0
+    Total                         100.0  100.0  100.0  100.0    n/a  100.0  100.0
+    ---------------------------- ------ ------ ------ ------ ------ ------ ------
 
 =head1 AUTHOR
@@ -28 +104 @@
 =head1 SEE ALSO
 
+L<Sledge::Plugin::JSON>
+
 =head1 LICENSE