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 OpenILS::Event;
   9 use OpenSRF::Utils::JSON;
  10 use OpenSRF::Utils::Cache;
  11 use Digest::MD5 qw(md5_hex);
  12 use Data::Dumper;
  13 $Data::Dumper::Indent = 0;
  14 use DateTime;
  15 use DateTime::Format::ISO8601;
  16 my $U = 'OpenILS::Application::AppUtils';
  17 use List::MoreUtils qw/uniq/;
  18
  19 sub prepare_extended_user_info {
  20     my $self = shift;
  21     my @extra_flesh = @_;
  22     my $e = $self->editor;
  23
  24     # are we already in a transaction?
  25     my $local_xact = !$e->{xact_id};
  26     $e->xact_begin if $local_xact;
  27
  28     # keep the original user object so we can restore
  29     # login-specific data (e.g. workstation)
  30     my $usr = $self->ctx->{user};
  31
  32     $self->ctx->{user} = $self->editor->retrieve_actor_user([
  33         $self->ctx->{user}->id,
  34         {
  35             flesh => 1,
  36             flesh_fields => {
  37                 au => [qw/card home_ou addresses ident_type billing_address waiver_entries/, @extra_flesh]
  38                 # ...
  39             }
  40         }
  41     ]);
  42
  43     $e->rollback if $local_xact;
  44
  45     $self->ctx->{user}->wsid($usr->wsid);
  46     $self->ctx->{user}->ws_ou($usr->ws_ou);
  47
  48     # discard replaced (negative-id) addresses.
  49     $self->ctx->{user}->addresses([
  50         grep {$_->id > 0} @{$self->ctx->{user}->addresses} ]);
  51
  52     return Apache2::Const::HTTP_INTERNAL_SERVER_ERROR
  53         unless $self->ctx->{user};
  54
  55     return;
  56 }
  57
  58 # Given an event returned by a failed attempt to create a hold, do we have
  59 # permission to override?  XXX Should the permission check be scoped to a
  60 # given org_unit context?
  61 sub test_could_override {
  62     my ($self, $event) = @_;
  63
  64     return 0 unless $event;
  65     return 1 if $self->editor->allowed($event->{textcode} . ".override");
  66     return 1 if $event->{"fail_part"} and
  67         $self->editor->allowed($event->{"fail_part"} . ".override");
  68     return 0;
  69 }
  70
  71 # Find out whether we care that local copies are available
  72 sub local_avail_concern {
  73     my ($self, $hold_target, $hold_type, $pickup_lib) = @_;
  74
  75     my $would_block = $self->ctx->{get_org_setting}->
  76         ($pickup_lib, "circ.holds.hold_has_copy_at.block");
  77     my $would_alert = (
  78         $self->ctx->{get_org_setting}->
  79             ($pickup_lib, "circ.holds.hold_has_copy_at.alert") and
  80                 not $self->cgi->param("override")
  81     ) unless $would_block;
  82
  83     if ($would_block or $would_alert) {
  84         my $args = {
  85             "hold_target" => $hold_target,
  86             "hold_type" => $hold_type,
  87             "org_unit" => $pickup_lib
  88         };
  89         my $local_avail = $U->simplereq(
  90             "open-ils.circ",
  91             "open-ils.circ.hold.has_copy_at", $self->editor->authtoken, $args
  92         );
  93         $logger->info(
  94             "copy availability information for " . Dumper($args) .
  95             " is " . Dumper($local_avail)
  96         );
  97         if (%$local_avail) { # if hash not empty
  98             $self->ctx->{hold_copy_available} = $local_avail;
  99             return ($would_block, $would_alert);
 100         }
 101     }
 102
 103     return (0, 0);
 104 }
 105
 106 # context additions:
 107 #   user : au object, fleshed
 108 sub load_myopac_prefs {
 109     my $self = shift;
 110     my $cgi = $self->cgi;
 111     my $e = $self->editor;
 112     my $pending_addr = $cgi->param('pending_addr');
 113     my $replace_addr = $cgi->param('replace_addr');
 114     my $delete_pending = $cgi->param('delete_pending');
 115
 116     $self->prepare_extended_user_info;
 117     my $user = $self->ctx->{user};
 118
 119     my $lock_usernames = $self->ctx->{get_org_setting}->($e->requestor->home_ou, 'opac.lock_usernames');
 120     if(defined($lock_usernames) and $lock_usernames == 1) {
 121         # Policy says no username changes
 122         $self->ctx->{username_change_disallowed} = 1;
 123     } else {
 124         my $username_unlimit = $self->ctx->{get_org_setting}->($e->requestor->home_ou, 'opac.unlimit_usernames');
 125         if(!$username_unlimit) {
 126             my $regex_check = $self->ctx->{get_org_setting}->($e->requestor->home_ou, 'opac.barcode_regex');
 127             if(!$regex_check) {
 128                 # Default is "starts with a number"
 129                 $regex_check = '^\d+';
 130             }
 131             # You already have a username?
 132             if($regex_check and $self->ctx->{user}->usrname !~ /$regex_check/) {
 133                 $self->ctx->{username_change_disallowed} = 1;
 134             }
 135         }
 136     }
 137
 138     return Apache2::Const::OK unless
 139         $pending_addr or $replace_addr or $delete_pending;
 140
 141     my @form_fields = qw/address_type street1 street2 city county state country post_code/;
 142
 143     my $paddr;
 144     if( $pending_addr ) { # update an existing pending address
 145
 146         ($paddr) = grep { $_->id == $pending_addr } @{$user->addresses};
 147         return Apache2::Const::HTTP_BAD_REQUEST unless $paddr;
 148         $paddr->$_( $cgi->param($_) ) for @form_fields;
 149
 150     } elsif( $replace_addr ) { # create a new pending address for 'replace_addr'
 151
 152         $paddr = Fieldmapper::actor::user_address->new;
 153         $paddr->isnew(1);
 154         $paddr->usr($user->id);
 155         $paddr->pending('t');
 156         $paddr->replaces($replace_addr);
 157         $paddr->$_( $cgi->param($_) ) for @form_fields;
 158
 159     } elsif( $delete_pending ) {
 160         $paddr = $e->retrieve_actor_user_address($delete_pending);
 161         return Apache2::Const::HTTP_BAD_REQUEST unless
 162             $paddr and $paddr->usr == $user->id and $U->is_true($paddr->pending);
 163         $paddr->isdeleted(1);
 164     }
 165
 166     my $resp = $U->simplereq(
 167         'open-ils.actor',
 168         'open-ils.actor.user.address.pending.cud',
 169         $e->authtoken, $paddr);
 170
 171     if( $U->event_code($resp) ) {
 172         $logger->error("Error updating pending address: $resp");
 173         return Apache2::Const::HTTP_INTERNAL_SERVER_ERROR;
 174     }
 175
 176     # in light of these changes, re-fetch latest data
 177     $e->xact_begin;
 178     $self->prepare_extended_user_info;
 179     $e->rollback;
 180
 181     return Apache2::Const::OK;
 182 }
 183
 184 sub load_myopac_prefs_notify {
 185     my $self = shift;
 186     my $e = $self->editor;
 187
 188
 189     my $stat = $self->_load_user_with_prefs;
 190     return $stat if $stat;
 191
 192     my $user_prefs = $self->fetch_optin_prefs;
 193     $user_prefs = $self->update_optin_prefs($user_prefs)
 194         if $self->cgi->request_method eq 'POST';
 195
 196     $self->ctx->{opt_in_settings} = $user_prefs;
 197
 198     return Apache2::Const::OK
 199         unless $self->cgi->request_method eq 'POST';
 200
 201     my %settings;
 202     my $set_map = $self->ctx->{user_setting_map};
 203
 204     foreach my $key (qw/
 205         opac.default_phone
 206         opac.default_sms_notify
 207     /) {
 208         my $val = $self->cgi->param($key);
 209         $settings{$key}= $val unless $$set_map{$key} eq $val;
 210     }
 211
 212     my $key = 'opac.default_sms_carrier';
 213     my $val = $self->cgi->param('sms_carrier');
 214     $settings{$key}= $val unless $$set_map{$key} eq $val;
 215
 216     $key = 'opac.hold_notify';
 217     my @notify_methods = ();
 218     if ($self->cgi->param($key . ".email") eq 'on') {
 219         push @notify_methods, "email";
 220     }
 221     if ($self->cgi->param($key . ".phone") eq 'on') {
 222         push @notify_methods, "phone";
 223     }
 224     if ($self->cgi->param($key . ".sms") eq 'on') {
 225         push @notify_methods, "sms";
 226     }
 227     $val = join("|",@notify_methods);
 228     $settings{$key}= $val unless $$set_map{$key} eq $val;
 229
 230     # Send the modified settings off to be saved
 231     $U->simplereq(
 232         'open-ils.actor',
 233         'open-ils.actor.patron.settings.update',
 234         $self->editor->authtoken, undef, \%settings);
 235
 236     # re-fetch user prefs
 237     $self->ctx->{updated_user_settings} = \%settings;
 238     return $self->_load_user_with_prefs || Apache2::Const::OK;
 239 }
 240
 241 sub fetch_optin_prefs {
 242     my $self = shift;
 243     my $e = $self->editor;
 244
 245     # fetch all of the opt-in settings the user has access to
 246     # XXX: user's should in theory have options to opt-in to notices
 247     # for remote locations, but that opens the door for a large
 248     # set of generally un-used opt-ins.. needs discussion
 249     my $opt_ins =  $U->simplereq(
 250         'open-ils.actor',
 251         'open-ils.actor.event_def.opt_in.settings.atomic',
 252         $e->authtoken, $e->requestor->home_ou);
 253
 254     # some opt-ins are staff-only
 255     $opt_ins = [ grep { $U->is_true($_->opac_visible) } @$opt_ins ];
 256
 257     # fetch user setting values for each of the opt-in settings
 258     my $user_set = $U->simplereq(
 259         'open-ils.actor',
 260         'open-ils.actor.patron.settings.retrieve',
 261         $e->authtoken,
 262         $e->requestor->id,
 263         [map {$_->name} @$opt_ins]
 264     );
 265
 266     return [map { {cust => $_, value => $user_set->{$_->name} } } @$opt_ins];
 267 }
 268
 269 sub load_myopac_messages {
 270     my $self = shift;
 271     my $e = $self->editor;
 272     my $ctx = $self->ctx;
 273     my $cgi = $self->cgi;
 274
 275     my $limit  = $cgi->param('limit') || 20;
 276     my $offset = $cgi->param('offset') || 0;
 277
 278     my $pcrud = OpenSRF::AppSession->create('open-ils.pcrud');
 279     $pcrud->connect();
 280
 281     my $action = $cgi->param('action') || '';
 282     if ($action) {
 283         my ($changed, $failed) = $self->_handle_message_action($pcrud, $action);
 284         if ($changed > 0 || $failed > 0) {
 285             $ctx->{message_update_action} = $action;
 286             $ctx->{message_update_changed} = $changed;
 287             $ctx->{message_update_failed} = $failed;
 288             $self->update_dashboard_stats();
 289         }
 290     }
 291
 292     my $single = $cgi->param('single') || 0;
 293     my $id = $cgi->param('message_id');
 294
 295     my $messages;
 296     my $fetch_all = 1;
 297     if (!$action && $single && $id) {
 298         $messages = $self->_fetch_and_mark_read_single_message($pcrud, $id);
 299         if (scalar(@$messages) == 1) {
 300             $ctx->{display_single_message} = 1;
 301             $ctx->{patron_message_id} = $id;
 302             $fetch_all = 0;
 303         }
 304     }
 305
 306     if ($fetch_all) {
 307         # fetch all the messages
 308         ($ctx->{patron_messages_count}, $messages) =
 309             $self->_fetch_user_messages($pcrud, $offset, $limit);
 310     }
 311
 312     $pcrud->kill_me;
 313
 314     foreach my $aum (@$messages) {
 315
 316         push @{ $ctx->{patron_messages} }, {
 317             id          => $aum->id,
 318             title       => $aum->title,
 319             message     => $aum->message,
 320             create_date => $aum->create_date,
 321             is_read     => defined($aum->read_date) ? 1 : 0,
 322             library     => $aum->sending_lib->name,
 323         };
 324     }
 325
 326     $ctx->{patron_messages_limit} = $limit;
 327     $ctx->{patron_messages_offset} = $offset;
 328
 329     return Apache2::Const::OK;
 330 }
 331
 332 sub _fetch_and_mark_read_single_message {
 333     my $self = shift;
 334     my $pcrud = shift;
 335     my $id = shift;
 336
 337     $pcrud->request('open-ils.pcrud.transaction.begin', $self->editor->authtoken)->gather(1);
 338     my $messages = $pcrud->request(
 339         'open-ils.pcrud.search.auml.atomic',
 340         $self->editor->authtoken,
 341         {
 342             usr     => $self->editor->requestor->id,
 343             deleted => 'f',
 344             id      => $id,
 345         },
 346         {
 347             flesh => 1,
 348             flesh_fields => { auml => ['sending_lib'] },
 349         }
 350     )->gather(1);
 351     if (@$messages) {
 352         $messages->[0]->read_date('now');
 353         $pcrud->request(
 354             'open-ils.pcrud.update.auml',
 355             $self->editor->authtoken,
 356             $messages->[0]
 357         )->gather(1);
 358     }
 359     $pcrud->request('open-ils.pcrud.transaction.commit', $self->editor->authtoken)->gather(1);
 360
 361     $self->update_dashboard_stats();
 362
 363     return $messages;
 364 }
 365
 366 sub _fetch_user_messages {
 367     my $self = shift;
 368     my $pcrud = shift;
 369     my $offset = shift;
 370     my $limit = shift;
 371
 372     my %paging = ($limit or $offset) ? (limit => $limit, offset => $offset) : ();
 373
 374     my $all_messages = $pcrud->request(
 375         'open-ils.pcrud.id_list.auml.atomic',
 376         $self->editor->authtoken,
 377         {
 378             usr     => $self->editor->requestor->id,
 379             deleted => 'f'
 380         },
 381         {}
 382     )->gather(1);
 383
 384     my $messages = $pcrud->request(
 385         'open-ils.pcrud.search.auml.atomic',
 386         $self->editor->authtoken,
 387         {
 388             usr     => $self->editor->requestor->id,
 389             deleted => 'f'
 390         },
 391         {
 392             flesh => 1,
 393             flesh_fields => { auml => ['sending_lib'] },
 394             order_by => { auml => 'create_date DESC' },
 395             %paging
 396         }
 397     )->gather(1);
 398
 399     return scalar(@$all_messages), $messages;
 400 }
 401
 402 sub _handle_message_action {
 403     my $self = shift;
 404     my $pcrud = shift;
 405     my $action = shift;
 406     my $cgi = $self->cgi;
 407
 408     my @ids = $cgi->param('message_id');
 409     return (0, 0) unless @ids;
 410
 411     my $changed = 0;
 412     my $failed = 0;
 413     $pcrud->request('open-ils.pcrud.transaction.begin', $self->editor->authtoken)->gather(1);
 414     for my $id (@ids) {
 415         my $aum = $pcrud->request(
 416             'open-ils.pcrud.retrieve.auml',
 417             $self->editor->authtoken,
 418             $id
 419         )->gather(1);
 420         next unless $aum;
 421         if      ($action eq 'mark_read') {
 422             $aum->read_date('now');
 423         } elsif ($action eq 'mark_unread') {
 424             $aum->clear_read_date();
 425         } elsif ($action eq 'mark_deleted') {
 426             $aum->deleted('t');
 427         }
 428         $pcrud->request('open-ils.pcrud.update.auml', $self->editor->authtoken, $aum)->gather(1) ?
 429             $changed++ :
 430             $failed++;
 431     }
 432     if ($failed) {
 433         $pcrud->request('open-ils.pcrud.transaction.rollback', $self->editor->authtoken)->gather(1);
 434         $changed = 0;
 435         $failed = scalar(@ids);
 436     } else {
 437         $pcrud->request('open-ils.pcrud.transaction.commit', $self->editor->authtoken)->gather(1);
 438     }
 439     return ($changed, $failed);
 440 }
 441
 442 sub _load_lists_and_settings {
 443     my $self = shift;
 444     my $e = $self->editor;
 445     my $stat = $self->_load_user_with_prefs;
 446     unless ($stat) {
 447         my $exclude = 0;
 448         my $setting_map = $self->ctx->{user_setting_map};
 449         $exclude = $$setting_map{'opac.default_list'} if ($$setting_map{'opac.default_list'});
 450         $self->ctx->{bookbags} = $e->search_container_biblio_record_entry_bucket(
 451             [
 452                 {owner => $self->ctx->{user}->id, btype => 'bookbag', id => {'<>' => $exclude}}, {
 453                     order_by => {cbreb => 'name'},
 454                     limit => $self->cgi->param('limit') || 10,
 455                     offset => $self->cgi->param('offset') || 0
 456                 }
 457             ]
 458         );
 459         # We also want a total count of the user's bookbags.
 460         my $q = {
 461             'select' => { 'cbreb' => [ { 'column' => 'id', 'transform' => 'count', 'aggregate' => 'true', 'alias' => 'count' } ] },
 462             'from' => 'cbreb',
 463             'where' => { 'btype' => 'bookbag', 'owner' => $self->ctx->{user}->id }
 464         };
 465         my $r = $e->json_query($q);
 466         $self->ctx->{bookbag_count} = $r->[0]->{'count'};
 467         # Someone has requested that we use the default list's name
 468         # rather than "Default List."
 469         if ($exclude) {
 470             $q = {
 471                 'select' => {'cbreb' => ['name']},
 472                 'from' => 'cbreb',
 473                 'where' => {'id' => $exclude}
 474             };
 475             $r = $e->json_query($q);
 476             $self->ctx->{default_bookbag} = $r->[0]->{'name'};
 477         }
 478     } else {
 479         return $stat;
 480     }
 481     return undef;
 482 }
 483
 484 sub update_optin_prefs {
 485     my $self = shift;
 486     my $user_prefs = shift;
 487     my $e = $self->editor;
 488     my @settings = $self->cgi->param('setting');
 489     my %newsets;
 490
 491     # apply now-true settings
 492     for my $applied (@settings) {
 493         # see if setting is already applied to this user
 494         next if grep { $_->{cust}->name eq $applied and $_->{value} } @$user_prefs;
 495         $newsets{$applied} = OpenSRF::Utils::JSON->true;
 496     }
 497
 498     # remove now-false settings
 499     for my $pref (grep { $_->{value} } @$user_prefs) {
 500         $newsets{$pref->{cust}->name} = undef
 501             unless grep { $_ eq $pref->{cust}->name } @settings;
 502     }
 503
 504     $U->simplereq(
 505         'open-ils.actor',
 506         'open-ils.actor.patron.settings.update',
 507         $e->authtoken, $e->requestor->id, \%newsets);
 508
 509     # update the local prefs to match reality
 510     for my $pref (@$user_prefs) {
 511         $pref->{value} = $newsets{$pref->{cust}->name}
 512             if exists $newsets{$pref->{cust}->name};
 513     }
 514
 515     return $user_prefs;
 516 }
 517
 518 sub _load_user_with_prefs {
 519     my $self = shift;
 520     my $stat = $self->prepare_extended_user_info('settings');
 521     return $stat if $stat; # not-OK
 522
 523     $self->ctx->{user_setting_map} = {
 524         map { $_->name => OpenSRF::Utils::JSON->JSON2perl($_->value) }
 525             @{$self->ctx->{user}->settings}
 526     };
 527
 528     return undef;
 529 }
 530
 531 sub _get_bookbag_sort_params {
 532     my ($self, $param_name) = @_;
 533
 534     # The interface that feeds this cgi parameter will provide a single
 535     # argument for a QP sort filter, and potentially a modifier after a period.
 536     # In practice this means the "sort" parameter will be something like
 537     # "titlesort" or "authorsort.descending".
 538     my $sorter = $self->cgi->param($param_name) || "";
 539     my $modifier;
 540     if ($sorter) {
 541         $sorter =~ s/^(.*?)\.(.*)/$1/;
 542         $modifier = $2 || undef;
 543     }
 544
 545     return ($sorter, $modifier);
 546 }
 547
 548 sub _prepare_bookbag_container_query {
 549     my ($self, $container_id, $sorter, $modifier) = @_;
 550
 551     return sprintf(
 552         "container(bre,bookbag,%d,%s)%s%s",
 553         $container_id, $self->editor->authtoken,
 554         ($sorter ? " sort($sorter)" : ""),
 555         ($modifier ? "#$modifier" : "")
 556     );
 557 }
 558
 559 sub _prepare_anonlist_sorting_query {
 560     my ($self, $list, $sorter, $modifier) = @_;
 561
 562     return sprintf(
 563         "record_list(%s)%s%s",
 564         join(",", @$list),
 565         ($sorter ? " sort($sorter)" : ""),
 566         ($modifier ? "#$modifier" : "")
 567     );
 568 }
 569
 570
 571 sub load_myopac_prefs_settings {
 572     my $self = shift;
 573
 574     my @user_prefs = qw/
 575         opac.hits_per_page
 576         opac.default_search_location
 577         opac.default_pickup_location
 578         opac.temporary_list_no_warn
 579     /;
 580
 581     my $stat = $self->_load_user_with_prefs;
 582     return $stat if $stat;
 583
 584     # if behind-desk holds are supported and the user
 585     # setting which controls the value is opac-visible,
 586     # add the setting to the list of settings to manage.
 587     # note: this logic may need to be changed later to
 588     # check whether behind-the-desk holds are supported
 589     # anywhere the patron may select as a pickup lib.
 590     my $e = $self->editor;
 591     my $bdous = $self->ctx->{get_org_setting}->(
 592         $e->requestor->home_ou,
 593         'circ.holds.behind_desk_pickup_supported');
 594
 595     if ($bdous) {
 596         my $setting =
 597             $e->retrieve_config_usr_setting_type(
 598                 'circ.holds_behind_desk');
 599
 600         if ($U->is_true($setting->opac_visible)) {
 601             push(@user_prefs, 'circ.holds_behind_desk');
 602             $self->ctx->{behind_desk_supported} = 1;
 603         }
 604     }
 605
 606     my $use_privacy_waiver = $self->ctx->{get_org_setting}->(
 607         $e->requestor->home_ou, 'circ.privacy_waiver');
 608
 609     return Apache2::Const::OK
 610         unless $self->cgi->request_method eq 'POST';
 611
 612     # some setting values from the form don't match the
 613     # required value/format for the db, so they have to be
 614     # individually translated.
 615
 616     my %settings;
 617     my $set_map = $self->ctx->{user_setting_map};
 618
 619     foreach my $key (@user_prefs) {
 620         my $val = $self->cgi->param($key);
 621         $settings{$key}= $val unless $$set_map{$key} eq $val;
 622     }
 623
 624     # Used by the settings update form when warning on history delete.
 625     my $clear_circ_history = 0;
 626     my $clear_hold_history = 0;
 627
 628     # true if we need to show the warning on next page load.
 629     my $hist_warning_needed = 0;
 630     my $hist_clear_confirmed = $self->cgi->param('history_delete_confirmed');
 631
 632     my $now = DateTime->now->strftime('%F');
 633     foreach my $key (
 634             qw/history.circ.retention_start history.hold.retention_start/) {
 635
 636         my $val = $self->cgi->param($key);
 637         if($val and $val eq 'on') {
 638             # Set the start time to 'now' unless a start time already exists for the user
 639             $settings{$key} = $now unless $$set_map{$key};
 640
 641         } else {
 642
 643             next unless $$set_map{$key}; # nothing to do
 644
 645             $clear_circ_history = 1 if $key =~ /circ/;
 646             $clear_hold_history = 1 if $key =~ /hold/;
 647
 648             if (!$hist_clear_confirmed) {
 649                 # when clearing circ history, only warn if history data exists.
 650
 651                 if ($clear_circ_history) {
 652
 653                     if ($self->fetch_user_circ_history(0, 1)->[0]) {
 654                         $hist_warning_needed = 1;
 655                         next; # no history updates while confirmation pending
 656                     }
 657
 658                 } else {
 659
 660                     my $one_hold = $e->json_query({
 661                         select => {
 662                             au => [{
 663                                 column => 'id',
 664                                 transform => 'action.usr_visible_holds',
 665                                 result_field => 'id'
 666                             }]
 667                         },
 668                         from => 'au',
 669                         where => {id => $e->requestor->id},
 670                         limit => 1
 671                     })->[0];
 672
 673                     if ($one_hold) {
 674                         $hist_warning_needed = 1;
 675                         next; # no history updates while confirmation pending
 676                     }
 677                 }
 678             }
 679
 680             $settings{$key} = undef;
 681
 682             if ($key eq 'history.circ.retention_start') {
 683                 # delete existing circulation history data.
 684                 $U->simplereq(
 685                     'open-ils.actor',
 686                     'open-ils.actor.history.circ.clear',
 687                     $self->editor->authtoken);
 688             }
 689         }
 690     }
 691
 692     # Warn patrons before clearing circ/hold history
 693     if ($hist_warning_needed) {
 694         $self->ctx->{clear_circ_history} = $clear_circ_history;
 695         $self->ctx->{clear_hold_history} = $clear_hold_history;
 696         $self->ctx->{confirm_history_delete} = 1;
 697     }
 698
 699     # Send the modified settings off to be saved
 700     $U->simplereq(
 701         'open-ils.actor',
 702         'open-ils.actor.patron.settings.update',
 703         $self->editor->authtoken, undef, \%settings);
 704
 705     $self->ctx->{updated_user_settings} = \%settings;
 706
 707     if ($use_privacy_waiver) {
 708         my %waiver;
 709         my $saved_entries = ();
 710         my @waiver_types = qw/place_holds pickup_holds checkout_items view_history/;
 711
 712         # initialize our waiver hash with waiver IDs from hidden input
 713         # (this ensures that we capture entries with no checked boxes)
 714         foreach my $waiver_row_id ($self->cgi->param("waiver_id")) {
 715             $waiver{$waiver_row_id} = {};
 716         }
 717
 718         # process our waiver checkboxes into a hash, keyed by waiver ID
 719         # (a new entry, if any, has id = 'new')
 720         foreach my $waiver_type (@waiver_types) {
 721             if ($self->cgi->param("waiver_$waiver_type")) {
 722                 foreach my $waiver_id ($self->cgi->param("waiver_$waiver_type")) {
 723                     # ensure this waiver exists in our hash
 724                     $waiver{$waiver_id} = {} if !$waiver{$waiver_id};
 725                     $waiver{$waiver_id}->{$waiver_type} = 1;
 726                 }
 727             }
 728         }
 729
 730         foreach my $k (keys %waiver) {
 731             my $w = $waiver{$k};
 732             # get name from textbox
 733             $w->{name} = $self->cgi->param("waiver_name_$k");
 734             $w->{id} = $k;
 735             foreach (@waiver_types) {
 736                 $w->{$_} = 0 unless ($w->{$_});
 737             }
 738             push @$saved_entries, $w;
 739         }
 740
 741         # update patron privacy waiver entries
 742         $U->simplereq(
 743             'open-ils.actor',
 744             'open-ils.actor.patron.privacy_waiver.update',
 745             $self->editor->authtoken, undef, $saved_entries);
 746
 747         $self->ctx->{updated_waiver_entries} = $saved_entries;
 748     }
 749
 750     # re-fetch user prefs
 751     return $self->_load_user_with_prefs || Apache2::Const::OK;
 752 }
 753
 754 sub load_myopac_prefs_my_lists {
 755     my $self = shift;
 756
 757     my @user_prefs = qw/
 758         opac.lists_per_page
 759         opac.list_items_per_page
 760     /;
 761
 762     my $stat = $self->_load_user_with_prefs;
 763     return $stat if $stat;
 764
 765     return Apache2::Const::OK
 766         unless $self->cgi->request_method eq 'POST';
 767
 768     my %settings;
 769     my $set_map = $self->ctx->{user_setting_map};
 770
 771     foreach my $key (@user_prefs) {
 772         my $val = $self->cgi->param($key);
 773         $settings{$key}= $val unless $$set_map{$key} eq $val;
 774     }
 775
 776     if (keys %settings) { # we found a different setting value
 777         # Send the modified settings off to be saved
 778         $U->simplereq(
 779             'open-ils.actor',
 780             'open-ils.actor.patron.settings.update',
 781             $self->editor->authtoken, undef, \%settings);
 782
 783         # re-fetch user prefs
 784         $self->ctx->{updated_user_settings} = \%settings;
 785         $stat = $self->_load_user_with_prefs;
 786     }
 787
 788     return $stat || Apache2::Const::OK;
 789 }
 790
 791 sub fetch_user_holds {
 792     my $self = shift;
 793     my $hold_ids = shift;
 794     my $ids_only = shift;
 795     my $flesh = shift;
 796     my $available = shift;
 797     my $limit = shift;
 798     my $offset = shift;
 799
 800     my $e = $self->editor;
 801     my $all_ids; # to be used below.
 802
 803     if(!$hold_ids) {
 804         my $circ = OpenSRF::AppSession->create('open-ils.circ');
 805
 806         $hold_ids = $circ->request(
 807             'open-ils.circ.holds.id_list.retrieve.authoritative',
 808             $e->authtoken,
 809             $e->requestor->id,
 810             $available
 811         )->gather(1);
 812         $circ->kill_me;
 813
 814         $all_ids = $hold_ids;
 815         $hold_ids = [ grep { defined $_ } @$hold_ids[$offset..($offset + $limit - 1)] ] if $limit or $offset;
 816
 817     } else {
 818         $all_ids = $hold_ids;
 819     }
 820
 821     return { ids => $hold_ids, all_ids => $all_ids } if $ids_only or @$hold_ids == 0;
 822
 823     my $args = {
 824         suppress_notices => 1,
 825         suppress_transits => 1,
 826         suppress_mvr => 1,
 827         suppress_patron_details => 1
 828     };
 829
 830     # ----------------------------------------------------------------
 831     # Collect holds in batches of $batch_size for faster retrieval
 832
 833     my $batch_size = 8;
 834     my $batch_idx = 0;
 835     my $mk_req_batch = sub {
 836         my @ses;
 837         my $top_idx = $batch_idx + $batch_size;
 838         while($batch_idx < $top_idx) {
 839             my $hold_id = $hold_ids->[$batch_idx++];
 840             last unless $hold_id;
 841             my $ses = OpenSRF::AppSession->create('open-ils.circ');
 842             my $req = $ses->request(
 843                 'open-ils.circ.hold.details.retrieve',
 844                 $e->authtoken, $hold_id, $args);
 845             push(@ses, {ses => $ses, req => $req});
 846         }
 847         return @ses;
 848     };
 849
 850     my $first = 1;
 851     my(@collected, @holds, @ses);
 852
 853     while(1) {
 854         @ses = $mk_req_batch->() if $first;
 855         last if $first and not @ses;
 856
 857         if(@collected) {
 858             while(my $blob = pop(@collected)) {
 859                 my @data;
 860
 861                 # in the holds edit UI, we need to know what formats and
 862                 # languages the user selected for this hold, plus what
 863                 # formats/langs are available on the MR as a whole.
 864                 if ($blob->{hold}{hold}->hold_type eq 'M') {
 865                     my $hold = $blob->{hold}->{hold};
 866
 867                     # for MR, fetch the combined MR unapi blob
 868                     (undef, @data) = $self->get_records_and_facets(
 869                         [$hold->target], undef, {flesh => '{mra}', metarecord => 1});
 870
 871                     my $filter_org = $U->org_unit_ancestor_at_depth(
 872                         $hold->selection_ou,
 873                         $hold->selection_depth);
 874
 875                     my $filter_data = $U->simplereq(
 876                         'open-ils.circ',
 877                         'open-ils.circ.mmr.holds.filters.authoritative.atomic',
 878                         $hold->target, $filter_org, [$hold->id]
 879                     );
 880
 881                     $blob->{metarecord_filters} =
 882                         $filter_data->[0]->{metarecord};
 883                     $blob->{metarecord_selected_filters} =
 884                         $filter_data->[1]->{hold};
 885                 } else {
 886
 887                     (undef, @data) = $self->get_records_and_facets(
 888                         [$blob->{hold}->{bre_id}], undef, {flesh => '{mra}'}
 889                     );
 890                 }
 891
 892                 $blob->{marc_xml} = $data[0]->{marc_xml};
 893                 push(@holds, $blob);
 894             }
 895         }
 896
 897         for my $req_data (@ses) {
 898             push(@collected, {hold => $req_data->{req}->gather(1)});
 899             $req_data->{ses}->kill_me;
 900         }
 901
 902         @ses = $mk_req_batch->();
 903         last unless @collected or @ses;
 904         $first = 0;
 905     }
 906
 907     # put the holds back into the original server sort order
 908     my @sorted;
 909     for my $id (@$hold_ids) {
 910         push @sorted, grep { $_->{hold}->{hold}->id == $id } @holds;
 911     }
 912
 913     return { holds => \@sorted, ids => $hold_ids, all_ids => $all_ids };
 914 }
 915
 916 sub handle_hold_update {
 917     my $self = shift;
 918     my $action = shift;
 919     my $hold_ids = shift;
 920     my $e = $self->editor;
 921     my $url;
 922
 923     my @hold_ids = ($hold_ids) ? @$hold_ids : $self->cgi->param('hold_id'); # for non-_all actions
 924     @hold_ids = @{$self->fetch_user_holds(undef, 1)->{ids}} if $action =~ /_all/;
 925
 926     my $circ = OpenSRF::AppSession->create('open-ils.circ');
 927
 928     if($action =~ /cancel/) {
 929
 930         for my $hold_id (@hold_ids) {
 931             my $resp = $circ->request(
 932                 'open-ils.circ.hold.cancel', $e->authtoken, $hold_id, 6 )->gather(1); # 6 == patron-cancelled-via-opac
 933         }
 934
 935     } elsif ($action =~ /activate|suspend/) {
 936
 937         my $vlist = [];
 938         for my $hold_id (@hold_ids) {
 939             my $vals = {id => $hold_id};
 940
 941             if($action =~ /activate/) {
 942                 $vals->{frozen} = 'f';
 943                 $vals->{thaw_date} = undef;
 944
 945             } elsif($action =~ /suspend/) {
 946                 $vals->{frozen} = 't';
 947                 # $vals->{thaw_date} = TODO;
 948             }
 949             push(@$vlist, $vals);
 950         }
 951
 952         my $resp = $circ->request('open-ils.circ.hold.update.batch.atomic', $e->authtoken, undef, $vlist)->gather(1);
 953         $self->ctx->{hold_suspend_post_capture} = 1 if
 954             grep {$U->event_equals($_, 'HOLD_SUSPEND_AFTER_CAPTURE')} @$resp;
 955
 956     } elsif ($action eq 'edit') {
 957
 958         my @vals = map {
 959             my $val = {"id" => $_};
 960             $val->{"frozen"} = $self->cgi->param("frozen");
 961             $val->{"pickup_lib"} = $self->cgi->param("pickup_lib");
 962
 963             for my $field (qw/expire_time thaw_date/) {
 964                 # XXX TODO make this support other date formats, not just
 965                 # MM/DD/YYYY.
 966                 next unless $self->cgi->param($field) =~
 967                     m:^(\d{2})/(\d{2})/(\d{4})$:;
 968                 $val->{$field} = "$3-$1-$2";
 969             }
 970
 971             $val->{holdable_formats} = # no-op for non-MR holds
 972                 $self->compile_holdable_formats(undef, $_);
 973
 974             $val;
 975         } @hold_ids;
 976
 977         $circ->request(
 978             'open-ils.circ.hold.update.batch.atomic',
 979             $e->authtoken, undef, \@vals
 980         )->gather(1);   # LFW XXX test for failure
 981         $url = $self->ctx->{proto} . '://' . $self->ctx->{hostname} . $self->ctx->{opac_root} . '/myopac/holds';
 982         foreach my $param (('loc', 'qtype', 'query')) {
 983             if ($self->cgi->param($param)) {
 984                 my @vals = $self->cgi->param($param);
 985                 $url .= ";$param=" . uri_escape_utf8($_) foreach @vals;
 986             }
 987         }
 988     }
 989
 990     $circ->kill_me;
 991     return defined($url) ? $self->generic_redirect($url) : undef;
 992 }
 993
 994 sub load_myopac_holds {
 995     my $self = shift;
 996     my $e = $self->editor;
 997     my $ctx = $self->ctx;
 998
 999     my $limit = $self->cgi->param('limit') || 15;
1000     my $offset = $self->cgi->param('offset') || 0;
1001     my $action = $self->cgi->param('action') || '';
1002     my $hold_id = $self->cgi->param('hid');
1003     my $available = int($self->cgi->param('available') || 0);
1004
1005     my $hold_handle_result;
1006     $hold_handle_result = $self->handle_hold_update($action) if $action;
1007
1008     my $holds_object;
1009     if ($self->cgi->param('sort') ne "") {
1010         $holds_object = $self->fetch_user_holds($hold_id ? [$hold_id] : undef, 0, 1, $available);
1011     }
1012     else {
1013         $holds_object = $self->fetch_user_holds($hold_id ? [$hold_id] : undef, 0, 1, $available, $limit, $offset);
1014     }
1015
1016     if($holds_object->{holds}) {
1017         $ctx->{holds} = $holds_object->{holds};
1018     }
1019     $ctx->{holds_ids} = $holds_object->{all_ids};
1020     $ctx->{holds_limit} = $limit;
1021     $ctx->{holds_offset} = $offset;
1022
1023     return defined($hold_handle_result) ? $hold_handle_result : Apache2::Const::OK;
1024 }
1025
1026 my $data_filler;
1027
1028 sub load_place_hold {
1029     my $self = shift;
1030     my $ctx = $self->ctx;
1031     my $gos = $ctx->{get_org_setting};
1032     my $e = $self->editor;
1033     my $cgi = $self->cgi;
1034
1035     $self->ctx->{page} = 'place_hold';
1036     my @targets = uniq $cgi->param('hold_target');
1037     my @parts = $cgi->param('part');
1038
1039     $ctx->{hold_type} = $cgi->param('hold_type');
1040     $ctx->{default_pickup_lib} = $e->requestor->home_ou; # unless changed below
1041     $ctx->{email_notify} = $cgi->param('email_notify');
1042     if ($cgi->param('phone_notify_checkbox')) {
1043         $ctx->{phone_notify} = $cgi->param('phone_notify');
1044     }
1045     if ($cgi->param('sms_notify_checkbox')) {
1046         $ctx->{sms_notify} = $cgi->param('sms_notify');
1047         $ctx->{sms_carrier} = $cgi->param('sms_carrier');
1048     }
1049
1050     return $self->generic_redirect unless @targets;
1051
1052     # Check for multiple hold placement via the num_copies widget.
1053     my $num_copies = int($cgi->param('num_copies')); # if undefined, we get 0.
1054     if ($num_copies > 1) {
1055         # Only if we have 1 hold target and no parts.
1056         if (scalar(@targets) == 1 && !$parts[0]) {
1057             # Also, only for M and T holds.
1058             if ($ctx->{hold_type} eq 'M' || $ctx->{hold_type} eq 'T') {
1059                 # Add the extra holds to @targets. NOTE: We start with
1060                 # 1 and go to < $num_copies to account for the
1061                 # existing target.
1062                 for (my $i = 1; $i < $num_copies; $i++) {
1063                     push(@targets, $targets[0]);
1064                 }
1065             }
1066         }
1067     }
1068
1069     $logger->info("Looking at hold_type: " . $ctx->{hold_type} . " and targets: @targets");
1070
1071     $ctx->{staff_recipient} = $self->editor->retrieve_actor_user([
1072         $e->requestor->id,
1073         {
1074             flesh => 1,
1075             flesh_fields => {
1076                 au => ['settings', 'card']
1077             }
1078         }
1079     ]) or return Apache2::Const::HTTP_INTERNAL_SERVER_ERROR;
1080     my $user_setting_map = {
1081         map { $_->name => OpenSRF::Utils::JSON->JSON2perl($_->value) }
1082             @{
1083                 $ctx->{staff_recipient}->settings
1084             }
1085     };
1086     $ctx->{user_setting_map} = $user_setting_map;
1087
1088     my $default_notify = (defined $$user_setting_map{'opac.hold_notify'} ? $$user_setting_map{'opac.hold_notify'} : 'email:phone');
1089     if ($default_notify =~ /email/) {
1090         $ctx->{default_email_notify} = 'checked';
1091     } else {
1092         $ctx->{default_email_notify} = '';
1093     }
1094     if ($default_notify =~ /phone/) {
1095         $ctx->{default_phone_notify} = 'checked';
1096     } else {
1097         $ctx->{default_phone_notify} = '';
1098     }
1099     if ($default_notify =~ /sms/) {
1100         $ctx->{default_sms_notify} = 'checked';
1101     } else {
1102         $ctx->{default_sms_notify} = '';
1103     }
1104     if ($cgi->param('hold_suspend')) {
1105         $ctx->{frozen} = 1;
1106         # TODO: Make this support other date formats, not just mm/dd/yyyy.
1107         # We should use a date input type on the forms once it is supported by Firefox.
1108         # I didn't do that now because it is not available in a general release.
1109         if ($cgi->param('thaw_date') =~ m:^(\d{2})/(\d{2})/(\d{4})$:){
1110             eval {
1111                 my $dt = DateTime::Format::ISO8601->parse_datetime("$3-$1-$2");
1112                 $ctx->{thaw_date} = $dt->ymd;
1113             };
1114             if ($@) {
1115                 $logger->warn("ignoring invalid thaw_date when placing hold request");
1116             }
1117         }
1118     }
1119
1120
1121     # If we have a default pickup location, grab it
1122     if ($$user_setting_map{'opac.default_pickup_location'}) {
1123         $ctx->{default_pickup_lib} = $$user_setting_map{'opac.default_pickup_location'};
1124     }
1125
1126     my $request_lib = $e->requestor->ws_ou;
1127     my @hold_data;
1128     $ctx->{hold_data} = \@hold_data;
1129
1130     $data_filler = sub {
1131         my $hdata = shift;
1132         if ($ctx->{email_notify}) { $hdata->{email_notify} = $ctx->{email_notify}; }
1133         if ($ctx->{phone_notify}) { $hdata->{phone_notify} = $ctx->{phone_notify}; }
1134         if ($ctx->{sms_notify}) { $hdata->{sms_notify} = $ctx->{sms_notify}; }
1135         if ($ctx->{sms_carrier}) { $hdata->{sms_carrier} = $ctx->{sms_carrier}; }
1136         if ($ctx->{frozen}) { $hdata->{frozen} = 1; }
1137         if ($ctx->{thaw_date}) { $hdata->{thaw_date} = $ctx->{thaw_date}; }
1138         return $hdata;
1139     };
1140
1141     my $type_dispatch = {
1142         M => sub {
1143             # target metarecords
1144             my $mrecs = $e->batch_retrieve_metabib_metarecord([
1145                 \@targets,
1146                 {flesh => 1, flesh_fields => {mmr => ['master_record']}}],
1147                 {substream => 1}
1148             );
1149
1150             for my $id (@targets) {
1151                 my ($mr) = grep {$_->id eq $id} @$mrecs;
1152
1153                 my $ou_id = $cgi->param('pickup_lib') || $self->ctx->{search_ou};
1154                 my $filter_data = $U->simplereq(
1155                     'open-ils.circ',
1156                     'open-ils.circ.mmr.holds.filters.authoritative', $mr->id, $ou_id);
1157
1158                 my $holdable_formats =
1159                     $self->compile_holdable_formats($mr->id);
1160
1161                 push(@hold_data, $data_filler->({
1162                     target => $mr,
1163                     record => $mr->master_record,
1164                     holdable_formats => $holdable_formats,
1165                     metarecord_filters => $filter_data->{metarecord}
1166                 }));
1167             }
1168         },
1169         T => sub {
1170             my $recs = $e->batch_retrieve_biblio_record_entry(
1171                 [\@targets,  {flesh => 1, flesh_fields => {bre => ['metarecord']}}],
1172                 {substream => 1}
1173             );
1174
1175             for my $id (@targets) { # force back into the correct order
1176                 my ($rec) = grep {$_->id eq $id} @$recs;
1177
1178                 # NOTE: if tpac ever supports locked-down pickup libs,
1179                 # we'll need to pass a pickup_lib param along with the
1180                 # record to filter the set of monographic parts.
1181                 my $parts = $U->simplereq(
1182                     'open-ils.search',
1183                     'open-ils.search.biblio.record_hold_parts',
1184                     {record => $rec->id}
1185                 );
1186
1187                 # T holds on records that have parts are OK, but if the record has
1188                 # no non-part copies, the hold will ultimately fail.  When that
1189                 # happens, require the user to select a part.
1190                 my $part_required = 0;
1191                 if (@$parts) {
1192                     my $np_copies = $e->json_query({
1193                         select => { acp => [{column => 'id', transform => 'count', alias => 'count'}]},
1194                         from => {acp => {acn => {}, acpm => {type => 'left'}}},
1195                         where => {
1196                             '+acp' => {deleted => 'f'},
1197                             '+acn' => {deleted => 'f', record => $rec->id},
1198                             '+acpm' => {id => undef}
1199                         }
1200                     });
1201                     $part_required = 1 if $np_copies->[0]->{count} == 0;
1202                 }
1203
1204                 push(@hold_data, $data_filler->({
1205                     target => $rec,
1206                     record => $rec,
1207                     parts => $parts,
1208                     part_required => $part_required
1209                 }));
1210             }
1211         },
1212         V => sub {
1213             my $vols = $e->batch_retrieve_asset_call_number([
1214                 \@targets, {
1215                     "flesh" => 1,
1216                     "flesh_fields" => {"acn" => ["record"]}
1217                 }
1218             ], {substream => 1});
1219
1220             for my $id (@targets) {
1221                 my ($vol) = grep {$_->id eq $id} @$vols;
1222                 push(@hold_data, $data_filler->({target => $vol, record => $vol->record}));
1223             }
1224         },
1225         C => sub {
1226             my $copies = $e->batch_retrieve_asset_copy([
1227                 \@targets, {
1228                     "flesh" => 2,
1229                     "flesh_fields" => {
1230                         "acn" => ["record"],
1231                         "acp" => ["call_number"]
1232                     }
1233                 }
1234             ], {substream => 1});
1235
1236             for my $id (@targets) {
1237                 my ($copy) = grep {$_->id eq $id} @$copies;
1238                 push(@hold_data, $data_filler->({target => $copy, record => $copy->call_number->record}));
1239             }
1240         },
1241         I => sub {
1242             my $isses = $e->batch_retrieve_serial_issuance([
1243                 \@targets, {
1244                     "flesh" => 2,
1245                     "flesh_fields" => {
1246                         "siss" => ["subscription"], "ssub" => ["record_entry"]
1247                     }
1248                 }
1249             ], {substream => 1});
1250
1251             for my $id (@targets) {
1252                 my ($iss) = grep {$_->id eq $id} @$isses;
1253                 push(@hold_data, $data_filler->({target => $iss, record => $iss->subscription->record_entry}));
1254             }
1255         }
1256         # ...
1257
1258     }->{$ctx->{hold_type}}->();
1259
1260     # caller sent bad target IDs or the wrong hold type
1261     return Apache2::Const::HTTP_BAD_REQUEST unless @hold_data;
1262
1263     # generate the MARC xml for each record
1264     $_->{marc_xml} = XML::LibXML->new->parse_string($_->{record}->marc) for @hold_data;
1265
1266     my $pickup_lib = $cgi->param('pickup_lib');
1267     # no pickup lib means no holds placement
1268     return Apache2::Const::OK unless $pickup_lib;
1269
1270     $ctx->{hold_attempt_made} = 1;
1271
1272     # Give the original CGI params back to the user in case they
1273     # want to try to override something.
1274     $ctx->{orig_params} = $cgi->Vars;
1275     delete $ctx->{orig_params}{submit};
1276     delete $ctx->{orig_params}{hold_target};
1277     delete $ctx->{orig_params}{part};
1278
1279     my $usr = $e->requestor->id;
1280
1281     if ($ctx->{is_staff} and !$cgi->param("hold_usr_is_requestor")) {
1282         # find the real hold target
1283
1284         $usr = $U->simplereq(
1285             'open-ils.actor',
1286             "open-ils.actor.user.retrieve_id_by_barcode_or_username",
1287             $e->authtoken, $cgi->param("hold_usr"));
1288
1289         if (defined $U->event_code($usr)) {
1290             $ctx->{hold_failed} = 1;
1291             $ctx->{hold_failed_event} = $usr;
1292         }
1293     }
1294
1295     # target_id is the true target_id for holds placement.
1296     # needed for attempt_hold_placement()
1297     # With the exception of P-type holds, target_id == target->id.
1298     $_->{target_id} = $_->{target}->id for @hold_data;
1299
1300     if ($ctx->{hold_type} eq 'T') {
1301
1302         # Much like quantum wave-particles, P-type holds pop into
1303         # and out of existence at the user's whim.  For our purposes,
1304         # we treat such holds as T(itle) holds with a selected_part
1305         # designation.  When the time comes to pass the hold information
1306         # off for holds possibility testing and placement, make it look
1307         # like a real P-type hold.
1308         my (@p_holds, @t_holds);
1309
1310         # Now that we have the num_copies field for mutliple title and
1311         # metarecord hold placement, the number of holds and parts
1312         # arrays can get out of sync.  We only want to parse out parts
1313         # if the numbers are equal.
1314         if ($#hold_data == $#parts) {
1315             for my $idx (0..$#parts) {
1316                 my $hdata = $hold_data[$idx];
1317                 if (my $part = $parts[$idx]) {
1318                     $hdata->{target_id} = $part;
1319                     $hdata->{selected_part} = $part;
1320                     push(@p_holds, $hdata);
1321                 } else {
1322                     push(@t_holds, $hdata);
1323                 }
1324             }
1325         } else {
1326             @t_holds = @hold_data;
1327         }
1328
1329         $self->apache->log->warn("$#parts : @t_holds");
1330
1331         $self->attempt_hold_placement($usr, $pickup_lib, 'P', @p_holds) if @p_holds;
1332         $self->attempt_hold_placement($usr, $pickup_lib, 'T', @t_holds) if @t_holds;
1333
1334     } else {
1335         $self->attempt_hold_placement($usr, $pickup_lib, $ctx->{hold_type}, @hold_data);
1336     }
1337
1338     # NOTE: we are leaving the staff-placed patron barcode cookie
1339     # in place.  Otherwise, it's not possible to place more than
1340     # one hold for the patron within a staff/patron session.  This
1341     # does leave the barcode to linger longer than is ideal, but
1342     # normal staff work flow will cause the cookie to be replaced
1343     # with each new patron anyway.
1344     # TODO: See about getting the staff client to clear the cookie
1345
1346     # return to the place_hold page so the results of the hold
1347     # placement attempt can be reported to the user
1348     return Apache2::Const::OK;
1349 }
1350
1351 sub attempt_hold_placement {
1352     my ($self, $usr, $pickup_lib, $hold_type, @hold_data) = @_;
1353     my $cgi = $self->cgi;
1354     my $ctx = $self->ctx;
1355     my $e = $self->editor;
1356
1357     # First see if we should warn/block for any holds that
1358     # might have locally available items.
1359     for my $hdata (@hold_data) {
1360         my ($local_block, $local_alert) = $self->local_avail_concern(
1361             $hdata->{target_id}, $hold_type, $pickup_lib);
1362
1363         if ($local_block) {
1364             $hdata->{hold_failed} = 1;
1365             $hdata->{hold_local_block} = 1;
1366         } elsif ($local_alert) {
1367             $hdata->{hold_failed} = 1;
1368             $hdata->{hold_local_alert} = 1;
1369         }
1370     }
1371
1372     my $method = 'open-ils.circ.holds.test_and_create.batch';
1373
1374     if ($cgi->param('override')) {
1375         $method .= '.override';
1376
1377     } elsif (!$ctx->{is_staff})  {
1378
1379         $method .= '.override' if $self->ctx->{get_org_setting}->(
1380             $e->requestor->home_ou, "opac.patron.auto_overide_hold_events");
1381     }
1382
1383     my @create_targets = map {$_->{target_id}} (grep { !$_->{hold_failed} } @hold_data);
1384
1385
1386     if(@create_targets) {
1387
1388         # holdable formats may be different for each MR hold.
1389         # map each set to the ID of the target.
1390         my $holdable_formats = {};
1391         if ($hold_type eq 'M') {
1392             $holdable_formats->{$_->{target_id}} =
1393                 $_->{holdable_formats} for @hold_data;
1394         }
1395
1396         my $bses = OpenSRF::AppSession->create('open-ils.circ');
1397         my $breq = $bses->request(
1398             $method,
1399             $e->authtoken,
1400             $data_filler->({
1401                 patronid => $usr,
1402                 pickup_lib => $pickup_lib,
1403                 hold_type => $hold_type,
1404                 holdable_formats_map => $holdable_formats,
1405             }),
1406             \@create_targets
1407         );
1408
1409         while (my $resp = $breq->recv) {
1410
1411             $resp = $resp->content;
1412             $logger->info('batch hold placement result: ' . OpenSRF::Utils::JSON->perl2JSON($resp));
1413
1414             if ($U->event_code($resp)) {
1415                 $ctx->{general_hold_error} = $resp;
1416                 last;
1417             }
1418
1419             # Skip those that had the hold_success or hold_failed fields set for duplicate holds placement.
1420             my ($hdata) = grep {$_->{target_id} eq $resp->{target} && !($_->{hold_failed} || $_->{hold_success})} @hold_data;
1421             my $result = $resp->{result};
1422
1423             if ($U->event_code($result)) {
1424                 # e.g. permission denied
1425                 $hdata->{hold_failed} = 1;
1426                 $hdata->{hold_failed_event} = $result;
1427
1428             } else {
1429
1430                 if(not ref $result and $result > 0) {
1431                     # successul hold returns the hold ID
1432
1433                     $hdata->{hold_success} = $result;
1434
1435                 } else {
1436                     # hold-specific failure event
1437                     $hdata->{hold_failed} = 1;
1438
1439                     if (ref $result eq 'HASH') {
1440                         $hdata->{hold_failed_event} = $result->{last_event};
1441
1442                         if ($result->{age_protected_copy}) {
1443                             my %temp = %{$hdata->{hold_failed_event}};
1444                             my $theTextcode = $temp{"textcode"};
1445                             $theTextcode.=".override";
1446                             $hdata->{could_override} = $self->editor->allowed( $theTextcode );
1447                             $hdata->{age_protect} = 1;
1448                         } else {
1449                             $hdata->{could_override} = $result->{place_unfillable} ||
1450                                 $self->test_could_override($hdata->{hold_failed_event});
1451                         }
1452                     } elsif (ref $result eq 'ARRAY') {
1453                         $hdata->{hold_failed_event} = $result->[0];
1454
1455                         if ($result->[3]) { # age_protect_only
1456                             my %temp = %{$hdata->{hold_failed_event}};
1457                             my $theTextcode = $temp{"textcode"};
1458                             $theTextcode.=".override";
1459                             $hdata->{could_override} = $self->editor->allowed( $theTextcode );
1460                             $hdata->{age_protect} = 1;
1461                         } else {
1462                             $hdata->{could_override} = $result->[4] || # place_unfillable
1463                                 $self->test_could_override($hdata->{hold_failed_event});
1464                         }
1465                     }
1466                 }
1467             }
1468         }
1469
1470         $bses->kill_me;
1471     }
1472
1473     if ($self->cgi->param('clear_cart')) {
1474         $self->clear_anon_cache;
1475     }
1476 }
1477
1478 # pull the selected formats and languages for metarecord holds
1479 # from the CGI params and map them into the JSON holdable
1480 # formats...er, format.
1481 # if no metarecord is provided, we'll pull it from the target
1482 # of the provided hold.
1483 sub compile_holdable_formats {
1484     my ($self, $mr_id, $hold_id) = @_;
1485     my $e = $self->editor;
1486     my $cgi = $self->cgi;
1487
1488     # exit early if not needed
1489     return undef unless
1490         grep /metarecord_formats_|metarecord_langs_/,
1491         $cgi->param;
1492
1493     # CGI params are based on the MR id, since during hold placement
1494     # we have no old ID.  During hold edit, map the hold ID back to
1495     # the metarecod target.
1496     $mr_id =
1497         $e->retrieve_action_hold_request($hold_id)->target
1498         unless $mr_id;
1499
1500     my $format_attr = $self->ctx->{get_cgf}->(
1501         'opac.metarecord.holds.format_attr');
1502
1503     if (!$format_attr) {
1504         $logger->error("Missing config.global_flag: ".
1505             "opac.metarecord.holds.format_attr!");
1506         return "";
1507     }
1508
1509     $format_attr = $format_attr->value;
1510
1511     # during hold placement or edit submission, the user selects
1512     # which of the available formats/langs are acceptable.
1513     # Capture those here as the holdable_formats for the MR hold.
1514     my @selected_formats = $cgi->param("metarecord_formats_$mr_id");
1515     my @selected_langs = $cgi->param("metarecord_langs_$mr_id");
1516
1517     # map the selected attrs into the JSON holdable_formats structure
1518     my $blob = {};
1519     if (@selected_formats) {
1520         $blob->{0} = [
1521             map { {_attr => $format_attr, _val => $_} }
1522             @selected_formats
1523         ];
1524     }
1525     if (@selected_langs) {
1526         $blob->{1} = [
1527             map { {_attr => 'item_lang', _val => $_} }
1528             @selected_langs
1529         ];
1530     }
1531
1532     return OpenSRF::Utils::JSON->perl2JSON($blob);
1533 }
1534
1535 sub fetch_user_circs {
1536     my $self = shift;
1537     my $flesh = shift; # flesh bib data, etc.
1538     my $circ_ids = shift;
1539     my $limit = shift;
1540     my $offset = shift;
1541
1542     my $e = $self->editor;
1543
1544     my @circ_ids;
1545
1546     if($circ_ids) {
1547         @circ_ids = @$circ_ids;
1548
1549     } else {
1550
1551         my $query = {
1552             select => {circ => ['id']},
1553             from => 'circ',
1554             where => {
1555                 '+circ' => {
1556                     usr => $e->requestor->id,
1557                     checkin_time => undef,
1558                     '-or' => [
1559                         {stop_fines => undef},
1560                         {stop_fines => {'not in' => ['LOST','CLAIMSRETURNED','LONGOVERDUE']}}
1561                     ],
1562                 }
1563             },
1564             order_by => {circ => ['due_date']}
1565         };
1566
1567         $query->{limit} = $limit if $limit;
1568         $query->{offset} = $offset if $offset;
1569
1570         my $ids = $e->json_query($query);
1571         @circ_ids = map {$_->{id}} @$ids;
1572     }
1573
1574     return [] unless @circ_ids;
1575
1576     my $qflesh = {
1577         flesh => 3,
1578         flesh_fields => {
1579             circ => ['target_copy'],
1580             acp => ['call_number'],
1581             acn => ['record']
1582         }
1583     };
1584
1585     $e->xact_begin;
1586     my $circs = $e->search_action_circulation(
1587         [{id => \@circ_ids}, ($flesh) ? $qflesh : {}], {substream => 1});
1588
1589     my @circs;
1590     for my $circ (@$circs) {
1591         push(@circs, {
1592             circ => $circ,
1593             marc_xml => ($flesh and $circ->target_copy->call_number->id != -1) ?
1594                 XML::LibXML->new->parse_string($circ->target_copy->call_number->record->marc) :
1595                 undef  # pre-cat copy, use the dummy title/author instead
1596         });
1597     }
1598     $e->rollback;
1599
1600     # make sure the final list is in the correct order
1601     my @sorted_circs;
1602     for my $id (@circ_ids) {
1603         push(
1604             @sorted_circs,
1605             (grep { $_->{circ}->id == $id } @circs)
1606         );
1607     }
1608
1609     return \@sorted_circs;
1610 }
1611
1612
1613 sub handle_circ_renew {
1614     my $self = shift;
1615     my $action = shift;
1616     my $ctx = $self->ctx;
1617
1618     my @renew_ids = $self->cgi->param('circ');
1619
1620     my $circs = $self->fetch_user_circs(0, ($action eq 'renew') ? [@renew_ids] : undef);
1621
1622     # TODO: fire off renewal calls in batches to speed things up
1623     my @responses;
1624     for my $circ (@$circs) {
1625
1626         my $evt = $U->simplereq(
1627             'open-ils.circ',
1628             'open-ils.circ.renew',
1629             $self->editor->authtoken,
1630             {
1631                 patron_id => $self->editor->requestor->id,
1632                 copy_id => $circ->{circ}->target_copy,
1633                 opac_renewal => 1
1634             }
1635         );
1636
1637         # TODO return these, then insert them into the circ data
1638         # blob that is shoved into the template for each circ
1639         # so the template won't have to match them
1640         push(@responses, {copy => $circ->{circ}->target_copy, evt => $evt});
1641     }
1642
1643     return @responses;
1644 }
1645
1646 sub load_myopac_circs {
1647     my $self = shift;
1648     my $e = $self->editor;
1649     my $ctx = $self->ctx;
1650
1651     $ctx->{circs} = [];
1652     my $limit = $self->cgi->param('limit') || 0; # 0 == unlimited
1653     my $offset = $self->cgi->param('offset') || 0;
1654     my $action = $self->cgi->param('action') || '';
1655
1656     # perform the renewal first if necessary
1657     my @results = $self->handle_circ_renew($action) if $action =~ /renew/;
1658
1659     $ctx->{circs} = $self->fetch_user_circs(1, undef, $limit, $offset);
1660
1661     my $success_renewals = 0;
1662     my $failed_renewals = 0;
1663     for my $data (@{$ctx->{circs}}) {
1664         my ($resp) = grep { $_->{copy} == $data->{circ}->target_copy->id } @results;
1665
1666         if($resp) {
1667             my $evt = ref($resp->{evt}) eq 'ARRAY' ? $resp->{evt}->[0] : $resp->{evt};
1668
1669             # extract the fail_part, if present, from the event payload;
1670             # since # the payload is an acp object in some cases,
1671             # blindly looking for a # 'fail_part' key in the template can
1672             # break things
1673             $evt->{fail_part} = (ref($evt->{payload}) eq 'HASH' && exists $evt->{payload}->{fail_part}) ?
1674                 $evt->{payload}->{fail_part} :
1675                 '';
1676
1677             $data->{renewal_response} = $evt;
1678             $success_renewals++ if $evt->{textcode} eq 'SUCCESS';
1679             $failed_renewals++ if $evt->{textcode} ne 'SUCCESS';
1680         }
1681     }
1682
1683     $ctx->{success_renewals} = $success_renewals;
1684     $ctx->{failed_renewals} = $failed_renewals;
1685
1686     return Apache2::Const::OK;
1687 }
1688
1689 sub load_myopac_circ_history {
1690     my $self = shift;
1691     my $e = $self->editor;
1692     my $ctx = $self->ctx;
1693     my $limit = $self->cgi->param('limit') || 15;
1694     my $offset = $self->cgi->param('offset') || 0;
1695     my $action = $self->cgi->param('action') || '';
1696
1697     my $circ_handle_result;
1698     $circ_handle_result = $self->handle_circ_update($action) if $action;
1699
1700     $ctx->{circ_history_limit} = $limit;
1701     $ctx->{circ_history_offset} = $offset;
1702
1703     # Defer limitation to circ_history.tt2 when sorting
1704     if ($self->cgi->param('sort')) {
1705         $limit = undef;
1706         $offset = undef;
1707     }
1708
1709     $ctx->{circs} = $self->fetch_user_circ_history(1, $limit, $offset);
1710     return Apache2::Const::OK;
1711 }
1712
1713 # if 'flesh' is set, copy data etc. is loaded and the return value is
1714 # a hash of 'circ' and 'marc_xml'.  Othwerwise, it's just a list of
1715 # auch objects.
1716 sub fetch_user_circ_history {
1717     my ($self, $flesh, $limit, $offset) = @_;
1718     my $e = $self->editor;
1719
1720     my %limits = ();
1721     $limits{offset} = $offset if defined $offset;
1722     $limits{limit} = $limit if defined $limit;
1723
1724     my %flesh_ops = (
1725         flesh => 3,
1726         flesh_fields => {
1727             auch => ['target_copy','source_circ'],
1728             acp => ['call_number'],
1729             acn => ['record']
1730         },
1731     );
1732
1733     $e->xact_begin;
1734     my $circs = $e->search_action_user_circ_history(
1735         [
1736             {usr => $e->requestor->id},
1737             {   # order newest to oldest by default
1738                 order_by => {auch => 'xact_start DESC'},
1739                 $flesh ? %flesh_ops : (),
1740                 %limits
1741             }
1742         ],
1743         {substream => 1}
1744     );
1745     $e->rollback;
1746
1747     return $circs unless $flesh;
1748
1749     $e->xact_begin;
1750     my @circs;
1751     my %unapi_cache = ();
1752     for my $circ (@$circs) {
1753         if ($circ->target_copy->call_number->id == -1) {
1754             push(@circs, {
1755                 circ => $circ,
1756                 marc_xml => undef # pre-cat copy, use the dummy title/author instead
1757             });
1758             next;
1759         }
1760         my $bre_id = $circ->target_copy->call_number->record->id;
1761         my $unapi;
1762         if (exists $unapi_cache{$bre_id}) {
1763             $unapi = $unapi_cache{$bre_id};
1764         } else {
1765             my $result = $e->json_query({
1766                 from => [
1767                     'unapi.bre', $bre_id, 'marcxml','record','{mra}', undef, undef, undef
1768                 ]
1769             });
1770             if ($result) {
1771                 $unapi_cache{$bre_id} = $unapi = XML::LibXML->new->parse_string($result->[0]->{'unapi.bre'});
1772             }
1773         }
1774         if ($unapi) {
1775             push(@circs, {
1776                 circ => $circ,
1777                 marc_xml => $unapi
1778             });
1779         } else {
1780             push(@circs, {
1781                 circ => $circ,
1782                 marc_xml => undef # failed, but try to go on
1783             });
1784         }
1785     }
1786     $e->rollback;
1787
1788     return \@circs;
1789 }
1790
1791 sub handle_circ_update {
1792     my $self     = shift;
1793     my $action   = shift;
1794     my $circ_ids = shift;
1795
1796     my $circ_ids //= [$self->cgi->param('circ_id')];
1797
1798     if ($action =~ /delete/) {
1799         my $options = {
1800             circ_ids => $circ_ids,
1801         };
1802
1803         $U->simplereq(
1804             'open-ils.actor',
1805             'open-ils.actor.history.circ.clear',
1806             $self->editor->authtoken,
1807             $options
1808         );
1809     }
1810
1811     return;
1812 }
1813
1814 # TODO: action.usr_visible_holds does not return cancelled holds.  Should it?
1815 sub load_myopac_hold_history {
1816     my $self = shift;
1817     my $e = $self->editor;
1818     my $ctx = $self->ctx;
1819     my $limit = $self->cgi->param('limit') || 15;
1820     my $offset = $self->cgi->param('offset') || 0;
1821     $ctx->{hold_history_limit} = $limit;
1822     $ctx->{hold_history_offset} = $offset;
1823
1824     my $hold_ids = $e->json_query({
1825         select => {
1826             au => [{
1827                 column => 'id',
1828                 transform => 'action.usr_visible_holds',
1829                 result_field => 'id'
1830             }]
1831         },
1832         from => 'au',
1833         where => {id => $e->requestor->id}
1834     });
1835
1836     my $holds_object = $self->fetch_user_holds([map { $_->{id} } @$hold_ids], 0, 1, 0, $limit, $offset);
1837     if($holds_object->{holds}) {
1838         $ctx->{holds} = $holds_object->{holds};
1839     }
1840     $ctx->{hold_history_ids} = $holds_object->{all_ids};
1841
1842     return Apache2::Const::OK;
1843 }
1844
1845 sub load_myopac_payment_form {
1846     my $self = shift;
1847     my $r;
1848
1849     $r = $self->prepare_fines(undef, undef, [$self->cgi->param('xact'), $self->cgi->param('xact_misc')]) and return $r;
1850     $r = $self->prepare_extended_user_info and return $r;
1851
1852     return Apache2::Const::OK;
1853 }
1854
1855 # TODO: add other filter options as params/configs/etc.
1856 sub load_myopac_payments {
1857     my $self = shift;
1858     my $limit = $self->cgi->param('limit') || 20;
1859     my $offset = $self->cgi->param('offset') || 0;
1860     my $e = $self->editor;
1861
1862     $self->ctx->{payment_history_limit} = $limit;
1863     $self->ctx->{payment_history_offset} = $offset;
1864
1865     my $args = {};
1866     $args->{limit} = $limit if $limit;
1867     $args->{offset} = $offset if $offset;
1868
1869     if (my $max_age = $self->ctx->{get_org_setting}->(
1870         $e->requestor->home_ou, "opac.payment_history_age_limit"
1871     )) {
1872         my $min_ts = DateTime->now(
1873             "time_zone" => DateTime::TimeZone->new("name" => "local"),
1874         )->subtract("seconds" => interval_to_seconds($max_age))->iso8601();
1875
1876         $logger->info("XXX min_ts: $min_ts");
1877         $args->{"where"} = {"payment_ts" => {">=" => $min_ts}};
1878     }
1879
1880     $self->ctx->{payments} = $U->simplereq(
1881         'open-ils.actor',
1882         'open-ils.actor.user.payments.retrieve.atomic',
1883         $e->authtoken, $e->requestor->id, $args);
1884
1885     return Apache2::Const::OK;
1886 }
1887
1888 # 1. caches the form parameters
1889 # 2. loads the credit card payment "Processing..." page
1890 sub load_myopac_pay_init {
1891     my $self = shift;
1892     my $cache = OpenSRF::Utils::Cache->new('global');
1893
1894     my @payment_xacts = ($self->cgi->param('xact'), $self->cgi->param('xact_misc'));
1895
1896     if (!@payment_xacts) {
1897         # for consistency with load_myopac_payment_form() and
1898         # to preserve backwards compatibility, if no xacts are
1899         # selected, assume all (applicable) transactions are wanted.
1900         my $stat = $self->prepare_fines(undef, undef, [$self->cgi->param('xact'), $self->cgi->param('xact_misc')]);
1901         return $stat if $stat;
1902         @payment_xacts =
1903             map { $_->{xact}->id } (
1904                 @{$self->ctx->{fines}->{circulation}},
1905                 @{$self->ctx->{fines}->{grocery}}
1906         );
1907     }
1908
1909     return $self->generic_redirect unless @payment_xacts;
1910
1911     my $cc_args = {"where_process" => 1};
1912
1913     $cc_args->{$_} = $self->cgi->param($_) for (qw/
1914         number cvv2 expire_year expire_month billing_first
1915         billing_last billing_address billing_city billing_state
1916         billing_zip stripe_token
1917     /);
1918
1919     my $cache_args = {
1920         cc_args => $cc_args,
1921         user => $self->ctx->{user}->id,
1922         xacts => \@payment_xacts
1923     };
1924
1925     # generate a temporary cache token and cache the form data
1926     my $token = md5_hex($$ . time() . rand());
1927     $cache->put_cache($token, $cache_args, 30);
1928
1929     $logger->info("tpac caching payment info with token $token and xacts [@payment_xacts]");
1930
1931     # after we render the processing page, we quickly redirect to submit
1932     # the actual payment.  The refresh url contains the payment token.
1933     # It also contains the list of xact IDs, which allows us to clear the
1934     # cache at the earliest possible time while leaving a trace of which
1935     # transactions we were processing, so the UI can bring the user back
1936     # to the payment form w/ the same xacts if the payment fails.
1937
1938     my $refresh = "1; url=main_pay/$token?xact=" . pop(@payment_xacts);
1939     $refresh .= ";xact=$_" for @payment_xacts;
1940     $self->ctx->{refresh} = $refresh;
1941
1942     return Apache2::Const::OK;
1943 }
1944
1945 # retrieve the cached CC payment info and send off for processing
1946 sub load_myopac_pay {
1947     my $self = shift;
1948     my $token = $self->ctx->{page_args}->[0];
1949     return Apache2::Const::HTTP_BAD_REQUEST unless $token;
1950
1951     my $cache = OpenSRF::Utils::Cache->new('global');
1952     my $cache_args = $cache->get_cache($token);
1953     $cache->delete_cache($token);
1954
1955     # this page is loaded immediately after the token is created.
1956     # if the cached data is not there, it's because of an invalid
1957     # token (or cache failure) and not because of a timeout.
1958     return Apache2::Const::HTTP_BAD_REQUEST unless $cache_args;
1959
1960     my @payment_xacts = @{$cache_args->{xacts}};
1961     my $cc_args = $cache_args->{cc_args};
1962
1963     # as an added security check, verify the user submitting
1964     # the form is the same as the user whose data was cached
1965     return Apache2::Const::HTTP_BAD_REQUEST unless
1966         $cache_args->{user} == $self->ctx->{user}->id;
1967
1968     $logger->info("tpac paying fines with token $token and xacts [@payment_xacts]");
1969
1970     my $r;
1971     $r = $self->prepare_fines(undef, undef, \@payment_xacts) and return $r;
1972
1973     # balance_owed is computed specifically from the fines we're paying
1974     if ($self->ctx->{fines}->{balance_owed} <= 0) {
1975         $logger->info("tpac can't pay non-positive balance. xacts selected: [@payment_xacts]");
1976         return Apache2::Const::HTTP_BAD_REQUEST;
1977     }
1978
1979     my $args = {
1980         "cc_args" => $cc_args,
1981         "userid" => $self->ctx->{user}->id,
1982         "payment_type" => "credit_card_payment",
1983         "payments" => $self->prepare_fines_for_payment  # should be safe after self->prepare_fines
1984     };
1985
1986     my $resp = $U->simplereq("open-ils.circ", "open-ils.circ.money.payment",
1987         $self->editor->authtoken, $args, $self->ctx->{user}->last_xact_id
1988     );
1989
1990     $self->ctx->{"payment_response"} = $resp;
1991
1992     unless ($resp->{"textcode"}) {
1993         $self->ctx->{printable_receipt} = $U->simplereq(
1994         "open-ils.circ", "open-ils.circ.money.payment_receipt.print",
1995         $self->editor->authtoken, $resp->{payments}
1996         );
1997     }
1998
1999     return Apache2::Const::OK;
2000 }
2001
2002 sub load_myopac_receipt_print {
2003     my $self = shift;
2004
2005     $self->ctx->{printable_receipt} = $U->simplereq(
2006     "open-ils.circ", "open-ils.circ.money.payment_receipt.print",
2007     $self->editor->authtoken, [$self->cgi->param("payment")]
2008     );
2009
2010     return Apache2::Const::OK;
2011 }
2012
2013 sub load_myopac_receipt_email {
2014     my $self = shift;
2015
2016     # The following ML method doesn't actually check whether the user in
2017     # question has an email address, so we do.
2018     if ($self->ctx->{user}->email) {
2019         $self->ctx->{email_receipt_result} = $U->simplereq(
2020         "open-ils.circ", "open-ils.circ.money.payment_receipt.email",
2021         $self->editor->authtoken, [$self->cgi->param("payment")]
2022         );
2023     } else {
2024         $self->ctx->{email_receipt_result} =
2025             new OpenILS::Event("PATRON_NO_EMAIL_ADDRESS");
2026     }
2027
2028     return Apache2::Const::OK;
2029 }
2030
2031 sub prepare_fines {
2032     my ($self, $limit, $offset, $id_list) = @_;
2033
2034     # XXX TODO: check for failure after various network calls
2035
2036     # It may be unclear, but this result structure lumps circulation and
2037     # reservation fines together, and keeps grocery fines separate.
2038     $self->ctx->{"fines"} = {
2039         "circulation" => [],
2040         "grocery" => [],
2041         "total_paid" => 0,
2042         "total_owed" => 0,
2043         "balance_owed" => 0
2044     };
2045
2046     my $cstore = OpenSRF::AppSession->create('open-ils.cstore');
2047
2048     # TODO: This should really be a ML call, but the existing calls
2049     # return an excessive amount of data and don't offer streaming
2050
2051     my %paging = ($limit or $offset) ? (limit => $limit, offset => $offset) : ();
2052
2053     my $req = $cstore->request(
2054         'open-ils.cstore.direct.money.open_billable_transaction_summary.search',
2055         {
2056             usr => $self->editor->requestor->id,
2057             balance_owed => {'!=' => 0},
2058             ($id_list && @$id_list ? ("id" => $id_list) : ()),
2059         },
2060         {
2061             flesh => 4,
2062             flesh_fields => {
2063                 mobts => [qw/grocery circulation reservation/],
2064                 bresv => ['target_resource_type'],
2065                 brt => ['record'],
2066                 mg => ['billings'],
2067                 mb => ['btype'],
2068                 circ => ['target_copy'],
2069                 acp => ['call_number'],
2070                 acn => ['record']
2071             },
2072             order_by => { mobts => 'xact_start' },
2073             %paging
2074         }
2075     );
2076
2077     # Collect $$ amounts from each transaction for summing below.
2078     my (@paid_amounts, @owed_amounts, @balance_amounts);
2079
2080     while(my $resp = $req->recv) {
2081         my $mobts = $resp->content;
2082         my $circ = $mobts->circulation;
2083
2084         my $last_billing;
2085         if($mobts->grocery) {
2086             my @billings = sort { $a->billing_ts cmp $b->billing_ts } @{$mobts->grocery->billings};
2087             $last_billing = pop(@billings);
2088         }
2089
2090         push(@paid_amounts, $mobts->total_paid);
2091         push(@owed_amounts, $mobts->total_owed);
2092         push(@balance_amounts, $mobts->balance_owed);
2093
2094         my $marc_xml = undef;
2095         if ($mobts->xact_type eq 'reservation' and
2096             $mobts->reservation->target_resource_type->record) {
2097             $marc_xml = XML::LibXML->new->parse_string(
2098                 $mobts->reservation->target_resource_type->record->marc
2099             );
2100         } elsif ($mobts->xact_type eq 'circulation' and
2101             $circ->target_copy->call_number->id != -1) {
2102             $marc_xml = XML::LibXML->new->parse_string(
2103                 $circ->target_copy->call_number->record->marc
2104             );
2105         }
2106
2107         push(
2108             @{$self->ctx->{"fines"}->{$mobts->grocery ? "grocery" : "circulation"}},
2109             {
2110                 xact => $mobts,
2111                 last_grocery_billing => $last_billing,
2112                 marc_xml => $marc_xml
2113             }
2114         );
2115     }
2116
2117     $cstore->kill_me;
2118
2119     $self->ctx->{"fines"}->{total_paid}   = $U->fpsum(@paid_amounts);
2120     $self->ctx->{"fines"}->{total_owed}   = $U->fpsum(@owed_amounts);
2121     $self->ctx->{"fines"}->{balance_owed} = $U->fpsum(@balance_amounts);
2122
2123     return;
2124 }
2125
2126 sub prepare_fines_for_payment {
2127     # This assumes $self->prepare_fines has already been run
2128     my ($self) = @_;
2129
2130     my @results = ();
2131     if ($self->ctx->{fines}) {
2132         push @results, [$_->{xact}->id, $_->{xact}->balance_owed] foreach (
2133             @{$self->ctx->{fines}->{circulation}},
2134             @{$self->ctx->{fines}->{grocery}}
2135         );
2136     }
2137
2138     return \@results;
2139 }
2140
2141 sub load_myopac_main {
2142     my $self = shift;
2143     my $limit = $self->cgi->param('limit') || 0;
2144     my $offset = $self->cgi->param('offset') || 0;
2145     $self->ctx->{search_ou} = $self->_get_search_lib();
2146     $self->ctx->{user}->notes(
2147         $self->editor->search_actor_usr_note({
2148             usr => $self->ctx->{user}->id,
2149             pub => 't'
2150         })
2151     );
2152     return $self->prepare_fines($limit, $offset) || Apache2::Const::OK;
2153 }
2154
2155 sub load_myopac_update_email {
2156     my $self = shift;
2157     my $e = $self->editor;
2158     my $ctx = $self->ctx;
2159     my $email = $self->cgi->param('email') || '';
2160     my $current_pw = $self->cgi->param('current_pw') || '';
2161
2162     # needed for most up-to-date email address
2163     if (my $r = $self->prepare_extended_user_info) { return $r };
2164
2165     return Apache2::Const::OK
2166         unless $self->cgi->request_method eq 'POST';
2167
2168     unless($email =~ /.+\@.+\..+/) { # TODO better regex?
2169         $ctx->{invalid_email} = $email;
2170         return Apache2::Const::OK;
2171     }
2172
2173     my $stat = $U->simplereq(
2174         'open-ils.actor',
2175         'open-ils.actor.user.email.update',
2176         $e->authtoken, $email, $current_pw);
2177
2178     if($U->event_equals($stat, 'INCORRECT_PASSWORD')) {
2179         $ctx->{password_incorrect} = 1;
2180         return Apache2::Const::OK;
2181     }
2182
2183     unless ($self->cgi->param("redirect_to")) {
2184         my $url = $self->apache->unparsed_uri;
2185         $url =~ s/update_email/prefs/;
2186
2187         return $self->generic_redirect($url);
2188     }
2189
2190     return $self->generic_redirect;
2191 }
2192
2193 sub load_myopac_update_username {
2194     my $self = shift;
2195     my $e = $self->editor;
2196     my $ctx = $self->ctx;
2197     my $username = $self->cgi->param('username') || '';
2198     my $current_pw = $self->cgi->param('current_pw') || '';
2199
2200     $self->prepare_extended_user_info;
2201
2202     my $allow_change = 1;
2203     my $regex_check;
2204     my $lock_usernames = $self->ctx->{get_org_setting}->($e->requestor->home_ou, 'opac.lock_usernames');
2205     if(defined($lock_usernames) and $lock_usernames == 1) {
2206         # Policy says no username changes
2207         $allow_change = 0;
2208     } else {
2209         # We want this further down.
2210         $regex_check = $self->ctx->{get_org_setting}->($e->requestor->home_ou, 'opac.barcode_regex');
2211         my $username_unlimit = $self->ctx->{get_org_setting}->($e->requestor->home_ou, 'opac.unlimit_usernames');
2212         if(!$username_unlimit) {
2213             if(!$regex_check) {
2214                 # Default is "starts with a number"
2215                 $regex_check = '^\d+';
2216             }
2217             # You already have a username?
2218             if($regex_check and $self->ctx->{user}->usrname !~ /$regex_check/) {
2219                 $allow_change = 0;
2220             }
2221         }
2222     }
2223     if(!$allow_change) {
2224         my $url = $self->apache->unparsed_uri;
2225         $url =~ s/update_username/prefs/;
2226
2227         return $self->generic_redirect($url);
2228     }
2229
2230     return Apache2::Const::OK
2231         unless $self->cgi->request_method eq 'POST';
2232
2233     unless($username and $username !~ /\s/) { # any other username restrictions?
2234         $ctx->{invalid_username} = $username;
2235         return Apache2::Const::OK;
2236     }
2237
2238     # New username can't look like a barcode if we have a barcode regex
2239     if($regex_check and $username =~ /$regex_check/) {
2240         $ctx->{invalid_username} = $username;
2241         return Apache2::Const::OK;
2242     }
2243
2244     # New username has to look like a username if we have a username regex
2245     $regex_check = $ctx->{get_org_setting}->($e->requestor->home_ou, 'opac.username_regex');
2246     if($regex_check and $username !~ /$regex_check/) {
2247         $ctx->{invalid_username} = $username;
2248         return Apache2::Const::OK;
2249     }
2250
2251     if($username ne $e->requestor->usrname) {
2252
2253         my $evt = $U->simplereq(
2254             'open-ils.actor',
2255             'open-ils.actor.user.username.update',
2256             $e->authtoken, $username, $current_pw);
2257
2258         if($U->event_equals($evt, 'INCORRECT_PASSWORD')) {
2259             $ctx->{password_incorrect} = 1;
2260             return Apache2::Const::OK;
2261         }
2262
2263         if($U->event_equals($evt, 'USERNAME_EXISTS')) {
2264             $ctx->{username_exists} = $username;
2265             return Apache2::Const::OK;
2266         }
2267     }
2268
2269     my $url = $self->apache->unparsed_uri;
2270     $url =~ s/update_username/prefs/;
2271
2272     return $self->generic_redirect($url);
2273 }
2274
2275 sub load_myopac_update_password {
2276     my $self = shift;
2277     my $e = $self->editor;
2278     my $ctx = $self->ctx;
2279
2280     return Apache2::Const::OK
2281         unless $self->cgi->request_method eq 'POST';
2282
2283     my $current_pw = $self->cgi->param('current_pw') || '';
2284     my $new_pw = $self->cgi->param('new_pw') || '';
2285     my $new_pw2 = $self->cgi->param('new_pw2') || '';
2286
2287     unless($new_pw eq $new_pw2) {
2288         $ctx->{password_nomatch} = 1;
2289         return Apache2::Const::OK;
2290     }
2291
2292     my $pw_regex = $ctx->{get_org_setting}->($e->requestor->home_ou, 'global.password_regex');
2293
2294     if(!$pw_regex) {
2295         # This regex duplicates the JSPac's default "digit, letter, and 7 characters" rule
2296         $pw_regex = '(?=.*\d+.*)(?=.*[A-Za-z]+.*).{7,}';
2297     }
2298
2299     if($pw_regex and $new_pw !~ /$pw_regex/) {
2300         $ctx->{password_invalid} = 1;
2301         return Apache2::Const::OK;
2302     }
2303
2304     my $evt = $U->simplereq(
2305         'open-ils.actor',
2306         'open-ils.actor.user.password.update',
2307         $e->authtoken, $new_pw, $current_pw);
2308
2309
2310     if($U->event_equals($evt, 'INCORRECT_PASSWORD')) {
2311         $ctx->{password_incorrect} = 1;
2312         return Apache2::Const::OK;
2313     }
2314
2315     my $url = $self->apache->unparsed_uri;
2316     $url =~ s/update_password/prefs/;
2317
2318     return $self->generic_redirect($url);
2319 }
2320
2321 sub _update_bookbag_metadata {
2322     my ($self, $bookbag) = @_;
2323
2324     $bookbag->name($self->cgi->param("name"));
2325     $bookbag->description($self->cgi->param("description"));
2326
2327     return 1 if $self->editor->update_container_biblio_record_entry_bucket($bookbag);
2328     return 0;
2329 }
2330
2331 sub _get_lists_per_page {
2332     my $self = shift;
2333
2334     if($self->editor->requestor) {
2335         $self->timelog("Checking for opac.lists_per_page preference");
2336         # See if the user has a lists per page preference
2337         my $ipp = $self->editor->search_actor_user_setting({
2338             usr => $self->editor->requestor->id,
2339             name => 'opac.lists_per_page'
2340         })->[0];
2341         $self->timelog("Got opac.lists_per_page preference");
2342         return OpenSRF::Utils::JSON->JSON2perl($ipp->value) if $ipp;
2343     }
2344     return 10; # default
2345 }
2346
2347 sub _get_items_per_page {
2348     my $self = shift;
2349
2350     if($self->editor->requestor) {
2351         $self->timelog("Checking for opac.list_items_per_page preference");
2352         # See if the user has a list items per page preference
2353         my $ipp = $self->editor->search_actor_user_setting({
2354             usr => $self->editor->requestor->id,
2355             name => 'opac.list_items_per_page'
2356         })->[0];
2357         $self->timelog("Got opac.list_items_per_page preference");
2358         return OpenSRF::Utils::JSON->JSON2perl($ipp->value) if $ipp;
2359     }
2360     return 10; # default
2361 }
2362
2363 sub load_myopac_bookbags {
2364     my $self = shift;
2365     my $e = $self->editor;
2366     my $ctx = $self->ctx;
2367     my $limit = $self->_get_lists_per_page || 10;
2368     my $offset = $self->cgi->param('offset') || 0;
2369
2370     $ctx->{bookbags_limit} = $limit;
2371     $ctx->{bookbags_offset} = $offset;
2372
2373     # for list item pagination
2374     my $item_limit = $self->_get_items_per_page;
2375     my $item_page = $self->cgi->param('item_page') || 1;
2376     my $item_offset = ($item_page - 1) * $item_limit;
2377     $ctx->{bookbags_item_page} = $item_page;
2378
2379     my ($sorter, $modifier) = $self->_get_bookbag_sort_params("sort");
2380     $e->xact_begin; # replication...
2381
2382     my $rv = $self->load_mylist;
2383     unless($rv eq Apache2::Const::OK) {
2384         $e->rollback;
2385         return $rv;
2386     }
2387
2388     $ctx->{bookbags} = $e->search_container_biblio_record_entry_bucket(
2389         [
2390             {owner => $e->requestor->id, btype => 'bookbag'}, {
2391                 order_by => {cbreb => 'name'},
2392                 limit => $limit,
2393                 offset => $offset
2394             }
2395         ],
2396         {substream => 1}
2397     );
2398
2399     if(!$ctx->{bookbags}) {
2400         $e->rollback;
2401         return Apache2::Const::HTTP_INTERNAL_SERVER_ERROR;
2402     }
2403
2404     # We load the user prefs to get their default bookbag.
2405     $self->_load_user_with_prefs;
2406
2407     # We also want a total count of the user's bookbags.
2408     my $q = {
2409         'select' => { 'cbreb' => [ { 'column' => 'id', 'transform' => 'count', 'aggregate' => 'true', 'alias' => 'count' } ] },
2410         'from' => 'cbreb',
2411         'where' => { 'btype' => 'bookbag', 'owner' => $self->ctx->{user}->id }
2412     };
2413     my $r = $e->json_query($q);
2414     $ctx->{bookbag_count} = $r->[0]->{'count'};
2415
2416     # If the user wants a specific bookbag's items, load them.
2417
2418     if ($self->cgi->param("bbid")) {
2419         my ($bookbag) =
2420             grep { $_->id eq $self->cgi->param("bbid") } @{$ctx->{bookbags}};
2421
2422         if ($bookbag) {
2423             my $query = $self->_prepare_bookbag_container_query(
2424                 $bookbag->id, $sorter, $modifier
2425             );
2426
2427             # Calculate total count of the items in selected bookbag.
2428             # This total includes record entries that have no assets available.
2429             my $bb_search_results = $U->simplereq(
2430                 "open-ils.search", "open-ils.search.biblio.multiclass.query",
2431                 {"limit" => 1, "offset" => 0}, $query
2432             ); # we only need the count, so do the actual search with limit=1
2433
2434             if ($bb_search_results) {
2435                 $ctx->{bb_item_count} = $bb_search_results->{count};
2436             } else {
2437                 $logger->warn("search failed in load_myopac_bookbags()");
2438                 $ctx->{bb_item_count} = 0; # fallback value
2439             }
2440
2441             #calculate page count
2442             $ctx->{bb_page_count} = int ((($ctx->{bb_item_count} - 1) / $item_limit) + 1);
2443
2444             if ( ($self->cgi->param("action") || '') eq "editmeta") {
2445                 if (!$self->_update_bookbag_metadata($bookbag))  {
2446                     $e->rollback;
2447                     return Apache2::Const::HTTP_INTERNAL_SERVER_ERROR;
2448                 } else {
2449                     $e->commit;
2450                     my $url = $self->ctx->{opac_root} . '/myopac/lists?bbid=' .
2451                         $bookbag->id;
2452
2453                     foreach my $param (('loc', 'qtype', 'query', 'sort', 'offset', 'limit')) {
2454                         if ($self->cgi->param($param)) {
2455                             my @vals = $self->cgi->param($param);
2456                             $url .= ";$param=" . uri_escape_utf8($_) foreach @vals;
2457                         }
2458                     }
2459
2460                     return $self->generic_redirect($url);
2461                 }
2462             }
2463
2464             # we're done with our CStoreEditor.  Rollback here so
2465             # later calls don't cause a timeout, resulting in a
2466             # transaction rollback under the covers.
2467             $e->rollback;
2468
2469
2470             # For list items pagination
2471             my $args = {
2472                 "limit" => $item_limit,
2473                 "offset" => $item_offset
2474             };
2475
2476             my $items = $U->bib_container_items_via_search($bookbag->id, $query, $args)
2477                 or return Apache2::Const::HTTP_INTERNAL_SERVER_ERROR;
2478
2479             # capture pref_ou for callnumber filter/display
2480             $ctx->{pref_ou} = $self->_get_pref_lib() || $ctx->{search_ou};
2481
2482             # search for local callnumbers for display
2483             my $focus_ou = $ctx->{physical_loc} || $ctx->{pref_ou};
2484
2485             my (undef, @recs) = $self->get_records_and_facets(
2486                 [ map {$_->target_biblio_record_entry->id} @$items ],
2487                 undef,
2488                 {
2489                     flesh => '{mra,holdings_xml,acp,exclude_invisible_acn}',
2490                     flesh_depth => 1,
2491                     site => $ctx->{get_aou}->($focus_ou)->shortname,
2492                     pref_lib => $ctx->{pref_ou}
2493                 }
2494             );
2495
2496             $ctx->{bookbags_marc_xml}{$_->{id}} = $_->{marc_xml} for @recs;
2497
2498             $bookbag->items($items);
2499         }
2500     }
2501
2502     # If we have add_rec, we got here from the "Add to new list"
2503     # or "See all" popmenu items.
2504     if (my $add_rec = $self->cgi->param('add_rec')) {
2505         $self->ctx->{add_rec} = $add_rec;
2506         # But not in the staff client, 'cause that breaks things.
2507         unless ($self->ctx->{is_staff}) {
2508             # allow caller to provide the where_from in cases where
2509             # the referer is an intermediate error page
2510             if ($self->cgi->param('where_from')) {
2511                 $self->ctx->{where_from} = $self->cgi->param('where_from');
2512             } else {
2513                 $self->ctx->{where_from} = $self->ctx->{referer};
2514                 if ( my $anchor = $self->cgi->param('anchor') ) {
2515                     $self->ctx->{where_from} =~ s/#.*|$/#$anchor/;
2516                 }
2517             }
2518         }
2519     }
2520
2521     # this rollback may be a dupe, but that's OK because
2522     # cstoreditor ignores dupe rollbacks
2523     $e->rollback;
2524
2525     return Apache2::Const::OK;
2526 }
2527
2528
2529 # actions are create, delete, show, hide, rename, add_rec, delete_item, place_hold, print, email
2530 # CGI is action, list=list_id, add_rec/record=bre_id, del_item=bucket_item_id, name=new_bucket_name
2531 sub load_myopac_bookbag_update {
2532     my ($self, $action, $list_id, @hold_recs) = @_;
2533     my $e = $self->editor;
2534     my $cgi = $self->cgi;
2535
2536     # save_notes is effectively another action, but is passed in a separate
2537     # CGI parameter for what are really just layout reasons.
2538     $action = 'save_notes' if $cgi->param('save_notes');
2539     $action ||= $cgi->param('action');
2540
2541     $list_id ||= $cgi->param('list') || $cgi->param('bbid');
2542
2543     my @add_rec = $cgi->param('add_rec') || $cgi->param('record');
2544     my @selected_item = $cgi->param('selected_item');
2545     my $shared = $cgi->param('shared');
2546     my $move_cart = $cgi->param('move_cart');
2547     my $name = $cgi->param('name');
2548     my $description = $cgi->param('description');
2549     my $success = 0;
2550     my $list;
2551
2552     # bail out if user is attempting an action that requires
2553     # that at least one list item be selected
2554     if ((scalar(@selected_item) == 0) && (scalar(@hold_recs) == 0) &&
2555         ($action eq 'place_hold' || $action eq 'print' ||
2556          $action eq 'email' || $action eq 'del_item')) {
2557         my $url = $self->ctx->{referer};
2558         $url .= ($url =~ /\?/ ? '&' : '?') . 'list_none_selected=1' unless $url =~ /list_none_selected/;
2559         return $self->generic_redirect($url);
2560     }
2561
2562     # This url intentionally leaves off the edit_notes parameter, but
2563     # may need to add some back in for paging.
2564
2565     my $url = $self->ctx->{proto} . "://" . $self->ctx->{hostname} .
2566         $self->ctx->{opac_root} . "/myopac/lists?";
2567
2568     foreach my $param (('loc', 'qtype', 'query', 'sort')) {
2569         if ($cgi->param($param)) {
2570             my @vals = $cgi->param($param);
2571             $url .= ";$param=" . uri_escape_utf8($_) foreach @vals;
2572         }
2573     }
2574
2575     if ($action eq 'create') {
2576
2577         if ($name) {
2578             $list = Fieldmapper::container::biblio_record_entry_bucket->new;
2579             $list->name($name);
2580             $list->description($description);
2581             $list->owner($e->requestor->id);
2582             $list->btype('bookbag');
2583             $list->pub($shared ? 't' : 'f');
2584             $success = $U->simplereq('open-ils.actor',
2585                 'open-ils.actor.container.create', $e->authtoken, 'biblio', $list);
2586             if (ref($success) ne 'HASH') {
2587                 $list_id = (ref($success)) ? $success->id : $success;
2588                 if (scalar @add_rec) {
2589                     foreach my $add_rec (@add_rec) {
2590                         my $item = Fieldmapper::container::biblio_record_entry_bucket_item->new;
2591                         $item->bucket($list_id);
2592                         $item->target_biblio_record_entry($add_rec);
2593                         $success = $U->simplereq('open-ils.actor',
2594                                                 'open-ils.actor.container.item.create', $e->authtoken, 'biblio', $item);
2595                         last unless $success;
2596                     }
2597                 }
2598                 if ($move_cart) {
2599                     my ($cache_key, $list) = $self->fetch_mylist(0, 1);
2600                     foreach my $add_rec (@$list) {
2601                         my $item = Fieldmapper::container::biblio_record_entry_bucket_item->new;
2602                         $item->bucket($list_id);
2603                         $item->target_biblio_record_entry($add_rec);
2604                         $success = $U->simplereq('open-ils.actor',
2605                                                 'open-ils.actor.container.item.create', $e->authtoken, 'biblio', $item);
2606                         last unless $success;
2607                     }
2608                     $self->clear_anon_cache;
2609                 }
2610             }
2611             $url = $cgi->param('where_from') if ($success && $cgi->param('where_from'));
2612
2613         } else { # no name
2614             $self->ctx->{bucket_failure_noname} = 1;
2615         }
2616
2617     } elsif($action eq 'place_hold') {
2618
2619         # @hold_recs comes from anon lists redirect; selected_items comes from existing buckets
2620         my $from_basket = scalar(@hold_recs);
2621         unless (@hold_recs) {
2622             if (@selected_item) {
2623                 my $items = $e->search_container_biblio_record_entry_bucket_item({id => \@selected_item});
2624                 @hold_recs = map { $_->target_biblio_record_entry } @$items;
2625             }
2626         }
2627
2628         return Apache2::Const::OK unless @hold_recs;
2629         $logger->info("placing holds from list page on: @hold_recs");
2630
2631         my $url = $self->ctx->{opac_root} . '/place_hold?hold_type=T';
2632         $url .= ';hold_target=' . $_ for @hold_recs;
2633         $url .= ';from_basket=1' if $from_basket;
2634         foreach my $param (('loc', 'qtype', 'query')) {
2635             if ($cgi->param($param)) {
2636                 my @vals = $cgi->param($param);
2637                 $url .= ";$param=" . uri_escape_utf8($_) foreach @vals;
2638             }
2639         }
2640         return $self->generic_redirect($url);
2641
2642     } elsif ($action eq 'print') {
2643         my $temp_cache_key = $self->_stash_record_list_in_anon_cache(@selected_item);
2644         return $self->load_mylist_print($temp_cache_key);
2645     } elsif ($action eq 'email') {
2646         my $temp_cache_key = $self->_stash_record_list_in_anon_cache(@selected_item);
2647         return $self->load_mylist_email($temp_cache_key);
2648     } else {
2649
2650         $list = $e->retrieve_container_biblio_record_entry_bucket($list_id);
2651
2652         return Apache2::Const::HTTP_BAD_REQUEST unless
2653             $list and $list->owner == $e->requestor->id;
2654     }
2655
2656     if($action eq 'delete') {
2657         $success = $U->simplereq('open-ils.actor',
2658             'open-ils.actor.container.full_delete', $e->authtoken, 'biblio', $list_id);
2659         if ($success) {
2660             # We check to see if we're deleting the user's default list.
2661             $self->_load_user_with_prefs;
2662             my $settings_map = $self->ctx->{user_setting_map};
2663             if ($$settings_map{'opac.default_list'} == $list_id) {
2664                 # We unset the user's opac.default_list setting.
2665                 $success = $U->simplereq(
2666                     'open-ils.actor',
2667                     'open-ils.actor.patron.settings.update',
2668                     $e->authtoken,
2669                     $e->requestor->id,
2670                     { 'opac.default_list' => 0 }
2671                 );
2672             }
2673         }
2674     } elsif($action eq 'show') {
2675         unless($U->is_true($list->pub)) {
2676             $list->pub('t');
2677             $success = $U->simplereq('open-ils.actor',
2678                 'open-ils.actor.container.update', $e->authtoken, 'biblio', $list);
2679         }
2680
2681     } elsif($action eq 'hide') {
2682         if($U->is_true($list->pub)) {
2683             $list->pub('f');
2684             $success = $U->simplereq('open-ils.actor',
2685                 'open-ils.actor.container.update', $e->authtoken, 'biblio', $list);
2686         }
2687
2688     } elsif($action eq 'rename') {
2689         if($name) {
2690             $list->name($name);
2691             $success = $U->simplereq('open-ils.actor',
2692                 'open-ils.actor.container.update', $e->authtoken, 'biblio', $list);
2693         }
2694
2695     } elsif($action eq 'add_rec') {
2696         foreach my $add_rec (@add_rec) {
2697             my $item = Fieldmapper::container::biblio_record_entry_bucket_item->new;
2698             $item->bucket($list_id);
2699             $item->target_biblio_record_entry($add_rec);
2700             $success = $U->simplereq('open-ils.actor',
2701                 'open-ils.actor.container.item.create', $e->authtoken, 'biblio', $item);
2702             last unless $success;
2703         }
2704         # Redirect back where we came from if we have an anchor parameter:
2705         if ( my $anchor = $cgi->param('anchor') && !$self->ctx->{is_staff}) {
2706             $url = $self->ctx->{referer};
2707             $url =~ s/#.*|$/#$anchor/;
2708         } elsif ($cgi->param('where_from')) {
2709             # Or, if we have a "where_from" parameter.
2710             $url = $cgi->param('where_from');
2711         }
2712     } elsif ($action eq 'del_item') {
2713         foreach (@selected_item) {
2714             $success = $U->simplereq(
2715                 'open-ils.actor',
2716                 'open-ils.actor.container.item.delete', $e->authtoken, 'biblio', $_
2717             );
2718             last unless $success;
2719         }
2720     } elsif ($action eq 'save_notes') {
2721         $success = $self->update_bookbag_item_notes;
2722         $url .= "&bbid=" . uri_escape_utf8($cgi->param("bbid")) if $cgi->param("bbid");
2723     } elsif ($action eq 'make_default') {
2724         $success = $U->simplereq(
2725             'open-ils.actor',
2726             'open-ils.actor.patron.settings.update',
2727             $e->authtoken,
2728             $list->owner,
2729             { 'opac.default_list' => $list_id }
2730         );
2731     } elsif ($action eq 'remove_default') {
2732         $success = $U->simplereq(
2733             'open-ils.actor',
2734             'open-ils.actor.patron.settings.update',
2735             $e->authtoken,
2736             $list->owner,
2737             { 'opac.default_list' => 0 }
2738         );
2739     }
2740
2741     return $self->generic_redirect($url) if $success;
2742
2743     $self->ctx->{where_from} = $cgi->param('where_from');
2744     $self->ctx->{bucket_action} = $action;
2745     $self->ctx->{bucket_action_failed} = 1;
2746     return Apache2::Const::OK;
2747 }
2748
2749 sub update_bookbag_item_notes {
2750     my ($self) = @_;
2751     my $e = $self->editor;
2752
2753     my @note_keys = grep /^note-\d+/, keys(%{$self->cgi->Vars});
2754     my @item_keys = grep /^item-\d+/, keys(%{$self->cgi->Vars});
2755
2756     # We're going to leverage an API call that's already been written to check
2757     # permissions appropriately.
2758
2759     my $a = create OpenSRF::AppSession("open-ils.actor");
2760     my $method = "open-ils.actor.container.item_note.cud";
2761
2762     for my $note_key (@note_keys) {
2763         my $note;
2764
2765         my $id = ($note_key =~ /(\d+)/)[0];
2766
2767         if (!($note =
2768             $e->retrieve_container_biblio_record_entry_bucket_item_note($id))) {
2769             my $event = $e->die_event;
2770             $self->apache->log->warn(
2771                 "error retrieving cbrebin id $id, got event " .
2772                 $event->{textcode}
2773             );
2774             $a->kill_me;
2775             $self->ctx->{bucket_action_event} = $event;
2776             return;
2777         }
2778
2779         if (length($self->cgi->param($note_key))) {
2780             $note->ischanged(1);
2781             $note->note($self->cgi->param($note_key));
2782         } else {
2783             $note->isdeleted(1);
2784         }
2785
2786         my $r = $a->request($method, $e->authtoken, "biblio", $note)->gather(1);
2787
2788         if (defined $U->event_code($r)) {
2789             $self->apache->log->warn(
2790                 "attempt to modify cbrebin " . $note->id .
2791                 " returned event " .  $r->{textcode}
2792             );
2793             $e->rollback;
2794             $a->kill_me;
2795             $self->ctx->{bucket_action_event} = $r;
2796             return;
2797         }
2798     }
2799
2800     for my $item_key (@item_keys) {
2801         my $id = int(($item_key =~ /(\d+)/)[0]);
2802         my $text = $self->cgi->param($item_key);
2803
2804         chomp $text;
2805         next unless length $text;
2806
2807         my $note = new Fieldmapper::container::biblio_record_entry_bucket_item_note;
2808         $note->isnew(1);
2809         $note->item($id);
2810         $note->note($text);
2811
2812         my $r = $a->request($method, $e->authtoken, "biblio", $note)->gather(1);
2813
2814         if (defined $U->event_code($r)) {
2815             $self->apache->log->warn(
2816                 "attempt to create cbrebin for item " . $note->item .
2817                 " returned event " .  $r->{textcode}
2818             );
2819             $e->rollback;
2820             $a->kill_me;
2821             $self->ctx->{bucket_action_event} = $r;
2822             return;
2823         }
2824     }
2825
2826     $a->kill_me;
2827     return 1;   # success
2828 }
2829
2830 sub load_myopac_bookbag_print {
2831     my ($self) = @_;
2832
2833     my $id = int($self->cgi->param("list"));
2834
2835     my ($sorter, $modifier) = $self->_get_bookbag_sort_params("sort");
2836
2837     my $item_search =
2838         $self->_prepare_bookbag_container_query($id, $sorter, $modifier);
2839
2840     my $bbag;
2841
2842     # Get the bookbag object itself, assuming we're allowed to.
2843     if ($self->editor->allowed("VIEW_CONTAINER")) {
2844
2845         $bbag = $self->editor->retrieve_container_biblio_record_entry_bucket($id) or return Apache2::Const::HTTP_INTERNAL_SERVER_ERROR;
2846     } else {
2847         my $bookbags = $self->editor->search_container_biblio_record_entry_bucket(
2848             {
2849                 "id" => $id,
2850                 "-or" => {
2851                     "owner" => $self->editor->requestor->id,
2852                     "pub" => "t"
2853                 }
2854             }
2855         ) or return Apache2::Const::HTTP_INTERNAL_SERVER_ERROR;
2856
2857         $bbag = pop @$bookbags;
2858     }
2859
2860     # If we have a bookbag we're allowed to look at, issue the A/T event
2861     # to get CSV, passing as a user param that search query we built before.
2862     if ($bbag) {
2863         $self->ctx->{csv} = $U->fire_object_event(
2864             undef, "container.biblio_record_entry_bucket.csv",
2865             $bbag, $self->editor->requestor->home_ou,
2866             undef, {"item_search" => $item_search}
2867         );
2868     }
2869
2870     # Create a reasonable filename and set the content disposition to
2871     # provoke browser download dialogs.
2872     (my $filename = $bbag->id . $bbag->name) =~ s/[^a-z0-9_ -]//gi;
2873
2874     return $self->set_file_download_headers("$filename.csv");
2875 }
2876
2877 sub load_myopac_circ_history_export {
2878     my $self = shift;
2879     my $e = $self->editor;
2880     my $filename = $self->cgi->param('filename') || 'circ_history.csv';
2881
2882     my $circs = $self->fetch_user_circ_history(1);
2883
2884     $self->ctx->{csv}->{circs} = $circs;
2885     return $self->set_file_download_headers($filename, 'text/csv; encoding=UTF-8');
2886
2887 }
2888
2889 sub load_myopac_reservations {
2890     my $self = shift;
2891     my $e = $self->editor;
2892     my $ctx = $self->ctx;
2893
2894     my $upcoming = $U->simplereq("open-ils.booking", "open-ils.booking.reservations.upcoming_reservation_list_by_user",
2895         $e->authtoken, undef
2896     );
2897
2898     $ctx->{reservations} = $upcoming;
2899     return Apache2::Const::OK;
2900
2901 }
2902
2903 sub load_password_reset {
2904     my $self = shift;
2905     my $cgi = $self->cgi;
2906     my $ctx = $self->ctx;
2907     my $barcode = $cgi->param('barcode');
2908     my $username = $cgi->param('username');
2909     my $email = $cgi->param('email');
2910     my $pwd1 = $cgi->param('pwd1');
2911     my $pwd2 = $cgi->param('pwd2');
2912     my $uuid = $ctx->{page_args}->[0];
2913
2914     if ($uuid) {
2915
2916         $logger->info("patron password reset with uuid $uuid");
2917
2918         if ($pwd1 and $pwd2) {
2919
2920             if ($pwd1 eq $pwd2) {
2921
2922                 my $response = $U->simplereq(
2923                     'open-ils.actor',
2924                     'open-ils.actor.patron.password_reset.commit',
2925                     $uuid, $pwd1);
2926
2927                 $logger->info("patron password reset response " . Dumper($response));
2928
2929                 if ($U->event_code($response)) { # non-success event
2930
2931                     my $code = $response->{textcode};
2932
2933                     if ($code eq 'PATRON_NOT_AN_ACTIVE_PASSWORD_RESET_REQUEST') {
2934                         $ctx->{pwreset} = {style => 'error', status => 'NOT_ACTIVE'};
2935                     }
2936
2937                     if ($code eq 'PATRON_PASSWORD_WAS_NOT_STRONG') {
2938                         $ctx->{pwreset} = {style => 'error', status => 'NOT_STRONG'};
2939                     }
2940
2941                 } else { # success
2942
2943                     $ctx->{pwreset} = {style => 'success', status => 'SUCCESS'};
2944                 }
2945
2946             } else { # passwords not equal
2947
2948                 $ctx->{pwreset} = {style => 'error', status => 'NO_MATCH'};
2949             }
2950
2951         } else { # 2 password values needed
2952
2953             $ctx->{pwreset} = {status => 'TWO_PASSWORDS'};
2954         }
2955
2956     } elsif ($barcode or $username) {
2957
2958         my @params = $barcode ? ('barcode', $barcode) : ('username', $username);
2959         push(@params, $email) if $email;
2960
2961         $U->simplereq(
2962             'open-ils.actor',
2963             'open-ils.actor.patron.password_reset.request', @params);
2964
2965         $ctx->{pwreset} = {status => 'REQUEST_SUCCESS'};
2966     }
2967
2968     $logger->info("patron password reset resulted in " . Dumper($ctx->{pwreset}));
2969     return Apache2::Const::OK;
2970 }
2971
2972 1;