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