Open-ILS/src/perlmods/OpenILS/WWW/EGCatLoader.pm

   1 package OpenILS::WWW::EGCatLoader;
   2 use strict; use warnings;
   3 use CGI;
   4 use XML::LibXML;
   5 use Digest::MD5 qw(md5_hex);
   6 use Apache2::Const -compile => qw(OK DECLINED FORBIDDEN HTTP_INTERNAL_SERVER_ERROR REDIRECT HTTP_BAD_REQUEST);
   7 use OpenSRF::AppSession;
   8 use OpenSRF::EX qw/:try/;
   9 use OpenSRF::Utils qw/:datetime/;
  10 use OpenSRF::Utils::Logger qw/$logger/;
  11 use OpenILS::Application::AppUtils;
  12 use OpenILS::Utils::CStoreEditor qw/:funcs/;
  13 use OpenILS::Utils::Fieldmapper;
  14 use DateTime::Format::ISO8601;
  15 my $U = 'OpenILS::Application::AppUtils';
  16
  17 my %cache; # proc-level cache
  18
  19 sub new {
  20     my($class, $apache, $ctx) = @_;
  21
  22     my $self = bless({}, ref($class) || $class);
  23
  24     $self->apache($apache);
  25     $self->ctx($ctx);
  26     $self->cgi(CGI->new);
  27
  28     OpenILS::Utils::CStoreEditor->init; # just in case
  29     $self->editor(new_editor());
  30
  31     return $self;
  32 }
  33
  34
  35 # current Apache2::RequestRec;
  36 sub apache {
  37     my($self, $apache) = @_;
  38     $self->{apache} = $apache if $apache;
  39     return $self->{apache};
  40 }
  41
  42 # runtime / template context
  43 sub ctx {
  44     my($self, $ctx) = @_;
  45     $self->{ctx} = $ctx if $ctx;
  46     return $self->{ctx};
  47 }
  48
  49 # cstore editor
  50 sub editor {
  51     my($self, $editor) = @_;
  52     $self->{editor} = $editor if $editor;
  53     return $self->{editor};
  54 }
  55
  56 # CGI handle
  57 sub cgi {
  58     my($self, $cgi) = @_;
  59     $self->{cgi} = $cgi if $cgi;
  60     return $self->{cgi};
  61 }
  62
  63
  64 # load common data, then load page data
  65 sub load {
  66     my $self = shift;
  67
  68     $self->load_helpers;
  69     my $stat = $self->load_common;
  70     return $stat unless $stat == Apache2::Const::OK;
  71
  72     my $path = $self->apache->path_info;
  73
  74     return $self->load_home if $path =~ /opac\/home/;
  75     return $self->load_login if $path =~ /opac\/login/;
  76     return $self->load_logout if $path =~ /opac\/logout/;
  77     return $self->load_rresults if $path =~ /opac\/results/;
  78     return $self->load_record if $path =~ /opac\/record/;
  79
  80     # ----------------------------------------------------------------
  81     # These pages require authentication
  82     # ----------------------------------------------------------------
  83     return Apache2::Const::FORBIDDEN unless $self->cgi->https;
  84     return $self->load_logout unless $self->editor->requestor;
  85
  86     return $self->load_place_hold if $path =~ /opac\/place_hold/;
  87     return $self->load_myopac_holds if $path =~ /opac\/myopac\/holds/;
  88     return $self->load_myopac_circs if $path =~ /opac\/myopac\/circs/;
  89     return $self->load_myopac if $path =~ /opac\/myopac/;
  90     # ----------------------------------------------------------------
  91
  92     return Apache2::Const::OK;
  93 }
  94
  95 # general purpose utility functions added to the environment
  96 sub load_helpers {
  97     my $self = shift;
  98     my $e = $self->editor;
  99     my $ctx = $self->ctx;
 100
 101     $cache{map} = {}; # public object maps
 102     $cache{list} = {}; # public object lists
 103
 104     # fetch-on-demand-and-cache subs for commonly used public data
 105     my @public_classes = qw/ccs aout/;
 106
 107     for my $hint (@public_classes) {
 108
 109         my ($class) = grep {
 110             $Fieldmapper::fieldmap->{$_}->{hint} eq $hint
 111         } keys %{ $Fieldmapper::fieldmap };
 112
 113             $class =~ s/Fieldmapper:://o;
 114             $class =~ s/::/_/g;
 115
 116         # copy statuses
 117         my $list_key = $hint . '_list';
 118         my $find_key = "find_$hint";
 119
 120         $ctx->{$list_key} = sub {
 121             my $method = "retrieve_all_$class";
 122             $cache{list}{$hint} = $e->$method() unless $cache{list}{$hint};
 123             return $cache{list}{$hint};
 124         };
 125
 126         $cache{map}{$hint} = {};
 127
 128         $ctx->{$find_key} = sub {
 129             my $id = shift;
 130             return $cache{map}{$hint}{$id} if $cache{map}{$hint}{$id};
 131             ($cache{map}{$hint}{$id}) = grep { $_->id == $id } @{$ctx->{$list_key}->()};
 132             return $cache{map}{$hint}{$id};
 133         };
 134
 135     }
 136
 137     $ctx->{aou_tree} = sub {
 138
 139         # fetch the org unit tree
 140         unless($cache{aou_tree}) {
 141             my $tree = $e->search_actor_org_unit([
 142                             {   parent_ou => undef},
 143                             {   flesh            => -1,
 144                                     flesh_fields    => {aou =>  ['children']},
 145                                     order_by        => {aou => 'name'}
 146                             }
 147                     ])->[0];
 148
 149             # flesh the org unit type for each org unit
 150             # and simultaneously set the id => aou map cache
 151             sub flesh_aout {
 152                 my $node = shift;
 153                 my $ctx = shift;
 154                 $node->ou_type( $ctx->{find_aout}->($node->ou_type) );
 155                 $cache{map}{aou}{$node->id} = $node;
 156                 flesh_aout($_, $ctx) foreach @{$node->children};
 157             };
 158             flesh_aout($tree, $ctx);
 159
 160             $cache{aou_tree} = $tree;
 161         }
 162
 163         return $cache{aou_tree};
 164     };
 165
 166     # Add a special handler for the tree-shaped org unit cache
 167     $cache{map}{aou} = {};
 168     $ctx->{find_aou} = sub {
 169         my $org_id = shift;
 170         $ctx->{aou_tree}->(); # force the org tree to load
 171         return $cache{map}{aou}{$org_id};
 172     };
 173
 174     # turns an ISO date into something TT can understand
 175     $ctx->{parse_datetime} = sub {
 176         my $date = shift;
 177         $date = DateTime::Format::ISO8601->new->parse_datetime(cleanse_ISO8601($date));
 178         return sprintf(
 179             "%0.2d:%0.2d:%0.2d %0.2d-%0.2d-%0.4d",
 180             $date->hour,
 181             $date->minute,
 182             $date->second,
 183             $date->day,
 184             $date->month,
 185             $date->year
 186         );
 187     }
 188 }
 189
 190 # context additions:
 191 #   authtoken : string
 192 #   user : au object
 193 #   user_status : hash of user circ numbers
 194 sub load_common {
 195     my $self = shift;
 196
 197     my $e = $self->editor;
 198     my $ctx = $self->ctx;
 199
 200     if($e->authtoken($self->cgi->cookie('ses'))) {
 201
 202         if($e->checkauth) {
 203
 204             $ctx->{authtoken} = $e->authtoken;
 205             $ctx->{user} = $e->requestor;
 206             $ctx->{user_stats} = $U->simplereq(
 207                 'open-ils.actor',
 208                 'open-ils.actor.user.opac.vital_stats',
 209                 $e->authtoken, $e->requestor->id);
 210
 211         } else {
 212
 213             return $self->load_logout;
 214         }
 215     }
 216
 217     return Apache2::Const::OK;
 218 }
 219
 220 sub load_home {
 221     my $self = shift;
 222     $self->ctx->{page} = 'home';
 223     return Apache2::Const::OK;
 224 }
 225
 226
 227 sub load_login {
 228     my $self = shift;
 229     my $cgi = $self->cgi;
 230
 231     $self->ctx->{page} = 'login';
 232
 233     my $username = $cgi->param('username');
 234     my $password = $cgi->param('password');
 235
 236     return Apache2::Const::OK unless $username and $password;
 237
 238         my $seed = $U->simplereq(
 239         'open-ils.auth',
 240                 'open-ils.auth.authenticate.init',
 241         $username);
 242
 243         my $response = $U->simplereq(
 244         'open-ils.auth',
 245                 'open-ils.auth.authenticate.complete',
 246                 {       username => $username,
 247                         password => md5_hex($seed . md5_hex($password)),
 248                         type => 'opac'
 249         }
 250     );
 251
 252     # XXX check event, redirect as necessary
 253
 254     my $home = $self->apache->unparsed_uri;
 255     $home =~ s/\/login/\/home/;
 256
 257     $self->apache->print(
 258         $cgi->redirect(
 259             -url => $cgi->param('origin') || $home,
 260             -cookie => $cgi->cookie(
 261                 -name => 'ses',
 262                 -path => '/',
 263                 -secure => 1,
 264                 -value => $response->{payload}->{authtoken},
 265                 -expires => CORE::time + $response->{payload}->{authtime}
 266             )
 267         )
 268     );
 269
 270     return Apache2::Const::REDIRECT;
 271 }
 272
 273 sub load_logout {
 274     my $self = shift;
 275
 276     my $url = 'http://' . $self->apache->hostname . $self->ctx->{base_path} . "/opac/home";
 277
 278     $self->apache->print(
 279         $self->cgi->redirect(
 280             -url => $url,
 281             -cookie => $self->cgi->cookie(
 282                 -name => 'ses',
 283                 -path => '/',
 284                 -value => '',
 285                 -expires => '-1h'
 286             )
 287         )
 288     );
 289
 290     return Apache2::Const::REDIRECT;
 291 }
 292
 293 # context additions:
 294 #   page_size
 295 #   hit_count
 296 #   records : list of bre's and copy-count objects
 297 sub load_rresults {
 298     my $self = shift;
 299     my $cgi = $self->cgi;
 300     my $ctx = $self->ctx;
 301     my $e = $self->editor;
 302
 303     $ctx->{page} = 'rresult';
 304     my $page = $cgi->param('page') || 0;
 305     my $facet = $cgi->param('facet');
 306     my $query = $cgi->param('query');
 307     my $limit = $cgi->param('limit') || 10; # XXX user settings
 308     my $args = {limit => $limit, offset => $page * $limit};
 309     $query = "$query $facet" if $facet;
 310     my $results;
 311
 312     try {
 313         $results = $U->simplereq(
 314             'open-ils.search',
 315             'open-ils.search.biblio.multiclass.query.staff',
 316             $args, $query, 1);
 317
 318     } catch Error with {
 319         my $err = shift;
 320         $logger->error("multiclass search error: $err");
 321         $results = {count => 0, ids => []};
 322     };
 323
 324     my $rec_ids = [map { $_->[0] } @{$results->{ids}}];
 325
 326     $ctx->{records} = [];
 327     $ctx->{search_facets} = {};
 328     $ctx->{page_size} = $limit;
 329     $ctx->{hit_count} = $results->{count};
 330
 331     return Apache2::Const::OK if @$rec_ids == 0;
 332
 333     my $cstore1 = OpenSRF::AppSession->create('open-ils.cstore');
 334     my $bre_req = $cstore1->request(
 335         'open-ils.cstore.direct.biblio.record_entry.search', {id => $rec_ids});
 336
 337     my $search = OpenSRF::AppSession->create('open-ils.search');
 338     my $facet_req = $search->request('open-ils.search.facet_cache.retrieve', $results->{facet_key}, 10);
 339
 340     unless($cache{cmf}) {
 341         $cache{cmf} = $e->search_config_metabib_field({id => {'!=' => undef}});
 342         $ctx->{metabib_field} = $cache{cmf};
 343         #$cache{cmc} = $e->search_config_metabib_class({name => {'!=' => undef}});
 344         #$ctx->{metabib_class} = $cache{cmc};
 345     }
 346
 347     my @data;
 348     while(my $resp = $bre_req->recv) {
 349         my $bre = $resp->content;
 350
 351         # XXX farm out to multiple cstore sessions before loop, then collect after
 352         my $copy_counts = $e->json_query(
 353             {from => ['asset.record_copy_count', 1, $bre->id, 0]})->[0];
 354
 355         push(@data,
 356             {
 357                 bre => $bre,
 358                 marc_xml => XML::LibXML->new->parse_string($bre->marc),
 359                 copy_counts => $copy_counts
 360             }
 361         );
 362     }
 363
 364     $cstore1->kill_me;
 365
 366     # shove recs into context in search results order
 367     for my $rec_id (@$rec_ids) {
 368         push(
 369             @{$ctx->{records}},
 370             grep { $_->{bre}->id == $rec_id } @data
 371         );
 372     }
 373
 374     my $facets = $facet_req->gather(1);
 375
 376     for my $cmf_id (keys %$facets) {  # quick-n-dirty
 377         my ($cmf) = grep { $_->id eq $cmf_id } @{$cache{cmf}};
 378         $facets->{$cmf_id} = {cmf => $cmf, data => $facets->{$cmf_id}};
 379     }
 380     $ctx->{search_facets} = $facets;
 381
 382     return Apache2::Const::OK;
 383 }
 384
 385 # context additions:
 386 #   record : bre object
 387 sub load_record {
 388     my $self = shift;
 389     $self->ctx->{page} = 'record';
 390
 391     my $rec_id = $self->ctx->{page_args}->[0]
 392         or return Apache2::Const::HTTP_BAD_REQUEST;
 393
 394     $self->ctx->{record} = $self->editor->retrieve_biblio_record_entry([
 395         $rec_id,
 396         {
 397             flesh => 2,
 398             flesh_fields => {
 399                 bre => ['call_numbers'],
 400                 acn => ['copies'] # limit, paging, etc.
 401             }
 402         }
 403     ]);
 404
 405     $self->ctx->{marc_xml} = XML::LibXML->new->parse_string($self->ctx->{record}->marc);
 406
 407     return Apache2::Const::OK;
 408 }
 409
 410 # context additions:
 411 #   user : au object, fleshed
 412 sub load_myopac {
 413     my $self = shift;
 414     $self->ctx->{page} = 'myopac';
 415
 416     $self->ctx->{user} = $self->editor->retrieve_actor_user([
 417         $self->ctx->{user}->id,
 418         {
 419             flesh => 1,
 420             flesh_fields => {
 421                 au => ['card']
 422                 # ...
 423             }
 424         }
 425     ]);
 426
 427     return Apache2::Const::OK;
 428 }
 429
 430 sub load_myopac_holds {
 431     my $self = shift;
 432     my $e = $self->editor;
 433     my $ctx = $self->ctx;
 434
 435     my $limit = $self->cgi->param('limit') || 10;
 436     my $offset = $self->cgi->param('offset') || 0;
 437
 438     my $circ = OpenSRF::AppSession->create('open-ils.circ');
 439     my $hold_ids = $circ->request(
 440         'open-ils.circ.holds.id_list.retrieve',
 441         $e->authtoken,
 442         $e->requestor->id
 443     )->gather(1);
 444
 445     $hold_ids = [ grep { defined $_ } @$hold_ids[$offset..($offset + $limit - 1)] ];
 446
 447     my $req = $circ->request(
 448         'open-ils.circ.hold.details.batch.retrieve',
 449         $e->authtoken,
 450         $hold_ids,
 451         {
 452             suppress_notices => 1,
 453             suppress_transits => 1,
 454             suppress_mvr => 1,
 455             suppress_patron_details => 1,
 456             include_bre => 1
 457         }
 458     );
 459
 460     # any requests we can fire off here?
 461
 462     $ctx->{holds} = [];
 463     while(my $resp = $req->recv) {
 464         my $hold = $resp->content;
 465         push(@{$ctx->{holds}}, {
 466             hold => $hold,
 467             marc_xml => XML::LibXML->new->parse_string($hold->{bre}->marc)
 468         });
 469     }
 470
 471     $circ->kill_me;
 472     return Apache2::Const::OK;
 473 }
 474
 475 sub load_place_hold {
 476     my $self = shift;
 477     my $ctx = $self->ctx;
 478     my $e = $self->editor;
 479     $self->ctx->{page} = 'place_hold';
 480
 481     $ctx->{hold_target} = $self->cgi->param('hold_target');
 482     $ctx->{hold_type} = $self->cgi->param('hold_type');
 483     $ctx->{default_pickup_lib} = $e->requestor->home_ou; # XXX staff
 484
 485     if($ctx->{hold_type} eq 'T') {
 486         $ctx->{record} = $e->retrieve_biblio_record_entry($ctx->{hold_target});
 487     }
 488     # ...
 489
 490     $ctx->{marc_xml} = XML::LibXML->new->parse_string($ctx->{record}->marc);
 491
 492     if(my $pickup_lib = $self->cgi->param('pickup_lib')) {
 493
 494         my $args = {
 495             patronid => $e->requestor->id,
 496             titleid => $ctx->{hold_target}, # XXX
 497             pickup_lib => $pickup_lib,
 498             depth => 0, # XXX
 499         };
 500
 501         my $allowed = $U->simplereq(
 502             'open-ils.circ',
 503             'open-ils.circ.title_hold.is_possible',
 504             $e->authtoken, $args
 505         );
 506
 507         if($allowed->{success} == 1) {
 508             my $hold = Fieldmapper::action::hold_request->new;
 509
 510             $hold->pickup_lib($pickup_lib);
 511             $hold->requestor($e->requestor->id);
 512             $hold->usr($e->requestor->id); # XXX staff
 513             $hold->target($ctx->{hold_target});
 514             $hold->hold_type($ctx->{hold_type});
 515             # frozen, expired, etc..
 516
 517             my $stat = $U->simplereq(
 518                 'open-ils.circ',
 519                 'open-ils.circ.holds.create',
 520                 $e->authtoken, $hold
 521             );
 522
 523             if($stat and $stat > 0) {
 524                 $ctx->{hold_success} = 1;
 525             } else {
 526                 $ctx->{hold_failed} = 1; # XXX process the events, etc
 527             }
 528         }
 529
 530         # place the hold and deliver results
 531     }
 532
 533     return Apache2::Const::OK;
 534 }
 535
 536
 537 sub load_myopac_circs {
 538     my $self = shift;
 539     my $e = $self->editor;
 540     my $ctx = $self->ctx;
 541     $ctx->{circs} = [];
 542
 543     my $limit = $self->cgi->param('limit') || 10;
 544     my $offset = $self->cgi->param('offset') || 0;
 545
 546     my $circ_data = $U->simplereq(
 547         'open-ils.actor',
 548         'open-ils.actor.user.checked_out',
 549         $e->authtoken,
 550         $e->requestor->id
 551     );
 552
 553     my @circ_ids =  ( @{$circ_data->{overdue}}, @{$circ_data->{out}} );
 554     @circ_ids = grep { defined $_ } @circ_ids[0..($offset + $limit - 1)];
 555
 556     return Apache2::Const::OK unless @circ_ids;
 557
 558     my $cstore = OpenSRF::AppSession->create('open-ils.cstore');
 559     my $req = $cstore->request(
 560         'open-ils.cstore.direct.action.circulation.search',
 561         {id => \@circ_ids},
 562         {
 563             flesh => 3,
 564             flesh_fields => {
 565                 circ => ['target_copy'],
 566                 acp => ['call_number'],
 567                 acn => ['record']
 568             }
 569         }
 570     );
 571
 572     my @circs;
 573     while(my $resp = $req->recv) {
 574         my $circ = $resp->content;
 575         push(@circs, {
 576             circ => $circ,
 577             marc_xml => ($circ->target_copy->call_number->id == -1) ?
 578                 undef :  # pre-cat copy, use the dummy title/author instead
 579                 XML::LibXML->new->parse_string($circ->target_copy->call_number->record->marc),
 580         });
 581     }
 582
 583     # make sure the final list is in the correct order
 584     for my $id (@circ_ids) {
 585         push(
 586             @{$ctx->{circs}},
 587             (grep { $_->{circ}->id == $id } @circs)
 588         );
 589     }
 590
 591     return Apache2::Const::OK;
 592 }
 593
 594
 595
 596 1;