LP1054322 - libparent-perl not needed for Ubuntu Precise
[working/Evergreen.git] / Open-ILS / src / extras / opensearch.pm
1 package opensearch;
2 use strict;
3 use warnings;
4
5 use Apache2 ();
6 use Apache2::Log;
7 use Apache2::Const -compile => qw(OK REDIRECT :log);
8 use APR::Const    -compile => qw(:error SUCCESS);
9 use Apache2::RequestRec ();
10 use Apache2::RequestIO ();
11 use Apache2::RequestUtil;
12 use LWP::UserAgent;
13
14 use CGI ();
15 use Template;
16
17 use OpenSRF::EX qw(:try);
18 use OpenSRF::System;
19
20 sub handler {
21
22         my $apache = shift;
23         print "Content-type: text/xml; charset=utf-8\n\n";
24
25         my $cgi = new CGI;
26         
27         if (my $fetch = $cgi->param('fetch')) {
28
29                 try {
30                         alarm(15);
31                         print LWP::UserAgent->new->get($fetch)->content;
32                         alarm(0);
33                 } catch Error with {
34                         alarm(0);
35                         print '<arg>';
36                 };
37                 alarm(0);
38
39         } else {
40
41                 my $template = Template->new( { 
42                         OUTPUT                  => $apache, 
43                         ABSOLUTE                        => 1, 
44                         RELATIVE                        => 1,
45                         PLUGIN_BASE             => 'OpenILS::Template::Plugin',
46                         INCLUDE_PATH    => ['/openils/var/templates/'],
47                         PRE_CHOMP               => 1,
48                         POST_CHOMP              => 1,
49                         } 
50                 );
51
52                 try {
53         
54                         if( ! $template->process( 'opensearch.ttk' ) ) { 
55                                 warn "Error processing template opensearch.ttk\n";      
56                                 warn  "Error Occured: " . $template->error();
57                                 my $err = $template->error();
58                                 $err =~ s/\n/\<br\/\>/g;
59                                 print "<br><b>Unable to process template:<br/><br/> " . $err . "!!!</b>";
60                         }
61
62                 } catch Error with {
63                         my $e = shift;
64                         warn "Error processing template opensearch.ttk:  $e - $@ \n";   
65                         print "<center><br/><br/><b>Error<br/><br/> $e <br/><br/> $@ </b><br/></center>";
66                         return;
67                 };
68         }
69         return Apache2::Const::OK;
70 }
71
72 1;