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