new files used in reporting templates

git-svn-id: svn://svn.open-ils.org/ILS/trunk@1845 dcc99617-32d9-48b4-a31d-7c20da2025e4

diff --git a/Open-ILS/src/perlmods/OpenILS/Template/Plugin/JSON.pm b/Open-ILS/src/perlmods/OpenILS/Template/Plugin/JSON.pm
new file mode 100644 (file)
index 0000000..ba54b1f
--- /dev/null
+++ b/Open-ILS/src/perlmods/OpenILS/Template/Plugin/JSON.pm
@@ -0,0 +1,32 @@
+package OpenILS::Template::Plugin::JSON;
+use strict; use warnings;
+
+use Template::Plugin;
+use base qw/Template::Plugin/;
+use JSON;
+
+sub new {
+       my ($class) = @_;
+       $class = ref($class) || $class;
+       my $self = {};
+       return bless($self,$class);
+}
+
+sub perl2JSON {
+       my( $self, $perl ) = @_;
+       return JSON->perl2JSON($perl);
+}
+       
+
+sub JSON2perl {
+       my( $self, $perl ) = @_;
+       return JSON->JSON2perl($perl);
+}
+
+sub perl2prettyJSON {
+       my( $self, $perl ) = @_;
+       return JSON->perl2prettyJSON($perl);
+}
+       
+
+1;

diff --git a/Open-ILS/src/perlmods/OpenILS/WWW/Reporter.pm b/Open-ILS/src/perlmods/OpenILS/WWW/Reporter.pm
new file mode 100644 (file)
index 0000000..67b6947
--- /dev/null
+++ b/Open-ILS/src/perlmods/OpenILS/WWW/Reporter.pm
@@ -0,0 +1,101 @@
+package OpenILS::WWW::Reporter;
+use strict; use warnings;
+
+use Apache2 ();
+use Apache2::Log;
+use Apache2::Const -compile => qw(OK REDIRECT :log);
+use APR::Const    -compile => qw(:error SUCCESS);
+use Apache2::RequestRec ();
+use Apache2::RequestIO ();
+use Apache2::RequestUtil;
+
+use Template qw(:template);
+
+use OpenSRF::EX qw(:try);
+use OpenSRF::System;
+
+
+
+
+# set the bootstrap config and template include directory when 
+# this module is loaded
+my $bootstrap;
+my $includes = [];  
+
+sub import {
+       my( $self, $bs_config, $tdir ) = @_;
+       $bootstrap = $bs_config;
+       $includes = [ $tdir ];
+}
+
+
+# our templates plugins are here
+my $plugin_base = 'OpenILS::Template::Plugin';
+
+sub child_init {
+       warn "Initing child with bootstrap $bootstrap\n";
+       OpenSRF::System->bootstrap_client( config_file => $bootstrap );
+}
+
+sub handler {
+
+       warn "TEST\n";
+       my $apache = shift;
+       my $path = $apache->path_info;
+       (my $ttk = $path) =~ s{^/?([a-zA-Z0-9_]+).*?$}{$1}o;
+
+       print "Content-type: text/html; charset=utf-8\n\n";
+
+       _process_template(
+                       apache          => $apache,
+                       template                => "$ttk.ttk",
+                       );
+
+       return Apache2::Const::OK;
+}
+
+
+sub _process_template {
+
+       my %params = @_;
+       my $ttk                         = $params{template}             || return undef;
+       my $apache                      = $params{apache}                       || undef;
+       my $param_hash          = $params{params}                       || {};
+
+       my $template;
+
+       $template = Template->new( { 
+               OUTPUT                  => $apache, 
+               ABSOLUTE                        => 1, 
+               RELATIVE                        => 1,
+               PLUGIN_BASE             => $plugin_base,
+               INCLUDE_PATH    => $includes, 
+               PRE_CHOMP               => 1,
+               POST_CHOMP              => 1,
+               LOAD_PERL               => 1,
+               } 
+       );
+
+       try {
+
+               if( ! $template->process( $ttk, $param_hash ) ) { 
+                       warn  "Error Processing Template: " . $template->error();
+                       my $err = $template->error();
+                       $err =~ s/\n/\<br\/\>/g;
+                       warn "Error processing template $ttk\n";        
+                       my $string =  "<br><b>Unable to process template:<br/><br/> " . $err . "!!!</b>";
+                       print "ERROR: $string";
+                       #$template->process( $error_ttk , { error => $string } );
+               }
+
+       } catch Error with {
+               my $e = shift;
+               warn "Error processing template $ttk:  $e - $@ \n";     
+               print "<center><br/><br/><b>Error<br/><br/> $e <br/><br/> $@ </b><br/></center>";
+               return;
+       };
+
+}
+
+
+1;