Open-ILS/src/extras/opensearch.pm

   1 package opensearch;
   2 use strict;
   3 use warnings;
   4
   5 use Apache2 ();
   6 use Apache::Log;
   7 use Apache::Const -compile => qw(OK REDIRECT :log);
   8 use APR::Const    -compile => qw(:error SUCCESS);
   9 use Apache::RequestRec ();
  10 use Apache::RequestIO ();
  11 use Apache::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                 print LWP::UserAgent->new->get($fetch)->content;
  30
  31         } else {
  32
  33                 my $template = Template->new( {
  34                         OUTPUT                  => $apache,
  35                         ABSOLUTE                        => 1,
  36                         RELATIVE                        => 1,
  37                         PLUGIN_BASE             => 'OpenILS::Template::Plugin',
  38                         INCLUDE_PATH    => ['/pines/cvs/ILS/Open-ILS/src/extras'],
  39                         PRE_CHOMP               => 1,
  40                         POST_CHOMP              => 1,
  41                         }
  42                 );
  43
  44                 try {
  45
  46                         if( ! $template->process( 'opensearch.ttk' ) ) {
  47                                 warn "Error processing template opensearch.ttk\n";
  48                                 warn  "Error Occured: " . $template->error();
  49                                 my $err = $template->error();
  50                                 $err =~ s/\n/\<br\/\>/g;
  51                                 print "<br><b>Unable to process template:<br/><br/> " . $err . "!!!</b>";
  52                         }
  53
  54                 } catch Error with {
  55                         my $e = shift;
  56                         warn "Error processing template opensearch.ttk:  $e - $@ \n";
  57                         print "<center><br/><br/><b>Error<br/><br/> $e <br/><br/> $@ </b><br/></center>";
  58                         return;
  59                 };
  60         }
  61         return Apache::OK;
  62 }
  63
  64 1;