Open-ILS/src/perlmods/OpenILS/WWW/Reporter.pm

   1 package OpenILS::WWW::Reporter;
   2 use strict; use warnings;
   3
   4 use Apache2 ();
   5 use Apache2::Log;
   6 use Apache2::Const -compile => qw(OK REDIRECT :log);
   7 use APR::Const    -compile => qw(:error SUCCESS);
   8 use Apache2::RequestRec ();
   9 use Apache2::RequestIO ();
  10 use Apache2::RequestUtil;
  11 use CGI;
  12
  13 use Template qw(:template);
  14
  15 use OpenSRF::EX qw(:try);
  16 use OpenSRF::System;
  17 use XML::LibXML;
  18
  19 use OpenSRF::Utils::SettingsParser;
  20 use OpenILS::Utils::Fieldmapper;
  21
  22
  23
  24 # set the bootstrap config and template include directory when
  25 # this module is loaded
  26 my $bootstrap;
  27 my $includes = [];
  28 my $base_xml;
  29 #my $base_xml_doc;
  30
  31 sub import {
  32         my( $self, $bs_config, $tdir, $core_xml ) = @_;
  33         $bootstrap = $bs_config;
  34         $base_xml = $core_xml;
  35         $includes = [ $tdir ];
  36 }
  37
  38
  39 # our templates plugins are here
  40 my $plugin_base = 'OpenILS::Template::Plugin';
  41
  42 sub child_init {
  43         OpenSRF::System->bootstrap_client( config_file => $bootstrap );
  44
  45         #parse the base xml file
  46         #my $parser = XML::LibXML->new;
  47         #$base_xml_doc = $parser->parse_file($base_xml);
  48
  49 }
  50
  51 sub handler {
  52
  53         my $apache = shift;
  54         my $cgi = CGI->new;
  55
  56         my $path = $apache->path_info;
  57         (my $ttk = $path) =~ s{^/?([a-zA-Z0-9_]+).*?$}{$1}o;
  58
  59         $ttk = "s1" unless $ttk;
  60         my $user;
  61
  62         # if the user is not logged in via cookie, route them to the login page
  63         if(! ($user = verify_login($cgi->cookie("ses"))) ) {
  64                 $ttk = "login";
  65         }
  66
  67         print "Content-type: text/html; charset=utf-8\n\n";
  68
  69         _process_template(
  70                         apache          => $apache,
  71                         template                => "$ttk.ttk",
  72                         params          => {
  73                                 user => $user,
  74                                 stage_dir => $ttk,
  75                                 config_xml => $base_xml,
  76                                 },
  77                         );
  78
  79         return Apache2::Const::OK;
  80 }
  81
  82
  83 sub _process_template {
  84
  85         my %params = @_;
  86         my $ttk                         = $params{template}             || return undef;
  87         my $apache                      = $params{apache}                       || undef;
  88         my $param_hash          = $params{params}                       || {};
  89
  90         my $template;
  91
  92         $template = Template->new( {
  93                 OUTPUT                  => $apache,
  94                 ABSOLUTE                => 1,
  95                 RELATIVE                => 1,
  96                 PLUGIN_BASE             => $plugin_base,
  97                 INCLUDE_PATH    => $includes,
  98                 PRE_CHOMP               => 1,
  99                 POST_CHOMP              => 1,
 100                 #LOAD_PERL              => 1,
 101                 }
 102         );
 103
 104         try {
 105
 106                 if( ! $template->process( $ttk, $param_hash ) ) {
 107                         warn  "Error Processing Template: " . $template->error();
 108                         my $err = $template->error();
 109                         $err =~ s/\n/\<br\/\>/g;
 110                         warn "Error processing template $ttk\n";
 111                         my $string =  "<br><b>Unable to process template:<br/><br/> " . $err . "</b>";
 112                         print "ERROR: $string";
 113                         #$template->process( $error_ttk , { error => $string } );
 114                 }
 115
 116         } catch Error with {
 117                 my $e = shift;
 118                 warn "Error processing template $ttk:  $e - $@ \n";
 119                 print "<center><br/><br/><b>Error<br/><br/> $e <br/><br/> $@ </b><br/></center>";
 120                 return;
 121         };
 122
 123 }
 124
 125 # returns the user object if the session is valid, 0 otherwise
 126 sub verify_login {
 127         my $auth_token = shift;
 128         return 0 unless $auth_token;
 129
 130         my $session = OpenSRF::AppSession->create("open-ils.auth");
 131         my $req = $session->request("open-ils.auth.session.retrieve", $auth_token );
 132         my $user = $req->gather(1);
 133
 134         return $user if ref($user);
 135         return 0;
 136 }
 137
 138
 139
 140 1;