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