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 qw(: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;