From 46829ac9702dcc90203788d282bced012be43474 Mon Sep 17 00:00:00 2001
From: Martin Kamerbeek <martin@webgui-svn>
Date: Mon, 10 Aug 2009 12:42:33 +0000
Subject: [PATCH] Adding return JSON on specific requeest feature to template.

---
 docs/changelog/7.x.x.txt      |  2 ++
 lib/WebGUI/Asset/Template.pm  |  8 ++++++++
 t/Asset/Template.t            | 15 ++++++++++++++-
 t/lib/WebGUI/PseudoRequest.pm | 15 ++++++++++++++-
 4 files changed, 38 insertions(+), 2 deletions(-)

diff --git a/docs/changelog/7.x.x.txt b/docs/changelog/7.x.x.txt
index af10de1c4..7097f78f0 100644
--- a/docs/changelog/7.x.x.txt
+++ b/docs/changelog/7.x.x.txt
@@ -39,6 +39,8 @@
  - fixed #10733: viewing pending version tags
  - added Survey JSON performance warning for people with non-wre-standard JSON modules/versions (Patrick Donelan, SDH Consulting)
  - rfe #10423: Provide a way to access the instance of the thing that was added, modified, or deleted via workflow. (Eric Kennedy)
+ - Templates can now return a JSONified version of their params hash based on
+   requested Accept headers ( Martin Kamerbeek / Oqapi )
 
 7.7.16
  - fixed #10590: Session::DateTime->secondsToInterval doesn't allow 7 weeks
diff --git a/lib/WebGUI/Asset/Template.pm b/lib/WebGUI/Asset/Template.pm
index 9cc0510cc..1578a9f94 100644
--- a/lib/WebGUI/Asset/Template.pm
+++ b/lib/WebGUI/Asset/Template.pm
@@ -24,6 +24,7 @@ use WebGUI::Exception;
 use Tie::IxHash;
 use Clone qw/clone/;
 use HTML::Packer;
+use JSON qw{ to_json };
 
 =head1 NAME
 
@@ -590,6 +591,13 @@ A hash reference containing template variables and loops. Automatically includes
 sub process {
 	my $self = shift;
 	my $vars = shift;
+
+    # Return a JSONinfied version of vars if JSON is the only requested content type.
+    if ( $self->session->request->headers_in->{Accept} eq 'application/json' ) {
+       $self->session->http->setMimeType( 'application/json' );
+       return to_json( $vars );
+    }
+
 	$self->prepare unless ($self->{_prepared});
     my $parser      = $self->getParser($self->session, $self->get("parser"));
     my $template    = $self->get('usePacked')
diff --git a/t/Asset/Template.t b/t/Asset/Template.t
index 9d11fac02..7731a6caa 100644
--- a/t/Asset/Template.t
+++ b/t/Asset/Template.t
@@ -16,8 +16,9 @@ use WebGUI::Test;
 use WebGUI::Session;
 use WebGUI::Asset::Template;
 use Exception::Class;
-use Test::More tests => 37; # increment this value for each test you create
+use Test::More tests => 39; # increment this value for each test you create
 use Test::Deep;
+use JSON qw{ from_json };
 
 my $session = WebGUI::Test->session;
 
@@ -47,6 +48,18 @@ ok($output =~ m/\bBBBBB\b/, "process() - variables");
 ok($output =~ m/true/, "process() - conditionals");
 ok($output =~ m/\b(?:XY){5}\b/, "process() - loops");
 
+# See if template listens the Accept header
+$session->request->headers_in->{Accept} = 'application/json';
+
+my $json = $template->process(\%var);
+my $andNowItsAPerlHashRef = eval { from_json( $json ) };
+ok( !$@, 'Accept = json, JSON is returned' );
+cmp_deeply( \%var, $andNowItsAPerlHashRef, 'Accept = json, The correct JSON is returned' );
+
+# Done, so remove the json Accept header.
+delete $session->request->headers_in->{Accept};
+
+
 my $newList = WebGUI::Asset::Template->getList($session, 'WebGUI Test Template');
 ok(exists $newList->{$template->getId}, 'Uncommitted template exists returned from getList');
 
diff --git a/t/lib/WebGUI/PseudoRequest.pm b/t/lib/WebGUI/PseudoRequest.pm
index 8b98e228b..4ef9e2747 100644
--- a/t/lib/WebGUI/PseudoRequest.pm
+++ b/t/lib/WebGUI/PseudoRequest.pm
@@ -213,7 +213,7 @@ sub new {
 	my $this = shift;
 	my $class = ref($this) || $this;
 	my $headers = WebGUI::PseudoRequest::Headers->new();
-	my $self = {headers_out => $headers};
+	my $self = { headers_out => $headers, headers_in => {} };
 	bless $self, $class;
 	return $self;
 }
@@ -292,6 +292,19 @@ sub content_type {
 
 #----------------------------------------------------------------------------
 
+=head2 headers_in ( )
+
+Mimics the behavior of Apache2::Request->headers_in.
+
+=cut
+
+sub headers_in {
+       my $self = shift;
+       return $self->{headers_in};
+}
+
+#----------------------------------------------------------------------------
+
 =head2 headers_out ( )
 
 Returns the PseudoRequst::Headers object stored in $self for access to the headers.