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 load_myopac_receipt_print {
 644     my $self = shift;
 645
 646     $self->ctx->{printable_receipt} = $U->simplereq(
 647        "open-ils.circ", "open-ils.circ.money.payment_receipt.print",
 648        $self->editor->authtoken, [$self->cgi->param("payment")]
 649     );
 650
 651     return Apache2::Const::OK;
 652 }
 653
 654 sub prepare_fines {
 655     my ($self, $limit, $offset, $id_list) = @_;
 656
 657     # XXX TODO: check for failure after various network calls
 658
 659     # It may be unclear, but this result structure lumps circulation and
 660     # reservation fines together, and keeps grocery fines separate.
 661     $self->ctx->{"fines"} = {
 662         "circulation" => [],
 663         "grocery" => [],
 664         "total_paid" => 0,
 665         "total_owed" => 0,
 666         "balance_owed" => 0
 667     };
 668
 669     my $cstore = OpenSRF::AppSession->create('open-ils.cstore');
 670
 671     # TODO: This should really be a ML call, but the existing calls
 672     # return an excessive amount of data and don't offer streaming
 673
 674     my %paging = ($limit or $offset) ? (limit => $limit, offset => $offset) : ();
 675
 676     my $req = $cstore->request(
 677         'open-ils.cstore.direct.money.open_billable_transaction_summary.search',
 678         {
 679             usr => $self->editor->requestor->id,
 680             balance_owed => {'!=' => 0},
 681             ($id_list && @$id_list ? ("id" => $id_list) : ()),
 682         },
 683         {
 684             flesh => 4,
 685             flesh_fields => {
 686                 mobts => [qw/grocery circulation reservation/],
 687                 bresv => ['target_resource_type'],
 688                 brt => ['record'],
 689                 mg => ['billings'],
 690                 mb => ['btype'],
 691                 circ => ['target_copy'],
 692                 acp => ['call_number'],
 693                 acn => ['record']
 694             },
 695             order_by => { mobts => 'xact_start' },
 696             %paging
 697         }
 698     );
 699
 700     my @total_keys = qw/total_paid total_owed balance_owed/;
 701     $self->ctx->{"fines"}->{@total_keys} = (0, 0, 0);
 702
 703     while(my $resp = $req->recv) {
 704         my $mobts = $resp->content;
 705         my $circ = $mobts->circulation;
 706
 707         my $last_billing;
 708         if($mobts->grocery) {
 709             my @billings = sort { $a->billing_ts cmp $b->billing_ts } @{$mobts->grocery->billings};
 710             $last_billing = pop(@billings);
 711         }
 712
 713         # XXX TODO confirm that the following, and the later division by 100.0
 714         # to get a floating point representation once again, is sufficiently
 715         # "money-safe" math.
 716         $self->ctx->{"fines"}->{$_} += int($mobts->$_ * 100) for (@total_keys);
 717
 718         my $marc_xml = undef;
 719         if ($mobts->xact_type eq 'reservation' and
 720             $mobts->reservation->target_resource_type->record) {
 721             $marc_xml = XML::LibXML->new->parse_string(
 722                 $mobts->reservation->target_resource_type->record->marc
 723             );
 724         } elsif ($mobts->xact_type eq 'circulation' and
 725             $circ->target_copy->call_number->id != -1) {
 726             $marc_xml = XML::LibXML->new->parse_string(
 727                 $circ->target_copy->call_number->record->marc
 728             );
 729         }
 730
 731         push(
 732             @{$self->ctx->{"fines"}->{$mobts->grocery ? "grocery" : "circulation"}},
 733             {
 734                 xact => $mobts,
 735                 last_grocery_billing => $last_billing,
 736                 marc_xml => $marc_xml
 737             }
 738         );
 739     }
 740
 741     $self->ctx->{"fines"}->{$_} /= 100.0 for (@total_keys);
 742     return;
 743 }
 744
 745 sub prepare_fines_for_payment {
 746     # This assumes $self->prepare_fines has already been run
 747     my ($self) = @_;
 748
 749     my @results = ();
 750     if ($self->ctx->{fines}) {
 751         push @results, [$_->{xact}->id, $_->{xact}->balance_owed] foreach (
 752             @{$self->ctx->{fines}->{circulation}},
 753             @{$self->ctx->{fines}->{grocery}}
 754         );
 755     }
 756
 757     return \@results;
 758 }
 759
 760 sub load_myopac_main {
 761     my $self = shift;
 762     my $limit = $self->cgi->param('limit') || 0;
 763     my $offset = $self->cgi->param('offset') || 0;
 764
 765     return $self->prepare_fines($limit, $offset) || Apache2::Const::OK;
 766 }
 767
 768 sub load_myopac_update_email {
 769     my $self = shift;
 770     my $e = $self->editor;
 771     my $ctx = $self->ctx;
 772     my $email = $self->cgi->param('email') || '';
 773
 774     return Apache2::Const::OK
 775         unless $self->cgi->request_method eq 'POST';
 776
 777     unless($email =~ /.+\@.+\..+/) { # TODO better regex?
 778         $ctx->{invalid_email} = $email;
 779         return Apache2::Const::OK;
 780     }
 781
 782     my $stat = $U->simplereq(
 783         'open-ils.actor',
 784         'open-ils.actor.user.email.update',
 785         $e->authtoken, $email);
 786
 787     my $url = $self->apache->unparsed_uri;
 788     $url =~ s/update_email/prefs/;
 789
 790     return $self->generic_redirect($url);
 791 }
 792
 793 sub load_myopac_update_username {
 794     my $self = shift;
 795     my $e = $self->editor;
 796     my $ctx = $self->ctx;
 797     my $username = $self->cgi->param('username') || '';
 798
 799     return Apache2::Const::OK
 800         unless $self->cgi->request_method eq 'POST';
 801
 802     unless($username and $username !~ /\s/) { # any other username restrictions?
 803         $ctx->{invalid_username} = $username;
 804         return Apache2::Const::OK;
 805     }
 806
 807     if($username ne $e->requestor->usrname) {
 808
 809         my $evt = $U->simplereq(
 810             'open-ils.actor',
 811             'open-ils.actor.user.username.update',
 812             $e->authtoken, $username);
 813
 814         if($U->event_equals($evt, 'USERNAME_EXISTS')) {
 815             $ctx->{username_exists} = $username;
 816             return Apache2::Const::OK;
 817         }
 818     }
 819
 820     my $url = $self->apache->unparsed_uri;
 821     $url =~ s/update_username/prefs/;
 822
 823     return $self->generic_redirect($url);
 824 }
 825
 826 sub load_myopac_update_password {
 827     my $self = shift;
 828     my $e = $self->editor;
 829     my $ctx = $self->ctx;
 830
 831     return Apache2::Const::OK
 832         unless $self->cgi->request_method eq 'POST';
 833
 834     my $current_pw = $self->cgi->param('current_pw') || '';
 835     my $new_pw = $self->cgi->param('new_pw') || '';
 836     my $new_pw2 = $self->cgi->param('new_pw2') || '';
 837
 838     unless($new_pw eq $new_pw2) {
 839         $ctx->{password_nomatch} = 1;
 840         return Apache2::Const::OK;
 841     }
 842
 843     my $pw_regex = $ctx->{get_org_setting}->($e->requestor->home_ou, 'global.password_regex');
 844
 845     if($pw_regex and $new_pw !~ /$pw_regex/) {
 846         $ctx->{password_invalid} = 1;
 847         return Apache2::Const::OK;
 848     }
 849
 850     my $evt = $U->simplereq(
 851         'open-ils.actor',
 852         'open-ils.actor.user.password.update',
 853         $e->authtoken, $new_pw, $current_pw);
 854
 855
 856     if($U->event_equals($evt, 'INCORRECT_PASSWORD')) {
 857         $ctx->{password_incorrect} = 1;
 858         return Apache2::Const::OK;
 859     }
 860
 861     my $url = $self->apache->unparsed_uri;
 862     $url =~ s/update_password/prefs/;
 863
 864     return $self->generic_redirect($url);
 865 }
 866
 867 sub load_myopac_bookbags {
 868     my $self = shift;
 869     my $e = $self->editor;
 870     my $ctx = $self->ctx;
 871
 872     $e->xact_begin; # replication...
 873
 874     my $rv = $self->load_mylist;
 875     unless($rv eq Apache2::Const::OK) {
 876         $e->rollback;
 877         return $rv;
 878     }
 879
 880     my $args = {
 881         order_by => {cbreb => 'name'},
 882         limit => $self->cgi->param('limit') || 10,
 883         offset => $self->cgi->param('offset') || 0
 884     };
 885
 886     $ctx->{bookbags} = $e->search_container_biblio_record_entry_bucket([
 887         {owner => $self->editor->requestor->id, btype => 'bookbag'},
 888         # XXX what to do about the possibility of really large bookbags here?
 889         {"flesh" => 1, "flesh_fields" => {"cbreb" => ["items"]}, %$args}
 890     ]);
 891
 892     if(!$ctx->{bookbags}) {
 893         $e->rollback;
 894         return Apache2::Const::HTTP_INTERNAL_SERVER_ERROR;
 895     }
 896
 897     # get unique record IDs
 898     my %rec_ids = ();
 899     foreach my $bbag (@{$ctx->{bookbags}}) {
 900         foreach my $rec_id (
 901             map { $_->target_biblio_record_entry } @{$bbag->items}
 902         ) {
 903             $rec_ids{$rec_id} = 1;
 904         }
 905     }
 906
 907     $ctx->{bookbags_marc_xml} = $self->fetch_marc_xml_by_id([keys %rec_ids]);
 908
 909     $e->rollback;
 910     return Apache2::Const::OK;
 911 }
 912
 913
 914 # actions are create, delete, show, hide, rename, add_rec, delete_item
 915 # CGI is action, list=list_id, add_rec/record=bre_id, del_item=bucket_item_id, name=new_bucket_name
 916 sub load_myopac_bookbag_update {
 917     my ($self, $action, $list_id) = @_;
 918     my $e = $self->editor;
 919     my $cgi = $self->cgi;
 920
 921     $action ||= $cgi->param('action');
 922     $list_id ||= $cgi->param('list');
 923
 924     my @add_rec = $cgi->param('add_rec') || $cgi->param('record');
 925     my @del_item = $cgi->param('del_item');
 926     my $shared = $cgi->param('shared');
 927     my $name = $cgi->param('name');
 928     my $success = 0;
 929     my $list;
 930
 931     if($action eq 'create') {
 932         $list = Fieldmapper::container::biblio_record_entry_bucket->new;
 933         $list->name($name);
 934         $list->owner($e->requestor->id);
 935         $list->btype('bookbag');
 936         $list->pub($shared ? 't' : 'f');
 937         $success = $U->simplereq('open-ils.actor',
 938             'open-ils.actor.container.create', $e->authtoken, 'biblio', $list)
 939
 940     } else {
 941
 942         $list = $e->retrieve_container_biblio_record_entry_bucket($list_id);
 943
 944         return Apache2::Const::HTTP_BAD_REQUEST unless
 945             $list and $list->owner == $e->requestor->id;
 946     }
 947
 948     if($action eq 'delete') {
 949         $success = $U->simplereq('open-ils.actor',
 950             'open-ils.actor.container.full_delete', $e->authtoken, 'biblio', $list_id);
 951
 952     } elsif($action eq 'show') {
 953         unless($U->is_true($list->pub)) {
 954             $list->pub('t');
 955             $success = $U->simplereq('open-ils.actor',
 956                 'open-ils.actor.container.update', $e->authtoken, 'biblio', $list);
 957         }
 958
 959     } elsif($action eq 'hide') {
 960         if($U->is_true($list->pub)) {
 961             $list->pub('f');
 962             $success = $U->simplereq('open-ils.actor',
 963                 'open-ils.actor.container.update', $e->authtoken, 'biblio', $list);
 964         }
 965
 966     } elsif($action eq 'rename') {
 967         if($name) {
 968             $list->name($name);
 969             $success = $U->simplereq('open-ils.actor',
 970                 'open-ils.actor.container.update', $e->authtoken, 'biblio', $list);
 971         }
 972
 973     } elsif($action eq 'add_rec') {
 974         foreach my $add_rec (@add_rec) {
 975             my $item = Fieldmapper::container::biblio_record_entry_bucket_item->new;
 976             $item->bucket($list_id);
 977             $item->target_biblio_record_entry($add_rec);
 978             $success = $U->simplereq('open-ils.actor',
 979                 'open-ils.actor.container.item.create', $e->authtoken, 'biblio', $item);
 980             last unless $success;
 981         }
 982
 983     } elsif($action eq 'del_item') {
 984         foreach (@del_item) {
 985             $success = $U->simplereq(
 986                 'open-ils.actor',
 987                 'open-ils.actor.container.item.delete', $e->authtoken, 'biblio', $_
 988             );
 989             last unless $success;
 990         }
 991     }
 992
 993     return $self->generic_redirect if $success;
 994
 995     $self->ctx->{bucket_action} = $action;
 996     $self->ctx->{bucket_action_failed} = 1;
 997     return Apache2::Const::OK;
 998 }
 999
1000 1