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::JSON;
  11 use OpenSRF::Utils::Logger qw/$logger/;
  12 use OpenILS::Application::AppUtils;
  13 use OpenILS::Utils::CStoreEditor qw/:funcs/;
  14 use OpenILS::Utils::Fieldmapper;
  15 use DateTime::Format::ISO8601;
  16 my $U = 'OpenILS::Application::AppUtils';
  17
  18 my %cache; # proc-level cache
  19
  20 sub new {
  21     my($class, $apache, $ctx) = @_;
  22
  23     my $self = bless({}, ref($class) || $class);
  24
  25     $self->apache($apache);
  26     $self->ctx($ctx);
  27     $self->cgi(CGI->new);
  28
  29     OpenILS::Utils::CStoreEditor->init; # just in case
  30     $self->editor(new_editor());
  31
  32     return $self;
  33 }
  34
  35
  36 # current Apache2::RequestRec;
  37 sub apache {
  38     my($self, $apache) = @_;
  39     $self->{apache} = $apache if $apache;
  40     return $self->{apache};
  41 }
  42
  43 # runtime / template context
  44 sub ctx {
  45     my($self, $ctx) = @_;
  46     $self->{ctx} = $ctx if $ctx;
  47     return $self->{ctx};
  48 }
  49
  50 # cstore editor
  51 sub editor {
  52     my($self, $editor) = @_;
  53     $self->{editor} = $editor if $editor;
  54     return $self->{editor};
  55 }
  56
  57 # CGI handle
  58 sub cgi {
  59     my($self, $cgi) = @_;
  60     $self->{cgi} = $cgi if $cgi;
  61     return $self->{cgi};
  62 }
  63
  64
  65 # load common data, then load page data
  66 sub load {
  67     my $self = shift;
  68
  69     $self->load_helpers;
  70     my $stat = $self->load_common;
  71     return $stat unless $stat == Apache2::Const::OK;
  72
  73     my $path = $self->apache->path_info;
  74
  75     return $self->load_home if $path =~ /opac\/home/;
  76     return $self->load_login if $path =~ /opac\/login/;
  77     return $self->load_logout if $path =~ /opac\/logout/;
  78     return $self->load_rresults if $path =~ /opac\/results/;
  79     return $self->load_record if $path =~ /opac\/record/;
  80
  81     # ----------------------------------------------------------------
  82     # These pages require authentication
  83     # ----------------------------------------------------------------
  84     return Apache2::Const::FORBIDDEN unless $self->cgi->https;
  85     return $self->load_logout unless $self->editor->requestor;
  86
  87     return $self->load_place_hold if $path =~ /opac\/place_hold/;
  88     return $self->load_myopac_holds if $path =~ /opac\/myopac\/holds/;
  89     return $self->load_myopac_circs if $path =~ /opac\/myopac\/circs/;
  90     return $self->load_myopac_fines if $path =~ /opac\/myopac\/fines/;
  91     return $self->load_myopac if $path =~ /opac\/myopac/;
  92     # ----------------------------------------------------------------
  93
  94     return Apache2::Const::OK;
  95 }
  96
  97 # general purpose utility functions added to the environment
  98 sub load_helpers {
  99     my $self = shift;
 100     my $e = $self->editor;
 101     my $ctx = $self->ctx;
 102
 103     $cache{map} = {}; # public object maps
 104     $cache{list} = {}; # public object lists
 105
 106     # fetch-on-demand-and-cache subs for commonly used public data
 107     my @public_classes = qw/ccs aout cifm citm clm/;
 108
 109     for my $hint (@public_classes) {
 110
 111         my ($class) = grep {
 112             $Fieldmapper::fieldmap->{$_}->{hint} eq $hint
 113         } keys %{ $Fieldmapper::fieldmap };
 114
 115         my $ident_field =  $Fieldmapper::fieldmap->{$class}->{identity};
 116
 117             $class =~ s/Fieldmapper:://o;
 118             $class =~ s/::/_/g;
 119
 120         # copy statuses
 121         my $list_key = $hint . '_list';
 122         my $find_key = "find_$hint";
 123
 124         $ctx->{$list_key} = sub {
 125             my $method = "retrieve_all_$class";
 126             $cache{list}{$hint} = $e->$method() unless $cache{list}{$hint};
 127             return $cache{list}{$hint};
 128         };
 129
 130         $cache{map}{$hint} = {};
 131
 132         $ctx->{$find_key} = sub {
 133             my $id = shift;
 134             return $cache{map}{$hint}{$id} if $cache{map}{$hint}{$id};
 135             ($cache{map}{$hint}{$id}) = grep { $_->$ident_field eq $id } @{$ctx->{$list_key}->()};
 136             return $cache{map}{$hint}{$id};
 137         };
 138
 139     }
 140
 141     $ctx->{aou_tree} = sub {
 142
 143         # fetch the org unit tree
 144         unless($cache{aou_tree}) {
 145             my $tree = $e->search_actor_org_unit([
 146                             {   parent_ou => undef},
 147                             {   flesh            => -1,
 148                                     flesh_fields    => {aou =>  ['children']},
 149                                     order_by        => {aou => 'name'}
 150                             }
 151                     ])->[0];
 152
 153             # flesh the org unit type for each org unit
 154             # and simultaneously set the id => aou map cache
 155             sub flesh_aout {
 156                 my $node = shift;
 157                 my $ctx = shift;
 158                 $node->ou_type( $ctx->{find_aout}->($node->ou_type) );
 159                 $cache{map}{aou}{$node->id} = $node;
 160                 flesh_aout($_, $ctx) foreach @{$node->children};
 161             };
 162             flesh_aout($tree, $ctx);
 163
 164             $cache{aou_tree} = $tree;
 165         }
 166
 167         return $cache{aou_tree};
 168     };
 169
 170     # Add a special handler for the tree-shaped org unit cache
 171     $cache{map}{aou} = {};
 172     $ctx->{find_aou} = sub {
 173         my $org_id = shift;
 174         $ctx->{aou_tree}->(); # force the org tree to load
 175         return $cache{map}{aou}{$org_id};
 176     };
 177
 178     # turns an ISO date into something TT can understand
 179     $ctx->{parse_datetime} = sub {
 180         my $date = shift;
 181         $date = DateTime::Format::ISO8601->new->parse_datetime(cleanse_ISO8601($date));
 182         return sprintf(
 183             "%0.2d:%0.2d:%0.2d %0.2d-%0.2d-%0.4d",
 184             $date->hour,
 185             $date->minute,
 186             $date->second,
 187             $date->day,
 188             $date->month,
 189             $date->year
 190         );
 191     }
 192 }
 193
 194 # context additions:
 195 #   authtoken : string
 196 #   user : au object
 197 #   user_status : hash of user circ numbers
 198 sub load_common {
 199     my $self = shift;
 200
 201     my $e = $self->editor;
 202     my $ctx = $self->ctx;
 203
 204     if($e->authtoken($self->cgi->cookie('ses'))) {
 205
 206         if($e->checkauth) {
 207
 208             $ctx->{authtoken} = $e->authtoken;
 209             $ctx->{user} = $e->requestor;
 210             $ctx->{user_stats} = $U->simplereq(
 211                 'open-ils.actor',
 212                 'open-ils.actor.user.opac.vital_stats',
 213                 $e->authtoken, $e->requestor->id);
 214
 215         } else {
 216
 217             return $self->load_logout;
 218         }
 219     }
 220
 221     return Apache2::Const::OK;
 222 }
 223
 224 sub load_home {
 225     my $self = shift;
 226     $self->ctx->{page} = 'home';
 227     return Apache2::Const::OK;
 228 }
 229
 230
 231 sub load_login {
 232     my $self = shift;
 233     my $cgi = $self->cgi;
 234
 235     $self->ctx->{page} = 'login';
 236
 237     my $username = $cgi->param('username');
 238     my $password = $cgi->param('password');
 239
 240     return Apache2::Const::OK unless $username and $password;
 241
 242         my $seed = $U->simplereq(
 243         'open-ils.auth',
 244                 'open-ils.auth.authenticate.init',
 245         $username);
 246
 247         my $response = $U->simplereq(
 248         'open-ils.auth',
 249                 'open-ils.auth.authenticate.complete',
 250                 {       username => $username,
 251                         password => md5_hex($seed . md5_hex($password)),
 252                         type => 'opac'
 253         }
 254     );
 255
 256     # XXX check event, redirect as necessary
 257
 258     my $home = $self->apache->unparsed_uri;
 259     $home =~ s/\/login/\/home/;
 260
 261     $self->apache->print(
 262         $cgi->redirect(
 263             -url => $cgi->param('origin') || $home,
 264             -cookie => $cgi->cookie(
 265                 -name => 'ses',
 266                 -path => '/',
 267                 -secure => 1,
 268                 -value => $response->{payload}->{authtoken},
 269                 -expires => CORE::time + $response->{payload}->{authtime}
 270             )
 271         )
 272     );
 273
 274     return Apache2::Const::REDIRECT;
 275 }
 276
 277 sub load_logout {
 278     my $self = shift;
 279
 280     my $url = 'http://' . $self->apache->hostname . $self->ctx->{base_path} . "/opac/home";
 281
 282     $self->apache->print(
 283         $self->cgi->redirect(
 284             -url => $url,
 285             -cookie => $self->cgi->cookie(
 286                 -name => 'ses',
 287                 -path => '/',
 288                 -value => '',
 289                 -expires => '-1h'
 290             )
 291         )
 292     );
 293
 294     return Apache2::Const::REDIRECT;
 295 }
 296
 297 # context additions:
 298 #   page_size
 299 #   hit_count
 300 #   records : list of bre's and copy-count objects
 301 sub load_rresults {
 302     my $self = shift;
 303     my $cgi = $self->cgi;
 304     my $ctx = $self->ctx;
 305     my $e = $self->editor;
 306
 307     $ctx->{page} = 'rresult';
 308     my $page = $cgi->param('page') || 0;
 309     my $facet = $cgi->param('facet');
 310     my $query = $cgi->param('query');
 311     my $limit = $cgi->param('limit') || 10; # XXX user settings
 312     my $args = {limit => $limit, offset => $page * $limit};
 313     $query = "$query $facet" if $facet;
 314     my $results;
 315
 316     try {
 317         $results = $U->simplereq(
 318             'open-ils.search',
 319             'open-ils.search.biblio.multiclass.query.staff',
 320             $args, $query, 1);
 321
 322     } catch Error with {
 323         my $err = shift;
 324         $logger->error("multiclass search error: $err");
 325         $results = {count => 0, ids => []};
 326     };
 327
 328     my $rec_ids = [map { $_->[0] } @{$results->{ids}}];
 329
 330     $ctx->{records} = [];
 331     $ctx->{search_facets} = {};
 332     $ctx->{page_size} = $limit;
 333     $ctx->{hit_count} = $results->{count};
 334
 335     return Apache2::Const::OK if @$rec_ids == 0;
 336
 337     my $cstore1 = OpenSRF::AppSession->create('open-ils.cstore');
 338     my $bre_req = $cstore1->request(
 339         'open-ils.cstore.direct.biblio.record_entry.search', {id => $rec_ids});
 340
 341     my $search = OpenSRF::AppSession->create('open-ils.search');
 342     my $facet_req = $search->request('open-ils.search.facet_cache.retrieve', $results->{facet_key}, 10);
 343
 344     unless($cache{cmf}) {
 345         $cache{cmf} = $e->search_config_metabib_field({id => {'!=' => undef}});
 346         $ctx->{metabib_field} = $cache{cmf};
 347         #$cache{cmc} = $e->search_config_metabib_class({name => {'!=' => undef}});
 348         #$ctx->{metabib_class} = $cache{cmc};
 349     }
 350
 351     my @data;
 352     while(my $resp = $bre_req->recv) {
 353         my $bre = $resp->content;
 354
 355         # XXX farm out to multiple cstore sessions before loop, then collect after
 356         my $copy_counts = $e->json_query(
 357             {from => ['asset.record_copy_count', 1, $bre->id, 0]})->[0];
 358
 359         push(@data,
 360             {
 361                 bre => $bre,
 362                 marc_xml => XML::LibXML->new->parse_string($bre->marc),
 363                 copy_counts => $copy_counts
 364             }
 365         );
 366     }
 367
 368     $cstore1->kill_me;
 369
 370     # shove recs into context in search results order
 371     for my $rec_id (@$rec_ids) {
 372         push(
 373             @{$ctx->{records}},
 374             grep { $_->{bre}->id == $rec_id } @data
 375         );
 376     }
 377
 378     my $facets = $facet_req->gather(1);
 379
 380     for my $cmf_id (keys %$facets) {  # quick-n-dirty
 381         my ($cmf) = grep { $_->id eq $cmf_id } @{$cache{cmf}};
 382         $facets->{$cmf_id} = {cmf => $cmf, data => $facets->{$cmf_id}};
 383     }
 384     $ctx->{search_facets} = $facets;
 385
 386     return Apache2::Const::OK;
 387 }
 388
 389 # context additions:
 390 #   record : bre object
 391 sub load_record {
 392     my $self = shift;
 393     $self->ctx->{page} = 'record';
 394
 395     my $rec_id = $self->ctx->{page_args}->[0]
 396         or return Apache2::Const::HTTP_BAD_REQUEST;
 397
 398     $self->ctx->{record} = $self->editor->retrieve_biblio_record_entry([
 399         $rec_id,
 400         {
 401             flesh => 2,
 402             flesh_fields => {
 403                 bre => ['call_numbers'],
 404                 acn => ['copies'] # limit, paging, etc.
 405             }
 406         }
 407     ]);
 408
 409     $self->ctx->{marc_xml} = XML::LibXML->new->parse_string($self->ctx->{record}->marc);
 410
 411     return Apache2::Const::OK;
 412 }
 413
 414 # context additions:
 415 #   user : au object, fleshed
 416 sub load_myopac {
 417     my $self = shift;
 418     $self->ctx->{page} = 'myopac';
 419
 420     $self->ctx->{user} = $self->editor->retrieve_actor_user([
 421         $self->ctx->{user}->id,
 422         {
 423             flesh => 1,
 424             flesh_fields => {
 425                 au => ['card']
 426                 # ...
 427             }
 428         }
 429     ]);
 430
 431     return Apache2::Const::OK;
 432 }
 433
 434
 435 sub fetch_user_holds {
 436     my $self = shift;
 437     my $hold_ids = shift;
 438     my $ids_only = shift;
 439     my $flesh = shift;
 440     my $limit = shift;
 441     my $offset = shift;
 442
 443     my $e = $self->editor;
 444
 445     my $circ = OpenSRF::AppSession->create('open-ils.circ');
 446
 447     if(!$hold_ids) {
 448
 449         $hold_ids = $circ->request(
 450             'open-ils.circ.holds.id_list.retrieve.authoritative',
 451             $e->authtoken,
 452             $e->requestor->id
 453         )->gather(1);
 454
 455         $hold_ids = [ grep { defined $_ } @$hold_ids[$offset..($offset + $limit - 1)] ] if $limit or $offset;
 456     }
 457
 458
 459     return $hold_ids if $ids_only or @$hold_ids == 0;
 460
 461     my $req = $circ->request(
 462         # TODO .authoritative version is chewing up cstores
 463         # 'open-ils.circ.hold.details.batch.retrieve.authoritative',
 464         'open-ils.circ.hold.details.batch.retrieve',
 465         $e->authtoken,
 466         $hold_ids,
 467         {
 468             suppress_notices => 1,
 469             suppress_transits => 1,
 470             suppress_mvr => 1,
 471             suppress_patron_details => 1,
 472             include_bre => 1
 473         }
 474     );
 475
 476     my @holds;
 477     while(my $resp = $req->recv) {
 478         my $hold = $resp->content;
 479         push(@holds, {
 480             hold => $hold,
 481             marc_xml => ($flesh) ? XML::LibXML->new->parse_string($hold->{bre}->marc) : undef
 482         });
 483     }
 484
 485     $circ->kill_me;
 486     return \@holds;
 487 }
 488
 489 sub handle_hold_update {
 490     my $self = shift;
 491     my $action = shift;
 492     my $e = $self->editor;
 493
 494
 495     my @hold_ids = $self->cgi->param('hold_id'); # for non-_all actions
 496     @hold_ids = @{$self->fetch_user_holds(undef, 1)} if $action =~ /_all/;
 497
 498     my $circ = OpenSRF::AppSession->create('open-ils.circ');
 499
 500     if($action =~ /cancel/) {
 501
 502         for my $hold_id (@hold_ids) {
 503             my $resp = $circ->request(
 504                 'open-ils.circ.hold.cancel', $e->authtoken, $hold_id, 6 )->gather(1); # 6 == patron-cancelled-via-opac
 505         }
 506
 507     } else {
 508
 509         my $vlist = [];
 510         for my $hold_id (@hold_ids) {
 511             my $vals = {id => $hold_id};
 512
 513             if($action =~ /activate/) {
 514                 $vals->{frozen} = 'f';
 515                 $vals->{thaw_date} = undef;
 516
 517             } elsif($action =~ /suspend/) {
 518                 $vals->{frozen} = 't';
 519                 # $vals->{thaw_date} = TODO;
 520             }
 521             push(@$vlist, $vals);
 522         }
 523
 524         $circ->request('open-ils.circ.hold.update.batch.atomic', $e->authtoken, undef, $vlist)->gather(1);
 525     }
 526
 527     $circ->kill_me;
 528     return undef;
 529 }
 530
 531 sub load_myopac_holds {
 532     my $self = shift;
 533     my $e = $self->editor;
 534     my $ctx = $self->ctx;
 535
 536
 537     my $limit = $self->cgi->param('limit') || 0;
 538     my $offset = $self->cgi->param('offset') || 0;
 539     my $action = $self->cgi->param('action') || '';
 540
 541     $self->handle_hold_update($action) if $action;
 542
 543     $ctx->{holds} = $self->fetch_user_holds(undef, 0, 1, $limit, $offset);
 544
 545     return Apache2::Const::OK;
 546 }
 547
 548 sub load_place_hold {
 549     my $self = shift;
 550     my $ctx = $self->ctx;
 551     my $e = $self->editor;
 552     my $cgi = $self->cgi;
 553     $self->ctx->{page} = 'place_hold';
 554
 555     $ctx->{hold_target} = $cgi->param('hold_target');
 556     $ctx->{hold_type} = $cgi->param('hold_type');
 557     $ctx->{default_pickup_lib} = $e->requestor->home_ou; # XXX staff
 558
 559     if($ctx->{hold_type} eq 'T') {
 560         $ctx->{record} = $e->retrieve_biblio_record_entry($ctx->{hold_target});
 561     }
 562     # ...
 563
 564     $ctx->{marc_xml} = XML::LibXML->new->parse_string($ctx->{record}->marc);
 565
 566     if(my $pickup_lib = $cgi->param('pickup_lib')) {
 567
 568         my $args = {
 569             patronid => $e->requestor->id,
 570             titleid => $ctx->{hold_target}, # XXX
 571             pickup_lib => $pickup_lib,
 572             depth => 0, # XXX
 573         };
 574
 575         my $allowed = $U->simplereq(
 576             'open-ils.circ',
 577             'open-ils.circ.title_hold.is_possible',
 578             $e->authtoken, $args
 579         );
 580
 581         if($allowed->{success} == 1) {
 582             my $hold = Fieldmapper::action::hold_request->new;
 583
 584             $hold->pickup_lib($pickup_lib);
 585             $hold->requestor($e->requestor->id);
 586             $hold->usr($e->requestor->id); # XXX staff
 587             $hold->target($ctx->{hold_target});
 588             $hold->hold_type($ctx->{hold_type});
 589             # frozen, expired, etc..
 590
 591             my $stat = $U->simplereq(
 592                 'open-ils.circ',
 593                 'open-ils.circ.holds.create',
 594                 $e->authtoken, $hold
 595             );
 596
 597             if($stat and $stat > 0) {
 598
 599                 # if successful, return the user to the requesting page
 600                 $self->apache->print($cgi->redirect(-url => $cgi->referer));
 601                 return Apache2::Const::REDIRECT;
 602
 603             } else {
 604                 $ctx->{hold_failed} = 1; # XXX process the events, etc
 605             }
 606         }
 607     }
 608
 609     return Apache2::Const::OK;
 610 }
 611
 612
 613 sub fetch_user_circs {
 614     my $self = shift;
 615     my $flesh = shift; # flesh bib data, etc.
 616     my $circ_ids = shift;
 617     my $limit = shift;
 618     my $offset = shift;
 619
 620     my $e = $self->editor;
 621
 622     my @circ_ids;
 623
 624     if($circ_ids) {
 625         @circ_ids = @$circ_ids;
 626
 627     } else {
 628
 629         my $circ_data = $U->simplereq(
 630             'open-ils.actor',
 631             'open-ils.actor.user.checked_out',
 632             $e->authtoken,
 633             $e->requestor->id
 634         );
 635
 636         @circ_ids =  ( @{$circ_data->{overdue}}, @{$circ_data->{out}} );
 637
 638         if($limit or $offset) {
 639             @circ_ids = grep { defined $_ } @circ_ids[0..($offset + $limit - 1)];
 640         }
 641     }
 642
 643     return [] unless @circ_ids;
 644
 645     my $cstore = OpenSRF::AppSession->create('open-ils.cstore');
 646
 647     my $qflesh = {
 648         flesh => 3,
 649         flesh_fields => {
 650             circ => ['target_copy'],
 651             acp => ['call_number'],
 652             acn => ['record']
 653         }
 654     };
 655
 656     $e->xact_begin;
 657     my $circs = $e->search_action_circulation(
 658         [{id => \@circ_ids}, ($flesh) ? $qflesh : {}], {substream => 1});
 659
 660     my @circs;
 661     for my $circ (@$circs) {
 662         push(@circs, {
 663             circ => $circ,
 664             marc_xml => ($flesh and $circ->target_copy->call_number->id != -1) ?
 665                 XML::LibXML->new->parse_string($circ->target_copy->call_number->record->marc) :
 666                 undef  # pre-cat copy, use the dummy title/author instead
 667         });
 668     }
 669     $e->xact_rollback;
 670
 671     # make sure the final list is in the correct order
 672     my @sorted_circs;
 673     for my $id (@circ_ids) {
 674         push(
 675             @sorted_circs,
 676             (grep { $_->{circ}->id == $id } @circs)
 677         );
 678     }
 679
 680     return \@sorted_circs;
 681 }
 682
 683
 684 sub handle_circ_renew {
 685     my $self = shift;
 686     my $action = shift;
 687     my $ctx = $self->ctx;
 688
 689     my @renew_ids = $self->cgi->param('circ');
 690
 691     my $circs = $self->fetch_user_circs(0, ($action eq 'renew') ? [@renew_ids] : undef);
 692
 693     # TODO: fire off renewal calls in batches to speed things up
 694     my @responses;
 695     for my $circ (@$circs) {
 696
 697         my $evt = $U->simplereq(
 698             'open-ils.circ',
 699             'open-ils.circ.renew',
 700             $self->editor->authtoken,
 701             {
 702                 patron_id => $self->editor->requestor->id,
 703                 copy_id => $circ->{circ}->target_copy,
 704                 opac_renewal => 1
 705             }
 706         );
 707
 708         # TODO return these, then insert them into the circ data
 709         # blob that is shoved into the template for each circ
 710         # so the template won't have to match them
 711         push(@responses, {copy => $circ->{circ}->target_copy, evt => $evt});
 712     }
 713
 714     return @responses;
 715 }
 716
 717
 718 sub load_myopac_circs {
 719     my $self = shift;
 720     my $e = $self->editor;
 721     my $ctx = $self->ctx;
 722
 723     $ctx->{circs} = [];
 724     my $limit = $self->cgi->param('limit') || 0; # 0 == unlimited
 725     my $offset = $self->cgi->param('offset') || 0;
 726     my $action = $self->cgi->param('action') || '';
 727
 728     # perform the renewal first if necessary
 729     my @results = $self->handle_circ_renew($action) if $action =~ /renew/;
 730
 731     $ctx->{circs} = $self->fetch_user_circs(1, undef, $limit, $offset);
 732
 733     my $success_renewals = 0;
 734     my $failed_renewals = 0;
 735     for my $data (@{$ctx->{circs}}) {
 736         my ($resp) = grep { $_->{copy} == $data->{circ}->target_copy->id } @results;
 737
 738         if($resp) {
 739             my $evt = ref($resp->{evt}) eq 'ARRAY' ? $resp->{evt}->[0] : $resp->{evt};
 740             $data->{renewal_response} = $evt;
 741             $success_renewals++ if $evt->{textcode} eq 'SUCCESS';
 742             $failed_renewals++ if $evt->{textcode} ne 'SUCCESS';
 743         }
 744     }
 745
 746     $ctx->{success_renewals} = $success_renewals;
 747     $ctx->{failed_renewals} = $failed_renewals;
 748
 749     return Apache2::Const::OK;
 750 }
 751
 752 sub load_myopac_fines {
 753     my $self = shift;
 754     my $e = $self->editor;
 755     my $ctx = $self->ctx;
 756     $ctx->{"fines"} = {
 757         "circulation" => [],
 758         "grocery" => [],
 759         "total_paid" => 0,
 760         "total_owed" => 0,
 761         "balance_owed" => 0
 762     };
 763
 764     my $limit = $self->cgi->param('limit') || 0;
 765     my $offset = $self->cgi->param('offset') || 0;
 766
 767     my $cstore = OpenSRF::AppSession->create('open-ils.cstore');
 768
 769     # TODO: This should really be a ML call, but the existing calls
 770     # return an excessive amount of data and don't offer streaming
 771
 772     my %paging = ($limit or $offset) ? (limit => $limit, offset => $offset) : ();
 773
 774     my $req = $cstore->request(
 775         'open-ils.cstore.direct.money.open_billable_transaction_summary.search',
 776         {
 777             usr => $e->requestor->id,
 778             balance_owed => {'!=' => 0}
 779         },
 780         {
 781             flesh => 4,
 782             flesh_fields => {
 783                 mobts => ['circulation', 'grocery'],
 784                 mg => ['billings'],
 785                 mb => ['btype'],
 786                 circ => ['target_copy'],
 787                 acp => ['call_number'],
 788                 acn => ['record']
 789             },
 790             order_by => { mobts => 'xact_start' },
 791             %paging
 792         }
 793     );
 794
 795     while(my $resp = $req->recv) {
 796         my $mobts = $resp->content;
 797         my $circ = $mobts->circulation;
 798
 799         my $last_billing;
 800         if($mobts->grocery) {
 801             my @billings = sort { $a->billing_ts cmp $b->billing_ts } @{$mobts->grocery->billings};
 802             $last_billing = pop(@billings);
 803         }
 804
 805         # XXX TODO switch to some money-safe non-fp library for math
 806         $ctx->{"fines"}->{$_} += $mobts->$_ for (
 807             qw/total_paid total_owed balance_owed/
 808         );
 809
 810         push(
 811             @{$ctx->{"fines"}->{$mobts->grocery ? "grocery" : "circulation"}},
 812             {
 813                 xact => $mobts,
 814                 last_grocery_billing => $last_billing,
 815                 marc_xml => ($mobts->xact_type ne 'circulation' or $circ->target_copy->call_number->id == -1) ?
 816                     undef :
 817                     XML::LibXML->new->parse_string($circ->target_copy->call_number->record->marc),
 818             }
 819         );
 820     }
 821
 822      return Apache2::Const::OK;
 823 }
 824
 825 1;