Open-ILS/src/perlmods/lib/OpenILS/WWW/AddedContent/Syndetic.pm

   1 package OpenILS::WWW::AddedContent::Syndetic;
   2 use strict; use warnings;
   3 use OpenSRF::Utils::Logger qw/$logger/;
   4 use OpenSRF::Utils::SettingsParser;
   5 use OpenSRF::Utils::JSON;
   6 use OpenSRF::EX qw/:try/;
   7 use OpenILS::WWW::AddedContent;
   8 use XML::LibXML;
   9 use MIME::Base64;
  10
  11 my $AC = 'OpenILS::WWW::AddedContent';
  12
  13
  14 sub new {
  15     my( $class, $args ) = @_;
  16     $class = ref $class || $class;
  17     return bless($args, $class);
  18 }
  19
  20 sub base_url {
  21     my $self = shift;
  22     return $self->{base_url};
  23 }
  24
  25 sub userid {
  26     my $self = shift;
  27     return $self->{userid};
  28 }
  29
  30
  31 # --------------------------------------------------------------------------
  32 sub jacket_small {
  33     my( $self, $key ) = @_;
  34     return $self->send_img(
  35         $self->fetch_response('sc.gif', $key, 1));
  36 }
  37
  38 sub jacket_medium {
  39     my( $self, $key ) = @_;
  40     return $self->send_img(
  41         $self->fetch_response('mc.gif', $key, 1));
  42
  43 }
  44 sub jacket_large {
  45     my( $self, $key ) = @_;
  46     return $self->send_img(
  47         $self->fetch_response('lc.gif', $key, 1));
  48 }
  49
  50 # --------------------------------------------------------------------------
  51
  52 sub toc_html {
  53     my( $self, $key ) = @_;
  54     return $self->send_html(
  55         $self->fetch_content('toc.html', $key));
  56 }
  57
  58 sub toc_xml {
  59     my( $self, $key ) = @_;
  60     return $self->send_xml(
  61         $self->fetch_content('toc.xml', $key));
  62 }
  63
  64 sub toc_json {
  65     my( $self, $key ) = @_;
  66     return $self->send_json(
  67         $self->fetch_content('toc.xml', $key));
  68 }
  69
  70 # --------------------------------------------------------------------------
  71
  72 sub anotes_html {
  73     my( $self, $key ) = @_;
  74     return $self->send_html(
  75         $self->fetch_content('anotes.html', $key));
  76 }
  77
  78 sub anotes_xml {
  79     my( $self, $key ) = @_;
  80     return $self->send_xml(
  81         $self->fetch_content('anotes.xml', $key));
  82 }
  83
  84 sub anotes_json {
  85     my( $self, $key ) = @_;
  86     return $self->send_json(
  87         $self->fetch_content('anotes.xml', $key));
  88 }
  89
  90
  91 # --------------------------------------------------------------------------
  92
  93 sub excerpt_html {
  94     my( $self, $key ) = @_;
  95     return $self->send_html(
  96         $self->fetch_content('dbchapter.html', $key));
  97 }
  98
  99 sub excerpt_xml {
 100     my( $self, $key ) = @_;
 101     return $self->send_xml(
 102         $self->fetch_content('dbchapter.xml', $key));
 103 }
 104
 105 sub excerpt_json {
 106     my( $self, $key ) = @_;
 107     return $self->send_json(
 108         $self->fetch_content('dbchapter.xml', $key));
 109 }
 110
 111 # --------------------------------------------------------------------------
 112
 113 sub reviews_html {
 114     my( $self, $key ) = @_;
 115
 116     my %reviews;
 117
 118     $reviews{ljreview} = $self->fetch_content('ljreview.html', $key);
 119     $reviews{pwreview} = $self->fetch_content('pwreview.html', $key);
 120     $reviews{slreview} = $self->fetch_content('slreview.html', $key);
 121     $reviews{chreview} = $self->fetch_content('chreview.html', $key);
 122     $reviews{blreview} = $self->fetch_content('blreview.html', $key);
 123     $reviews{hbreview} = $self->fetch_content('hbreview.html', $key);
 124     $reviews{kireview} = $self->fetch_content('kireview.html', $key);
 125
 126     for(keys %reviews) {
 127         if( ! $self->data_exists($reviews{$_}) ) {
 128             delete $reviews{$_};
 129             next;
 130         }
 131         $reviews{$_} =~ s/<!.*?>//og; # Strip any doctype declarations
 132     }
 133
 134     return 0 if scalar(keys %reviews) == 0;
 135
 136     #my $html = "<div>";
 137     my $html;
 138     $html .= $reviews{$_} for keys %reviews;
 139     #$html .= "</div>";
 140
 141     return $self->send_html($html);
 142 }
 143
 144 # we have to aggregate the reviews
 145 sub reviews_xml {
 146     my( $self, $key ) = @_;
 147     my %reviews;
 148
 149     $reviews{ljreview} = $self->fetch_content('ljreview.xml', $key);
 150     $reviews{pwreview} = $self->fetch_content('pwreview.xml', $key);
 151     $reviews{slreview} = $self->fetch_content('slreview.xml', $key);
 152     $reviews{chreview} = $self->fetch_content('chreview.xml', $key);
 153     $reviews{blreview} = $self->fetch_content('blreview.xml', $key);
 154     $reviews{hbreview} = $self->fetch_content('hbreview.xml', $key);
 155     $reviews{kireview} = $self->fetch_content('kireview.xml', $key);
 156
 157     for(keys %reviews) {
 158         if( ! $self->data_exists($reviews{$_}) ) {
 159             delete $reviews{$_};
 160             next;
 161         }
 162         # Strip the xml and doctype declarations
 163         $reviews{$_} =~ s/<\?xml.*?>//og;
 164         $reviews{$_} =~ s/<!.*?>//og;
 165     }
 166
 167     return 0 if scalar(keys %reviews) == 0;
 168
 169     my $xml = "<reviews>";
 170     $xml .= $reviews{$_} for keys %reviews;
 171     $xml .= "</reviews>";
 172
 173     return $self->send_xml($xml);
 174 }
 175
 176
 177 sub reviews_json {
 178     my( $self, $key ) = @_;
 179     return $self->send_json(
 180         $self->fetch_content('dbchapter.xml', $key));
 181 }
 182
 183 # --------------------------------------------------------------------------
 184
 185
 186 sub data_exists {
 187     my( $self, $data ) = @_;
 188     return 0 if $data =~ m/<title>error<\/title>/iog;
 189     return 1;
 190 }
 191
 192
 193 sub send_json {
 194     my( $self, $xml ) = @_;
 195     return 0 unless $self->data_exists($xml);
 196     my $doc;
 197
 198     try {
 199         $doc = XML::LibXML->new->parse_string($xml);
 200     } catch Error with {
 201         my $err = shift;
 202         $logger->error("added content XML parser error: $err\n\n$xml");
 203         $doc = undef;
 204     };
 205
 206     return 0 unless $doc;
 207     my $perl = OpenSRF::Utils::SettingsParser::XML2perl($doc->documentElement);
 208     my $json = OpenSRF::Utils::JSON->perl2JSON($perl);
 209     return { content_type => 'text/plain', content => $json };
 210 }
 211
 212 sub send_xml {
 213     my( $self, $xml ) = @_;
 214     return 0 unless $self->data_exists($xml);
 215     return { content_type => 'application/xml', content => $xml };
 216 }
 217
 218 sub send_html {
 219     my( $self, $content ) = @_;
 220     return 0 unless $self->data_exists($content);
 221
 222     # Hide anything that might contain a link since it will be broken
 223     my $HTML = <<"    HTML";
 224         <div>
 225             <style type='text/css'>
 226                 div.ac input, div.ac a[href],div.ac img, div.ac button { display: none; visibility: hidden }
 227             </style>
 228             <div class='ac'>
 229                 $content
 230             </div>
 231         </div>
 232     HTML
 233
 234     return { content_type => 'text/html', content => $HTML };
 235 }
 236
 237 sub send_img {
 238     my($self, $response) = @_;
 239     return {
 240         content_type => $response->header('Content-type'),
 241         content => $response->content,
 242         binary => 1
 243     };
 244 }
 245
 246 # returns the raw content returned from the URL fetch
 247 sub fetch_content {
 248     my( $self, $page, $key ) = @_;
 249     return $self->fetch_response($page, $key)->content;
 250 }
 251
 252 # returns the HTTP response object from the URL fetch
 253 sub fetch_response {
 254     my( $self, $page, $key, $notype ) = @_;
 255     my $uname = $self->userid;
 256     my $url = $self->base_url . "?isbn=$key/$page&client=$uname" . (($notype) ? '' : "&type=rw12");
 257     return $AC->get_url($url);
 258 }
 259
 260
 261
 262 1;