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

   1 package OpenILS::WWW::AddedContent::ContentCafe;
   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 my $base_url = 'http://contentcafe2.btol.com/ContentCafe/ContentCafe.asmx/Single';
  14 my $cover_base_url = 'http://contentcafe2.btol.com/ContentCafe/Jacket.aspx';
  15
  16 sub new {
  17     my( $class, $args ) = @_;
  18     $class = ref $class || $class;
  19     return bless($args, $class);
  20 }
  21
  22 sub userid {
  23     my $self = shift;
  24     return $self->{ContentCafe}->{userid};
  25 }
  26
  27 sub password {
  28     my $self = shift;
  29     return $self->{ContentCafe}->{password};
  30 }
  31
  32 sub return_behavior_on_no_jacket_image {
  33     my $self = shift;
  34     return $self->{ContentCafe}->{return_behavior_on_no_jacket_image};
  35 }
  36
  37 # --------------------------------------------------------------------------
  38 sub jacket_small {
  39     my( $self, $key ) = @_;
  40     return $self->send_img(
  41         $self->fetch_cover_response('S', $key));
  42 }
  43
  44 sub jacket_medium {
  45     my( $self, $key ) = @_;
  46     return $self->send_img(
  47         $self->fetch_cover_response('M', $key));
  48
  49 }
  50 sub jacket_large {
  51     my( $self, $key ) = @_;
  52     return $self->send_img(
  53         $self->fetch_cover_response('L', $key));
  54 }
  55
  56 # --------------------------------------------------------------------------
  57
  58 sub toc_html {
  59     my( $self, $key ) = @_;
  60     my $xml = $self->fetch_content('TocDetail', $key);
  61     my $doc = XML::LibXML->new->parse_string($xml);
  62     $doc->documentElement->setNamespace('http://ContentCafe2.btol.com', 'cc');
  63     my $html = '';
  64     my @nodes = $doc->findnodes('//cc:Toc');
  65     return 0 if (scalar(@nodes) < 1);
  66     foreach my $node ( @nodes ) {
  67         $html .= $node->textContent . '</P></P>';
  68     }
  69     return $self->send_html($html);
  70 }
  71
  72 sub toc_xml {
  73     my( $self, $key ) = @_;
  74     return $self->send_xml(
  75         $self->fetch_content('TocDetail', $key));
  76 }
  77
  78 sub toc_json {
  79     my( $self, $key ) = @_;
  80     return $self->send_json(
  81         $self->fetch_content('TocDetail', $key));
  82 }
  83
  84 # --------------------------------------------------------------------------
  85
  86 sub anotes_html {
  87     my( $self, $key ) = @_;
  88     my $xml = $self->fetch_content('BiographyDetail', $key);
  89     my $doc = XML::LibXML->new->parse_string($xml);
  90     $doc->documentElement->setNamespace('http://ContentCafe2.btol.com', 'cc');
  91     my $html = '';
  92     my @nodes = $doc->findnodes('//cc:Biography');
  93     return 0 if (scalar(@nodes) < 1);
  94     foreach my $node ( @nodes ) {
  95         $html .= '<P class="biography">' . $node->textContent . '</P>';
  96     }
  97     return $self->send_html($html);
  98 }
  99
 100 sub anotes_xml {
 101     my( $self, $key ) = @_;
 102     return $self->send_xml(
 103         $self->fetch_content('BiographyDetail', $key));
 104 }
 105
 106 sub anotes_json {
 107     my( $self, $key ) = @_;
 108     return $self->send_json(
 109         $self->fetch_content('BiographyDetail', $key));
 110 }
 111
 112
 113 # --------------------------------------------------------------------------
 114
 115 sub excerpt_html {
 116     my( $self, $key ) = @_;
 117     my $xml = $self->fetch_content('ExcerptDetail', $key);
 118     my $doc = XML::LibXML->new->parse_string($xml);
 119     $doc->documentElement->setNamespace('http://ContentCafe2.btol.com', 'cc');
 120     my $html = '';
 121     my @nodes = $doc->findnodes('//cc:Excerpt');
 122     return 0 if (scalar(@nodes) < 1);
 123     foreach my $node ( @nodes ) {
 124         $html .= $node->textContent;
 125     }
 126     return $self->send_html($html);
 127 }
 128
 129 sub excerpt_xml {
 130     my( $self, $key ) = @_;
 131     return $self->send_xml(
 132         $self->fetch_content('ExcerptDetail', $key));
 133 }
 134
 135 sub excerpt_json {
 136     my( $self, $key ) = @_;
 137     return $self->send_json(
 138         $self->fetch_content('ExcerptDetail', $key));
 139 }
 140
 141 # --------------------------------------------------------------------------
 142
 143 sub reviews_html {
 144     my( $self, $key ) = @_;
 145     my $xml = $self->fetch_content('ReviewDetail', $key);
 146     my $doc = XML::LibXML->new->parse_string($xml);
 147     $doc->documentElement->setNamespace('http://ContentCafe2.btol.com', 'cc');
 148     my $html = '<ul>';
 149     my @nodes = $doc->findnodes('//cc:ReviewItem');
 150     return 0 if (scalar(@nodes) < 1);
 151     foreach my $node ( @nodes ) {
 152         my @s_nodes = $node->findnodes('./cc:Supplier');
 153         my @p_nodes = $node->findnodes('./cc:Publication');
 154         my @i_nodes = $node->findnodes('./cc:Issue');
 155         my @r_nodes = $node->findnodes('./cc:Review');
 156         $html .= '<li><b>' . (scalar(@p_nodes) ? $p_nodes[0]->textContent : '') . '</b>';
 157         if (scalar(@i_nodes) && scalar(@p_nodes)) { $html .= ' : '; }
 158         $html .= (scalar(@i_nodes) ? $i_nodes[0]->textContent : '') . '<br/>';
 159         $html .= (scalar(@r_nodes) ? $r_nodes[0]->textContent : '') . '</li>';
 160     }
 161     $html .= '</ul>';
 162     return $self->send_html($html);
 163 }
 164
 165 sub reviews_xml {
 166     my( $self, $key ) = @_;
 167     return $self->send_xml(
 168         $self->fetch_content('ReviewDetail', $key));
 169 }
 170
 171 sub reviews_json {
 172     my( $self, $key ) = @_;
 173     return $self->send_json(
 174         $self->fetch_content('ReviewDetail', $key));
 175 }
 176
 177 # --------------------------------------------------------------------------
 178
 179 sub summary_html {
 180     my( $self, $key ) = @_;
 181     my $xml = $self->fetch_content('AnnotationDetail', $key);
 182     my $doc = XML::LibXML->new->parse_string($xml);
 183     $doc->documentElement->setNamespace('http://ContentCafe2.btol.com', 'cc');
 184     my $html = '<ul>';
 185     my @nodes = $doc->findnodes('//cc:AnnotationItem');
 186     return 0 if (scalar(@nodes) < 1);
 187     foreach my $node ( @nodes ) {
 188         my @s_nodes = $node->findnodes('./cc:Supplier');
 189         my @a_nodes = $node->findnodes('./cc:Annotation');
 190         $html .= '<li><b>' . (scalar(@s_nodes) ? $s_nodes[0]->textContent : '') . '</b><br/>';
 191         $html .= (scalar(@a_nodes) ? $a_nodes[0]->textContent : '') . '</li>';
 192     }
 193     $html .= '</ul>';
 194     return $self->send_html($html);
 195 }
 196
 197 sub summary_xml {
 198     my( $self, $key ) = @_;
 199     return $self->send_xml(
 200         $self->fetch_content('AnnotationDetail', $key));
 201 }
 202
 203 sub summary_json {
 204     my( $self, $key ) = @_;
 205     return $self->send_json(
 206         $self->fetch_content('AnnotationDetail', $key));
 207 }
 208
 209 sub available_json {
 210     my($self, $key) = @_;
 211     my $xml = $self->fetch_content('AvailableContent', $key);
 212     my $doc = XML::LibXML->new->parse_string($xml);
 213
 214     my @avail;
 215     for my $node ($doc->findnodes('//*[text()="true"]')) {
 216         push(@avail, 'summary') if $node->nodeName eq 'Annotation';
 217         push(@avail, 'jacket') if $node->nodeName eq 'Jacket';
 218         push(@avail, 'toc') if $node->nodeName eq 'TOC';
 219         push(@avail, 'anotes') if $node->nodeName eq 'Biography';
 220         push(@avail, 'excerpt') if $node->nodeName eq 'Excerpt';
 221         push(@avail, 'reviews') if $node->nodeName eq 'Review';
 222     }
 223
 224     return {
 225         content_type => 'text/plain',
 226         content => OpenSRF::Utils::JSON->perl2JSON(\@avail)
 227     };
 228 }
 229
 230
 231 # --------------------------------------------------------------------------
 232
 233
 234 sub data_exists {
 235     my( $self, $data ) = @_;
 236     return 0 if $data =~ m/<title>error<\/title>/iog;
 237     return 1;
 238 }
 239
 240
 241 sub send_json {
 242     my( $self, $xml ) = @_;
 243     return 0 unless $self->data_exists($xml);
 244     my $doc;
 245
 246     try {
 247         $doc = XML::LibXML->new->parse_string($xml);
 248     } catch Error with {
 249         my $err = shift;
 250         $logger->error("added content XML parser error: $err\n\n$xml");
 251         $doc = undef;
 252     };
 253
 254     return 0 unless $doc;
 255     my $perl = OpenSRF::Utils::SettingsParser::XML2perl($doc->documentElement);
 256     my $json = OpenSRF::Utils::JSON->perl2JSON($perl);
 257     return { content_type => 'text/plain', content => $json };
 258 }
 259
 260 sub send_xml {
 261     my( $self, $xml ) = @_;
 262     return 0 unless $self->data_exists($xml);
 263     return { content_type => 'application/xml', content => $xml };
 264 }
 265
 266 sub send_html {
 267     my( $self, $content ) = @_;
 268     return 0 unless $self->data_exists($content);
 269
 270     # Hide anything that might contain a link since it will be broken
 271     my $HTML = <<"    HTML";
 272         <div>
 273             <style type='text/css'>
 274                 div.ac input, div.ac a[href],div.ac img, div.ac button { display: none; visibility: hidden }
 275             </style>
 276             <div class='ac'>
 277                 $content
 278             </div>
 279         </div>
 280     HTML
 281
 282     return { content_type => 'text/html', content => $HTML };
 283 }
 284
 285 sub send_img {
 286     my($self, $response) = @_;
 287     return {
 288         content_type => $response->header('Content-type'),
 289         content => $response->content,
 290         binary => 1
 291     };
 292 }
 293
 294 # returns the raw content returned from the URL fetch
 295 sub fetch_content {
 296     my( $self, $contentType, $key ) = @_;
 297     return $self->fetch_response($contentType, $key)->content;
 298 }
 299
 300 # returns the HTTP response object from the URL fetch
 301 sub fetch_response {
 302     my( $self, $contentType, $key ) = @_;
 303     my $userid = $self->userid;
 304     my $password = $self->password;
 305     my $url = $base_url . "?UserID=$userid&Password=$password&Key=$key&Content=$contentType";
 306     return $AC->get_url($url);
 307 }
 308
 309 # returns the HTTP response object from the URL fetch
 310 sub fetch_cover_response {
 311     my( $self, $size, $key ) = @_;
 312     my $userid = $self->userid;
 313     my $password = $self->password;
 314     my $return = $self->return_behavior_on_no_jacket_image;
 315     my $url = $cover_base_url . "?UserID=$userid&Password=$password&Return=$return&Type=$size&Value=$key";
 316     return $AC->get_url($url);
 317 }
 318
 319
 320 1;