small reporter updates
[Evergreen.git] / 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, $core_xml, @incs ) = @_;
33         $bootstrap = $bs_config;
34         $base_xml = $core_xml;
35         $includes = [ @incs ];
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         #$parser->expand_xinclude(1);
48
49         #$base_xml_doc = $parser->parse_file($base_xml);
50
51 }
52
53 sub handler {
54
55         my $apache = shift;
56         my $cgi = CGI->new;
57
58         my $path = $apache->path_info;
59         (my $ttk = $path) =~ s{^/?([a-zA-Z0-9_]+).*?$}{$1}o;
60
61         $ttk = "s1" unless $ttk;
62         my $user;
63
64         # if the user is not logged in via cookie, route them to the login page
65         if(! ($user = verify_login($cgi->cookie("ses"))) ) {
66                 $ttk = "login";
67         }
68
69         print "Content-type: text/html; charset=utf-8\n\n";
70
71         _process_template(
72                         apache          => $apache,
73                         template                => "$ttk.ttk",
74                         params          => { 
75                                 user => $user, 
76                                 stage_dir => $ttk, 
77                                 config_xml => $base_xml, 
78                                 },
79                         );
80
81         return Apache2::Const::OK;
82 }
83
84
85 sub _process_template {
86
87         my %params = @_;
88         my $ttk                         = $params{template}             || return undef;
89         my $apache                      = $params{apache}                       || undef;
90         my $param_hash          = $params{params}                       || {};
91
92         my $template;
93
94         $template = Template->new( { 
95                 OUTPUT                  => $apache, 
96                 ABSOLUTE                => 1, 
97                 RELATIVE                => 1,
98                 PLUGIN_BASE             => $plugin_base,
99                 INCLUDE_PATH    => $includes, 
100                 PRE_CHOMP               => 1,
101                 POST_CHOMP              => 1,
102                 #LOAD_PERL              => 1,
103                 } 
104         );
105
106         try {
107
108                 if( ! $template->process( $ttk, $param_hash ) ) { 
109                         warn  "Error Processing Template: " . $template->error();
110                         my $err = $template->error();
111                         $err =~ s/\n/\<br\/\>/g;
112                         warn "Error processing template $ttk\n";        
113                         my $string =  "<br><b>Unable to process template:<br/><br/> " . $err . "</b>";
114                         print "ERROR: $string";
115                         #$template->process( $error_ttk , { error => $string } );
116                 }
117
118         } catch Error with {
119                 my $e = shift;
120                 warn "Error processing template $ttk:  $e - $@ \n";     
121                 print "<center><br/><br/><b>Error<br/><br/> $e <br/><br/> $@ </b><br/></center>";
122                 return;
123         };
124
125 }
126
127 # returns the user object if the session is valid, 0 otherwise
128 sub verify_login {
129         my $auth_token = shift;
130         return 0 unless $auth_token;
131
132         my $session = OpenSRF::AppSession->create("open-ils.auth");
133         my $req = $session->request(
134                 "open-ils.auth.session.retrieve", $auth_token );
135         my $user = $req->gather(1);
136
137         return $user if ref($user);
138         return 0;
139 }
140
141
142
143 1;