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

   1 package OpenILS::WWW::EGCatLoader;
   2 use strict; use warnings;
   3 use Apache2::Const -compile => qw(OK DECLINED FORBIDDEN HTTP_INTERNAL_SERVER_ERROR REDIRECT HTTP_BAD_REQUEST);
   4 use OpenSRF::Utils::Logger qw/$logger/;
   5 use OpenILS::Utils::CStoreEditor qw/:funcs/;
   6 use OpenILS::Utils::Fieldmapper;
   7 use OpenILS::Application::AppUtils;
   8 use OpenSRF::Utils::JSON;
   9 #use Data::Dumper;
  10 #$Data::Dumper::Indent = 0;
  11 my $U = 'OpenILS::Application::AppUtils';
  12
  13 sub prepare_extended_user_info {
  14     my $self = shift;
  15
  16     $self->ctx->{user} = $self->editor->retrieve_actor_user([
  17         $self->ctx->{user}->id,
  18         {
  19             flesh => 1,
  20             flesh_fields => {
  21                 au => [qw/card home_ou addresses ident_type billing_address/]
  22                 # ...
  23             }
  24         }
  25     ]) or return Apache2::Const::HTTP_INTERNAL_SERVER_ERROR;
  26
  27     return;
  28 }
  29
  30 # context additions:
  31 #   user : au object, fleshed
  32 sub load_myopac_prefs {
  33     my $self = shift;
  34     return $self->prepare_extended_user_info || Apache2::Const::OK;
  35 }
  36
  37 sub load_myopac_prefs_notify {
  38     my $self = shift;
  39     my $e = $self->editor;
  40
  41     my $user_prefs = $self->fetch_optin_prefs;
  42     $user_prefs = $self->update_optin_prefs($user_prefs)
  43         if $self->cgi->request_method eq 'POST';
  44
  45     $self->ctx->{opt_in_settings} = $user_prefs;
  46
  47     return Apache2::Const::OK;
  48 }
  49
  50 sub fetch_optin_prefs {
  51     my $self = shift;
  52     my $e = $self->editor;
  53
  54     # fetch all of the opt-in settings the user has access to
  55     # XXX: user's should in theory have options to opt-in to notices
  56     # for remote locations, but that opens the door for a large
  57     # set of generally un-used opt-ins.. needs discussion
  58     my $opt_ins =  $U->simplereq(
  59         'open-ils.actor',
  60         'open-ils.actor.event_def.opt_in.settings.atomic',
  61         $e->authtoken, $e->requestor->home_ou);
  62
  63     # fetch user setting values for each of the opt-in settings
  64     my $user_set = $U->simplereq(
  65         'open-ils.actor',
  66         'open-ils.actor.patron.settings.retrieve',
  67         $e->authtoken,
  68         $e->requestor->id,
  69         [map {$_->name} @$opt_ins]
  70     );
  71
  72     return [map { {cust => $_, value => $user_set->{$_->name} } } @$opt_ins];
  73 }
  74
  75 sub update_optin_prefs {
  76     my $self = shift;
  77     my $user_prefs = shift;
  78     my $e = $self->editor;
  79     my @settings = $self->cgi->param('setting');
  80     my %newsets;
  81
  82     # apply now-true settings
  83     for my $applied (@settings) {
  84         # see if setting is already applied to this user
  85         next if grep { $_->{cust}->name eq $applied and $_->{value} } @$user_prefs;
  86         $newsets{$applied} = OpenSRF::Utils::JSON->true;
  87     }
  88
  89     # remove now-false settings
  90     for my $pref (grep { $_->{value} } @$user_prefs) {
  91         $newsets{$pref->{cust}->name} = undef
  92             unless grep { $_ eq $pref->{cust}->name } @settings;
  93     }
  94
  95     $U->simplereq(
  96         'open-ils.actor',
  97         'open-ils.actor.patron.settings.update',
  98         $e->authtoken, $e->requestor->id, \%newsets);
  99
 100     # update the local prefs to match reality
 101     for my $pref (@$user_prefs) {
 102         $pref->{value} = $newsets{$pref->{cust}->name}
 103             if exists $newsets{$pref->{cust}->name};
 104     }
 105
 106     return $user_prefs;
 107 }
 108
 109 sub load_myopac_prefs_settings {
 110     my $self = shift;
 111     return $self->prepare_extended_user_info || Apache2::Const::OK;
 112 }
 113
 114 sub fetch_user_holds {
 115     my $self = shift;
 116     my $hold_ids = shift;
 117     my $ids_only = shift;
 118     my $flesh = shift;
 119     my $available = shift;
 120     my $limit = shift;
 121     my $offset = shift;
 122
 123     my $e = $self->editor;
 124
 125     my $circ = OpenSRF::AppSession->create('open-ils.circ');
 126
 127     if(!$hold_ids) {
 128
 129         $hold_ids = $circ->request(
 130             'open-ils.circ.holds.id_list.retrieve.authoritative',
 131             $e->authtoken,
 132             $e->requestor->id
 133         )->gather(1);
 134
 135         $hold_ids = [ grep { defined $_ } @$hold_ids[$offset..($offset + $limit - 1)] ] if $limit or $offset;
 136     }
 137
 138
 139     return $hold_ids if $ids_only or @$hold_ids == 0;
 140
 141     my $args = {
 142         suppress_notices => 1,
 143         suppress_transits => 1,
 144         suppress_mvr => 1,
 145         suppress_patron_details => 1,
 146         include_bre => $flesh ? 1 : 0
 147     };
 148
 149     # ----------------------------------------------------------------
 150     # Collect holds in batches of $batch_size for faster retrieval
 151
 152     my $batch_size = 8;
 153     my $batch_idx = 0;
 154     my $mk_req_batch = sub {
 155         my @ses;
 156         my $top_idx = $batch_idx + $batch_size;
 157         while($batch_idx < $top_idx) {
 158             my $hold_id = $hold_ids->[$batch_idx++];
 159             last unless $hold_id;
 160             my $ses = OpenSRF::AppSession->create('open-ils.circ');
 161             my $req = $ses->request(
 162                 'open-ils.circ.hold.details.retrieve',
 163                 $e->authtoken, $hold_id, $args);
 164             push(@ses, {ses => $ses, req => $req});
 165         }
 166         return @ses;
 167     };
 168
 169     my $first = 1;
 170     my(@collected, @holds, @ses);
 171
 172     while(1) {
 173         @ses = $mk_req_batch->() if $first;
 174         last if $first and not @ses;
 175
 176         if(@collected) {
 177             # If desired by the caller, filter any holds that are not available.
 178             if ($available) {
 179                 @collected = grep { $_->{hold}->{status} == 4 } @collected;
 180             }
 181             while(my $blob = pop(@collected)) {
 182                 $blob->{marc_xml} = XML::LibXML->new->parse_string($blob->{hold}->{bre}->marc) if $flesh;
 183                 push(@holds, $blob);
 184             }
 185         }
 186
 187         for my $req_data (@ses) {
 188             push(@collected, {hold => $req_data->{req}->gather(1)});
 189             $req_data->{ses}->kill_me;
 190         }
 191
 192         @ses = $mk_req_batch->();
 193         last unless @collected or @ses;
 194         $first = 0;
 195     }
 196
 197     # put the holds back into the original server sort order
 198     my @sorted;
 199     for my $id (@$hold_ids) {
 200         push @sorted, grep { $_->{hold}->{hold}->id == $id } @holds;
 201     }
 202
 203     return \@sorted;
 204 }
 205
 206 sub handle_hold_update {
 207     my $self = shift;
 208     my $action = shift;
 209     my $e = $self->editor;
 210     my $url;
 211
 212     my @hold_ids = $self->cgi->param('hold_id'); # for non-_all actions
 213     @hold_ids = @{$self->fetch_user_holds(undef, 1)} if $action =~ /_all/;
 214
 215     my $circ = OpenSRF::AppSession->create('open-ils.circ');
 216
 217     if($action =~ /cancel/) {
 218
 219         for my $hold_id (@hold_ids) {
 220             my $resp = $circ->request(
 221                 'open-ils.circ.hold.cancel', $e->authtoken, $hold_id, 6 )->gather(1); # 6 == patron-cancelled-via-opac
 222         }
 223
 224     } elsif ($action =~ /activate|suspend/) {
 225
 226         my $vlist = [];
 227         for my $hold_id (@hold_ids) {
 228             my $vals = {id => $hold_id};
 229
 230             if($action =~ /activate/) {
 231                 $vals->{frozen} = 'f';
 232                 $vals->{thaw_date} = undef;
 233
 234             } elsif($action =~ /suspend/) {
 235                 $vals->{frozen} = 't';
 236                 # $vals->{thaw_date} = TODO;
 237             }
 238             push(@$vlist, $vals);
 239         }
 240
 241         $circ->request('open-ils.circ.hold.update.batch.atomic', $e->authtoken, undef, $vlist)->gather(1);
 242     } elsif ($action eq 'edit') {
 243
 244         my @vals = map {
 245             my $val = {"id" => $_};
 246             $val->{"frozen"} = $self->cgi->param("frozen");
 247             $val->{"pickup_lib"} = $self->cgi->param("pickup_lib");
 248
 249             for my $field (qw/expire_time thaw_date/) {
 250                 # XXX TODO make this support other date formats, not just
 251                 # MM/DD/YYYY.
 252                 next unless $self->cgi->param($field) =~
 253                     m:^(\d{2})/(\d{2})/(\d{4})$:;
 254                 $val->{$field} = "$3-$1-$2";
 255             }
 256             $val;
 257         } @hold_ids;
 258
 259         $circ->request(
 260             'open-ils.circ.hold.update.batch.atomic',
 261             $e->authtoken, undef, \@vals
 262         )->gather(1);   # LFW XXX test for failure
 263         $url = 'https://' . $self->apache->hostname . $self->ctx->{opac_root} . '/myopac/holds';
 264     }
 265
 266     $circ->kill_me;
 267     return defined($url) ? $self->generic_redirect($url) : undef;
 268 }
 269
 270 sub load_myopac_holds {
 271     my $self = shift;
 272     my $e = $self->editor;
 273     my $ctx = $self->ctx;
 274
 275
 276     my $limit = $self->cgi->param('limit') || 0;
 277     my $offset = $self->cgi->param('offset') || 0;
 278     my $action = $self->cgi->param('action') || '';
 279     my $available = int($self->cgi->param('available') || 0);
 280
 281     my $hold_handle_result;
 282     $hold_handle_result = $self->handle_hold_update($action) if $action;
 283
 284     $ctx->{holds} = $self->fetch_user_holds(undef, 0, 1, $available, $limit, $offset);
 285
 286     return defined($hold_handle_result) ? $hold_handle_result : Apache2::Const::OK;
 287 }
 288
 289 sub load_place_hold {
 290     my $self = shift;
 291     my $ctx = $self->ctx;
 292     my $e = $self->editor;
 293     my $cgi = $self->cgi;
 294     $self->ctx->{page} = 'place_hold';
 295
 296     $ctx->{hold_target} = $cgi->param('hold_target');
 297     $ctx->{hold_type} = $cgi->param('hold_type');
 298     $ctx->{default_pickup_lib} = $e->requestor->home_ou; # XXX staff
 299
 300     if ($ctx->{hold_type} eq 'T') {
 301         $ctx->{record} = $e->retrieve_biblio_record_entry($ctx->{hold_target});
 302     } elsif ($ctx->{hold_type} eq 'I') {
 303         my $iss = $e->retrieve_serial_issuance([
 304             $ctx->{hold_target}, {
 305                 "flesh" => 2,
 306                 "flesh_fields" => {
 307                     "siss" => ["subscription"], "ssub" => ["record_entry"]
 308                 }
 309             }
 310         ]);
 311         $ctx->{record} = $iss->subscription->record_entry;
 312     }
 313     # ...
 314
 315     $ctx->{marc_xml} = XML::LibXML->new->parse_string($ctx->{record}->marc);
 316
 317     if(my $pickup_lib = $cgi->param('pickup_lib')) {
 318
 319         my $args = {
 320             patronid => $e->requestor->id,
 321             titleid => $ctx->{hold_target}, # XXX
 322             pickup_lib => $pickup_lib,
 323             depth => 0, # XXX
 324         };
 325
 326         my $allowed = $U->simplereq(
 327             'open-ils.circ',
 328             'open-ils.circ.title_hold.is_possible',
 329             $e->authtoken, $args
 330         );
 331
 332         if($allowed->{success} == 1) {
 333             my $hold = Fieldmapper::action::hold_request->new;
 334
 335             $hold->pickup_lib($pickup_lib);
 336             $hold->requestor($e->requestor->id);
 337             $hold->usr($e->requestor->id); # XXX staff
 338             $hold->target($ctx->{hold_target});
 339             $hold->hold_type($ctx->{hold_type});
 340             # frozen, expired, etc..
 341
 342             my $stat = $U->simplereq(
 343                 'open-ils.circ',
 344                 'open-ils.circ.holds.create',
 345                 $e->authtoken, $hold
 346             );
 347
 348             if($stat and $stat > 0) {
 349                 # if successful, return the user to the requesting page
 350                 $self->apache->log->info("Redirecting back to " . $cgi->param('redirect_to'));
 351                 return $self->generic_redirect;
 352
 353             } else {
 354                 $ctx->{hold_failed} = 1;
 355             }
 356         } else { # hold *check* failed
 357             $ctx->{hold_failed} = 1; # XXX process the events, etc
 358             $ctx->{hold_failed_event} = $allowed->{last_event};
 359         }
 360
 361         # hold permit failed
 362         $logger->info('hold permit result ' . OpenSRF::Utils::JSON->perl2JSON($allowed));
 363     }
 364
 365     return Apache2::Const::OK;
 366 }
 367
 368
 369 sub fetch_user_circs {
 370     my $self = shift;
 371     my $flesh = shift; # flesh bib data, etc.
 372     my $circ_ids = shift;
 373     my $limit = shift;
 374     my $offset = shift;
 375
 376     my $e = $self->editor;
 377
 378     my @circ_ids;
 379
 380     if($circ_ids) {
 381         @circ_ids = @$circ_ids;
 382
 383     } else {
 384
 385         my $circ_data = $U->simplereq(
 386             'open-ils.actor',
 387             'open-ils.actor.user.checked_out',
 388             $e->authtoken,
 389             $e->requestor->id
 390         );
 391
 392         @circ_ids =  ( @{$circ_data->{overdue}}, @{$circ_data->{out}} );
 393
 394         if($limit or $offset) {
 395             @circ_ids = grep { defined $_ } @circ_ids[0..($offset + $limit - 1)];
 396         }
 397     }
 398
 399     return [] unless @circ_ids;
 400
 401     my $cstore = OpenSRF::AppSession->create('open-ils.cstore');
 402
 403     my $qflesh = {
 404         flesh => 3,
 405         flesh_fields => {
 406             circ => ['target_copy'],
 407             acp => ['call_number'],
 408             acn => ['record']
 409         }
 410     };
 411
 412     $e->xact_begin;
 413     my $circs = $e->search_action_circulation(
 414         [{id => \@circ_ids}, ($flesh) ? $qflesh : {}], {substream => 1});
 415
 416     my @circs;
 417     for my $circ (@$circs) {
 418         push(@circs, {
 419             circ => $circ,
 420             marc_xml => ($flesh and $circ->target_copy->call_number->id != -1) ?
 421                 XML::LibXML->new->parse_string($circ->target_copy->call_number->record->marc) :
 422                 undef  # pre-cat copy, use the dummy title/author instead
 423         });
 424     }
 425     $e->xact_rollback;
 426
 427     # make sure the final list is in the correct order
 428     my @sorted_circs;
 429     for my $id (@circ_ids) {
 430         push(
 431             @sorted_circs,
 432             (grep { $_->{circ}->id == $id } @circs)
 433         );
 434     }
 435
 436     return \@sorted_circs;
 437 }
 438
 439
 440 sub handle_circ_renew {
 441     my $self = shift;
 442     my $action = shift;
 443     my $ctx = $self->ctx;
 444
 445     my @renew_ids = $self->cgi->param('circ');
 446
 447     my $circs = $self->fetch_user_circs(0, ($action eq 'renew') ? [@renew_ids] : undef);
 448
 449     # TODO: fire off renewal calls in batches to speed things up
 450     my @responses;
 451     for my $circ (@$circs) {
 452
 453         my $evt = $U->simplereq(
 454             'open-ils.circ',
 455             'open-ils.circ.renew',
 456             $self->editor->authtoken,
 457             {
 458                 patron_id => $self->editor->requestor->id,
 459                 copy_id => $circ->{circ}->target_copy,
 460                 opac_renewal => 1
 461             }
 462         );
 463
 464         # TODO return these, then insert them into the circ data
 465         # blob that is shoved into the template for each circ
 466         # so the template won't have to match them
 467         push(@responses, {copy => $circ->{circ}->target_copy, evt => $evt});
 468     }
 469
 470     return @responses;
 471 }
 472
 473
 474 sub load_myopac_circs {
 475     my $self = shift;
 476     my $e = $self->editor;
 477     my $ctx = $self->ctx;
 478
 479     $ctx->{circs} = [];
 480     my $limit = $self->cgi->param('limit') || 0; # 0 == unlimited
 481     my $offset = $self->cgi->param('offset') || 0;
 482     my $action = $self->cgi->param('action') || '';
 483
 484     # perform the renewal first if necessary
 485     my @results = $self->handle_circ_renew($action) if $action =~ /renew/;
 486
 487     $ctx->{circs} = $self->fetch_user_circs(1, undef, $limit, $offset);
 488
 489     my $success_renewals = 0;
 490     my $failed_renewals = 0;
 491     for my $data (@{$ctx->{circs}}) {
 492         my ($resp) = grep { $_->{copy} == $data->{circ}->target_copy->id } @results;
 493
 494         if($resp) {
 495             my $evt = ref($resp->{evt}) eq 'ARRAY' ? $resp->{evt}->[0] : $resp->{evt};
 496             $data->{renewal_response} = $evt;
 497             $success_renewals++ if $evt->{textcode} eq 'SUCCESS';
 498             $failed_renewals++ if $evt->{textcode} ne 'SUCCESS';
 499         }
 500     }
 501
 502     $ctx->{success_renewals} = $success_renewals;
 503     $ctx->{failed_renewals} = $failed_renewals;
 504
 505     return Apache2::Const::OK;
 506 }
 507
 508 sub load_myopac_circ_history {
 509     my $self = shift;
 510     my $e = $self->editor;
 511     my $ctx = $self->ctx;
 512     my $limit = $self->cgi->param('limit') || 15;
 513     my $offset = $self->cgi->param('offset') || 0;
 514
 515     $ctx->{circ_history_limit} = $limit;
 516     $ctx->{circ_history_offset} = $offset;
 517
 518     my $circs = $e->json_query({
 519         from => ['action.usr_visible_circs', $e->requestor->id],
 520         #limit => $limit || 25,
 521         #offset => $offset || 0,
 522     });
 523
 524     # XXX: order-by in the json_query above appears to do nothing, so in-query
 525     # paging is not reallly an option.  do the sorting/paging here
 526
 527     # sort newest to oldest
 528     $circs = [ sort { $b->{xact_start} cmp $a->{xact_start} } @$circs ];
 529     my @ids = map { $_->{id} } @$circs;
 530
 531     # find the selected page and trim cruft
 532     @ids = @ids[$offset..($offset + $limit - 1)] if $limit;
 533     @ids = grep { defined $_ } @ids;
 534
 535     $ctx->{circs} = $self->fetch_user_circs(1, \@ids);
 536     #$ctx->{circs} = $self->fetch_user_circs(1, [map { $_->{id} } @$circs], $limit, $offset);
 537
 538     return Apache2::Const::OK;
 539 }
 540
 541 # TODO: action.usr_visible_holds does not return cancelled holds.  Should it?
 542 sub load_myopac_hold_history {
 543     my $self = shift;
 544     my $e = $self->editor;
 545     my $ctx = $self->ctx;
 546     my $limit = $self->cgi->param('limit') || 15;
 547     my $offset = $self->cgi->param('offset') || 0;
 548     $ctx->{hold_history_limit} = $limit;
 549     $ctx->{hold_history_offset} = $offset;
 550
 551
 552     my $holds = $e->json_query({
 553         from => ['action.usr_visible_holds', $e->requestor->id],
 554         limit => $limit || 25,
 555         offset => $offset || 0
 556     });
 557
 558     $ctx->{holds} = $self->fetch_user_holds([map { $_->{id} } @$holds], 0, 1, 0, $limit, $offset);
 559
 560     return Apache2::Const::OK;
 561 }
 562
 563 sub load_myopac_payment_form {
 564     my $self = shift;
 565     my $r;
 566
 567     $r = $self->prepare_fines(undef, undef, [$self->cgi->param('xact')]) and return $r;
 568     $r = $self->prepare_extended_user_info and return $r;
 569
 570     return Apache2::Const::OK;
 571 }
 572
 573 # TODO: add other filter options as params/configs/etc.
 574 sub load_myopac_payments {
 575     my $self = shift;
 576     my $limit = $self->cgi->param('limit') || 20;
 577     my $offset = $self->cgi->param('offset') || 0;
 578     my $e = $self->editor;
 579
 580     $self->ctx->{payment_history_limit} = $limit;
 581     $self->ctx->{payment_history_offset} = $offset;
 582
 583     my $args = {};
 584     $args->{limit} = $limit if $limit;
 585     $args->{offset} = $offset if $offset;
 586
 587     $self->ctx->{payments} = $U->simplereq(
 588         'open-ils.actor',
 589         'open-ils.actor.user.payments.retrieve.atomic',
 590         $e->authtoken, $e->requestor->id, $args);
 591
 592     return Apache2::Const::OK;
 593 }
 594
 595 sub load_myopac_pay {
 596     my $self = shift;
 597     my $r;
 598
 599     $r = $self->prepare_fines(undef, undef, [$self->cgi->param('xact')]) and
 600         return $r;
 601
 602     # balance_owed is computed specifically from the fines we're trying
 603     # to pay in this case.
 604     if ($self->ctx->{fines}->{balance_owed} <= 0) {
 605         $self->apache->log->info(
 606             sprintf("Can't pay non-positive balance. xacts selected: (%s)",
 607                 join(", ", map(int, $self->cgi->param("xact"))))
 608         );
 609         return Apache2::Const::HTTP_INTERNAL_SERVER_ERROR;
 610     }
 611
 612     my $cc_args = {"where_process" => 1};
 613
 614     $cc_args->{$_} = $self->cgi->param($_) for (qw/
 615         number cvv2 expire_year expire_month billing_first
 616         billing_last billing_address billing_city billing_state
 617         billing_zip
 618     /);
 619
 620     my $args = {
 621         "cc_args" => $cc_args,
 622         "userid" => $self->ctx->{user}->id,
 623         "payment_type" => "credit_card_payment",
 624         "payments" => $self->prepare_fines_for_payment   # should be safe after self->prepare_fines
 625     };
 626
 627     my $resp = $U->simplereq("open-ils.circ", "open-ils.circ.money.payment",
 628         $self->editor->authtoken, $args, $self->ctx->{user}->last_xact_id
 629     );
 630
 631     $self->ctx->{"payment_response"} = $resp;
 632
 633     unless ($resp->{"textcode"}) {
 634         $self->ctx->{printable_receipt} = $U->simplereq(
 635            "open-ils.circ", "open-ils.circ.money.payment_receipt.print",
 636            $self->editor->authtoken, $resp->{payments}
 637         );
 638     }
 639
 640     return Apache2::Const::OK;
 641 }
 642
 643 sub prepare_fines {
 644     my ($self, $limit, $offset, $id_list) = @_;
 645
 646     # XXX TODO: check for failure after various network calls
 647
 648     # It may be unclear, but this result structure lumps circulation and
 649     # reservation fines together, and keeps grocery fines separate.
 650     $self->ctx->{"fines"} = {
 651         "circulation" => [],
 652         "grocery" => [],
 653         "total_paid" => 0,
 654         "total_owed" => 0,
 655         "balance_owed" => 0
 656     };
 657
 658     my $cstore = OpenSRF::AppSession->create('open-ils.cstore');
 659
 660     # TODO: This should really be a ML call, but the existing calls
 661     # return an excessive amount of data and don't offer streaming
 662
 663     my %paging = ($limit or $offset) ? (limit => $limit, offset => $offset) : ();
 664
 665     my $req = $cstore->request(
 666         'open-ils.cstore.direct.money.open_billable_transaction_summary.search',
 667         {
 668             usr => $self->editor->requestor->id,
 669             balance_owed => {'!=' => 0},
 670             ($id_list && @$id_list ? ("id" => $id_list) : ()),
 671         },
 672         {
 673             flesh => 4,
 674             flesh_fields => {
 675                 mobts => [qw/grocery circulation reservation/],
 676                 bresv => ['target_resource_type'],
 677                 brt => ['record'],
 678                 mg => ['billings'],
 679                 mb => ['btype'],
 680                 circ => ['target_copy'],
 681                 acp => ['call_number'],
 682                 acn => ['record']
 683             },
 684             order_by => { mobts => 'xact_start' },
 685             %paging
 686         }
 687     );
 688
 689     my @total_keys = qw/total_paid total_owed balance_owed/;
 690     $self->ctx->{"fines"}->{@total_keys} = (0, 0, 0);
 691
 692     while(my $resp = $req->recv) {
 693         my $mobts = $resp->content;
 694         my $circ = $mobts->circulation;
 695
 696         my $last_billing;
 697         if($mobts->grocery) {
 698             my @billings = sort { $a->billing_ts cmp $b->billing_ts } @{$mobts->grocery->billings};
 699             $last_billing = pop(@billings);
 700         }
 701
 702         # XXX TODO confirm that the following, and the later division by 100.0
 703         # to get a floating point representation once again, is sufficiently
 704         # "money-safe" math.
 705         $self->ctx->{"fines"}->{$_} += int($mobts->$_ * 100) for (@total_keys);
 706
 707         my $marc_xml = undef;
 708         if ($mobts->xact_type eq 'reservation' and
 709             $mobts->reservation->target_resource_type->record) {
 710             $marc_xml = XML::LibXML->new->parse_string(
 711                 $mobts->reservation->target_resource_type->record->marc
 712             );
 713         } elsif ($mobts->xact_type eq 'circulation' and
 714             $circ->target_copy->call_number->id != -1) {
 715             $marc_xml = XML::LibXML->new->parse_string(
 716                 $circ->target_copy->call_number->record->marc
 717             );
 718         }
 719
 720         push(
 721             @{$self->ctx->{"fines"}->{$mobts->grocery ? "grocery" : "circulation"}},
 722             {
 723                 xact => $mobts,
 724                 last_grocery_billing => $last_billing,
 725                 marc_xml => $marc_xml
 726             }
 727         );
 728     }
 729
 730     $self->ctx->{"fines"}->{$_} /= 100.0 for (@total_keys);
 731     return;
 732 }
 733
 734 sub prepare_fines_for_payment {
 735     # This assumes $self->prepare_fines has already been run
 736     my ($self) = @_;
 737
 738     my @results = ();
 739     if ($self->ctx->{fines}) {
 740         push @results, [$_->{xact}->id, $_->{xact}->balance_owed] foreach (
 741             @{$self->ctx->{fines}->{circulation}},
 742             @{$self->ctx->{fines}->{grocery}}
 743         );
 744     }
 745
 746     return \@results;
 747 }
 748
 749 sub load_myopac_main {
 750     my $self = shift;
 751     my $limit = $self->cgi->param('limit') || 0;
 752     my $offset = $self->cgi->param('offset') || 0;
 753
 754     return $self->prepare_fines($limit, $offset) || Apache2::Const::OK;
 755 }
 756
 757 sub load_myopac_update_email {
 758     my $self = shift;
 759     my $e = $self->editor;
 760     my $ctx = $self->ctx;
 761     my $email = $self->cgi->param('email') || '';
 762
 763     return Apache2::Const::OK
 764         unless $self->cgi->request_method eq 'POST';
 765
 766     unless($email =~ /.+\@.+\..+/) { # TODO better regex?
 767         $ctx->{invalid_email} = $email;
 768         return Apache2::Const::OK;
 769     }
 770
 771     my $stat = $U->simplereq(
 772         'open-ils.actor',
 773         'open-ils.actor.user.email.update',
 774         $e->authtoken, $email);
 775
 776     my $url = $self->apache->unparsed_uri;
 777     $url =~ s/update_email/prefs/;
 778
 779     return $self->generic_redirect($url);
 780 }
 781
 782 sub load_myopac_update_username {
 783     my $self = shift;
 784     my $e = $self->editor;
 785     my $ctx = $self->ctx;
 786     my $username = $self->cgi->param('username') || '';
 787
 788     return Apache2::Const::OK
 789         unless $self->cgi->request_method eq 'POST';
 790
 791     unless($username and $username !~ /\s/) { # any other username restrictions?
 792         $ctx->{invalid_username} = $username;
 793         return Apache2::Const::OK;
 794     }
 795
 796     if($username ne $e->requestor->usrname) {
 797
 798         my $evt = $U->simplereq(
 799             'open-ils.actor',
 800             'open-ils.actor.user.username.update',
 801             $e->authtoken, $username);
 802
 803         if($U->event_equals($evt, 'USERNAME_EXISTS')) {
 804             $ctx->{username_exists} = $username;
 805             return Apache2::Const::OK;
 806         }
 807     }
 808
 809     my $url = $self->apache->unparsed_uri;
 810     $url =~ s/update_username/prefs/;
 811
 812     return $self->generic_redirect($url);
 813 }
 814
 815 sub load_myopac_update_password {
 816     my $self = shift;
 817     my $e = $self->editor;
 818     my $ctx = $self->ctx;
 819
 820     return Apache2::Const::OK
 821         unless $self->cgi->request_method eq 'POST';
 822
 823     my $current_pw = $self->cgi->param('current_pw') || '';
 824     my $new_pw = $self->cgi->param('new_pw') || '';
 825     my $new_pw2 = $self->cgi->param('new_pw2') || '';
 826
 827     unless($new_pw eq $new_pw2) {
 828         $ctx->{password_nomatch} = 1;
 829         return Apache2::Const::OK;
 830     }
 831
 832     my $pw_regex = $ctx->{get_org_setting}->($e->requestor->home_ou, 'global.password_regex');
 833
 834     if($pw_regex and $new_pw !~ /$pw_regex/) {
 835         $ctx->{password_invalid} = 1;
 836         return Apache2::Const::OK;
 837     }
 838
 839     my $evt = $U->simplereq(
 840         'open-ils.actor',
 841         'open-ils.actor.user.password.update',
 842         $e->authtoken, $new_pw, $current_pw);
 843
 844
 845     if($U->event_equals($evt, 'INCORRECT_PASSWORD')) {
 846         $ctx->{password_incorrect} = 1;
 847         return Apache2::Const::OK;
 848     }
 849
 850     my $url = $self->apache->unparsed_uri;
 851     $url =~ s/update_password/prefs/;
 852
 853     return $self->generic_redirect($url);
 854 }
 855
 856 sub load_myopac_bookbags {
 857     my $self = shift;
 858     my $e = $self->editor;
 859     my $ctx = $self->ctx;
 860
 861     $e->xact_begin; # replication...
 862
 863     my $rv = $self->load_mylist;
 864     unless($rv eq Apache2::Const::OK) {
 865         $e->rollback;
 866         return $rv;
 867     }
 868
 869     my $args = {
 870         order_by => {cbreb => 'name'},
 871         limit => $self->cgi->param('limit') || 10,
 872         offset => $self->cgi->param('offset') || 0
 873     };
 874
 875     $ctx->{bookbags} = $e->search_container_biblio_record_entry_bucket([
 876         {owner => $self->editor->requestor->id, btype => 'bookbag'},
 877         # XXX what to do about the possibility of really large bookbags here?
 878         {"flesh" => 1, "flesh_fields" => {"cbreb" => ["items"]}, %$args}
 879     ]);
 880
 881     if(!$ctx->{bookbags}) {
 882         $e->rollback;
 883         return Apache2::Const::HTTP_INTERNAL_SERVER_ERROR;
 884     }
 885
 886     # get unique record IDs
 887     my %rec_ids = ();
 888     foreach my $bbag (@{$ctx->{bookbags}}) {
 889         foreach my $rec_id (
 890             map { $_->target_biblio_record_entry } @{$bbag->items}
 891         ) {
 892             $rec_ids{$rec_id} = 1;
 893         }
 894     }
 895
 896     $ctx->{bookbags_marc_xml} = $self->fetch_marc_xml_by_id([keys %rec_ids]);
 897
 898     $e->rollback;
 899     return Apache2::Const::OK;
 900 }
 901
 902
 903 # actions are create, delete, show, hide, rename, add_rec, delete_item
 904 # CGI is action, list=list_id, add_rec/record=bre_id, del_item=bucket_item_id, name=new_bucket_name
 905 sub load_myopac_bookbag_update {
 906     my ($self, $action, $list_id) = @_;
 907     my $e = $self->editor;
 908     my $cgi = $self->cgi;
 909
 910     $action ||= $cgi->param('action');
 911     $list_id ||= $cgi->param('list');
 912
 913     my @add_rec = $cgi->param('add_rec') || $cgi->param('record');
 914     my @del_item = $cgi->param('del_item');
 915     my $shared = $cgi->param('shared');
 916     my $name = $cgi->param('name');
 917     my $success = 0;
 918     my $list;
 919
 920     if($action eq 'create') {
 921         $list = Fieldmapper::container::biblio_record_entry_bucket->new;
 922         $list->name($name);
 923         $list->owner($e->requestor->id);
 924         $list->btype('bookbag');
 925         $list->pub($shared ? 't' : 'f');
 926         $success = $U->simplereq('open-ils.actor',
 927             'open-ils.actor.container.create', $e->authtoken, 'biblio', $list)
 928
 929     } else {
 930
 931         $list = $e->retrieve_container_biblio_record_entry_bucket($list_id);
 932
 933         return Apache2::Const::HTTP_BAD_REQUEST unless
 934             $list and $list->owner == $e->requestor->id;
 935     }
 936
 937     if($action eq 'delete') {
 938         $success = $U->simplereq('open-ils.actor',
 939             'open-ils.actor.container.full_delete', $e->authtoken, 'biblio', $list_id);
 940
 941     } elsif($action eq 'show') {
 942         unless($U->is_true($list->pub)) {
 943             $list->pub('t');
 944             $success = $U->simplereq('open-ils.actor',
 945                 'open-ils.actor.container.update', $e->authtoken, 'biblio', $list);
 946         }
 947
 948     } elsif($action eq 'hide') {
 949         if($U->is_true($list->pub)) {
 950             $list->pub('f');
 951             $success = $U->simplereq('open-ils.actor',
 952                 'open-ils.actor.container.update', $e->authtoken, 'biblio', $list);
 953         }
 954
 955     } elsif($action eq 'rename') {
 956         if($name) {
 957             $list->name($name);
 958             $success = $U->simplereq('open-ils.actor',
 959                 'open-ils.actor.container.update', $e->authtoken, 'biblio', $list);
 960         }
 961
 962     } elsif($action eq 'add_rec') {
 963         foreach my $add_rec (@add_rec) {
 964             my $item = Fieldmapper::container::biblio_record_entry_bucket_item->new;
 965             $item->bucket($list_id);
 966             $item->target_biblio_record_entry($add_rec);
 967             $success = $U->simplereq('open-ils.actor',
 968                 'open-ils.actor.container.item.create', $e->authtoken, 'biblio', $item);
 969             last unless $success;
 970         }
 971
 972     } elsif($action eq 'del_item') {
 973         foreach (@del_item) {
 974             $success = $U->simplereq(
 975                 'open-ils.actor',
 976                 'open-ils.actor.container.item.delete', $e->authtoken, 'biblio', $_
 977             );
 978             last unless $success;
 979         }
 980     }
 981
 982     return $self->generic_redirect if $success;
 983
 984     $self->ctx->{bucket_action} = $action;
 985     $self->ctx->{bucket_action_failed} = 1;
 986     return Apache2::Const::OK;
 987 }
 988
 989 1