Open-ILS/src/perlmods/lib/OpenILS/Application/Actor.pm

   1 package OpenILS::Application::Actor;
   2 use OpenILS::Application;
   3 use base qw/OpenILS::Application/;
   4 use strict; use warnings;
   5 use Data::Dumper;
   6 $Data::Dumper::Indent = 0;
   7 use OpenILS::Event;
   8
   9 use Digest::MD5 qw(md5_hex);
  10
  11 use OpenSRF::EX qw(:try);
  12 use OpenILS::Perm;
  13
  14 use OpenILS::Application::AppUtils;
  15
  16 use OpenILS::Utils::Fieldmapper;
  17 use OpenILS::Utils::ModsParser;
  18 use OpenSRF::Utils::Logger qw/$logger/;
  19 use OpenSRF::Utils qw/:datetime/;
  20 use OpenSRF::Utils::SettingsClient;
  21
  22 use OpenSRF::Utils::Cache;
  23
  24 use OpenSRF::Utils::JSON;
  25 use DateTime;
  26 use DateTime::Format::ISO8601;
  27 use OpenILS::Const qw/:const/;
  28
  29 use OpenILS::Application::Actor::Container;
  30 use OpenILS::Application::Actor::ClosedDates;
  31 use OpenILS::Application::Actor::UserGroups;
  32 use OpenILS::Application::Actor::Friends;
  33 use OpenILS::Application::Actor::Stage;
  34
  35 use OpenILS::Utils::CStoreEditor qw/:funcs/;
  36 use OpenILS::Utils::Penalty;
  37 use OpenILS::Utils::BadContact;
  38 use List::Util qw/max reduce/;
  39
  40 use UUID::Tiny qw/:std/;
  41
  42 sub initialize {
  43     OpenILS::Application::Actor::Container->initialize();
  44     OpenILS::Application::Actor::UserGroups->initialize();
  45     OpenILS::Application::Actor::ClosedDates->initialize();
  46 }
  47
  48 my $apputils = "OpenILS::Application::AppUtils";
  49 my $U = $apputils;
  50
  51 sub _d { warn "Patron:\n" . Dumper(shift()); }
  52
  53 my $cache;
  54 my $set_user_settings;
  55 my $set_ou_settings;
  56
  57
  58 #__PACKAGE__->register_method(
  59 #   method  => "allowed_test",
  60 #   api_name    => "open-ils.actor.allowed_test",
  61 #);
  62 #sub allowed_test {
  63 #    my($self, $conn, $auth, $orgid, $permcode) = @_;
  64 #    my $e = new_editor(authtoken => $auth);
  65 #    return $e->die_event unless $e->checkauth;
  66 #
  67 #    return {
  68 #        orgid => $orgid,
  69 #        permcode => $permcode,
  70 #        result => $e->allowed($permcode, $orgid)
  71 #    };
  72 #}
  73
  74 __PACKAGE__->register_method(
  75     method  => "update_user_setting",
  76     api_name    => "open-ils.actor.patron.settings.update",
  77 );
  78 sub update_user_setting {
  79     my($self, $conn, $auth, $user_id, $settings) = @_;
  80     my $e = new_editor(xact => 1, authtoken => $auth);
  81     return $e->die_event unless $e->checkauth;
  82
  83     $user_id = $e->requestor->id unless defined $user_id;
  84
  85     unless($e->requestor->id == $user_id) {
  86         my $user = $e->retrieve_actor_user($user_id) or return $e->die_event;
  87         return $e->die_event unless $e->allowed('UPDATE_USER', $user->home_ou);
  88     }
  89
  90     for my $name (keys %$settings) {
  91         my $val = $$settings{$name};
  92         my $set = $e->search_actor_user_setting({usr => $user_id, name => $name})->[0];
  93
  94         if(defined $val) {
  95             $val = OpenSRF::Utils::JSON->perl2JSON($val);
  96             if($set) {
  97                 $set->value($val);
  98                 $e->update_actor_user_setting($set) or return $e->die_event;
  99             } else {
 100                 $set = Fieldmapper::actor::user_setting->new;
 101                 $set->usr($user_id);
 102                 $set->name($name);
 103                 $set->value($val);
 104                 $e->create_actor_user_setting($set) or return $e->die_event;
 105             }
 106         } elsif($set) {
 107             $e->delete_actor_user_setting($set) or return $e->die_event;
 108         }
 109     }
 110
 111     $e->commit;
 112     return 1;
 113 }
 114
 115
 116 __PACKAGE__->register_method(
 117     method    => "set_ou_settings",
 118     api_name  => "open-ils.actor.org_unit.settings.update",
 119     signature => {
 120         desc => "Updates the value for a given org unit setting.  The permission to update "          .
 121                 "an org unit setting is either the UPDATE_ORG_UNIT_SETTING_ALL, or a specific "       .
 122                 "permission specified in the update_perm column of the config.org_unit_setting_type " .
 123                 "table's row corresponding to the setting being changed." ,
 124         params => [
 125             {desc => 'Authentication token',             type => 'string'},
 126             {desc => 'Org unit ID',                      type => 'number'},
 127             {desc => 'Hash of setting name-value pairs', type => 'object'}
 128         ],
 129         return => {desc => '1 on success, Event on error'}
 130     }
 131 );
 132
 133 sub set_ou_settings {
 134     my( $self, $client, $auth, $org_id, $settings ) = @_;
 135
 136     my $e = new_editor(authtoken => $auth, xact => 1);
 137     return $e->die_event unless $e->checkauth;
 138
 139     my $all_allowed = $e->allowed("UPDATE_ORG_UNIT_SETTING_ALL", $org_id);
 140
 141     for my $name (keys %$settings) {
 142         my $val = $$settings{$name};
 143
 144         my $type = $e->retrieve_config_org_unit_setting_type([
 145             $name,
 146             {flesh => 1, flesh_fields => {'coust' => ['update_perm']}}
 147         ]) or return $e->die_event;
 148         my $set = $e->search_actor_org_unit_setting({org_unit => $org_id, name => $name})->[0];
 149
 150         # If there is no relevant permission, the default assumption will
 151         # be, "no, the caller cannot change that value."
 152         return $e->die_event unless ($all_allowed ||
 153             ($type->update_perm && $e->allowed($type->update_perm->code, $org_id)));
 154
 155         if(defined $val) {
 156             $val = OpenSRF::Utils::JSON->perl2JSON($val);
 157             if($set) {
 158                 $set->value($val);
 159                 $e->update_actor_org_unit_setting($set) or return $e->die_event;
 160             } else {
 161                 $set = Fieldmapper::actor::org_unit_setting->new;
 162                 $set->org_unit($org_id);
 163                 $set->name($name);
 164                 $set->value($val);
 165                 $e->create_actor_org_unit_setting($set) or return $e->die_event;
 166             }
 167         } elsif($set) {
 168             $e->delete_actor_org_unit_setting($set) or return $e->die_event;
 169         }
 170     }
 171
 172     $e->commit;
 173     return 1;
 174 }
 175
 176 __PACKAGE__->register_method(
 177     method   => "user_settings",
 178     authoritative => 1,
 179     api_name => "open-ils.actor.patron.settings.retrieve",
 180 );
 181 sub user_settings {
 182     my( $self, $client, $auth, $user_id, $setting ) = @_;
 183
 184     my $e = new_editor(authtoken => $auth);
 185     return $e->event unless $e->checkauth;
 186     $user_id = $e->requestor->id unless defined $user_id;
 187
 188     my $patron = $e->retrieve_actor_user($user_id) or return $e->event;
 189     if($e->requestor->id != $user_id) {
 190         return $e->event unless $e->allowed('VIEW_USER', $patron->home_ou);
 191     }
 192
 193     sub get_setting {
 194         my($e, $user_id, $setting) = @_;
 195         my $val = $e->search_actor_user_setting({usr => $user_id, name => $setting})->[0];
 196         return undef unless $val; # XXX this should really return undef, but needs testing
 197         return OpenSRF::Utils::JSON->JSON2perl($val->value);
 198     }
 199
 200     if($setting) {
 201         if(ref $setting eq 'ARRAY') {
 202             my %settings;
 203             $settings{$_} = get_setting($e, $user_id, $_) for @$setting;
 204             return \%settings;
 205         } else {
 206             return get_setting($e, $user_id, $setting);
 207         }
 208     } else {
 209         my $s = $e->search_actor_user_setting({usr => $user_id});
 210         return { map { ( $_->name => OpenSRF::Utils::JSON->JSON2perl($_->value) ) } @$s };
 211     }
 212 }
 213
 214
 215 __PACKAGE__->register_method(
 216     method    => "ranged_ou_settings",
 217     api_name  => "open-ils.actor.org_unit_setting.values.ranged.retrieve",
 218     signature => {
 219         desc   => "Retrieves all org unit settings for the given org_id, up to whatever limit " .
 220                 "is implied for retrieving OU settings by the authenticated users' permissions.",
 221         params => [
 222             {desc => 'Authentication token',   type => 'string'},
 223             {desc => 'Org unit ID',            type => 'number'},
 224         ],
 225         return => {desc => 'A hashref of "ranged" settings, event on error'}
 226     }
 227 );
 228 sub ranged_ou_settings {
 229     my( $self, $client, $auth, $org_id ) = @_;
 230
 231     my $e = new_editor(authtoken => $auth);
 232     return $e->event unless $e->checkauth;
 233
 234     my %ranged_settings;
 235     my $org_list = $U->get_org_ancestors($org_id);
 236     my $settings = $e->search_actor_org_unit_setting({org_unit => $org_list});
 237     $org_list = [ reverse @$org_list ];
 238
 239     # start at the context org and capture the setting value
 240     # without clobbering settings we've already captured
 241     for my $this_org_id (@$org_list) {
 242
 243         my @sets = grep { $_->org_unit == $this_org_id } @$settings;
 244
 245         for my $set (@sets) {
 246             my $type = $e->retrieve_config_org_unit_setting_type([
 247                 $set->name,
 248                 {flesh => 1, flesh_fields => {coust => ['view_perm']}}
 249             ]);
 250
 251             # If there is no relevant permission, the default assumption will
 252             # be, "yes, the caller can have that value."
 253             if ($type && $type->view_perm) {
 254                 next if not $e->allowed($type->view_perm->code, $org_id);
 255             }
 256
 257             $ranged_settings{$set->name} = OpenSRF::Utils::JSON->JSON2perl($set->value)
 258                 unless defined $ranged_settings{$set->name};
 259         }
 260     }
 261
 262     return \%ranged_settings;
 263 }
 264
 265
 266
 267 __PACKAGE__->register_method(
 268     api_name  => 'open-ils.actor.ou_setting.ancestor_default',
 269     method    => 'ou_ancestor_setting',
 270     signature => {
 271         desc => 'Get the org unit setting value associated with the setting name as seen from the specified org unit.  ' .
 272                 'This method will make sure that the given user has permission to view that setting, if there is a '     .
 273                 'permission associated with the setting.  If a permission is required and no authtoken is given, or '     .
 274                 'the user lacks the permisssion, undef will be returned.'       ,
 275         params => [
 276             { desc => 'Org unit ID',          type => 'number' },
 277             { desc => 'setting name',         type => 'string' },
 278             { desc => 'authtoken (optional)', type => 'string' }
 279         ],
 280         return => {desc => 'A value for the org unit setting, or undef'}
 281     }
 282 );
 283
 284 # ------------------------------------------------------------------
 285 # Attempts to find the org setting value for a given org.  if not
 286 # found at the requested org, searches up the org tree until it
 287 # finds a parent that has the requested setting.
 288 # when found, returns { org => $id, value => $value }
 289 # otherwise, returns NULL
 290 # ------------------------------------------------------------------
 291 sub ou_ancestor_setting {
 292     my( $self, $client, $orgid, $name, $auth ) = @_;
 293     # Make sure $auth is set to something if not given.
 294     $auth ||= -1;
 295     return $U->ou_ancestor_setting($orgid, $name, undef, $auth);
 296 }
 297
 298 __PACKAGE__->register_method(
 299     api_name  => 'open-ils.actor.ou_setting.ancestor_default.batch',
 300     method    => 'ou_ancestor_setting_batch',
 301     signature => {
 302         desc => 'Get org unit setting name => value pairs for a list of names, as seen from the specified org unit.  ' .
 303                 'This method will make sure that the given user has permission to view that setting, if there is a '     .
 304                 'permission associated with the setting.  If a permission is required and no authtoken is given, or '     .
 305                 'the user lacks the permisssion, undef will be returned.'       ,
 306         params => [
 307             { desc => 'Org unit ID',          type => 'number' },
 308             { desc => 'setting name list',    type => 'array'  },
 309             { desc => 'authtoken (optional)', type => 'string' }
 310         ],
 311         return => {desc => 'A hash with name => value pairs for the org unit settings'}
 312     }
 313 );
 314 sub ou_ancestor_setting_batch {
 315     my( $self, $client, $orgid, $name_list, $auth ) = @_;
 316
 317     # splitting the list of settings to fetch values
 318     # so that ones that *don't* require view_perm checks
 319     # can be fetched in one fell swoop, which is
 320     # significantly faster in cases where a large
 321     # number of settings need to be fetched.
 322     my %perm_check_required = ();
 323     my @perm_check_not_required = ();
 324
 325     # Note that ->ou_ancestor_setting also can check
 326     # to see if the setting has a view_perm, but testing
 327     # suggests that the redundant checks do not significantly
 328     # increase the time it takes to fetch the values of
 329     # permission-controlled settings.
 330     my $e = new_editor();
 331     my $res = $e->search_config_org_unit_setting_type({
 332         name      => $name_list,
 333         view_perm => { "!=" => undef },
 334     });
 335     %perm_check_required = map { $_->name() => 1 } @$res;
 336     foreach my $setting (@$name_list) {
 337         push @perm_check_not_required, $setting
 338             unless exists($perm_check_required{$setting});
 339     }
 340
 341     my %values;
 342     if (@perm_check_not_required) {
 343         %values = $U->ou_ancestor_setting_batch_insecure($orgid, \@perm_check_not_required);
 344     }
 345     $values{$_} = $U->ou_ancestor_setting(
 346         $orgid, $_, undef,
 347         ($auth ? $auth : -1)
 348     ) for keys(%perm_check_required);
 349     return \%values;
 350 }
 351
 352
 353
 354 __PACKAGE__->register_method(
 355     method   => "update_patron",
 356     api_name => "open-ils.actor.patron.update",
 357     signature => {
 358         desc   => q/
 359             Update an existing user, or create a new one.  Related objects,
 360             like cards, addresses, survey responses, and stat cats,
 361             can be updated by attaching them to the user object in their
 362             respective fields.  For examples, the billing address object
 363             may be inserted into the 'billing_address' field, etc.  For each
 364             attached object, indicate if the object should be created,
 365             updated, or deleted using the built-in 'isnew', 'ischanged',
 366             and 'isdeleted' fields on the object.
 367         /,
 368         params => [
 369             { desc => 'Authentication token', type => 'string' },
 370             { desc => 'Patron data object',   type => 'object' }
 371         ],
 372         return => {desc => 'A fleshed user object, event on error'}
 373     }
 374 );
 375
 376 sub update_patron {
 377     my( $self, $client, $auth, $patron ) = @_;
 378
 379     my $e = new_editor(xact => 1, authtoken => $auth);
 380     return $e->event unless $e->checkauth;
 381
 382     $logger->info($patron->isnew ? "Creating new patron..." :
 383         "Updating Patron: " . $patron->id);
 384
 385     my $evt = check_group_perm($e, $e->requestor, $patron);
 386     return $evt if $evt;
 387
 388     # $new_patron is the patron in progress.  $patron is the original patron
 389     # passed in with the method.  new_patron will change as the components
 390     # of patron are added/updated.
 391
 392     my $new_patron;
 393
 394     # unflesh the real items on the patron
 395     $patron->card( $patron->card->id ) if(ref($patron->card));
 396     $patron->billing_address( $patron->billing_address->id )
 397         if(ref($patron->billing_address));
 398     $patron->mailing_address( $patron->mailing_address->id )
 399         if(ref($patron->mailing_address));
 400
 401     # create/update the patron first so we can use his id
 402
 403     # $patron is the obj from the client (new data) and $new_patron is the
 404     # patron object properly built for db insertion, so we need a third variable
 405     # if we want to represent the old patron.
 406
 407     my $old_patron;
 408     my $barred_hook = '';
 409
 410     if($patron->isnew()) {
 411         ( $new_patron, $evt ) = _add_patron($e, _clone_patron($patron));
 412         return $evt if $evt;
 413         if($U->is_true($patron->barred)) {
 414             return $e->die_event unless
 415                 $e->allowed('BAR_PATRON', $patron->home_ou);
 416         }
 417     } else {
 418         $new_patron = $patron;
 419
 420         # Did auth checking above already.
 421         $old_patron = $e->retrieve_actor_user($patron->id) or
 422             return $e->die_event;
 423
 424         if($U->is_true($old_patron->barred) != $U->is_true($new_patron->barred)) {
 425             my $perm = $U->is_true($old_patron->barred) ? 'UNBAR_PATRON' : 'BAR_PATRON';
 426             return $e->die_event unless $e->allowed($perm, $patron->home_ou);
 427
 428             $barred_hook = $U->is_true($new_patron->barred) ?
 429                 'au.barred' : 'au.unbarred';
 430         }
 431
 432         # update the password by itself to avoid the password protection magic
 433         if ($patron->passwd && $patron->passwd ne $old_patron->passwd) {
 434             modify_migrated_user_password($e, $patron->id, $patron->passwd);
 435             $new_patron->passwd(''); # subsequent update will set
 436                                      # actor.usr.passwd to MD5('')
 437         }
 438     }
 439
 440     ( $new_patron, $evt ) = _add_update_addresses($e, $patron, $new_patron);
 441     return $evt if $evt;
 442
 443     ( $new_patron, $evt ) = _add_update_cards($e, $patron, $new_patron);
 444     return $evt if $evt;
 445
 446     ( $new_patron, $evt ) = _add_survey_responses($e, $patron, $new_patron);
 447     return $evt if $evt;
 448
 449     # re-update the patron if anything has happened to him during this process
 450     if($new_patron->ischanged()) {
 451         ( $new_patron, $evt ) = _update_patron($e, $new_patron);
 452         return $evt if $evt;
 453     }
 454
 455     ( $new_patron, $evt ) = _clear_badcontact_penalties($e, $old_patron, $new_patron);
 456     return $evt if $evt;
 457
 458     ($new_patron, $evt) = _create_stat_maps($e, $patron, $new_patron);
 459     return $evt if $evt;
 460
 461     ($new_patron, $evt) = _create_perm_maps($e, $patron, $new_patron);
 462     return $evt if $evt;
 463
 464     $evt = apply_invalid_addr_penalty($e, $patron);
 465     return $evt if $evt;
 466
 467     $e->commit;
 468
 469     my $tses = OpenSRF::AppSession->create('open-ils.trigger');
 470     if($patron->isnew) {
 471         $tses->request('open-ils.trigger.event.autocreate',
 472             'au.create', $new_patron, $new_patron->home_ou);
 473     } else {
 474         $tses->request('open-ils.trigger.event.autocreate',
 475             'au.update', $new_patron, $new_patron->home_ou);
 476
 477         $tses->request('open-ils.trigger.event.autocreate', $barred_hook,
 478             $new_patron, $new_patron->home_ou) if $barred_hook;
 479     }
 480
 481     $e->xact_begin; # $e->rollback is called in new_flesh_user
 482     return flesh_user($new_patron->id(), $e);
 483 }
 484
 485 sub apply_invalid_addr_penalty {
 486     my $e = shift;
 487     my $patron = shift;
 488
 489     # grab the invalid address penalty if set
 490     my $penalties = OpenILS::Utils::Penalty->retrieve_usr_penalties($e, $patron->id, $patron->home_ou);
 491
 492     my ($addr_penalty) = grep
 493         { $_->standing_penalty->name eq 'INVALID_PATRON_ADDRESS' } @$penalties;
 494
 495     # do we enforce invalid address penalty
 496     my $enforce = $U->ou_ancestor_setting_value(
 497         $patron->home_ou, 'circ.patron_invalid_address_apply_penalty') || 0;
 498
 499     my $addrs = $e->search_actor_user_address(
 500         {usr => $patron->id, valid => 'f', id => {'>' => 0}}, {idlist => 1});
 501     my $addr_count = scalar(@$addrs);
 502
 503     if($addr_count == 0 and $addr_penalty) {
 504
 505         # regardless of any settings, remove the penalty when the user has no invalid addresses
 506         $e->delete_actor_user_standing_penalty($addr_penalty) or return $e->die_event;
 507         $e->commit;
 508
 509     } elsif($enforce and $addr_count > 0 and !$addr_penalty) {
 510
 511         my $ptype = $e->retrieve_config_standing_penalty(29) or return $e->die_event;
 512         my $depth = $ptype->org_depth;
 513         my $ctx_org = $U->org_unit_ancestor_at_depth($patron->home_ou, $depth) if defined $depth;
 514         $ctx_org = $patron->home_ou unless defined $ctx_org;
 515
 516         my $penalty = Fieldmapper::actor::user_standing_penalty->new;
 517         $penalty->usr($patron->id);
 518         $penalty->org_unit($ctx_org);
 519         $penalty->standing_penalty(OILS_PENALTY_INVALID_PATRON_ADDRESS);
 520
 521         $e->create_actor_user_standing_penalty($penalty) or return $e->die_event;
 522     }
 523
 524     return undef;
 525 }
 526
 527
 528 sub flesh_user {
 529     my $id = shift;
 530     my $e = shift;
 531     my $home_ou = shift;
 532
 533     my $fields = [
 534         "cards",
 535         "card",
 536         "standing_penalties",
 537         "addresses",
 538         "billing_address",
 539         "mailing_address",
 540         "stat_cat_entries",
 541         "settings",
 542         "usr_activity"
 543     ];
 544     push @$fields, "home_ou" if $home_ou;
 545     return new_flesh_user($id, $fields, $e );
 546 }
 547
 548
 549
 550
 551
 552
 553 # clone and clear stuff that would break the database
 554 sub _clone_patron {
 555     my $patron = shift;
 556
 557     my $new_patron = $patron->clone;
 558     # clear these
 559     $new_patron->clear_billing_address();
 560     $new_patron->clear_mailing_address();
 561     $new_patron->clear_addresses();
 562     $new_patron->clear_card();
 563     $new_patron->clear_cards();
 564     $new_patron->clear_id();
 565     $new_patron->clear_isnew();
 566     $new_patron->clear_ischanged();
 567     $new_patron->clear_isdeleted();
 568     $new_patron->clear_stat_cat_entries();
 569     $new_patron->clear_permissions();
 570     $new_patron->clear_standing_penalties();
 571
 572     return $new_patron;
 573 }
 574
 575
 576 sub _add_patron {
 577
 578     my $e          = shift;
 579     my $patron      = shift;
 580
 581     return (undef, $e->die_event) unless
 582         $e->allowed('CREATE_USER', $patron->home_ou);
 583
 584     my $ex = $e->search_actor_user(
 585         {usrname => $patron->usrname}, {idlist => 1});
 586     return (undef, OpenILS::Event->new('USERNAME_EXISTS')) if @$ex;
 587
 588     $logger->info("Creating new user in the DB with username: ".$patron->usrname());
 589
 590     # do a dance to get the password hashed securely
 591     my $saved_password = $patron->passwd;
 592     $patron->passwd('');
 593     $e->create_actor_user($patron) or return $e->die_event;
 594     modify_migrated_user_password($e, $patron->id, $saved_password);
 595
 596     my $id = $patron->id; # added by CStoreEditor
 597
 598     $logger->info("Successfully created new user [$id] in DB");
 599     return ($e->retrieve_actor_user($id), undef);
 600 }
 601
 602
 603 sub check_group_perm {
 604     my( $e, $requestor, $patron ) = @_;
 605     my $evt;
 606
 607     # first let's see if the requestor has
 608     # priveleges to update this user in any way
 609     if( ! $patron->isnew ) {
 610         my $p = $e->retrieve_actor_user($patron->id);
 611
 612         # If we are the requestor (trying to update our own account)
 613         # and we are not trying to change our profile, we're good
 614         if( $p->id == $requestor->id and
 615                 $p->profile == $patron->profile ) {
 616             return undef;
 617         }
 618
 619
 620         $evt = group_perm_failed($e, $requestor, $p);
 621         return $evt if $evt;
 622     }
 623
 624     # They are allowed to edit this patron.. can they put the
 625     # patron into the group requested?
 626     $evt = group_perm_failed($e, $requestor, $patron);
 627     return $evt if $evt;
 628     return undef;
 629 }
 630
 631
 632 sub group_perm_failed {
 633     my( $e, $requestor, $patron ) = @_;
 634
 635     my $perm;
 636     my $grp;
 637     my $grpid = $patron->profile;
 638
 639     do {
 640
 641         $logger->debug("user update looking for group perm for group $grpid");
 642         $grp = $e->retrieve_permission_grp_tree($grpid);
 643
 644     } while( !($perm = $grp->application_perm) and ($grpid = $grp->parent) );
 645
 646     $logger->info("user update checking perm $perm on user ".
 647         $requestor->id." for update/create on user username=".$patron->usrname);
 648
 649     return $e->allowed($perm, $patron->home_ou) ? undef : $e->die_event;
 650 }
 651
 652
 653
 654 sub _update_patron {
 655     my( $e, $patron, $noperm) = @_;
 656
 657     $logger->info("Updating patron ".$patron->id." in DB");
 658
 659     my $evt;
 660
 661     if(!$noperm) {
 662         return (undef, $e->die_event)
 663             unless $e->allowed('UPDATE_USER', $patron->home_ou);
 664     }
 665
 666     if(!$patron->ident_type) {
 667         $patron->clear_ident_type;
 668         $patron->clear_ident_value;
 669     }
 670
 671     $evt = verify_last_xact($e, $patron);
 672     return (undef, $evt) if $evt;
 673
 674     $e->update_actor_user($patron) or return (undef, $e->die_event);
 675
 676     # re-fetch the user to pick up the latest last_xact_id value
 677     # to avoid collisions.
 678     $patron = $e->retrieve_actor_user($patron->id);
 679
 680     return ($patron);
 681 }
 682
 683 sub verify_last_xact {
 684     my( $e, $patron ) = @_;
 685     return undef unless $patron->id and $patron->id > 0;
 686     my $p = $e->retrieve_actor_user($patron->id);
 687     my $xact = $p->last_xact_id;
 688     return undef unless $xact;
 689     $logger->info("user xact = $xact, saving with xact " . $patron->last_xact_id);
 690     return OpenILS::Event->new('XACT_COLLISION')
 691         if $xact ne $patron->last_xact_id;
 692     return undef;
 693 }
 694
 695
 696 sub _check_dup_ident {
 697     my( $session, $patron ) = @_;
 698
 699     return undef unless $patron->ident_value;
 700
 701     my $search = {
 702         ident_type  => $patron->ident_type,
 703         ident_value => $patron->ident_value,
 704     };
 705
 706     $logger->debug("patron update searching for dup ident values: " .
 707         $patron->ident_type . ':' . $patron->ident_value);
 708
 709     $search->{id} = {'!=' => $patron->id} if $patron->id and $patron->id > 0;
 710
 711     my $dups = $session->request(
 712         'open-ils.storage.direct.actor.user.search_where.atomic', $search )->gather(1);
 713
 714
 715     return OpenILS::Event->new('PATRON_DUP_IDENT1', payload => $patron )
 716         if $dups and @$dups;
 717
 718     return undef;
 719 }
 720
 721
 722 sub _add_update_addresses {
 723
 724     my $e = shift;
 725     my $patron = shift;
 726     my $new_patron = shift;
 727
 728     my $evt;
 729
 730     my $current_id; # id of the address before creation
 731
 732     my $addresses = $patron->addresses();
 733
 734     for my $address (@$addresses) {
 735
 736         next unless ref $address;
 737         $current_id = $address->id();
 738
 739         if( $patron->billing_address() and
 740             $patron->billing_address() == $current_id ) {
 741             $logger->info("setting billing addr to $current_id");
 742             $new_patron->billing_address($address->id());
 743             $new_patron->ischanged(1);
 744         }
 745
 746         if( $patron->mailing_address() and
 747             $patron->mailing_address() == $current_id ) {
 748             $new_patron->mailing_address($address->id());
 749             $logger->info("setting mailing addr to $current_id");
 750             $new_patron->ischanged(1);
 751         }
 752
 753
 754         if($address->isnew()) {
 755
 756             $address->usr($new_patron->id());
 757
 758             ($address, $evt) = _add_address($e,$address);
 759             return (undef, $evt) if $evt;
 760
 761             # we need to get the new id
 762             if( $patron->billing_address() and
 763                     $patron->billing_address() == $current_id ) {
 764                 $new_patron->billing_address($address->id());
 765                 $logger->info("setting billing addr to $current_id");
 766                 $new_patron->ischanged(1);
 767             }
 768
 769             if( $patron->mailing_address() and
 770                     $patron->mailing_address() == $current_id ) {
 771                 $new_patron->mailing_address($address->id());
 772                 $logger->info("setting mailing addr to $current_id");
 773                 $new_patron->ischanged(1);
 774             }
 775
 776         } elsif($address->ischanged() ) {
 777
 778             ($address, $evt) = _update_address($e, $address);
 779             return (undef, $evt) if $evt;
 780
 781         } elsif($address->isdeleted() ) {
 782
 783             if( $address->id() == $new_patron->mailing_address() ) {
 784                 $new_patron->clear_mailing_address();
 785                 ($new_patron, $evt) = _update_patron($e, $new_patron);
 786                 return (undef, $evt) if $evt;
 787             }
 788
 789             if( $address->id() == $new_patron->billing_address() ) {
 790                 $new_patron->clear_billing_address();
 791                 ($new_patron, $evt) = _update_patron($e, $new_patron);
 792                 return (undef, $evt) if $evt;
 793             }
 794
 795             $evt = _delete_address($e, $address);
 796             return (undef, $evt) if $evt;
 797         }
 798     }
 799
 800     return ( $new_patron, undef );
 801 }
 802
 803
 804 # adds an address to the db and returns the address with new id
 805 sub _add_address {
 806     my($e, $address) = @_;
 807     $address->clear_id();
 808
 809     $logger->info("Creating new address at street ".$address->street1);
 810
 811     # put the address into the database
 812     $e->create_actor_user_address($address) or return (undef, $e->die_event);
 813     return ($address, undef);
 814 }
 815
 816
 817 sub _update_address {
 818     my( $e, $address ) = @_;
 819
 820     $logger->info("Updating address ".$address->id." in the DB");
 821
 822     $e->update_actor_user_address($address) or return (undef, $e->die_event);
 823
 824     return ($address, undef);
 825 }
 826
 827
 828
 829 sub _add_update_cards {
 830
 831     my $e = shift;
 832     my $patron = shift;
 833     my $new_patron = shift;
 834
 835     my $evt;
 836
 837     my $virtual_id; #id of the card before creation
 838
 839     my $cards = $patron->cards();
 840     for my $card (@$cards) {
 841
 842         $card->usr($new_patron->id());
 843
 844         if(ref($card) and $card->isnew()) {
 845
 846             $virtual_id = $card->id();
 847             ( $card, $evt ) = _add_card($e, $card);
 848             return (undef, $evt) if $evt;
 849
 850             #if(ref($patron->card)) { $patron->card($patron->card->id); }
 851             if($patron->card() == $virtual_id) {
 852                 $new_patron->card($card->id());
 853                 $new_patron->ischanged(1);
 854             }
 855
 856         } elsif( ref($card) and $card->ischanged() ) {
 857             $evt = _update_card($e, $card);
 858             return (undef, $evt) if $evt;
 859         }
 860     }
 861
 862     return ( $new_patron, undef );
 863 }
 864
 865
 866 # adds an card to the db and returns the card with new id
 867 sub _add_card {
 868     my( $e, $card ) = @_;
 869     $card->clear_id();
 870
 871     $logger->info("Adding new patron card ".$card->barcode);
 872
 873     $e->create_actor_card($card) or return (undef, $e->die_event);
 874
 875     return ( $card, undef );
 876 }
 877
 878
 879 # returns event on error.  returns undef otherwise
 880 sub _update_card {
 881     my( $e, $card ) = @_;
 882     $logger->info("Updating patron card ".$card->id);
 883
 884     $e->update_actor_card($card) or return $e->die_event;
 885     return undef;
 886 }
 887
 888
 889
 890
 891 # returns event on error.  returns undef otherwise
 892 sub _delete_address {
 893     my( $e, $address ) = @_;
 894
 895     $logger->info("Deleting address ".$address->id." from DB");
 896
 897     $e->delete_actor_user_address($address) or return $e->die_event;
 898     return undef;
 899 }
 900
 901
 902
 903 sub _add_survey_responses {
 904     my ($e, $patron, $new_patron) = @_;
 905
 906     $logger->info( "Updating survey responses for patron ".$new_patron->id );
 907
 908     my $responses = $patron->survey_responses;
 909
 910     if($responses) {
 911
 912         $_->usr($new_patron->id) for (@$responses);
 913
 914         my $evt = $U->simplereq( "open-ils.circ",
 915             "open-ils.circ.survey.submit.user_id", $responses );
 916
 917         return (undef, $evt) if defined($U->event_code($evt));
 918
 919     }
 920
 921     return ( $new_patron, undef );
 922 }
 923
 924 sub _clear_badcontact_penalties {
 925     my ($e, $old_patron, $new_patron) = @_;
 926
 927     return ($new_patron, undef) unless $old_patron;
 928
 929     my $PNM = $OpenILS::Utils::BadContact::PENALTY_NAME_MAP;
 930
 931     # This ignores whether the caller of update_patron has any permission
 932     # to remove penalties, but these penalties no longer make sense
 933     # if an email address field (for example) is changed (and the caller must
 934     # have perms to do *that*) so there's no reason not to clear the penalties.
 935
 936     my $bad_contact_penalties = $e->search_actor_user_standing_penalty([
 937         {
 938             "+csp" => {"name" => [values(%$PNM)]},
 939             "+ausp" => {"stop_date" => undef, "usr" => $new_patron->id}
 940         }, {
 941             "join" => {"csp" => {}},
 942             "flesh" => 1,
 943             "flesh_fields" => {"ausp" => ["standing_penalty"]}
 944         }
 945     ]) or return (undef, $e->die_event);
 946
 947     return ($new_patron, undef) unless @$bad_contact_penalties;
 948
 949     my @penalties_to_clear;
 950     my ($field, $penalty_name);
 951
 952     # For each field that might have an associated bad contact penalty,
 953     # check for such penalties and add them to the to-clear list if that
 954     # field has changed.
 955     while (($field, $penalty_name) = each(%$PNM)) {
 956         if ($old_patron->$field ne $new_patron->$field) {
 957             push @penalties_to_clear, grep {
 958                 $_->standing_penalty->name eq $penalty_name
 959             } @$bad_contact_penalties;
 960         }
 961     }
 962
 963     foreach (@penalties_to_clear) {
 964         # Note that this "archives" penalties, in the terminology of the staff
 965         # client, instead of just deleting them.  This may assist reporting,
 966         # or preserving old contact information when it is still potentially
 967         # of interest.
 968         $_->standing_penalty($_->standing_penalty->id); # deflesh
 969         $_->stop_date('now');
 970         $e->update_actor_user_standing_penalty($_) or return (undef, $e->die_event);
 971     }
 972
 973     return ($new_patron, undef);
 974 }
 975
 976
 977 sub _create_stat_maps {
 978
 979     my($e, $patron, $new_patron) = @_;
 980
 981     my $maps = $patron->stat_cat_entries();
 982
 983     for my $map (@$maps) {
 984
 985         my $method = "update_actor_stat_cat_entry_user_map";
 986
 987         if ($map->isdeleted()) {
 988             $method = "delete_actor_stat_cat_entry_user_map";
 989
 990         } elsif ($map->isnew()) {
 991             $method = "create_actor_stat_cat_entry_user_map";
 992             $map->clear_id;
 993         }
 994
 995
 996         $map->target_usr($new_patron->id);
 997
 998         $logger->info("Updating stat entry with method $method and map $map");
 999
1000         $e->$method($map) or return (undef, $e->die_event);
1001     }
1002
1003     return ($new_patron, undef);
1004 }
1005
1006 sub _create_perm_maps {
1007
1008     my($e, $patron, $new_patron) = @_;
1009
1010     my $maps = $patron->permissions;
1011
1012     for my $map (@$maps) {
1013
1014         my $method = "update_permission_usr_perm_map";
1015         if ($map->isdeleted()) {
1016             $method = "delete_permission_usr_perm_map";
1017         } elsif ($map->isnew()) {
1018             $method = "create_permission_usr_perm_map";
1019             $map->clear_id;
1020         }
1021
1022         $map->usr($new_patron->id);
1023
1024         $logger->info( "Updating permissions with method $method and map $map" );
1025
1026         $e->$method($map) or return (undef, $e->die_event);
1027     }
1028
1029     return ($new_patron, undef);
1030 }
1031
1032
1033 __PACKAGE__->register_method(
1034     method   => "set_user_work_ous",
1035     api_name => "open-ils.actor.user.work_ous.update",
1036 );
1037
1038 sub set_user_work_ous {
1039     my $self   = shift;
1040     my $client = shift;
1041     my $ses    = shift;
1042     my $maps   = shift;
1043
1044     my( $requestor, $evt ) = $apputils->checksesperm( $ses, 'ASSIGN_WORK_ORG_UNIT' );
1045     return $evt if $evt;
1046
1047     my $session = $apputils->start_db_session();
1048     $apputils->set_audit_info($session, $ses, $requestor->id, $requestor->wsid);
1049
1050     for my $map (@$maps) {
1051
1052         my $method = "open-ils.storage.direct.permission.usr_work_ou_map.update";
1053         if ($map->isdeleted()) {
1054             $method = "open-ils.storage.direct.permission.usr_work_ou_map.delete";
1055         } elsif ($map->isnew()) {
1056             $method = "open-ils.storage.direct.permission.usr_work_ou_map.create";
1057             $map->clear_id;
1058         }
1059
1060         #warn( "Updating permissions with method $method and session $ses and map $map" );
1061         $logger->info( "Updating work_ou map with method $method and map $map" );
1062
1063         my $stat = $session->request($method, $map)->gather(1);
1064         $logger->warn( "update failed: ".$U->DB_UPDATE_FAILED($map) ) unless defined($stat);
1065
1066     }
1067
1068     $apputils->commit_db_session($session);
1069
1070     return scalar(@$maps);
1071 }
1072
1073
1074 __PACKAGE__->register_method(
1075     method   => "set_user_perms",
1076     api_name => "open-ils.actor.user.permissions.update",
1077 );
1078
1079 sub set_user_perms {
1080     my $self = shift;
1081     my $client = shift;
1082     my $ses = shift;
1083     my $maps = shift;
1084
1085     my $session = $apputils->start_db_session();
1086
1087     my( $user_obj, $evt ) = $U->checkses($ses);
1088     return $evt if $evt;
1089     $apputils->set_audit_info($session, $ses, $user_obj->id, $user_obj->wsid);
1090
1091     my $perms = $session->request('open-ils.storage.permission.user_perms.atomic', $user_obj->id)->gather(1);
1092
1093     my $all = undef;
1094     $all = 1 if ($U->is_true($user_obj->super_user()));
1095     $all = 1 unless ($U->check_perms($user_obj->id, $user_obj->home_ou, 'EVERYTHING'));
1096
1097     for my $map (@$maps) {
1098
1099         my $method = "open-ils.storage.direct.permission.usr_perm_map.update";
1100         if ($map->isdeleted()) {
1101             $method = "open-ils.storage.direct.permission.usr_perm_map.delete";
1102         } elsif ($map->isnew()) {
1103             $method = "open-ils.storage.direct.permission.usr_perm_map.create";
1104             $map->clear_id;
1105         }
1106
1107         next if (!$all and !grep { $_->perm eq $map->perm and $U->is_true($_->grantable) and $_->depth <= $map->depth } @$perms);
1108         #warn( "Updating permissions with method $method and session $ses and map $map" );
1109         $logger->info( "Updating permissions with method $method and map $map" );
1110
1111         my $stat = $session->request($method, $map)->gather(1);
1112         $logger->warn( "update failed: ".$U->DB_UPDATE_FAILED($map) ) unless defined($stat);
1113
1114     }
1115
1116     $apputils->commit_db_session($session);
1117
1118     return scalar(@$maps);
1119 }
1120
1121
1122 __PACKAGE__->register_method(
1123     method  => "user_retrieve_by_barcode",
1124     authoritative => 1,
1125     api_name    => "open-ils.actor.user.fleshed.retrieve_by_barcode",);
1126
1127 sub user_retrieve_by_barcode {
1128     my($self, $client, $auth, $barcode, $flesh_home_ou) = @_;
1129
1130     my $e = new_editor(authtoken => $auth);
1131     return $e->event unless $e->checkauth;
1132
1133     my $card = $e->search_actor_card({barcode => $barcode})->[0]
1134         or return $e->event;
1135
1136     my $user = flesh_user($card->usr, $e, $flesh_home_ou);
1137     return $e->event unless $e->allowed(
1138         "VIEW_USER", $flesh_home_ou ? $user->home_ou->id : $user->home_ou
1139     );
1140     return $user;
1141 }
1142
1143
1144
1145 __PACKAGE__->register_method(
1146     method        => "get_user_by_id",
1147     authoritative => 1,
1148     api_name      => "open-ils.actor.user.retrieve",
1149 );
1150
1151 sub get_user_by_id {
1152     my ($self, $client, $auth, $id) = @_;
1153     my $e = new_editor(authtoken=>$auth);
1154     return $e->event unless $e->checkauth;
1155     my $user = $e->retrieve_actor_user($id) or return $e->event;
1156     return $e->event unless $e->allowed('VIEW_USER', $user->home_ou);
1157     return $user;
1158 }
1159
1160
1161 __PACKAGE__->register_method(
1162     method   => "get_org_types",
1163     api_name => "open-ils.actor.org_types.retrieve",
1164 );
1165 sub get_org_types {
1166     return $U->get_org_types();
1167 }
1168
1169
1170 __PACKAGE__->register_method(
1171     method   => "get_user_ident_types",
1172     api_name => "open-ils.actor.user.ident_types.retrieve",
1173 );
1174 my $ident_types;
1175 sub get_user_ident_types {
1176     return $ident_types if $ident_types;
1177     return $ident_types =
1178         new_editor()->retrieve_all_config_identification_type();
1179 }
1180
1181
1182 __PACKAGE__->register_method(
1183     method   => "get_org_unit",
1184     api_name => "open-ils.actor.org_unit.retrieve",
1185 );
1186
1187 sub get_org_unit {
1188     my( $self, $client, $user_session, $org_id ) = @_;
1189     my $e = new_editor(authtoken => $user_session);
1190     if(!$org_id) {
1191         return $e->event unless $e->checkauth;
1192         $org_id = $e->requestor->ws_ou;
1193     }
1194     my $o = $e->retrieve_actor_org_unit($org_id)
1195         or return $e->event;
1196     return $o;
1197 }
1198
1199 __PACKAGE__->register_method(
1200     method   => "search_org_unit",
1201     api_name => "open-ils.actor.org_unit_list.search",
1202 );
1203
1204 sub search_org_unit {
1205
1206     my( $self, $client, $field, $value ) = @_;
1207
1208     my $list = OpenILS::Application::AppUtils->simple_scalar_request(
1209         "open-ils.cstore",
1210         "open-ils.cstore.direct.actor.org_unit.search.atomic",
1211         { $field => $value } );
1212
1213     return $list;
1214 }
1215
1216
1217 # build the org tree
1218
1219 __PACKAGE__->register_method(
1220     method  => "get_org_tree",
1221     api_name    => "open-ils.actor.org_tree.retrieve",
1222     argc        => 0,
1223     note        => "Returns the entire org tree structure",
1224 );
1225
1226 sub get_org_tree {
1227     my $self = shift;
1228     my $client = shift;
1229     return $U->get_org_tree($client->session->session_locale);
1230 }
1231
1232
1233 __PACKAGE__->register_method(
1234     method  => "get_org_descendants",
1235     api_name    => "open-ils.actor.org_tree.descendants.retrieve"
1236 );
1237
1238 # depth is optional.  org_unit is the id
1239 sub get_org_descendants {
1240     my( $self, $client, $org_unit, $depth ) = @_;
1241
1242     if(ref $org_unit eq 'ARRAY') {
1243         $depth ||= [];
1244         my @trees;
1245         for my $i (0..scalar(@$org_unit)-1) {
1246             my $list = $U->simple_scalar_request(
1247                 "open-ils.storage",
1248                 "open-ils.storage.actor.org_unit.descendants.atomic",
1249                 $org_unit->[$i], $depth->[$i] );
1250             push(@trees, $U->build_org_tree($list));
1251         }
1252         return \@trees;
1253
1254     } else {
1255         my $orglist = $apputils->simple_scalar_request(
1256                 "open-ils.storage",
1257                 "open-ils.storage.actor.org_unit.descendants.atomic",
1258                 $org_unit, $depth );
1259         return $U->build_org_tree($orglist);
1260     }
1261 }
1262
1263
1264 __PACKAGE__->register_method(
1265     method  => "get_org_ancestors",
1266     api_name    => "open-ils.actor.org_tree.ancestors.retrieve"
1267 );
1268
1269 # depth is optional.  org_unit is the id
1270 sub get_org_ancestors {
1271     my( $self, $client, $org_unit, $depth ) = @_;
1272     my $orglist = $apputils->simple_scalar_request(
1273             "open-ils.storage",
1274             "open-ils.storage.actor.org_unit.ancestors.atomic",
1275             $org_unit, $depth );
1276     return $U->build_org_tree($orglist);
1277 }
1278
1279
1280 __PACKAGE__->register_method(
1281     method  => "get_standings",
1282     api_name    => "open-ils.actor.standings.retrieve"
1283 );
1284
1285 my $user_standings;
1286 sub get_standings {
1287     return $user_standings if $user_standings;
1288     return $user_standings =
1289         $apputils->simple_scalar_request(
1290             "open-ils.cstore",
1291             "open-ils.cstore.direct.config.standing.search.atomic",
1292             { id => { "!=" => undef } }
1293         );
1294 }
1295
1296
1297 __PACKAGE__->register_method(
1298     method   => "get_my_org_path",
1299     api_name => "open-ils.actor.org_unit.full_path.retrieve"
1300 );
1301
1302 sub get_my_org_path {
1303     my( $self, $client, $auth, $org_id ) = @_;
1304     my $e = new_editor(authtoken=>$auth);
1305     return $e->event unless $e->checkauth;
1306     $org_id = $e->requestor->ws_ou unless defined $org_id;
1307
1308     return $apputils->simple_scalar_request(
1309         "open-ils.storage",
1310         "open-ils.storage.actor.org_unit.full_path.atomic",
1311         $org_id );
1312 }
1313
1314
1315 __PACKAGE__->register_method(
1316     method   => "patron_adv_search",
1317     api_name => "open-ils.actor.patron.search.advanced"
1318 );
1319
1320 __PACKAGE__->register_method(
1321     method   => "patron_adv_search",
1322     api_name => "open-ils.actor.patron.search.advanced.fleshed",
1323     stream => 1,
1324     # TODO: change when opensrf 'bundling' is merged.
1325     # set a relatively small bundle size so the caller can start
1326     # seeing results fairly quickly
1327     max_chunk_size => 4096, # bundling
1328
1329     # api_level => 2,
1330     # pending opensrf work -- also, not sure if needed since we're not
1331     # actaully creating an alternate vesrion, only offering to return a
1332     # different format.
1333     #
1334     signature => {
1335         desc => q/Returns a stream of fleshed user objects instead of
1336             a pile of identifiers/
1337     }
1338 );
1339
1340 sub patron_adv_search {
1341     my( $self, $client, $auth, $search_hash, $search_limit,
1342         $search_sort, $include_inactive, $search_ou, $flesh_fields, $offset) = @_;
1343
1344     # API params sanity checks.
1345     # Exit early with empty result if no filter exists.
1346     # .fleshed call is streaming.  Non-fleshed is effectively atomic.
1347     my $fleshed = ($self->api_name =~ /fleshed/);
1348     return ($fleshed ? undef : []) unless (ref $search_hash ||'') eq 'HASH';
1349     my $search_ok = 0;
1350     for my $key (keys %$search_hash) {
1351         next if $search_hash->{$key}{value} =~ /^\s*$/; # empty filter
1352         $search_ok = 1;
1353         last;
1354     }
1355     return ($fleshed ? undef : []) unless $search_ok;
1356
1357     my $e = new_editor(authtoken=>$auth);
1358     return $e->event unless $e->checkauth;
1359     return $e->event unless $e->allowed('VIEW_USER');
1360
1361     # depth boundary outside of which patrons must opt-in, default to 0
1362     my $opt_boundary = 0;
1363     $opt_boundary = $U->ou_ancestor_setting_value($e->requestor->ws_ou,'org.patron_opt_boundary') if user_opt_in_enabled($self);
1364
1365     if (not defined $search_ou) {
1366         my $depth = $U->ou_ancestor_setting_value(
1367             $e->requestor->ws_ou,
1368             'circ.patron_edit.duplicate_patron_check_depth'
1369         );
1370
1371         if (defined $depth) {
1372             $search_ou = $U->org_unit_ancestor_at_depth(
1373                 $e->requestor->ws_ou, $depth
1374             );
1375         }
1376     }
1377
1378     my $ids = $U->storagereq(
1379         "open-ils.storage.actor.user.crazy_search", $search_hash,
1380         $search_limit, $search_sort, $include_inactive,
1381         $e->requestor->ws_ou, $search_ou, $opt_boundary, $offset);
1382
1383     return $ids unless $self->api_name =~ /fleshed/;
1384
1385     $client->respond(new_flesh_user($_, $flesh_fields, $e)) for @$ids;
1386
1387     return;
1388 }
1389
1390
1391 # A migrated (main) password has the form:
1392 # CRYPT( MD5( pw_salt || MD5(real_password) ), pw_salt )
1393 sub modify_migrated_user_password {
1394     my ($e, $user_id, $passwd) = @_;
1395
1396     # new password gets a new salt
1397     my $new_salt = $e->json_query({
1398         from => ['actor.create_salt', 'main']})->[0];
1399     $new_salt = $new_salt->{'actor.create_salt'};
1400
1401     $e->json_query({
1402         from => [
1403             'actor.set_passwd',
1404             $user_id,
1405             'main',
1406             md5_hex($new_salt . md5_hex($passwd)),
1407             $new_salt
1408         ]
1409     });
1410 }
1411
1412
1413
1414 __PACKAGE__->register_method(
1415     method    => "update_passwd",
1416     api_name  => "open-ils.actor.user.password.update",
1417     signature => {
1418         desc   => "Update the operator's password",
1419         params => [
1420             { desc => 'Authentication token', type => 'string' },
1421             { desc => 'New password',         type => 'string' },
1422             { desc => 'Current password',     type => 'string' }
1423         ],
1424         return => {desc => '1 on success, Event on error or incorrect current password'}
1425     }
1426 );
1427
1428 __PACKAGE__->register_method(
1429     method    => "update_passwd",
1430     api_name  => "open-ils.actor.user.username.update",
1431     signature => {
1432         desc   => "Update the operator's username",
1433         params => [
1434             { desc => 'Authentication token', type => 'string' },
1435             { desc => 'New username',         type => 'string' },
1436             { desc => 'Current password',     type => 'string' }
1437         ],
1438         return => {desc => '1 on success, Event on error or incorrect current password'}
1439     }
1440 );
1441
1442 __PACKAGE__->register_method(
1443     method    => "update_passwd",
1444     api_name  => "open-ils.actor.user.email.update",
1445     signature => {
1446         desc   => "Update the operator's email address",
1447         params => [
1448             { desc => 'Authentication token', type => 'string' },
1449             { desc => 'New email address',    type => 'string' },
1450             { desc => 'Current password',     type => 'string' }
1451         ],
1452         return => {desc => '1 on success, Event on error or incorrect current password'}
1453     }
1454 );
1455
1456 sub update_passwd {
1457     my( $self, $conn, $auth, $new_val, $orig_pw ) = @_;
1458     my $e = new_editor(xact=>1, authtoken=>$auth);
1459     return $e->die_event unless $e->checkauth;
1460
1461     my $db_user = $e->retrieve_actor_user($e->requestor->id)
1462         or return $e->die_event;
1463     my $api = $self->api_name;
1464
1465     if (!$U->verify_migrated_user_password($e, $db_user->id, $orig_pw)) {
1466         $e->rollback;
1467         return new OpenILS::Event('INCORRECT_PASSWORD');
1468     }
1469
1470     if( $api =~ /password/o ) {
1471         # NOTE: with access to the plain text password we could crypt
1472         # the password without the extra MD5 pre-hashing.  Other changes
1473         # would be required.  Noting here for future reference.
1474         modify_migrated_user_password($e, $db_user->id, $new_val);
1475         $db_user->passwd('');
1476
1477     } else {
1478
1479         # if we don't clear the password, the user will be updated with
1480         # a hashed version of the hashed version of their password
1481         $db_user->clear_passwd;
1482
1483         if( $api =~ /username/o ) {
1484
1485             # make sure no one else has this username
1486             my $exist = $e->search_actor_user({usrname=>$new_val},{idlist=>1});
1487             if (@$exist) {
1488                 $e->rollback;
1489                 return new OpenILS::Event('USERNAME_EXISTS');
1490             }
1491             $db_user->usrname($new_val);
1492
1493         } elsif( $api =~ /email/o ) {
1494             $db_user->email($new_val);
1495         }
1496     }
1497
1498     $e->update_actor_user($db_user) or return $e->die_event;
1499     $e->commit;
1500
1501     # update the cached user to pick up these changes
1502     $U->simplereq('open-ils.auth', 'open-ils.auth.session.reset_timeout', $auth, 1);
1503     return 1;
1504 }
1505
1506
1507
1508 __PACKAGE__->register_method(
1509     method   => "check_user_perms",
1510     api_name => "open-ils.actor.user.perm.check",
1511     notes    => <<"    NOTES");
1512     Takes a login session, user id, an org id, and an array of perm type strings.  For each
1513     perm type, if the user does *not* have the given permission it is added
1514     to a list which is returned from the method.  If all permissions
1515     are allowed, an empty list is returned
1516     if the logged in user does not match 'user_id', then the logged in user must
1517     have VIEW_PERMISSION priveleges.
1518     NOTES
1519
1520 sub check_user_perms {
1521     my( $self, $client, $login_session, $user_id, $org_id, $perm_types ) = @_;
1522
1523     my( $staff, $evt ) = $apputils->checkses($login_session);
1524     return $evt if $evt;
1525
1526     if($staff->id ne $user_id) {
1527         if( $evt = $apputils->check_perms(
1528             $staff->id, $org_id, 'VIEW_PERMISSION') ) {
1529             return $evt;
1530         }
1531     }
1532
1533     my @not_allowed;
1534     for my $perm (@$perm_types) {
1535         if($apputils->check_perms($user_id, $org_id, $perm)) {
1536             push @not_allowed, $perm;
1537         }
1538     }
1539
1540     return \@not_allowed
1541 }
1542
1543 __PACKAGE__->register_method(
1544     method  => "check_user_perms2",
1545     api_name    => "open-ils.actor.user.perm.check.multi_org",
1546     notes       => q/
1547         Checks the permissions on a list of perms and orgs for a user
1548         @param authtoken The login session key
1549         @param user_id The id of the user to check
1550         @param orgs The array of org ids
1551         @param perms The array of permission names
1552         @return An array of  [ orgId, permissionName ] arrays that FAILED the check
1553         if the logged in user does not match 'user_id', then the logged in user must
1554         have VIEW_PERMISSION priveleges.
1555     /);
1556
1557 sub check_user_perms2 {
1558     my( $self, $client, $authtoken, $user_id, $orgs, $perms ) = @_;
1559
1560     my( $staff, $target, $evt ) = $apputils->checkses_requestor(
1561         $authtoken, $user_id, 'VIEW_PERMISSION' );
1562     return $evt if $evt;
1563
1564     my @not_allowed;
1565     for my $org (@$orgs) {
1566         for my $perm (@$perms) {
1567             if($apputils->check_perms($user_id, $org, $perm)) {
1568                 push @not_allowed, [ $org, $perm ];
1569             }
1570         }
1571     }
1572
1573     return \@not_allowed
1574 }
1575
1576
1577 __PACKAGE__->register_method(
1578     method => 'check_user_perms3',
1579     api_name    => 'open-ils.actor.user.perm.highest_org',
1580     notes       => q/
1581         Returns the highest org unit id at which a user has a given permission
1582         If the requestor does not match the target user, the requestor must have
1583         'VIEW_PERMISSION' rights at the home org unit of the target user
1584         @param authtoken The login session key
1585         @param userid The id of the user in question
1586         @param perm The permission to check
1587         @return The org unit highest in the org tree within which the user has
1588         the requested permission
1589     /);
1590
1591 sub check_user_perms3 {
1592     my($self, $client, $authtoken, $user_id, $perm) = @_;
1593     my $e = new_editor(authtoken=>$authtoken);
1594     return $e->event unless $e->checkauth;
1595
1596     my $tree = $U->get_org_tree();
1597
1598     unless($e->requestor->id == $user_id) {
1599         my $user = $e->retrieve_actor_user($user_id)
1600             or return $e->event;
1601         return $e->event unless $e->allowed('VIEW_PERMISSION', $user->home_ou);
1602         return $U->find_highest_perm_org($perm, $user_id, $user->home_ou, $tree );
1603     }
1604
1605     return $U->find_highest_perm_org($perm, $user_id, $e->requestor->ws_ou, $tree);
1606 }
1607
1608 __PACKAGE__->register_method(
1609     method => 'user_has_work_perm_at',
1610     api_name    => 'open-ils.actor.user.has_work_perm_at',
1611     authoritative => 1,
1612     signature => {
1613         desc => q/
1614             Returns a set of org unit IDs which represent the highest orgs in
1615             the org tree where the user has the requested permission.  The
1616             purpose of this method is to return the smallest set of org units
1617             which represent the full expanse of the user's ability to perform
1618             the requested action.  The user whose perms this method should
1619             check is implied by the authtoken. /,
1620         params => [
1621             {desc => 'authtoken', type => 'string'},
1622             {desc => 'permission name', type => 'string'},
1623             {desc => q/user id, optional.  If present, check perms for
1624                 this user instead of the logged in user/, type => 'number'},
1625         ],
1626         return => {desc => 'An array of org IDs'}
1627     }
1628 );
1629
1630 sub user_has_work_perm_at {
1631     my($self, $conn, $auth, $perm, $user_id) = @_;
1632     my $e = new_editor(authtoken=>$auth);
1633     return $e->event unless $e->checkauth;
1634     if(defined $user_id) {
1635         my $user = $e->retrieve_actor_user($user_id) or return $e->event;
1636         return $e->event unless $e->allowed('VIEW_PERMISSION', $user->home_ou);
1637     }
1638     return $U->user_has_work_perm_at($e, $perm, undef, $user_id);
1639 }
1640
1641 __PACKAGE__->register_method(
1642     method => 'user_has_work_perm_at_batch',
1643     api_name    => 'open-ils.actor.user.has_work_perm_at.batch',
1644     authoritative => 1,
1645 );
1646
1647 sub user_has_work_perm_at_batch {
1648     my($self, $conn, $auth, $perms, $user_id) = @_;
1649     my $e = new_editor(authtoken=>$auth);
1650     return $e->event unless $e->checkauth;
1651     if(defined $user_id) {
1652         my $user = $e->retrieve_actor_user($user_id) or return $e->event;
1653         return $e->event unless $e->allowed('VIEW_PERMISSION', $user->home_ou);
1654     }
1655     my $map = {};
1656     $map->{$_} = $U->user_has_work_perm_at($e, $_) for @$perms;
1657     return $map;
1658 }
1659
1660
1661
1662 __PACKAGE__->register_method(
1663     method => 'check_user_perms4',
1664     api_name    => 'open-ils.actor.user.perm.highest_org.batch',
1665     notes       => q/
1666         Returns the highest org unit id at which a user has a given permission
1667         If the requestor does not match the target user, the requestor must have
1668         'VIEW_PERMISSION' rights at the home org unit of the target user
1669         @param authtoken The login session key
1670         @param userid The id of the user in question
1671         @param perms An array of perm names to check
1672         @return An array of orgId's  representing the org unit
1673         highest in the org tree within which the user has the requested permission
1674         The arrah of orgId's has matches the order of the perms array
1675     /);
1676
1677 sub check_user_perms4 {
1678     my( $self, $client, $authtoken, $userid, $perms ) = @_;
1679
1680     my( $staff, $target, $org, $evt );
1681
1682     ( $staff, $target, $evt ) = $apputils->checkses_requestor(
1683         $authtoken, $userid, 'VIEW_PERMISSION' );
1684     return $evt if $evt;
1685
1686     my @arr;
1687     return [] unless ref($perms);
1688     my $tree = $U->get_org_tree();
1689
1690     for my $p (@$perms) {
1691         push( @arr, $U->find_highest_perm_org( $p, $userid, $target->home_ou, $tree ) );
1692     }
1693     return \@arr;
1694 }
1695
1696
1697 __PACKAGE__->register_method(
1698     method        => "user_fines_summary",
1699     api_name      => "open-ils.actor.user.fines.summary",
1700     authoritative => 1,
1701     signature     => {
1702         desc   => 'Returns a short summary of the users total open fines, '  .
1703                 'excluding voided fines Params are login_session, user_id' ,
1704         params => [
1705             {desc => 'Authentication token', type => 'string'},
1706             {desc => 'User ID',              type => 'string'}  # number?
1707         ],
1708         return => {
1709             desc => "a 'mous' object, event on error",
1710         }
1711     }
1712 );
1713
1714 sub user_fines_summary {
1715     my( $self, $client, $auth, $user_id ) = @_;
1716
1717     my $e = new_editor(authtoken=>$auth);
1718     return $e->event unless $e->checkauth;
1719
1720     if( $user_id ne $e->requestor->id ) {
1721         my $user = $e->retrieve_actor_user($user_id) or return $e->event;
1722         return $e->event unless
1723             $e->allowed('VIEW_USER_FINES_SUMMARY', $user->home_ou);
1724     }
1725
1726     return $e->search_money_open_user_summary({usr => $user_id})->[0];
1727 }
1728
1729
1730 __PACKAGE__->register_method(
1731     method        => "user_opac_vitals",
1732     api_name      => "open-ils.actor.user.opac.vital_stats",
1733     argc          => 1,
1734     authoritative => 1,
1735     signature     => {
1736         desc   => 'Returns a short summary of the users vital stats, including '  .
1737                 'identification information, accumulated balance, number of holds, ' .
1738                 'and current open circulation stats' ,
1739         params => [
1740             {desc => 'Authentication token',                          type => 'string'},
1741             {desc => 'Optional User ID, for use in the staff client', type => 'number'}  # number?
1742         ],
1743         return => {
1744             desc => "An object with four properties: user, fines, checkouts and holds."
1745         }
1746     }
1747 );
1748
1749 sub user_opac_vitals {
1750     my( $self, $client, $auth, $user_id ) = @_;
1751
1752     my $e = new_editor(authtoken=>$auth);
1753     return $e->event unless $e->checkauth;
1754
1755     $user_id ||= $e->requestor->id;
1756
1757     my $user = $e->retrieve_actor_user( $user_id );
1758
1759     my ($fines) = $self
1760         ->method_lookup('open-ils.actor.user.fines.summary')
1761         ->run($auth => $user_id);
1762     return $fines if (defined($U->event_code($fines)));
1763
1764     if (!$fines) {
1765         $fines = new Fieldmapper::money::open_user_summary ();
1766         $fines->balance_owed(0.00);
1767         $fines->total_owed(0.00);
1768         $fines->total_paid(0.00);
1769         $fines->usr($user_id);
1770     }
1771
1772     my ($holds) = $self
1773         ->method_lookup('open-ils.actor.user.hold_requests.count')
1774         ->run($auth => $user_id);
1775     return $holds if (defined($U->event_code($holds)));
1776
1777     my ($out) = $self
1778         ->method_lookup('open-ils.actor.user.checked_out.count')
1779         ->run($auth => $user_id);
1780     return $out if (defined($U->event_code($out)));
1781
1782     $out->{"total_out"} = reduce { $a + $out->{$b} } 0, qw/out overdue/;
1783
1784     my $unread_msgs = $e->search_actor_usr_message([
1785         {usr => $user_id, read_date => undef, deleted => 'f'},
1786         {idlist => 1}
1787     ]);
1788
1789     return {
1790         user => {
1791             first_given_name  => $user->first_given_name,
1792             second_given_name => $user->second_given_name,
1793             family_name       => $user->family_name,
1794             alias             => $user->alias,
1795             usrname           => $user->usrname
1796         },
1797         fines => $fines->to_bare_hash,
1798         checkouts => $out,
1799         holds => $holds,
1800         messages => { unread => scalar(@$unread_msgs) }
1801     };
1802 }
1803
1804
1805 ##### a small consolidation of related method registrations
1806 my $common_params = [
1807     { desc => 'Authentication token', type => 'string' },
1808     { desc => 'User ID',              type => 'string' },
1809     { desc => 'Transactions type (optional, defaults to all)', type => 'string' },
1810     { desc => 'Options hash.  May contain limit and offset for paged results.', type => 'object' },
1811 ];
1812 my %methods = (
1813     'open-ils.actor.user.transactions'                      => '',
1814     'open-ils.actor.user.transactions.fleshed'              => '',
1815     'open-ils.actor.user.transactions.have_charge'          => ' that have an initial charge',
1816     'open-ils.actor.user.transactions.have_charge.fleshed'  => ' that have an initial charge',
1817     'open-ils.actor.user.transactions.have_balance'         => ' that have an outstanding balance',
1818     'open-ils.actor.user.transactions.have_balance.fleshed' => ' that have an outstanding balance',
1819 );
1820
1821 foreach (keys %methods) {
1822     my %args = (
1823         method    => "user_transactions",
1824         api_name  => $_,
1825         signature => {
1826             desc   => 'For a given user, retrieve a list of '
1827                     . (/\.fleshed/ ? 'fleshed ' : '')
1828                     . 'transactions' . $methods{$_}
1829                     . ' optionally limited to transactions of a given type.',
1830             params => $common_params,
1831             return => {
1832                 desc => "List of objects, or event on error.  Each object is a hash containing: transaction, circ, record. "
1833                     . 'These represent the relevant (mbts) transaction, attached circulation and title pointed to in the circ, respectively.',
1834             }
1835         }
1836     );
1837     $args{authoritative} = 1;
1838     __PACKAGE__->register_method(%args);
1839 }
1840
1841 # Now for the counts
1842 %methods = (
1843     'open-ils.actor.user.transactions.count'              => '',
1844     'open-ils.actor.user.transactions.have_charge.count'  => ' that have an initial charge',
1845     'open-ils.actor.user.transactions.have_balance.count' => ' that have an outstanding balance',
1846 );
1847
1848 foreach (keys %methods) {
1849     my %args = (
1850         method    => "user_transactions",
1851         api_name  => $_,
1852         signature => {
1853             desc   => 'For a given user, retrieve a count of open '
1854                     . 'transactions' . $methods{$_}
1855                     . ' optionally limited to transactions of a given type.',
1856             params => $common_params,
1857             return => { desc => "Integer count of transactions, or event on error" }
1858         }
1859     );
1860     /\.have_balance/ and $args{authoritative} = 1;     # FIXME: I don't know why have_charge isn't authoritative
1861     __PACKAGE__->register_method(%args);
1862 }
1863
1864 __PACKAGE__->register_method(
1865     method        => "user_transactions",
1866     api_name      => "open-ils.actor.user.transactions.have_balance.total",
1867     authoritative => 1,
1868     signature     => {
1869         desc   => 'For a given user, retrieve the total balance owed for open transactions,'
1870                 . ' optionally limited to transactions of a given type.',
1871         params => $common_params,
1872         return => { desc => "Decimal balance value, or event on error" }
1873     }
1874 );
1875
1876
1877 sub user_transactions {
1878     my( $self, $client, $auth, $user_id, $type, $options ) = @_;
1879     $options ||= {};
1880
1881     my $e = new_editor(authtoken => $auth);
1882     return $e->event unless $e->checkauth;
1883
1884     my $user = $e->retrieve_actor_user($user_id) or return $e->event;
1885
1886     return $e->event unless
1887         $e->requestor->id == $user_id or
1888         $e->allowed('VIEW_USER_TRANSACTIONS', $user->home_ou);
1889
1890     my $api = $self->api_name();
1891
1892     my $filter = ($api =~ /have_balance/o) ?
1893         { 'balance_owed' => { '<>' => 0 } }:
1894         { 'total_owed' => { '>' => 0 } };
1895
1896     my $method = 'open-ils.actor.user.transactions.history.still_open';
1897     $method = "$method.authoritative" if $api =~ /authoritative/;
1898     my ($trans) = $self->method_lookup($method)->run($auth, $user_id, $type, $filter, $options);
1899
1900     if($api =~ /total/o) {
1901         my $total = 0.0;
1902         $total += $_->balance_owed for @$trans;
1903         return $total;
1904     }
1905
1906     ($api =~ /count/o  ) and return scalar @$trans;
1907     ($api !~ /fleshed/o) and return $trans;
1908
1909     my @resp;
1910     for my $t (@$trans) {
1911
1912         if( $t->xact_type ne 'circulation' ) {
1913             push @resp, {transaction => $t};
1914             next;
1915         }
1916
1917         my $circ_data = flesh_circ($e, $t->id);
1918         push @resp, {transaction => $t, %$circ_data};
1919     }
1920
1921     return \@resp;
1922 }
1923
1924
1925 __PACKAGE__->register_method(
1926     method   => "user_transaction_retrieve",
1927     api_name => "open-ils.actor.user.transaction.fleshed.retrieve",
1928     argc     => 1,
1929     authoritative => 1,
1930     notes    => "Returns a fleshed transaction record"
1931 );
1932
1933 __PACKAGE__->register_method(
1934     method   => "user_transaction_retrieve",
1935     api_name => "open-ils.actor.user.transaction.retrieve",
1936     argc     => 1,
1937     authoritative => 1,
1938     notes    => "Returns a transaction record"
1939 );
1940
1941 sub user_transaction_retrieve {
1942     my($self, $client, $auth, $bill_id) = @_;
1943
1944     my $e = new_editor(authtoken => $auth);
1945     return $e->event unless $e->checkauth;
1946
1947     my $trans = $e->retrieve_money_billable_transaction_summary(
1948         [$bill_id, {flesh => 1, flesh_fields => {mbts => ['usr']}}]) or return $e->event;
1949
1950     return $e->event unless $e->allowed('VIEW_USER_TRANSACTIONS', $trans->usr->home_ou);
1951
1952     $trans->usr($trans->usr->id); # de-flesh for backwards compat
1953
1954     return $trans unless $self->api_name =~ /flesh/;
1955     return {transaction => $trans} if $trans->xact_type ne 'circulation';
1956
1957     my $circ_data = flesh_circ($e, $trans->id, 1);
1958
1959     return {transaction => $trans, %$circ_data};
1960 }
1961
1962 sub flesh_circ {
1963     my $e = shift;
1964     my $circ_id = shift;
1965     my $flesh_copy = shift;
1966
1967     my $circ = $e->retrieve_action_circulation([
1968         $circ_id, {
1969             flesh => 3,
1970             flesh_fields => {
1971                 circ => ['target_copy'],
1972                 acp => ['call_number'],
1973                 acn => ['record']
1974             }
1975         }
1976     ]);
1977
1978     my $mods;
1979     my $copy = $circ->target_copy;
1980
1981     if($circ->target_copy->call_number->id == OILS_PRECAT_CALL_NUMBER) {
1982         $mods = new Fieldmapper::metabib::virtual_record;
1983         $mods->doc_id(OILS_PRECAT_RECORD);
1984         $mods->title($copy->dummy_title);
1985         $mods->author($copy->dummy_author);
1986
1987     } else {
1988         $mods = $U->record_to_mvr($circ->target_copy->call_number->record);
1989     }
1990
1991     # more de-fleshiing
1992     $circ->target_copy($circ->target_copy->id);
1993     $copy->call_number($copy->call_number->id);
1994
1995     return {circ => $circ, record => $mods, copy => ($flesh_copy) ? $copy : undef };
1996 }
1997
1998
1999 __PACKAGE__->register_method(
2000     method        => "hold_request_count",
2001     api_name      => "open-ils.actor.user.hold_requests.count",
2002     authoritative => 1,
2003     argc          => 1,
2004     notes         => q/
2005         Returns hold ready vs. total counts.
2006         If a context org unit is provided, a third value
2007         is returned with key 'behind_desk', which reports
2008         how many holds are ready at the pickup library
2009         with the behind_desk flag set to true.
2010     /
2011 );
2012
2013 sub hold_request_count {
2014     my( $self, $client, $authtoken, $user_id, $ctx_org ) = @_;
2015     my $e = new_editor(authtoken => $authtoken);
2016     return $e->event unless $e->checkauth;
2017
2018     $user_id = $e->requestor->id unless defined $user_id;
2019
2020     if($e->requestor->id ne $user_id) {
2021         my $user = $e->retrieve_actor_user($user_id);
2022         return $e->event unless $e->allowed('VIEW_HOLD', $user->home_ou);
2023     }
2024
2025     my $holds = $e->json_query({
2026         select => {ahr => ['pickup_lib', 'current_shelf_lib', 'behind_desk']},
2027         from => 'ahr',
2028         where => {
2029             usr => $user_id,
2030             fulfillment_time => {"=" => undef },
2031             cancel_time => undef,
2032         }
2033     });
2034
2035     my @ready = grep {
2036         $_->{current_shelf_lib} and # avoid undef warnings
2037         $_->{pickup_lib} eq $_->{current_shelf_lib}
2038     } @$holds;
2039
2040     my $resp = {
2041         total => scalar(@$holds),
2042         ready => scalar(@ready)
2043     };
2044
2045     if ($ctx_org) {
2046         # count of holds ready at pickup lib with behind_desk true.
2047         $resp->{behind_desk} = scalar(
2048             grep {
2049                 $_->{pickup_lib} == $ctx_org and
2050                 $U->is_true($_->{behind_desk})
2051             } @ready
2052         );
2053     }
2054
2055     return $resp;
2056 }
2057
2058 __PACKAGE__->register_method(
2059     method        => "checked_out",
2060     api_name      => "open-ils.actor.user.checked_out",
2061     authoritative => 1,
2062     argc          => 2,
2063     signature     => {
2064         desc => "For a given user, returns a structure of circulations objects sorted by out, overdue, lost, claims_returned, long_overdue. "
2065             . "A list of IDs are returned of each type.  Circs marked lost, long_overdue, and claims_returned will not be 'finished' "
2066             . "(i.e., outstanding balance or some other pending action on the circ). "
2067             . "The .count method also includes a 'total' field which sums all open circs.",
2068         params => [
2069             { desc => 'Authentication Token', type => 'string'},
2070             { desc => 'User ID',              type => 'string'},
2071         ],
2072         return => {
2073             desc => 'Returns event on error, or an object with ID lists, like: '
2074                 . '{"out":[12552,451232], "claims_returned":[], "long_overdue":[23421] "overdue":[], "lost":[]}'
2075         },
2076     }
2077 );
2078
2079 __PACKAGE__->register_method(
2080     method        => "checked_out",
2081     api_name      => "open-ils.actor.user.checked_out.count",
2082     authoritative => 1,
2083     argc          => 2,
2084     signature     => q/@see open-ils.actor.user.checked_out/
2085 );
2086
2087 sub checked_out {
2088     my( $self, $conn, $auth, $userid ) = @_;
2089
2090     my $e = new_editor(authtoken=>$auth);
2091     return $e->event unless $e->checkauth;
2092
2093     if( $userid ne $e->requestor->id ) {
2094         my $user = $e->retrieve_actor_user($userid) or return $e->event;
2095         unless($e->allowed('VIEW_CIRCULATIONS', $user->home_ou)) {
2096
2097             # see if there is a friend link allowing circ.view perms
2098             my $allowed = OpenILS::Application::Actor::Friends->friend_perm_allowed(
2099                 $e, $userid, $e->requestor->id, 'circ.view');
2100             return $e->event unless $allowed;
2101         }
2102     }
2103
2104     my $count = $self->api_name =~ /count/;
2105     return _checked_out( $count, $e, $userid );
2106 }
2107
2108 sub _checked_out {
2109     my( $iscount, $e, $userid ) = @_;
2110
2111     my %result = (
2112         out => [],
2113         overdue => [],
2114         lost => [],
2115         claims_returned => [],
2116         long_overdue => []
2117     );
2118     my $meth = 'retrieve_action_open_circ_';
2119
2120     if ($iscount) {
2121         $meth .= 'count';
2122         %result = (
2123             out => 0,
2124             overdue => 0,
2125             lost => 0,
2126             claims_returned => 0,
2127             long_overdue => 0
2128         );
2129     } else {
2130         $meth .= 'list';
2131     }
2132
2133     my $data = $e->$meth($userid);
2134
2135     if ($data) {
2136         if ($iscount) {
2137             $result{$_} += $data->$_() for (keys %result);
2138             $result{total} += $data->$_() for (keys %result);
2139         } else {
2140             for my $k (keys %result) {
2141                 $result{$k} = [ grep { $_ > 0 } split( ',', $data->$k()) ];
2142             }
2143         }
2144     }
2145
2146     return \%result;
2147 }
2148
2149
2150
2151 __PACKAGE__->register_method(
2152     method        => "checked_in_with_fines",
2153     api_name      => "open-ils.actor.user.checked_in_with_fines",
2154     authoritative => 1,
2155     argc          => 2,
2156     signature     => q/@see open-ils.actor.user.checked_out/
2157 );
2158
2159 sub checked_in_with_fines {
2160     my( $self, $conn, $auth, $userid ) = @_;
2161
2162     my $e = new_editor(authtoken=>$auth);
2163     return $e->event unless $e->checkauth;
2164
2165     if( $userid ne $e->requestor->id ) {
2166         return $e->event unless $e->allowed('VIEW_CIRCULATIONS');
2167     }
2168
2169     # money is owed on these items and they are checked in
2170     my $open = $e->search_action_circulation(
2171         {
2172             usr             => $userid,
2173             xact_finish     => undef,
2174             checkin_time    => { "!=" => undef },
2175         }
2176     );
2177
2178
2179     my( @lost, @cr, @lo );
2180     for my $c (@$open) {
2181         push( @lost, $c->id ) if ($c->stop_fines eq 'LOST');
2182         push( @cr, $c->id ) if $c->stop_fines eq 'CLAIMSRETURNED';
2183         push( @lo, $c->id ) if $c->stop_fines eq 'LONGOVERDUE';
2184     }
2185
2186     return {
2187         lost        => \@lost,
2188         claims_returned => \@cr,
2189         long_overdue        => \@lo
2190     };
2191 }
2192
2193
2194 sub _sigmaker {
2195     my ($api, $desc, $auth) = @_;
2196     $desc = $desc ? (" " . $desc) : '';
2197     my $ids = ($api =~ /ids$/) ? 1 : 0;
2198     my @sig = (
2199         argc      => 1,
2200         method    => "user_transaction_history",
2201         api_name  => "open-ils.actor.user.transactions.$api",
2202         signature => {
2203             desc   => "For a given User ID, returns a list of billable transaction" .
2204                     ($ids ? " id" : '') .
2205                     "s$desc, optionally filtered by type and/or fields in money.billable_xact_summary.  " .
2206                     "The VIEW_USER_TRANSACTIONS permission is required to view another user's transactions",
2207             params => [
2208                 {desc => 'Authentication token',        type => 'string'},
2209                 {desc => 'User ID',                     type => 'number'},
2210                 {desc => 'Transaction type (optional)', type => 'number'},
2211                 {desc => 'Hash of Billable Transaction Summary filters (optional)', type => 'object'}
2212             ],
2213             return => {
2214                 desc => 'List of transaction' . ($ids ? " id" : '') . 's, Event on error'
2215             },
2216         }
2217     );
2218     $auth and push @sig, (authoritative => 1);
2219     return @sig;
2220 }
2221
2222 my %auth_hist_methods = (
2223     'history'             => '',
2224     'history.have_charge' => 'that have an initial charge',
2225     'history.still_open'  => 'that are not finished',
2226     'history.have_balance'         => 'that have a balance',
2227     'history.have_bill'            => 'that have billings',
2228     'history.have_bill_or_payment' => 'that have non-zero-sum billings or at least 1 payment',
2229     'history.have_payment' => 'that have at least 1 payment',
2230 );
2231
2232 foreach (keys %auth_hist_methods) {
2233     __PACKAGE__->register_method(_sigmaker($_,       $auth_hist_methods{$_}, 1));
2234     __PACKAGE__->register_method(_sigmaker("$_.ids", $auth_hist_methods{$_}, 1));
2235     __PACKAGE__->register_method(_sigmaker("$_.fleshed", $auth_hist_methods{$_}, 1));
2236 }
2237
2238 sub user_transaction_history {
2239     my( $self, $conn, $auth, $userid, $type, $filter, $options ) = @_;
2240     $filter ||= {};
2241     $options ||= {};
2242
2243     my $e = new_editor(authtoken=>$auth);
2244     return $e->die_event unless $e->checkauth;
2245
2246     if ($e->requestor->id ne $userid) {
2247         return $e->die_event unless $e->allowed('VIEW_USER_TRANSACTIONS');
2248     }
2249
2250     my $api = $self->api_name;
2251     my @xact_finish  = (xact_finish => undef ) if ($api =~ /history\.still_open$/);     # What about history.still_open.ids?
2252
2253     if(defined($type)) {
2254         $filter->{'xact_type'} = $type;
2255     }
2256
2257     if($api =~ /have_bill_or_payment/o) {
2258
2259         # transactions that have a non-zero sum across all billings or at least 1 payment
2260         $filter->{'-or'} = {
2261             'balance_owed' => { '<>' => 0 },
2262             'last_payment_ts' => { '<>' => undef }
2263         };
2264
2265     } elsif($api =~ /have_payment/) {
2266
2267         $filter->{last_payment_ts} ||= {'<>' => undef};
2268
2269     } elsif( $api =~ /have_balance/o) {
2270
2271         # transactions that have a non-zero overall balance
2272         $filter->{'balance_owed'} = { '<>' => 0 };
2273
2274     } elsif( $api =~ /have_charge/o) {
2275
2276         # transactions that have at least 1 billing, regardless of whether it was voided
2277         $filter->{'last_billing_ts'} = { '<>' => undef };
2278
2279     } elsif( $api =~ /have_bill/o) {    # needs to be an elsif, or we double-match have_bill_or_payment!
2280
2281         # transactions that have non-zero sum across all billings.  This will exclude
2282         # xacts where all billings have been voided
2283         $filter->{'total_owed'} = { '<>' => 0 };
2284     }
2285
2286     my $options_clause = { order_by => { mbt => 'xact_start DESC' } };
2287     $options_clause->{'limit'} = $options->{'limit'} if $options->{'limit'};
2288     $options_clause->{'offset'} = $options->{'offset'} if $options->{'offset'};
2289
2290     my $mbts = $e->search_money_billable_transaction_summary(
2291         [   { usr => $userid, @xact_finish, %$filter },
2292             $options_clause
2293         ]
2294     );
2295
2296     return [map {$_->id} @$mbts] if $api =~ /\.ids/;
2297     return $mbts unless $api =~ /fleshed/;
2298
2299     my @resp;
2300     for my $t (@$mbts) {
2301
2302         if( $t->xact_type ne 'circulation' ) {
2303             push @resp, {transaction => $t};
2304             next;
2305         }
2306
2307         my $circ_data = flesh_circ($e, $t->id);
2308         push @resp, {transaction => $t, %$circ_data};
2309     }
2310
2311     return \@resp;
2312 }
2313
2314
2315
2316 __PACKAGE__->register_method(
2317     method   => "user_perms",
2318     api_name => "open-ils.actor.permissions.user_perms.retrieve",
2319     argc     => 1,
2320     notes    => "Returns a list of permissions"
2321 );
2322
2323 sub user_perms {
2324     my( $self, $client, $authtoken, $user ) = @_;
2325
2326     my( $staff, $evt ) = $apputils->checkses($authtoken);
2327     return $evt if $evt;
2328
2329     $user ||= $staff->id;
2330
2331     if( $user != $staff->id and $evt = $apputils->check_perms( $staff->id, $staff->home_ou, 'VIEW_PERMISSION') ) {
2332         return $evt;
2333     }
2334
2335     return $apputils->simple_scalar_request(
2336         "open-ils.storage",
2337         "open-ils.storage.permission.user_perms.atomic",
2338         $user);
2339 }
2340
2341 __PACKAGE__->register_method(
2342     method   => "retrieve_perms",
2343     api_name => "open-ils.actor.permissions.retrieve",
2344     notes    => "Returns a list of permissions"
2345 );
2346 sub retrieve_perms {
2347     my( $self, $client ) = @_;
2348     return $apputils->simple_scalar_request(
2349         "open-ils.cstore",
2350         "open-ils.cstore.direct.permission.perm_list.search.atomic",
2351         { id => { '!=' => undef } }
2352     );
2353 }
2354
2355 __PACKAGE__->register_method(
2356     method   => "retrieve_groups",
2357     api_name => "open-ils.actor.groups.retrieve",
2358     notes    => "Returns a list of user groups"
2359 );
2360 sub retrieve_groups {
2361     my( $self, $client ) = @_;
2362     return new_editor()->retrieve_all_permission_grp_tree();
2363 }
2364
2365 __PACKAGE__->register_method(
2366     method  => "retrieve_org_address",
2367     api_name    => "open-ils.actor.org_unit.address.retrieve",
2368     notes        => <<'    NOTES');
2369     Returns an org_unit address by ID
2370     @param An org_address ID
2371     NOTES
2372 sub retrieve_org_address {
2373     my( $self, $client, $id ) = @_;
2374     return $apputils->simple_scalar_request(
2375         "open-ils.cstore",
2376         "open-ils.cstore.direct.actor.org_address.retrieve",
2377         $id
2378     );
2379 }
2380
2381 __PACKAGE__->register_method(
2382     method   => "retrieve_groups_tree",
2383     api_name => "open-ils.actor.groups.tree.retrieve",
2384     notes    => "Returns a list of user groups"
2385 );
2386
2387 sub retrieve_groups_tree {
2388     my( $self, $client ) = @_;
2389     return new_editor()->search_permission_grp_tree(
2390         [
2391             { parent => undef},
2392             {
2393                 flesh               => -1,
2394                 flesh_fields    => { pgt => ["children"] },
2395                 order_by            => { pgt => 'name'}
2396             }
2397         ]
2398     )->[0];
2399 }
2400
2401
2402 __PACKAGE__->register_method(
2403     method   => "add_user_to_groups",
2404     api_name => "open-ils.actor.user.set_groups",
2405     notes    => "Adds a user to one or more permission groups"
2406 );
2407
2408 sub add_user_to_groups {
2409     my( $self, $client, $authtoken, $userid, $groups ) = @_;
2410
2411     my( $requestor, $target, $evt ) = $apputils->checkses_requestor(
2412         $authtoken, $userid, 'CREATE_USER_GROUP_LINK' );
2413     return $evt if $evt;
2414
2415     ( $requestor, $target, $evt ) = $apputils->checkses_requestor(
2416         $authtoken, $userid, 'REMOVE_USER_GROUP_LINK' );
2417     return $evt if $evt;
2418
2419     $apputils->simplereq(
2420         'open-ils.storage',
2421         'open-ils.storage.direct.permission.usr_grp_map.mass_delete', { usr => $userid } );
2422
2423     for my $group (@$groups) {
2424         my $link = Fieldmapper::permission::usr_grp_map->new;
2425         $link->grp($group);
2426         $link->usr($userid);
2427
2428         my $id = $apputils->simplereq(
2429             'open-ils.storage',
2430             'open-ils.storage.direct.permission.usr_grp_map.create', $link );
2431     }
2432
2433     return 1;
2434 }
2435
2436 __PACKAGE__->register_method(
2437     method   => "get_user_perm_groups",
2438     api_name => "open-ils.actor.user.get_groups",
2439     notes    => "Retrieve a user's permission groups."
2440 );
2441
2442
2443 sub get_user_perm_groups {
2444     my( $self, $client, $authtoken, $userid ) = @_;
2445
2446     my( $requestor, $target, $evt ) = $apputils->checkses_requestor(
2447         $authtoken, $userid, 'VIEW_PERM_GROUPS' );
2448     return $evt if $evt;
2449
2450     return $apputils->simplereq(
2451         'open-ils.cstore',
2452         'open-ils.cstore.direct.permission.usr_grp_map.search.atomic', { usr => $userid } );
2453 }
2454
2455
2456 __PACKAGE__->register_method(
2457     method   => "get_user_work_ous",
2458     api_name => "open-ils.actor.user.get_work_ous",
2459     notes    => "Retrieve a user's work org units."
2460 );
2461
2462 __PACKAGE__->register_method(
2463     method   => "get_user_work_ous",
2464     api_name => "open-ils.actor.user.get_work_ous.ids",
2465     notes    => "Retrieve a user's work org units."
2466 );
2467
2468 sub get_user_work_ous {
2469     my( $self, $client, $auth, $userid ) = @_;
2470     my $e = new_editor(authtoken=>$auth);
2471     return $e->event unless $e->checkauth;
2472     $userid ||= $e->requestor->id;
2473
2474     if($e->requestor->id != $userid) {
2475         my $user = $e->retrieve_actor_user($userid)
2476             or return $e->event;
2477         return $e->event unless $e->allowed('ASSIGN_WORK_ORG_UNIT', $user->home_ou);
2478     }
2479
2480     return $e->search_permission_usr_work_ou_map({usr => $userid})
2481         unless $self->api_name =~ /.ids$/;
2482
2483     # client just wants a list of org IDs
2484     return $U->get_user_work_ou_ids($e, $userid);
2485 }
2486
2487
2488
2489 __PACKAGE__->register_method(
2490     method    => 'register_workstation',
2491     api_name  => 'open-ils.actor.workstation.register.override',
2492     signature => q/@see open-ils.actor.workstation.register/
2493 );
2494
2495 __PACKAGE__->register_method(
2496     method    => 'register_workstation',
2497     api_name  => 'open-ils.actor.workstation.register',
2498     signature => q/
2499         Registers a new workstion in the system
2500         @param authtoken The login session key
2501         @param name The name of the workstation id
2502         @param owner The org unit that owns this workstation
2503         @return The workstation id on success, WORKSTATION_NAME_EXISTS
2504         if the name is already in use.
2505     /
2506 );
2507
2508 sub register_workstation {
2509     my( $self, $conn, $authtoken, $name, $owner, $oargs ) = @_;
2510
2511     my $e = new_editor(authtoken=>$authtoken, xact=>1);
2512     return $e->die_event unless $e->checkauth;
2513     return $e->die_event unless $e->allowed('REGISTER_WORKSTATION', $owner);
2514     my $existing = $e->search_actor_workstation({name => $name})->[0];
2515     $oargs = { all => 1 } unless defined $oargs;
2516
2517     if( $existing ) {
2518
2519         if( $self->api_name =~ /override/o && ($oargs->{all} || grep { $_ eq 'WORKSTATION_NAME_EXISTS' } @{$oargs->{events}}) ) {
2520             # workstation with the given name exists.
2521
2522             if($owner ne $existing->owning_lib) {
2523                 # if necessary, update the owning_lib of the workstation
2524
2525                 $logger->info("changing owning lib of workstation ".$existing->id.
2526                     " from ".$existing->owning_lib." to $owner");
2527                 return $e->die_event unless
2528                     $e->allowed('UPDATE_WORKSTATION', $existing->owning_lib);
2529
2530                 return $e->die_event unless $e->allowed('UPDATE_WORKSTATION', $owner);
2531
2532                 $existing->owning_lib($owner);
2533                 return $e->die_event unless $e->update_actor_workstation($existing);
2534
2535                 $e->commit;
2536
2537             } else {
2538                 $logger->info(
2539                     "attempt to register an existing workstation.  returning existing ID");
2540             }
2541
2542             return $existing->id;
2543
2544         } else {
2545             return OpenILS::Event->new('WORKSTATION_NAME_EXISTS')
2546         }
2547     }
2548
2549     my $ws = Fieldmapper::actor::workstation->new;
2550     $ws->owning_lib($owner);
2551     $ws->name($name);
2552     $e->create_actor_workstation($ws) or return $e->die_event;
2553     $e->commit;
2554     return $ws->id; # note: editor sets the id on the new object for us
2555 }
2556
2557 __PACKAGE__->register_method(
2558     method    => 'workstation_list',
2559     api_name  => 'open-ils.actor.workstation.list',
2560     signature => q/
2561         Returns a list of workstations registered at the given location
2562         @param authtoken The login session key
2563         @param ids A list of org_unit.id's for the workstation owners
2564     /
2565 );
2566
2567 sub workstation_list {
2568     my( $self, $conn, $authtoken, @orgs ) = @_;
2569
2570     my $e = new_editor(authtoken=>$authtoken);
2571     return $e->event unless $e->checkauth;
2572     my %results;
2573
2574     for my $o (@orgs) {
2575         return $e->event
2576             unless $e->allowed('REGISTER_WORKSTATION', $o);
2577         $results{$o} = $e->search_actor_workstation({owning_lib=>$o});
2578     }
2579     return \%results;
2580 }
2581
2582
2583 __PACKAGE__->register_method(
2584     method        => 'fetch_patron_note',
2585     api_name      => 'open-ils.actor.note.retrieve.all',
2586     authoritative => 1,
2587     signature     => q/
2588         Returns a list of notes for a given user
2589         Requestor must have VIEW_USER permission if pub==false and
2590         @param authtoken The login session key
2591         @param args Hash of params including
2592             patronid : the patron's id
2593             pub : true if retrieving only public notes
2594     /
2595 );
2596
2597 sub fetch_patron_note {
2598     my( $self, $conn, $authtoken, $args ) = @_;
2599     my $patronid = $$args{patronid};
2600
2601     my($reqr, $evt) = $U->checkses($authtoken);
2602     return $evt if $evt;
2603
2604     my $patron;
2605     ($patron, $evt) = $U->fetch_user($patronid);
2606     return $evt if $evt;
2607
2608     if($$args{pub}) {
2609         if( $patronid ne $reqr->id ) {
2610             $evt = $U->check_perms($reqr->id, $patron->home_ou, 'VIEW_USER');
2611             return $evt if $evt;
2612         }
2613         return $U->cstorereq(
2614             'open-ils.cstore.direct.actor.usr_note.search.atomic',
2615             { usr => $patronid, pub => 't' } );
2616     }
2617
2618     $evt = $U->check_perms($reqr->id, $patron->home_ou, 'VIEW_USER');
2619     return $evt if $evt;
2620
2621     return $U->cstorereq(
2622         'open-ils.cstore.direct.actor.usr_note.search.atomic', { usr => $patronid } );
2623 }
2624
2625 __PACKAGE__->register_method(
2626     method    => 'create_user_note',
2627     api_name  => 'open-ils.actor.note.create',
2628     signature => q/
2629         Creates a new note for the given user
2630         @param authtoken The login session key
2631         @param note The note object
2632     /
2633 );
2634 sub create_user_note {
2635     my( $self, $conn, $authtoken, $note ) = @_;
2636     my $e = new_editor(xact=>1, authtoken=>$authtoken);
2637     return $e->die_event unless $e->checkauth;
2638
2639     my $user = $e->retrieve_actor_user($note->usr)
2640         or return $e->die_event;
2641
2642     return $e->die_event unless
2643         $e->allowed('UPDATE_USER',$user->home_ou);
2644
2645     $note->creator($e->requestor->id);
2646     $e->create_actor_usr_note($note) or return $e->die_event;
2647     $e->commit;
2648     return $note->id;
2649 }
2650
2651
2652 __PACKAGE__->register_method(
2653     method    => 'delete_user_note',
2654     api_name  => 'open-ils.actor.note.delete',
2655     signature => q/
2656         Deletes a note for the given user
2657         @param authtoken The login session key
2658         @param noteid The note id
2659     /
2660 );
2661 sub delete_user_note {
2662     my( $self, $conn, $authtoken, $noteid ) = @_;
2663
2664     my $e = new_editor(xact=>1, authtoken=>$authtoken);
2665     return $e->die_event unless $e->checkauth;
2666     my $note = $e->retrieve_actor_usr_note($noteid)
2667         or return $e->die_event;
2668     my $user = $e->retrieve_actor_user($note->usr)
2669         or return $e->die_event;
2670     return $e->die_event unless
2671         $e->allowed('UPDATE_USER', $user->home_ou);
2672
2673     $e->delete_actor_usr_note($note) or return $e->die_event;
2674     $e->commit;
2675     return 1;
2676 }
2677
2678
2679 __PACKAGE__->register_method(
2680     method    => 'update_user_note',
2681     api_name  => 'open-ils.actor.note.update',
2682     signature => q/
2683         @param authtoken The login session key
2684         @param note The note
2685     /
2686 );
2687
2688 sub update_user_note {
2689     my( $self, $conn, $auth, $note ) = @_;
2690     my $e = new_editor(authtoken=>$auth, xact=>1);
2691     return $e->die_event unless $e->checkauth;
2692     my $patron = $e->retrieve_actor_user($note->usr)
2693         or return $e->die_event;
2694     return $e->die_event unless
2695         $e->allowed('UPDATE_USER', $patron->home_ou);
2696     $e->update_actor_user_note($note)
2697         or return $e->die_event;
2698     $e->commit;
2699     return 1;
2700 }
2701
2702 __PACKAGE__->register_method(
2703     method        => 'fetch_patron_messages',
2704     api_name      => 'open-ils.actor.message.retrieve',
2705     authoritative => 1,
2706     signature     => q/
2707         Returns a list of notes for a given user, not
2708         including ones marked deleted
2709         @param authtoken The login session key
2710         @param patronid patron ID
2711         @param options hash containing optional limit and offset
2712     /
2713 );
2714
2715 sub fetch_patron_messages {
2716     my( $self, $conn, $auth, $patronid, $options ) = @_;
2717
2718     $options ||= {};
2719
2720     my $e = new_editor(authtoken => $auth);
2721     return $e->die_event unless $e->checkauth;
2722
2723     if ($e->requestor->id ne $patronid) {
2724         return $e->die_event unless $e->allowed('VIEW_USER');
2725     }
2726
2727     my $select_clause = { usr => $patronid };
2728     my $options_clause = { order_by => { aum => 'create_date DESC' } };
2729     $options_clause->{'limit'} = $options->{'limit'} if $options->{'limit'};
2730     $options_clause->{'offset'} = $options->{'offset'} if $options->{'offset'};
2731
2732     my $aum = $e->search_actor_usr_message([ $select_clause, $options_clause ]);
2733     return $aum;
2734 }
2735
2736
2737 __PACKAGE__->register_method(
2738     method    => 'usrname_exists',
2739     api_name  => 'open-ils.actor.username.exists',
2740     signature => {
2741         desc  => 'Check if a username is already taken (by an undeleted patron)',
2742         param => [
2743             {desc => 'Authentication token', type => 'string'},
2744             {desc => 'Username',             type => 'string'}
2745         ],
2746         return => {
2747             desc => 'id of existing user if username exists, undef otherwise.  Event on error'
2748         },
2749     }
2750 );
2751
2752 sub usrname_exists {
2753     my( $self, $conn, $auth, $usrname ) = @_;
2754     my $e = new_editor(authtoken=>$auth);
2755     return $e->event unless $e->checkauth;
2756     my $a = $e->search_actor_user({usrname => $usrname}, {idlist=>1});
2757     return $$a[0] if $a and @$a;
2758     return undef;
2759 }
2760
2761 __PACKAGE__->register_method(
2762     method        => 'barcode_exists',
2763     api_name      => 'open-ils.actor.barcode.exists',
2764     authoritative => 1,
2765     signature     => 'Returns 1 if the requested barcode exists, returns 0 otherwise'
2766 );
2767
2768 sub barcode_exists {
2769     my( $self, $conn, $auth, $barcode ) = @_;
2770     my $e = new_editor(authtoken=>$auth);
2771     return $e->event unless $e->checkauth;
2772     my $card = $e->search_actor_card({barcode => $barcode});
2773     if (@$card) {
2774         return 1;
2775     } else {
2776         return 0;
2777     }
2778     #return undef unless @$card;
2779     #return $card->[0]->usr;
2780 }
2781
2782
2783 __PACKAGE__->register_method(
2784     method   => 'retrieve_net_levels',
2785     api_name => 'open-ils.actor.net_access_level.retrieve.all',
2786 );
2787
2788 sub retrieve_net_levels {
2789     my( $self, $conn, $auth ) = @_;
2790     my $e = new_editor(authtoken=>$auth);
2791     return $e->event unless $e->checkauth;
2792     return $e->retrieve_all_config_net_access_level();
2793 }
2794
2795 # Retain the old typo API name just in case
2796 __PACKAGE__->register_method(
2797     method   => 'fetch_org_by_shortname',
2798     api_name => 'open-ils.actor.org_unit.retrieve_by_shorname',
2799 );
2800 __PACKAGE__->register_method(
2801     method   => 'fetch_org_by_shortname',
2802     api_name => 'open-ils.actor.org_unit.retrieve_by_shortname',
2803 );
2804 sub fetch_org_by_shortname {
2805     my( $self, $conn, $sname ) = @_;
2806     my $e = new_editor();
2807     my $org = $e->search_actor_org_unit({ shortname => uc($sname)})->[0];
2808     return $e->event unless $org;
2809     return $org;
2810 }
2811
2812
2813 __PACKAGE__->register_method(
2814     method   => 'session_home_lib',
2815     api_name => 'open-ils.actor.session.home_lib',
2816 );
2817
2818 sub session_home_lib {
2819     my( $self, $conn, $auth ) = @_;
2820     my $e = new_editor(authtoken=>$auth);
2821     return undef unless $e->checkauth;
2822     my $org = $e->retrieve_actor_org_unit($e->requestor->home_ou);
2823     return $org->shortname;
2824 }
2825
2826 __PACKAGE__->register_method(
2827     method    => 'session_safe_token',
2828     api_name  => 'open-ils.actor.session.safe_token',
2829     signature => q/
2830         Returns a hashed session ID that is safe for export to the world.
2831         This safe token will expire after 1 hour of non-use.
2832         @param auth Active authentication token
2833     /
2834 );
2835
2836 sub session_safe_token {
2837     my( $self, $conn, $auth ) = @_;
2838     my $e = new_editor(authtoken=>$auth);
2839     return undef unless $e->checkauth;
2840
2841     my $safe_token = md5_hex($auth);
2842
2843     $cache ||= OpenSRF::Utils::Cache->new("global", 0);
2844
2845     # add more user fields as needed
2846     $cache->put_cache(
2847         "safe-token-user-$safe_token", {
2848             id => $e->requestor->id,
2849             home_ou_shortname => $e->retrieve_actor_org_unit(
2850                 $e->requestor->home_ou)->shortname,
2851         },
2852         60 * 60
2853     );
2854
2855     return $safe_token;
2856 }
2857
2858
2859 __PACKAGE__->register_method(
2860     method    => 'safe_token_home_lib',
2861     api_name  => 'open-ils.actor.safe_token.home_lib.shortname',
2862     signature => q/
2863         Returns the home library shortname from the session
2864         asscociated with a safe token from generated by
2865         open-ils.actor.session.safe_token.
2866         @param safe_token Active safe token
2867         @param who Optional user activity "ewho" value
2868     /
2869 );
2870
2871 sub safe_token_home_lib {
2872     my( $self, $conn, $safe_token, $who ) = @_;
2873     $cache ||= OpenSRF::Utils::Cache->new("global", 0);
2874
2875     my $blob = $cache->get_cache("safe-token-user-$safe_token");
2876     return unless $blob;
2877
2878     $U->log_user_activity($blob->{id}, $who, 'verify');
2879     return $blob->{home_ou_shortname};
2880 }
2881
2882
2883 __PACKAGE__->register_method(
2884     method   => "update_penalties",
2885     api_name => "open-ils.actor.user.penalties.update"
2886 );
2887
2888 sub update_penalties {
2889     my($self, $conn, $auth, $user_id) = @_;
2890     my $e = new_editor(authtoken=>$auth, xact => 1);
2891     return $e->die_event unless $e->checkauth;
2892     my $user = $e->retrieve_actor_user($user_id) or return $e->die_event;
2893     return $e->die_event unless $e->allowed('UPDATE_USER', $user->home_ou);
2894     my $evt = OpenILS::Utils::Penalty->calculate_penalties($e, $user_id, $e->requestor->ws_ou);
2895     return $evt if $evt;
2896     $e->commit;
2897     return 1;
2898 }
2899
2900
2901 __PACKAGE__->register_method(
2902     method   => "apply_penalty",
2903     api_name => "open-ils.actor.user.penalty.apply"
2904 );
2905
2906 sub apply_penalty {
2907     my($self, $conn, $auth, $penalty) = @_;
2908
2909     my $e = new_editor(authtoken=>$auth, xact => 1);
2910     return $e->die_event unless $e->checkauth;
2911
2912     my $user = $e->retrieve_actor_user($penalty->usr) or return $e->die_event;
2913     return $e->die_event unless $e->allowed('UPDATE_USER', $user->home_ou);
2914
2915     my $ptype = $e->retrieve_config_standing_penalty($penalty->standing_penalty) or return $e->die_event;
2916
2917     my $ctx_org =
2918         (defined $ptype->org_depth) ?
2919         $U->org_unit_ancestor_at_depth($penalty->org_unit, $ptype->org_depth) :
2920         $penalty->org_unit;
2921
2922     $penalty->org_unit($ctx_org);
2923     $penalty->staff($e->requestor->id);
2924     $e->create_actor_user_standing_penalty($penalty) or return $e->die_event;
2925
2926     $e->commit;
2927     return $penalty->id;
2928 }
2929
2930 __PACKAGE__->register_method(
2931     method   => "remove_penalty",
2932     api_name => "open-ils.actor.user.penalty.remove"
2933 );
2934
2935 sub remove_penalty {
2936     my($self, $conn, $auth, $penalty) = @_;
2937     my $e = new_editor(authtoken=>$auth, xact => 1);
2938     return $e->die_event unless $e->checkauth;
2939     my $user = $e->retrieve_actor_user($penalty->usr) or return $e->die_event;
2940     return $e->die_event unless $e->allowed('UPDATE_USER', $user->home_ou);
2941
2942     $e->delete_actor_user_standing_penalty($penalty) or return $e->die_event;
2943     $e->commit;
2944     return 1;
2945 }
2946
2947 __PACKAGE__->register_method(
2948     method   => "update_penalty_note",
2949     api_name => "open-ils.actor.user.penalty.note.update"
2950 );
2951
2952 sub update_penalty_note {
2953     my($self, $conn, $auth, $penalty_ids, $note) = @_;
2954     my $e = new_editor(authtoken=>$auth, xact => 1);
2955     return $e->die_event unless $e->checkauth;
2956     for my $penalty_id (@$penalty_ids) {
2957         my $penalty = $e->search_actor_user_standing_penalty( { id => $penalty_id } )->[0];
2958         if (! $penalty ) { return $e->die_event; }
2959         my $user = $e->retrieve_actor_user($penalty->usr) or return $e->die_event;
2960         return $e->die_event unless $e->allowed('UPDATE_USER', $user->home_ou);
2961
2962         $penalty->note( $note ); $penalty->ischanged( 1 );
2963
2964         $e->update_actor_user_standing_penalty($penalty) or return $e->die_event;
2965     }
2966     $e->commit;
2967     return 1;
2968 }
2969
2970 __PACKAGE__->register_method(
2971     method   => "ranged_penalty_thresholds",
2972     api_name => "open-ils.actor.grp_penalty_threshold.ranged.retrieve",
2973     stream   => 1
2974 );
2975
2976 sub ranged_penalty_thresholds {
2977     my($self, $conn, $auth, $context_org) = @_;
2978     my $e = new_editor(authtoken=>$auth);
2979     return $e->event unless $e->checkauth;
2980     return $e->event unless $e->allowed('VIEW_GROUP_PENALTY_THRESHOLD', $context_org);
2981     my $list = $e->search_permission_grp_penalty_threshold([
2982         {org_unit => $U->get_org_ancestors($context_org)},
2983         {order_by => {pgpt => 'id'}}
2984     ]);
2985     $conn->respond($_) for @$list;
2986     return undef;
2987 }
2988
2989
2990
2991 __PACKAGE__->register_method(
2992     method        => "user_retrieve_fleshed_by_id",
2993     authoritative => 1,
2994     api_name      => "open-ils.actor.user.fleshed.retrieve",
2995 );
2996
2997 sub user_retrieve_fleshed_by_id {
2998     my( $self, $client, $auth, $user_id, $fields ) = @_;
2999     my $e = new_editor(authtoken => $auth);
3000     return $e->event unless $e->checkauth;
3001
3002     if( $e->requestor->id != $user_id ) {
3003         return $e->event unless $e->allowed('VIEW_USER');
3004     }
3005
3006     $fields ||= [
3007         "cards",
3008         "card",
3009         "groups",
3010         "standing_penalties",
3011         "addresses",
3012         "billing_address",
3013         "mailing_address",
3014         "stat_cat_entries",
3015         "usr_activity" ];
3016     return new_flesh_user($user_id, $fields, $e);
3017 }
3018
3019
3020 sub new_flesh_user {
3021
3022     my $id = shift;
3023     my $fields = shift || [];
3024     my $e = shift;
3025
3026     my $fetch_penalties = 0;
3027     if(grep {$_ eq 'standing_penalties'} @$fields) {
3028         $fields = [grep {$_ ne 'standing_penalties'} @$fields];
3029         $fetch_penalties = 1;
3030     }
3031
3032     my $fetch_usr_act = 0;
3033     if(grep {$_ eq 'usr_activity'} @$fields) {
3034         $fields = [grep {$_ ne 'usr_activity'} @$fields];
3035         $fetch_usr_act = 1;
3036     }
3037
3038     my $user = $e->retrieve_actor_user(
3039     [
3040         $id,
3041         {
3042             "flesh"             => 1,
3043             "flesh_fields" =>  { "au" => $fields }
3044         }
3045     ]
3046     ) or return $e->die_event;
3047
3048
3049     if( grep { $_ eq 'addresses' } @$fields ) {
3050
3051         $user->addresses([]) unless @{$user->addresses};
3052         # don't expose "replaced" addresses by default
3053         $user->addresses([grep {$_->id >= 0} @{$user->addresses}]);
3054
3055         if( ref $user->billing_address ) {
3056             unless( grep { $user->billing_address->id == $_->id } @{$user->addresses} ) {
3057                 push( @{$user->addresses}, $user->billing_address );
3058             }
3059         }
3060
3061         if( ref $user->mailing_address ) {
3062             unless( grep { $user->mailing_address->id == $_->id } @{$user->addresses} ) {
3063                 push( @{$user->addresses}, $user->mailing_address );
3064             }
3065         }
3066     }
3067
3068     if($fetch_penalties) {
3069         # grab the user penalties ranged for this location
3070         $user->standing_penalties(
3071             $e->search_actor_user_standing_penalty([
3072                 {   usr => $id,
3073                     '-or' => [
3074                         {stop_date => undef},
3075                         {stop_date => {'>' => 'now'}}
3076                     ],
3077                     org_unit => $U->get_org_full_path($e->requestor->ws_ou)
3078                 },
3079                 {   flesh => 1,
3080                     flesh_fields => {ausp => ['standing_penalty']}
3081                 }
3082             ])
3083         );
3084     }
3085
3086     # retrieve the most recent usr_activity entry
3087     if ($fetch_usr_act) {
3088
3089         # max number to return for simple patron fleshing
3090         my $limit = $U->ou_ancestor_setting_value(
3091             $e->requestor->ws_ou,
3092             'circ.patron.usr_activity_retrieve.max');
3093
3094         my $opts = {
3095             flesh => 1,
3096             flesh_fields => {auact => ['etype']},
3097             order_by => {auact => 'event_time DESC'},
3098         };
3099
3100         # 0 == none, <0 == return all
3101         $limit = 1 unless defined $limit;
3102         $opts->{limit} = $limit if $limit > 0;
3103
3104         $user->usr_activity(
3105             ($limit == 0) ?
3106                 [] : # skip the DB call
3107                 $e->search_actor_usr_activity([{usr => $user->id}, $opts])
3108         );
3109     }
3110
3111     $e->rollback;
3112     $user->clear_passwd();
3113     return $user;
3114 }
3115
3116
3117
3118
3119 __PACKAGE__->register_method(
3120     method   => "user_retrieve_parts",
3121     api_name => "open-ils.actor.user.retrieve.parts",
3122 );
3123
3124 sub user_retrieve_parts {
3125     my( $self, $client, $auth, $user_id, $fields ) = @_;
3126     my $e = new_editor(authtoken => $auth);
3127     return $e->event unless $e->checkauth;
3128     $user_id ||= $e->requestor->id;
3129     if( $e->requestor->id != $user_id ) {
3130         return $e->event unless $e->allowed('VIEW_USER');
3131     }
3132     my @resp;
3133     my $user = $e->retrieve_actor_user($user_id) or return $e->event;
3134     push(@resp, $user->$_()) for(@$fields);
3135     return \@resp;
3136 }
3137
3138
3139
3140 __PACKAGE__->register_method(
3141     method    => 'user_opt_in_enabled',
3142     api_name  => 'open-ils.actor.user.org_unit_opt_in.enabled',
3143     signature => '@return 1 if user opt-in is globally enabled, 0 otherwise.'
3144 );
3145
3146 sub user_opt_in_enabled {
3147     my($self, $conn) = @_;
3148     my $sc = OpenSRF::Utils::SettingsClient->new;
3149     return 1 if lc($sc->config_value(share => user => 'opt_in')) eq 'true';
3150     return 0;
3151 }
3152
3153
3154 __PACKAGE__->register_method(
3155     method    => 'user_opt_in_at_org',
3156     api_name  => 'open-ils.actor.user.org_unit_opt_in.check',
3157     signature => q/
3158         @param $auth The auth token
3159         @param user_id The ID of the user to test
3160         @return 1 if the user has opted in at the specified org,
3161             2 if opt-in is disallowed for the user's home org,
3162             event on error, and 0 otherwise. /
3163 );
3164 sub user_opt_in_at_org {
3165     my($self, $conn, $auth, $user_id) = @_;
3166
3167     # see if we even need to enforce the opt-in value
3168     return 1 unless user_opt_in_enabled($self);
3169
3170     my $e = new_editor(authtoken => $auth);
3171     return $e->event unless $e->checkauth;
3172
3173     my $user = $e->retrieve_actor_user($user_id) or return $e->event;
3174     return $e->event unless $e->allowed('VIEW_USER', $user->home_ou);
3175
3176     my $ws_org = $e->requestor->ws_ou;
3177     # user is automatically opted-in if they are from the local org
3178     return 1 if $user->home_ou eq $ws_org;
3179
3180     # get the boundary setting
3181     my $opt_boundary = $U->ou_ancestor_setting_value($e->requestor->ws_ou,'org.patron_opt_boundary');
3182
3183     # auto opt in if user falls within the opt boundary
3184     my $opt_orgs = $U->get_org_descendants($ws_org, $opt_boundary);
3185
3186     return 1 if grep $_ eq $user->home_ou, @$opt_orgs;
3187
3188     # check whether opt-in is restricted at the user's home library
3189     my $opt_restrict_depth = $U->ou_ancestor_setting_value($user->home_ou, 'org.restrict_opt_to_depth');
3190     if ($opt_restrict_depth) {
3191         my $restrict_ancestor = $U->org_unit_ancestor_at_depth($user->home_ou, $opt_restrict_depth);
3192         my $unrestricted_orgs = $U->get_org_descendants($restrict_ancestor);
3193
3194         # opt-in is disallowed unless the workstation org is within the home
3195         # library's opt-in scope
3196         return 2 unless grep $_ eq $e->requestor->ws_ou, @$unrestricted_orgs;
3197     }
3198
3199     my $vals = $e->search_actor_usr_org_unit_opt_in(
3200         {org_unit=>$opt_orgs, usr=>$user_id},{idlist=>1});
3201
3202     return 1 if @$vals;
3203     return 0;
3204 }
3205
3206 __PACKAGE__->register_method(
3207     method    => 'create_user_opt_in_at_org',
3208     api_name  => 'open-ils.actor.user.org_unit_opt_in.create',
3209     signature => q/
3210         @param $auth The auth token
3211         @param user_id The ID of the user to test
3212         @return The ID of the newly created object, event on error./
3213 );
3214
3215 sub create_user_opt_in_at_org {
3216     my($self, $conn, $auth, $user_id, $org_id) = @_;
3217
3218     my $e = new_editor(authtoken => $auth, xact=>1);
3219     return $e->die_event unless $e->checkauth;
3220
3221     # if a specific org unit wasn't passed in, get one based on the defaults;
3222     if(!$org_id){
3223         my $wsou = $e->requestor->ws_ou;
3224         # get the default opt depth
3225         my $opt_depth = $U->ou_ancestor_setting_value($wsou,'org.patron_opt_default');
3226         # get the org unit at that depth
3227         my $org = $e->json_query({
3228             from => [ 'actor.org_unit_ancestor_at_depth', $wsou, $opt_depth ]})->[0];
3229         $org_id = $org->{id};
3230     }
3231     if (!$org_id) {
3232         # fall back to the workstation OU, the pre-opt-in-boundary way
3233         $org_id = $e->requestor->ws_ou;
3234     }
3235
3236     my $user = $e->retrieve_actor_user($user_id) or return $e->die_event;
3237     return $e->die_event unless $e->allowed('UPDATE_USER', $user->home_ou);
3238
3239     my $opt_in = Fieldmapper::actor::usr_org_unit_opt_in->new;
3240
3241     $opt_in->org_unit($org_id);
3242     $opt_in->usr($user_id);
3243     $opt_in->staff($e->requestor->id);
3244     $opt_in->opt_in_ts('now');
3245     $opt_in->opt_in_ws($e->requestor->wsid);
3246
3247     $opt_in = $e->create_actor_usr_org_unit_opt_in($opt_in)
3248         or return $e->die_event;
3249
3250     $e->commit;
3251
3252     return $opt_in->id;
3253 }
3254
3255
3256 __PACKAGE__->register_method (
3257     method      => 'retrieve_org_hours',
3258     api_name    => 'open-ils.actor.org_unit.hours_of_operation.retrieve',
3259     signature   => q/
3260         Returns the hours of operation for a specified org unit
3261         @param authtoken The login session key
3262         @param org_id The org_unit ID
3263     /
3264 );
3265
3266 sub retrieve_org_hours {
3267     my($self, $conn, $auth, $org_id) = @_;
3268     my $e = new_editor(authtoken => $auth);
3269     return $e->die_event unless $e->checkauth;
3270     $org_id ||= $e->requestor->ws_ou;
3271     return $e->retrieve_actor_org_unit_hours_of_operation($org_id);
3272 }
3273
3274
3275 __PACKAGE__->register_method (
3276     method      => 'verify_user_password',
3277     api_name    => 'open-ils.actor.verify_user_password',
3278     signature   => q/
3279         Given a barcode or username and the MD5 encoded password,
3280         returns 1 if the password is correct.  Returns 0 otherwise.
3281     /
3282 );
3283
3284 sub verify_user_password {
3285     my($self, $conn, $auth, $barcode, $username, $password) = @_;
3286     my $e = new_editor(authtoken => $auth);
3287     return $e->die_event unless $e->checkauth;
3288     my $user;
3289     my $user_by_barcode;
3290     my $user_by_username;
3291     if($barcode) {
3292         my $card = $e->search_actor_card([
3293             {barcode => $barcode},
3294             {flesh => 1, flesh_fields => {ac => ['usr']}}])->[0] or return 0;
3295         $user_by_barcode = $card->usr;
3296         $user = $user_by_barcode;
3297     }
3298     if ($username) {
3299         $user_by_username = $e->search_actor_user({usrname => $username})->[0] or return 0;
3300         $user = $user_by_username;
3301     }
3302     return 0 if (!$user || $U->is_true($user->deleted));
3303     return 0 if ($user_by_username && $user_by_barcode && $user_by_username->id != $user_by_barcode->id);
3304     return $e->event unless $e->allowed('VIEW_USER', $user->home_ou);
3305     return $U->verify_migrated_user_password($e, $user->id, $password, 1);
3306 }
3307
3308 __PACKAGE__->register_method (
3309     method      => 'retrieve_usr_id_via_barcode_or_usrname',
3310     api_name    => "open-ils.actor.user.retrieve_id_by_barcode_or_username",
3311     signature   => q/
3312         Given a barcode or username returns the id for the user or
3313         a failure event.
3314     /
3315 );
3316
3317 sub retrieve_usr_id_via_barcode_or_usrname {
3318     my($self, $conn, $auth, $barcode, $username) = @_;
3319     my $e = new_editor(authtoken => $auth);
3320     return $e->die_event unless $e->checkauth;
3321     my $id_as_barcode= OpenSRF::Utils::SettingsClient->new->config_value(apps => 'open-ils.actor' => app_settings => 'id_as_barcode');
3322     my $user;
3323     my $user_by_barcode;
3324     my $user_by_username;
3325     $logger->info("$id_as_barcode is the ID as BARCODE");
3326     if($barcode) {
3327         my $card = $e->search_actor_card([
3328             {barcode => $barcode},
3329             {flesh => 1, flesh_fields => {ac => ['usr']}}])->[0];
3330         if ($id_as_barcode =~ /^t/i) {
3331             if (!$card) {
3332                 $user = $e->retrieve_actor_user($barcode);
3333                 return OpenILS::Event->new( 'ACTOR_USER_NOT_FOUND' ) if(!$user);
3334             }else {
3335                 $user_by_barcode = $card->usr;
3336                 $user = $user_by_barcode;
3337             }
3338         }else {
3339             return OpenILS::Event->new( 'ACTOR_USER_NOT_FOUND' ) if(!$card);
3340             $user_by_barcode = $card->usr;
3341             $user = $user_by_barcode;
3342         }
3343     }
3344
3345     if ($username) {
3346         $user_by_username = $e->search_actor_user({usrname => $username})->[0] or return OpenILS::Event->new( 'ACTOR_USR_NOT_FOUND' );
3347
3348         $user = $user_by_username;
3349     }
3350     return OpenILS::Event->new( 'ACTOR_USER_NOT_FOUND' ) if (!$user);
3351     return OpenILS::Event->new( 'ACTOR_USER_NOT_FOUND' ) if ($user_by_username && $user_by_barcode && $user_by_username->id != $user_by_barcode->id);
3352     return $e->event unless $e->allowed('VIEW_USER', $user->home_ou);
3353     return $user->id;
3354 }
3355
3356
3357 __PACKAGE__->register_method (
3358     method      => 'merge_users',
3359     api_name    => 'open-ils.actor.user.merge',
3360     signature   => {
3361         desc => q/
3362             Given a list of source users and destination user, transfer all data from the source
3363             to the dest user and delete the source user.  All user related data is
3364             transferred, including circulations, holds, bookbags, etc.
3365         /
3366     }
3367 );
3368
3369 sub merge_users {
3370     my($self, $conn, $auth, $master_id, $user_ids, $options) = @_;
3371     my $e = new_editor(xact => 1, authtoken => $auth);
3372     return $e->die_event unless $e->checkauth;
3373
3374     # disallow the merge if any subordinate accounts are in collections
3375     my $colls = $e->search_money_collections_tracker({usr => $user_ids}, {idlist => 1});
3376     return OpenILS::Event->new('MERGED_USER_IN_COLLECTIONS', payload => $user_ids) if @$colls;
3377
3378     my $master_user = $e->retrieve_actor_user($master_id) or return $e->die_event;
3379     my $del_addrs = ($U->ou_ancestor_setting_value(
3380         $master_user->home_ou, 'circ.user_merge.delete_addresses', $e)) ? 't' : 'f';
3381     my $del_cards = ($U->ou_ancestor_setting_value(
3382         $master_user->home_ou, 'circ.user_merge.delete_cards', $e)) ? 't' : 'f';
3383     my $deactivate_cards = ($U->ou_ancestor_setting_value(
3384         $master_user->home_ou, 'circ.user_merge.deactivate_cards', $e)) ? 't' : 'f';
3385
3386     for my $src_id (@$user_ids) {
3387         my $src_user = $e->retrieve_actor_user($src_id) or return $e->die_event;
3388
3389         return $e->die_event unless $e->allowed('MERGE_USERS', $src_user->home_ou);
3390         if($src_user->home_ou ne $master_user->home_ou) {
3391             return $e->die_event unless $e->allowed('MERGE_USERS', $master_user->home_ou);
3392         }
3393
3394         return $e->die_event unless
3395             $e->json_query({from => [
3396                 'actor.usr_merge',
3397                 $src_id,
3398                 $master_id,
3399                 $del_addrs,
3400                 $del_cards,
3401                 $deactivate_cards
3402             ]});
3403     }
3404
3405     $e->commit;
3406     return 1;
3407 }
3408
3409
3410 __PACKAGE__->register_method (
3411     method      => 'approve_user_address',
3412     api_name    => 'open-ils.actor.user.pending_address.approve',
3413     signature   => {
3414         desc => q/
3415         /
3416     }
3417 );
3418
3419 sub approve_user_address {
3420     my($self, $conn, $auth, $addr) = @_;
3421     my $e = new_editor(xact => 1, authtoken => $auth);
3422     return $e->die_event unless $e->checkauth;
3423     if(ref $addr) {
3424         # if the caller passes an address object, assume they want to
3425         # update it first before approving it
3426         $e->update_actor_user_address($addr) or return $e->die_event;
3427     } else {
3428         $addr = $e->retrieve_actor_user_address($addr) or return $e->die_event;
3429     }
3430     my $user = $e->retrieve_actor_user($addr->usr);
3431     return $e->die_event unless $e->allowed('UPDATE_USER', $user->home_ou);
3432     my $result = $e->json_query({from => ['actor.approve_pending_address', $addr->id]})->[0]
3433         or return $e->die_event;
3434     $e->commit;
3435     return [values %$result]->[0];
3436 }
3437
3438
3439 __PACKAGE__->register_method (
3440     method      => 'retrieve_friends',
3441     api_name    => 'open-ils.actor.friends.retrieve',
3442     signature   => {
3443         desc => q/
3444             returns { confirmed: [], pending_out: [], pending_in: []}
3445             pending_out are users I'm requesting friendship with
3446             pending_in are users requesting friendship with me
3447         /
3448     }
3449 );
3450
3451 sub retrieve_friends {
3452     my($self, $conn, $auth, $user_id, $options) = @_;
3453     my $e = new_editor(authtoken => $auth);
3454     return $e->event unless $e->checkauth;
3455     $user_id ||= $e->requestor->id;
3456
3457     if($user_id != $e->requestor->id) {
3458         my $user = $e->retrieve_actor_user($user_id) or return $e->event;
3459         return $e->event unless $e->allowed('VIEW_USER', $user->home_ou);
3460     }
3461
3462     return OpenILS::Application::Actor::Friends->retrieve_friends(
3463         $e, $user_id, $options);
3464 }
3465
3466
3467
3468 __PACKAGE__->register_method (
3469     method      => 'apply_friend_perms',
3470     api_name    => 'open-ils.actor.friends.perms.apply',
3471     signature   => {
3472         desc => q/
3473         /
3474     }
3475 );
3476 sub apply_friend_perms {
3477     my($self, $conn, $auth, $user_id, $delegate_id, @perms) = @_;
3478     my $e = new_editor(authtoken => $auth, xact => 1);
3479     return $e->die_event unless $e->checkauth;
3480
3481     if($user_id != $e->requestor->id) {
3482         my $user = $e->retrieve_actor_user($user_id) or return $e->die_event;
3483         return $e->die_event unless $e->allowed('VIEW_USER', $user->home_ou);
3484     }
3485
3486     for my $perm (@perms) {
3487         my $evt =
3488             OpenILS::Application::Actor::Friends->apply_friend_perm(
3489                 $e, $user_id, $delegate_id, $perm);
3490         return $evt if $evt;
3491     }
3492
3493     $e->commit;
3494     return 1;
3495 }
3496
3497
3498 __PACKAGE__->register_method (
3499     method      => 'update_user_pending_address',
3500     api_name    => 'open-ils.actor.user.address.pending.cud'
3501 );
3502
3503 sub update_user_pending_address {
3504     my($self, $conn, $auth, $addr) = @_;
3505     my $e = new_editor(authtoken => $auth, xact => 1);
3506     return $e->die_event unless $e->checkauth;
3507
3508     if($addr->usr != $e->requestor->id) {
3509         my $user = $e->retrieve_actor_user($addr->usr) or return $e->die_event;
3510         return $e->die_event unless $e->allowed('UPDATE_USER', $user->home_ou);
3511     }
3512
3513     if($addr->isnew) {
3514         $e->create_actor_user_address($addr) or return $e->die_event;
3515     } elsif($addr->isdeleted) {
3516         $e->delete_actor_user_address($addr) or return $e->die_event;
3517     } else {
3518         $e->update_actor_user_address($addr) or return $e->die_event;
3519     }
3520
3521     $e->commit;
3522     return $addr->id;
3523 }
3524
3525
3526 __PACKAGE__->register_method (
3527     method      => 'user_events',
3528     api_name    => 'open-ils.actor.user.events.circ',
3529     stream      => 1,
3530 );
3531 __PACKAGE__->register_method (
3532     method      => 'user_events',
3533     api_name    => 'open-ils.actor.user.events.ahr',
3534     stream      => 1,
3535 );
3536
3537 sub user_events {
3538     my($self, $conn, $auth, $user_id, $filters) = @_;
3539     my $e = new_editor(authtoken => $auth);
3540     return $e->event unless $e->checkauth;
3541
3542     (my $obj_type = $self->api_name) =~ s/.*\.([a-z]+)$/$1/;
3543     my $user_field = 'usr';
3544
3545     $filters ||= {};
3546     $filters->{target} = {
3547         select => { $obj_type => ['id'] },
3548         from => $obj_type,
3549         where => {usr => $user_id}
3550     };
3551
3552     my $user = $e->retrieve_actor_user($user_id) or return $e->event;
3553     if($e->requestor->id != $user_id) {
3554         return $e->event unless $e->allowed('VIEW_USER', $user->home_ou);
3555     }
3556
3557     my $ses = OpenSRF::AppSession->create('open-ils.trigger');
3558     my $req = $ses->request('open-ils.trigger.events_by_target',
3559         $obj_type, $filters, {atevdef => ['reactor', 'validator']}, 2);
3560
3561     while(my $resp = $req->recv) {
3562         my $val = $resp->content;
3563         my $tgt = $val->target;
3564
3565         if($obj_type eq 'circ') {
3566             $tgt->target_copy($e->retrieve_asset_copy($tgt->target_copy));
3567
3568         } elsif($obj_type eq 'ahr') {
3569             $tgt->current_copy($e->retrieve_asset_copy($tgt->current_copy))
3570                 if $tgt->current_copy;
3571         }
3572
3573         $conn->respond($val) if $val;
3574     }
3575
3576     return undef;
3577 }
3578
3579 __PACKAGE__->register_method (
3580     method      => 'copy_events',
3581     api_name    => 'open-ils.actor.copy.events.circ',
3582     stream      => 1,
3583 );
3584 __PACKAGE__->register_method (
3585     method      => 'copy_events',
3586     api_name    => 'open-ils.actor.copy.events.ahr',
3587     stream      => 1,
3588 );
3589
3590 sub copy_events {
3591     my($self, $conn, $auth, $copy_id, $filters) = @_;
3592     my $e = new_editor(authtoken => $auth);
3593     return $e->event unless $e->checkauth;
3594
3595     (my $obj_type = $self->api_name) =~ s/.*\.([a-z]+)$/$1/;
3596
3597     my $copy = $e->retrieve_asset_copy($copy_id) or return $e->event;
3598
3599     my $copy_field = 'target_copy';
3600     $copy_field = 'current_copy' if $obj_type eq 'ahr';
3601
3602     $filters ||= {};
3603     $filters->{target} = {
3604         select => { $obj_type => ['id'] },
3605         from => $obj_type,
3606         where => {$copy_field => $copy_id}
3607     };
3608
3609
3610     my $ses = OpenSRF::AppSession->create('open-ils.trigger');
3611     my $req = $ses->request('open-ils.trigger.events_by_target',
3612         $obj_type, $filters, {atevdef => ['reactor', 'validator']}, 2);
3613
3614     while(my $resp = $req->recv) {
3615         my $val = $resp->content;
3616         my $tgt = $val->target;
3617
3618         my $user = $e->retrieve_actor_user($tgt->usr);
3619         if($e->requestor->id != $user->id) {
3620             return $e->event unless $e->allowed('VIEW_USER', $user->home_ou);
3621         }
3622
3623         $tgt->$copy_field($copy);
3624
3625         $tgt->usr($user);
3626         $conn->respond($val) if $val;
3627     }
3628
3629     return undef;
3630 }
3631
3632
3633
3634
3635 __PACKAGE__->register_method (
3636     method      => 'update_events',
3637     api_name    => 'open-ils.actor.user.event.cancel.batch',
3638     stream      => 1,
3639 );
3640 __PACKAGE__->register_method (
3641     method      => 'update_events',
3642     api_name    => 'open-ils.actor.user.event.reset.batch',
3643     stream      => 1,
3644 );
3645
3646 sub update_events {
3647     my($self, $conn, $auth, $event_ids) = @_;
3648     my $e = new_editor(xact => 1, authtoken => $auth);
3649     return $e->die_event unless $e->checkauth;
3650
3651     my $x = 1;
3652     for my $id (@$event_ids) {
3653
3654         # do a little dance to determine what user we are ultimately affecting
3655         my $event = $e->retrieve_action_trigger_event([
3656             $id,
3657             {   flesh => 2,
3658                 flesh_fields => {atev => ['event_def'], atevdef => ['hook']}
3659             }
3660         ]) or return $e->die_event;
3661
3662         my $user_id;
3663         if($event->event_def->hook->core_type eq 'circ') {
3664             $user_id = $e->retrieve_action_circulation($event->target)->usr;
3665         } elsif($event->event_def->hook->core_type eq 'ahr') {
3666             $user_id = $e->retrieve_action_hold_request($event->target)->usr;
3667         } else {
3668             return 0;
3669         }
3670
3671         my $user = $e->retrieve_actor_user($user_id);
3672         return $e->die_event unless $e->allowed('UPDATE_USER', $user->home_ou);
3673
3674         if($self->api_name =~ /cancel/) {
3675             $event->state('invalid');
3676         } elsif($self->api_name =~ /reset/) {
3677             $event->clear_start_time;
3678             $event->clear_update_time;
3679             $event->state('pending');
3680         }
3681
3682         $e->update_action_trigger_event($event) or return $e->die_event;
3683         $conn->respond({maximum => scalar(@$event_ids), progress => $x++});
3684     }
3685
3686     $e->commit;
3687     return {complete => 1};
3688 }
3689
3690
3691 __PACKAGE__->register_method (
3692     method      => 'really_delete_user',
3693     api_name    => 'open-ils.actor.user.delete.override',
3694     signature   => q/@see open-ils.actor.user.delete/
3695 );
3696
3697 __PACKAGE__->register_method (
3698     method      => 'really_delete_user',
3699     api_name    => 'open-ils.actor.user.delete',
3700     signature   => q/
3701         It anonymizes all personally identifiable information in actor.usr. By calling actor.usr_purge_data()
3702         it also purges related data from other tables, sometimes by transferring it to a designated destination user.
3703         The usrname field (along with first_given_name and family_name) is updated to id '-PURGED-' now().
3704         dest_usr_id is only required when deleting a user that performs staff functions.
3705     /
3706 );
3707
3708 sub really_delete_user {
3709     my($self, $conn, $auth, $user_id, $dest_user_id, $oargs) = @_;
3710     my $e = new_editor(authtoken => $auth, xact => 1);
3711     return $e->die_event unless $e->checkauth;
3712     $oargs = { all => 1 } unless defined $oargs;
3713
3714     # Find all unclosed billings for for user $user_id, thereby, also checking for open circs
3715     my $open_bills = $e->json_query({
3716         select => { mbts => ['id'] },
3717         from => 'mbts',
3718         where => {
3719             xact_finish => { '=' => undef },
3720             usr => { '=' => $user_id },
3721         }
3722     }) or return $e->die_event;
3723
3724     my $user = $e->retrieve_actor_user($user_id) or return $e->die_event;
3725
3726     # No deleting patrons with open billings or checked out copies, unless perm-enabled override
3727     if (@$open_bills) {
3728         return $e->die_event(OpenILS::Event->new('ACTOR_USER_DELETE_OPEN_XACTS'))
3729         unless $self->api_name =~ /override/o && ($oargs->{all} || grep { $_ eq 'ACTOR_USER_DELETE_OPEN_XACTS' } @{$oargs->{events}})
3730         && $e->allowed('ACTOR_USER_DELETE_OPEN_XACTS.override', $user->home_ou);
3731     }
3732     # No deleting yourself - UI is supposed to stop you first, though.
3733     return $e->die_event unless $e->requestor->id != $user->id;
3734     return $e->die_event unless $e->allowed('DELETE_USER', $user->home_ou);
3735     # Check if you are allowed to mess with this patron permission group at all
3736     my $evt = group_perm_failed($e, $e->requestor, $user);
3737     return $e->die_event($evt) if $evt;
3738     my $stat = $e->json_query(
3739         {from => ['actor.usr_delete', $user_id, $dest_user_id]})->[0]
3740         or return $e->die_event;
3741     $e->commit;
3742     return 1;
3743 }
3744
3745
3746 __PACKAGE__->register_method (
3747     method      => 'user_payments',
3748     api_name    => 'open-ils.actor.user.payments.retrieve',
3749     stream => 1,
3750     signature   => q/
3751         Returns all payments for a given user.  Default order is newest payments first.
3752         @param auth Authentication token
3753         @param user_id The user ID
3754         @param filters An optional hash of filters, including limit, offset, and order_by definitions
3755     /
3756 );
3757
3758 sub user_payments {
3759     my($self, $conn, $auth, $user_id, $filters) = @_;
3760     $filters ||= {};
3761
3762     my $e = new_editor(authtoken => $auth);
3763     return $e->die_event unless $e->checkauth;
3764
3765     my $user = $e->retrieve_actor_user($user_id) or return $e->event;
3766     return $e->event unless
3767         $e->requestor->id == $user_id or
3768         $e->allowed('VIEW_USER_TRANSACTIONS', $user->home_ou);
3769
3770     # Find all payments for all transactions for user $user_id
3771     my $query = {
3772         select => {mp => ['id']},
3773         from => 'mp',
3774         where => {
3775             xact => {
3776                 in => {
3777                     select => {mbt => ['id']},
3778                     from => 'mbt',
3779                     where => {usr => $user_id}
3780                 }
3781             }
3782         },
3783         order_by => [
3784             { # by default, order newest payments first
3785                 class => 'mp',
3786                 field => 'payment_ts',
3787                 direction => 'desc'
3788             }, {
3789                 # secondary sort in ID as a tie-breaker, since payments created
3790                 # within the same transaction will have identical payment_ts's
3791                 class => 'mp',
3792                 field => 'id'
3793             }
3794         ]
3795     };
3796
3797     for (qw/order_by limit offset/) {
3798         $query->{$_} = $filters->{$_} if defined $filters->{$_};
3799     }
3800
3801     if(defined $filters->{where}) {
3802         foreach (keys %{$filters->{where}}) {
3803             # don't allow the caller to expand the result set to other users
3804             $query->{where}->{$_} = $filters->{where}->{$_} unless $_ eq 'xact';
3805         }
3806     }
3807
3808     my $payment_ids = $e->json_query($query);
3809     for my $pid (@$payment_ids) {
3810         my $pay = $e->retrieve_money_payment([
3811             $pid->{id},
3812             {   flesh => 6,
3813                 flesh_fields => {
3814                     mp => ['xact'],
3815                     mbt => ['summary', 'circulation', 'grocery'],
3816                     circ => ['target_copy'],
3817                     acp => ['call_number'],
3818                     acn => ['record']
3819                 }
3820             }
3821         ]);
3822
3823         my $resp = {
3824             mp => $pay,
3825             xact_type => $pay->xact->summary->xact_type,
3826             last_billing_type => $pay->xact->summary->last_billing_type,
3827         };
3828
3829         if($pay->xact->summary->xact_type eq 'circulation') {
3830             $resp->{barcode} = $pay->xact->circulation->target_copy->barcode;
3831             $resp->{title} = $U->record_to_mvr($pay->xact->circulation->target_copy->call_number->record)->title;
3832         }
3833
3834         $pay->xact($pay->xact->id); # de-flesh
3835         $conn->respond($resp);
3836     }
3837
3838     return undef;
3839 }
3840
3841
3842
3843 __PACKAGE__->register_method (
3844     method      => 'negative_balance_users',
3845     api_name    => 'open-ils.actor.users.negative_balance',
3846     stream => 1,
3847     signature   => q/
3848         Returns all users that have an overall negative balance
3849         @param auth Authentication token
3850         @param org_id The context org unit as an ID or list of IDs.  This will be the home
3851         library of the user.  If no org_unit is specified, no org unit filter is applied
3852     /
3853 );
3854
3855 sub negative_balance_users {
3856     my($self, $conn, $auth, $org_id) = @_;
3857
3858     my $e = new_editor(authtoken => $auth);
3859     return $e->die_event unless $e->checkauth;
3860     return $e->die_event unless $e->allowed('VIEW_USER', $org_id);
3861
3862     my $query = {
3863         select => {
3864             mous => ['usr', 'balance_owed'],
3865             au => ['home_ou'],
3866             mbts => [
3867                 {column => 'last_billing_ts', transform => 'max', aggregate => 1},
3868                 {column => 'last_payment_ts', transform => 'max', aggregate => 1},
3869             ]
3870         },
3871         from => {
3872             mous => {
3873                 au => {
3874                     fkey => 'usr',
3875                     field => 'id',
3876                     join => {
3877                         mbts => {
3878                             key => 'id',
3879                             field => 'usr'
3880                         }
3881                     }
3882                 }
3883             }
3884         },
3885         where => {'+mous' => {balance_owed => {'<' => 0}}}
3886     };
3887
3888     $query->{from}->{mous}->{au}->{filter}->{home_ou} = $org_id if $org_id;
3889
3890     my $list = $e->json_query($query, {timeout => 600});
3891
3892     for my $data (@$list) {
3893         $conn->respond({
3894             usr => $e->retrieve_actor_user([$data->{usr}, {flesh => 1, flesh_fields => {au => ['card']}}]),
3895             balance_owed => $data->{balance_owed},
3896             last_billing_activity => max($data->{last_billing_ts}, $data->{last_payment_ts})
3897         });
3898     }
3899
3900     return undef;
3901 }
3902
3903 __PACKAGE__->register_method(
3904     method  => "request_password_reset",
3905     api_name    => "open-ils.actor.patron.password_reset.request",
3906     signature   => {
3907         desc => "Generates a UUID token usable with the open-ils.actor.patron.password_reset.commit " .
3908                 "method for changing a user's password.  The UUID token is distributed via A/T "      .
3909                 "templates (i.e. email to the user).",
3910         params => [
3911             { desc => 'user_id_type', type => 'string' },
3912             { desc => 'user_id', type => 'string' },
3913             { desc => 'optional (based on library setting) matching email address for authorizing request', type => 'string' },
3914         ],
3915         return => {desc => '1 on success, Event on error'}
3916     }
3917 );
3918 sub request_password_reset {
3919     my($self, $conn, $user_id_type, $user_id, $email) = @_;
3920
3921     # Check to see if password reset requests are already being throttled:
3922     # 0. Check cache to see if we're in throttle mode (avoid hitting database)
3923
3924     my $e = new_editor(xact => 1);
3925     my $user;
3926
3927     # Get the user, if any, depending on the input value
3928     if ($user_id_type eq 'username') {
3929         $user = $e->search_actor_user({usrname => $user_id})->[0];
3930         if (!$user) {
3931             $e->die_event;
3932             return OpenILS::Event->new( 'ACTOR_USER_NOT_FOUND' );
3933         }
3934     } elsif ($user_id_type eq 'barcode') {
3935         my $card = $e->search_actor_card([
3936             {barcode => $user_id},
3937             {flesh => 1, flesh_fields => {ac => ['usr']}}])->[0];
3938         if (!$card) {
3939             $e->die_event;
3940             return OpenILS::Event->new('ACTOR_USER_NOT_FOUND');
3941         }
3942         $user = $card->usr;
3943     }
3944
3945     # If the user doesn't have an email address, we can't help them
3946     if (!$user->email) {
3947         $e->die_event;
3948         return OpenILS::Event->new('PATRON_NO_EMAIL_ADDRESS');
3949     }
3950
3951     my $email_must_match = $U->ou_ancestor_setting_value($user->home_ou, 'circ.password_reset_request_requires_matching_email');
3952     if ($email_must_match) {
3953         if (lc($user->email) ne lc($email)) {
3954             return OpenILS::Event->new('EMAIL_VERIFICATION_FAILED');
3955         }
3956     }
3957
3958     _reset_password_request($conn, $e, $user);
3959 }
3960
3961 # Once we have the user, we can issue the password reset request
3962 # XXX Add a wrapper method that accepts barcode + email input
3963 sub _reset_password_request {
3964     my ($conn, $e, $user) = @_;
3965
3966     # 1. Get throttle threshold and time-to-live from OU_settings
3967     my $aupr_throttle = $U->ou_ancestor_setting_value($user->home_ou, 'circ.password_reset_request_throttle') || 1000;
3968     my $aupr_ttl = $U->ou_ancestor_setting_value($user->home_ou, 'circ.password_reset_request_time_to_live') || 24*60*60;
3969
3970     my $threshold_time = DateTime->now(time_zone => 'local')->subtract(seconds => $aupr_ttl)->iso8601();
3971
3972     # 2. Get time of last request and number of active requests (num_active)
3973     my $active_requests = $e->json_query({
3974         from => 'aupr',
3975         select => {
3976             aupr => [
3977                 {
3978                     column => 'uuid',
3979                     transform => 'COUNT'
3980                 },
3981                 {
3982                     column => 'request_time',
3983                     transform => 'MAX'
3984                 }
3985             ]
3986         },
3987         where => {
3988             has_been_reset => { '=' => 'f' },
3989             request_time => { '>' => $threshold_time }
3990         }
3991     });
3992
3993     # Guard against no active requests
3994     if ($active_requests->[0]->{'request_time'}) {
3995         my $last_request = DateTime::Format::ISO8601->parse_datetime(clense_ISO8601($active_requests->[0]->{'request_time'}));
3996         my $now = DateTime::Format::ISO8601->new();
3997
3998         # 3. if (num_active > throttle_threshold) and (now - last_request < 1 minute)
3999         if (($active_requests->[0]->{'usr'} > $aupr_throttle) &&
4000             ($last_request->add_duration('1 minute') > $now)) {
4001             $cache->put_cache('open-ils.actor.password.throttle', DateTime::Format::ISO8601->new(), 60);
4002             $e->die_event;
4003             return OpenILS::Event->new('PATRON_TOO_MANY_ACTIVE_PASSWORD_RESET_REQUESTS');
4004         }
4005     }
4006
4007     # TODO Check to see if the user is in a password-reset-restricted group
4008
4009     # Otherwise, go ahead and try to get the user.
4010
4011     # Check the number of active requests for this user
4012     $active_requests = $e->json_query({
4013         from => 'aupr',
4014         select => {
4015             aupr => [
4016                 {
4017                     column => 'usr',
4018                     transform => 'COUNT'
4019                 }
4020             ]
4021         },
4022         where => {
4023             usr => { '=' => $user->id },
4024             has_been_reset => { '=' => 'f' },
4025             request_time => { '>' => $threshold_time }
4026         }
4027     });
4028
4029     $logger->info("User " . $user->id . " has " . $active_requests->[0]->{'usr'} . " active password reset requests.");
4030
4031     # if less than or equal to per-user threshold, proceed; otherwise, return event
4032     my $aupr_per_user_limit = $U->ou_ancestor_setting_value($user->home_ou, 'circ.password_reset_request_per_user_limit') || 3;
4033     if ($active_requests->[0]->{'usr'} > $aupr_per_user_limit) {
4034         $e->die_event;
4035         return OpenILS::Event->new('PATRON_TOO_MANY_ACTIVE_PASSWORD_RESET_REQUESTS');
4036     }
4037
4038     # Create the aupr object and insert into the database
4039     my $reset_request = Fieldmapper::actor::usr_password_reset->new;
4040     my $uuid = create_uuid_as_string(UUID_V4);
4041     $reset_request->uuid($uuid);
4042     $reset_request->usr($user->id);
4043
4044     my $aupr = $e->create_actor_usr_password_reset($reset_request) or return $e->die_event;
4045     $e->commit;
4046
4047     # Create an event to notify user of the URL to reset their password
4048
4049     # Can we stuff this in the user_data param for trigger autocreate?
4050     my $hostname = $U->ou_ancestor_setting_value($user->home_ou, 'lib.hostname') || 'localhost';
4051
4052     my $ses = OpenSRF::AppSession->create('open-ils.trigger');
4053     $ses->request('open-ils.trigger.event.autocreate', 'password.reset_request', $aupr, $user->home_ou);
4054
4055     # Trunk only
4056     # $U->create_trigger_event('password.reset_request', $aupr, $user->home_ou);
4057
4058     return 1;
4059 }
4060
4061 __PACKAGE__->register_method(
4062     method  => "commit_password_reset",
4063     api_name    => "open-ils.actor.patron.password_reset.commit",
4064     signature   => {
4065         desc => "Checks a UUID token generated by the open-ils.actor.patron.password_reset.request method for " .
4066                 "validity, and if valid, uses it as authorization for changing the associated user's password " .
4067                 "with the supplied password.",
4068         params => [
4069             { desc => 'uuid', type => 'string' },
4070             { desc => 'password', type => 'string' },
4071         ],
4072         return => {desc => '1 on success, Event on error'}
4073     }
4074 );
4075 sub commit_password_reset {
4076     my($self, $conn, $uuid, $password) = @_;
4077
4078     # Check to see if password reset requests are already being throttled:
4079     # 0. Check cache to see if we're in throttle mode (avoid hitting database)
4080     $cache ||= OpenSRF::Utils::Cache->new("global", 0);
4081     my $throttle = $cache->get_cache('open-ils.actor.password.throttle') || undef;
4082     if ($throttle) {
4083         return OpenILS::Event->new('PATRON_NOT_AN_ACTIVE_PASSWORD_RESET_REQUEST');
4084     }
4085
4086     my $e = new_editor(xact => 1);
4087
4088     my $aupr = $e->search_actor_usr_password_reset({
4089         uuid => $uuid,
4090         has_been_reset => 0
4091     });
4092
4093     if (!$aupr->[0]) {
4094         $e->die_event;
4095         return OpenILS::Event->new('PATRON_NOT_AN_ACTIVE_PASSWORD_RESET_REQUEST');
4096     }
4097     my $user_id = $aupr->[0]->usr;
4098     my $user = $e->retrieve_actor_user($user_id);
4099
4100     # Ensure we're still within the TTL for the request
4101     my $aupr_ttl = $U->ou_ancestor_setting_value($user->home_ou, 'circ.password_reset_request_time_to_live') || 24*60*60;
4102     my $threshold = DateTime::Format::ISO8601->parse_datetime(clense_ISO8601($aupr->[0]->request_time))->add(seconds => $aupr_ttl);
4103     if ($threshold < DateTime->now(time_zone => 'local')) {
4104         $e->die_event;
4105         $logger->info("Password reset request needed to be submitted before $threshold");
4106         return OpenILS::Event->new('PATRON_NOT_AN_ACTIVE_PASSWORD_RESET_REQUEST');
4107     }
4108
4109     # Check complexity of password against OU-defined regex
4110     my $pw_regex = $U->ou_ancestor_setting_value($user->home_ou, 'global.password_regex');
4111
4112     my $is_strong = 0;
4113     if ($pw_regex) {
4114         # Calling JSON2perl on the $pw_regex causes failure, even before the fancy Unicode regex
4115         # ($pw_regex = OpenSRF::Utils::JSON->JSON2perl($pw_regex)) =~ s/\\u([0-9a-fA-F]{4})/\\x{$1}/gs;
4116         $is_strong = check_password_strength_custom($password, $pw_regex);
4117     } else {
4118         $is_strong = check_password_strength_default($password);
4119     }
4120
4121     if (!$is_strong) {
4122         $e->die_event;
4123         return OpenILS::Event->new('PATRON_PASSWORD_WAS_NOT_STRONG');
4124     }
4125
4126     # All is well; update the password
4127     modify_migrated_user_password($e, $user->id, $password);
4128
4129     # And flag that this password reset request has been honoured
4130     $aupr->[0]->has_been_reset('t');
4131     $e->update_actor_usr_password_reset($aupr->[0]);
4132     $e->commit;
4133
4134     return 1;
4135 }
4136
4137 sub check_password_strength_default {
4138     my $password = shift;
4139     # Use the default set of checks
4140     if ( (length($password) < 7) or
4141             ($password !~ m/.*\d+.*/) or
4142             ($password !~ m/.*[A-Za-z]+.*/)
4143     ) {
4144         return 0;
4145     }
4146     return 1;
4147 }
4148
4149 sub check_password_strength_custom {
4150     my ($password, $pw_regex) = @_;
4151
4152     $pw_regex = qr/$pw_regex/;
4153     if ($password !~  /$pw_regex/) {
4154         return 0;
4155     }
4156     return 1;
4157 }
4158
4159
4160
4161 __PACKAGE__->register_method(
4162     method    => "event_def_opt_in_settings",
4163     api_name  => "open-ils.actor.event_def.opt_in.settings",
4164     stream => 1,
4165     signature => {
4166         desc   => 'Streams the set of "cust" objects that are used as opt-in settings for event definitions',
4167         params => [
4168             { desc => 'Authentication token',  type => 'string'},
4169             {
4170                 desc => 'Org Unit ID.  (optional).  If no org ID is present, the home_ou of the requesting user is used',
4171                 type => 'number'
4172             },
4173         ],
4174         return => {
4175             desc => q/set of "cust" objects that are used as opt-in settings for event definitions at the specified org unit/,
4176             type => 'object',
4177             class => 'cust'
4178         }
4179     }
4180 );
4181
4182 sub event_def_opt_in_settings {
4183     my($self, $conn, $auth, $org_id) = @_;
4184     my $e = new_editor(authtoken => $auth);
4185     return $e->event unless $e->checkauth;
4186
4187     if(defined $org_id and $org_id != $e->requestor->home_ou) {
4188         return $e->event unless
4189             $e->allowed(['VIEW_USER_SETTING_TYPE', 'ADMIN_USER_SETTING_TYPE'], $org_id);
4190     } else {
4191         $org_id = $e->requestor->home_ou;
4192     }
4193
4194     # find all config.user_setting_type's related to event_defs for the requested org unit
4195     my $types = $e->json_query({
4196         select => {cust => ['name']},
4197         from => {atevdef => 'cust'},
4198         where => {
4199             '+atevdef' => {
4200                 owner => $U->get_org_ancestors($org_id), # context org plus parents
4201                 active => 't'
4202             }
4203         }
4204     });
4205
4206     if(@$types) {
4207         $conn->respond($_) for
4208             @{$e->search_config_usr_setting_type({name => [map {$_->{name}} @$types]})};
4209     }
4210
4211     return undef;
4212 }
4213
4214
4215 __PACKAGE__->register_method(
4216     method    => "user_circ_history",
4217     api_name  => "open-ils.actor.history.circ",
4218     stream => 1,
4219     authoritative => 1,
4220     signature => {
4221         desc   => 'Returns user circ history objects for the calling user',
4222         params => [
4223             { desc => 'Authentication token',  type => 'string'},
4224             { desc => 'Options hash.  Supported fields are "limit" and "offset"', type => 'object' },
4225         ],
4226         return => {
4227             desc => q/Stream of 'auch' circ history objects/,
4228             type => 'object',
4229         }
4230     }
4231 );
4232
4233 __PACKAGE__->register_method(
4234     method    => "user_circ_history",
4235     api_name  => "open-ils.actor.history.circ.clear",
4236     stream => 1,
4237     signature => {
4238         desc   => 'Delete all user circ history entries for the calling user',
4239         params => [
4240             { desc => 'Authentication token',  type => 'string'},
4241             { desc => "Options hash. 'circ_ids' is an arrayref of circulation IDs to delete", type => 'object' },
4242         ],
4243         return => {
4244             desc => q/1 on success, event on error/,
4245             type => 'object',
4246         }
4247     }
4248 );
4249
4250 __PACKAGE__->register_method(
4251     method    => "user_circ_history",
4252     api_name  => "open-ils.actor.history.circ.print",
4253     stream => 1,
4254     signature => {
4255         desc   => q/Returns printable output for the caller's circ history objects/,
4256         params => [
4257             { desc => 'Authentication token',  type => 'string'},
4258             { desc => 'Options hash.  Supported fields are "limit" and "offset"', type => 'object' },
4259         ],
4260         return => {
4261             desc => q/An action_trigger.event object or error event./,
4262             type => 'object',
4263         }
4264     }
4265 );
4266
4267 __PACKAGE__->register_method(
4268     method    => "user_circ_history",
4269     api_name  => "open-ils.actor.history.circ.email",
4270     stream => 1,
4271     signature => {
4272         desc   => q/Emails the caller's circ history/,
4273         params => [
4274             { desc => 'Authentication token',  type => 'string'},
4275             { desc => 'User ID.  If no user id is present, the authenticated user is assumed', type => 'number' },
4276             { desc => 'Options hash.  Supported fields are "limit" and "offset"', type => 'object' },
4277         ],
4278         return => {
4279             desc => q/undef, or event on error/
4280         }
4281     }
4282 );
4283
4284 sub user_circ_history {
4285     my ($self, $conn, $auth, $options) = @_;
4286     $options ||= {};
4287
4288     my $for_print = ($self->api_name =~ /print/);
4289     my $for_email = ($self->api_name =~ /email/);
4290     my $for_clear = ($self->api_name =~ /clear/);
4291
4292     # No perm check is performed.  Caller may only access his/her own
4293     # circ history entries.
4294     my $e = new_editor(authtoken => $auth);
4295     return $e->event unless $e->checkauth;
4296
4297     my %limits = ();
4298     if (!$for_clear) { # clear deletes all
4299         $limits{offset} = $options->{offset} if defined $options->{offset};
4300         $limits{limit} = $options->{limit} if defined $options->{limit};
4301     }
4302
4303     my %circ_id_filter = $options->{circ_ids} ?
4304         (id => $options->{circ_ids}) : ();
4305
4306     my $circs = $e->search_action_user_circ_history([
4307         {   usr => $e->requestor->id,
4308             %circ_id_filter
4309         },
4310         {   # order newest to oldest by default
4311             order_by => {auch => 'xact_start DESC'},
4312             %limits
4313         },
4314         {substream => 1} # could be a large list
4315     ]);
4316
4317     if ($for_print) {
4318         return $U->fire_object_event(undef,
4319             'circ.format.history.print', $circs, $e->requestor->home_ou);
4320     }
4321
4322     $e->xact_begin if $for_clear;
4323     $conn->respond_complete(1) if $for_email;  # no sense in waiting
4324
4325     for my $circ (@$circs) {
4326
4327         if ($for_email) {
4328             # events will be fired from action_trigger_runner
4329             $U->create_events_for_hook('circ.format.history.email',
4330                 $circ, $e->editor->home_ou, undef, undef, 1);
4331
4332         } elsif ($for_clear) {
4333
4334             $e->delete_action_user_circ_history($circ)
4335                 or return $e->die_event;
4336
4337         } else {
4338             $conn->respond($circ);
4339         }
4340     }
4341
4342     if ($for_clear) {
4343         $e->commit;
4344         return 1;
4345     }
4346
4347     return undef;
4348 }
4349
4350
4351 __PACKAGE__->register_method(
4352     method    => "user_visible_holds",
4353     api_name  => "open-ils.actor.history.hold.visible",
4354     stream => 1,
4355     signature => {
4356         desc   => 'Returns the set of opt-in visible holds',
4357         params => [
4358             { desc => 'Authentication token',  type => 'string'},
4359             { desc => 'User ID.  If no user id is present, the authenticated user is assumed', type => 'number' },
4360             { desc => 'Options hash.  Supported fields are "limit" and "offset"', type => 'object' },
4361         ],
4362         return => {
4363             desc => q/An object with 1 field: "hold"/,
4364             type => 'object',
4365         }
4366     }
4367 );
4368
4369 __PACKAGE__->register_method(
4370     method    => "user_visible_holds",
4371     api_name  => "open-ils.actor.history.hold.visible.print",
4372     stream => 1,
4373     signature => {
4374         desc   => 'Returns printable output for the set of opt-in visible holds',
4375         params => [
4376             { desc => 'Authentication token',  type => 'string'},
4377             { desc => 'User ID.  If no user id is present, the authenticated user is assumed', type => 'number' },
4378             { desc => 'Options hash.  Supported fields are "limit" and "offset"', type => 'object' },
4379         ],
4380         return => {
4381             desc => q/An action_trigger.event object or error event./,
4382             type => 'object',
4383         }
4384     }
4385 );
4386
4387 __PACKAGE__->register_method(
4388     method    => "user_visible_holds",
4389     api_name  => "open-ils.actor.history.hold.visible.email",
4390     stream => 1,
4391     signature => {
4392         desc   => 'Emails the set of opt-in visible holds to the requestor',
4393         params => [
4394             { desc => 'Authentication token',  type => 'string'},
4395             { desc => 'User ID.  If no user id is present, the authenticated user is assumed', type => 'number' },
4396             { desc => 'Options hash.  Supported fields are "limit" and "offset"', type => 'object' },
4397         ],
4398         return => {
4399             desc => q/undef, or event on error/
4400         }
4401     }
4402 );
4403
4404 sub user_visible_holds {
4405     my($self, $conn, $auth, $user_id, $options) = @_;
4406
4407     my $is_hold = 1;
4408     my $for_print = ($self->api_name =~ /print/);
4409     my $for_email = ($self->api_name =~ /email/);
4410     my $e = new_editor(authtoken => $auth);
4411     return $e->event unless $e->checkauth;
4412
4413     $user_id ||= $e->requestor->id;
4414     $options ||= {};
4415     $options->{limit} ||= 50;
4416     $options->{offset} ||= 0;
4417
4418     if($user_id != $e->requestor->id) {
4419         my $perm = ($is_hold) ? 'VIEW_HOLD' : 'VIEW_CIRCULATIONS';
4420         my $user = $e->retrieve_actor_user($user_id) or return $e->event;
4421         return $e->event unless $e->allowed($perm, $user->home_ou);
4422     }
4423
4424     my $db_func = ($is_hold) ? 'action.usr_visible_holds' : 'action.usr_visible_circs';
4425
4426     my $data = $e->json_query({
4427         from => [$db_func, $user_id],
4428         limit => $$options{limit},
4429         offset => $$options{offset}
4430
4431         # TODO: I only want IDs. code below didn't get me there
4432         # {"select":{"au":[{"column":"id", "result_field":"id",
4433         # "transform":"action.usr_visible_circs"}]}, "where":{"id":10}, "from":"au"}
4434     },{
4435         substream => 1
4436     });
4437
4438     return undef unless @$data;
4439
4440     if ($for_print) {
4441
4442         # collect the batch of objects
4443
4444         if($is_hold) {
4445
4446             my $hold_list = $e->search_action_hold_request({id => [map { $_->{id} } @$data]});
4447             return $U->fire_object_event(undef, 'ahr.format.history.print', $hold_list, $$hold_list[0]->request_lib);
4448
4449         } else {
4450
4451             my $circ_list = $e->search_action_circulation({id => [map { $_->{id} } @$data]});
4452             return $U->fire_object_event(undef, 'circ.format.history.print', $circ_list, $$circ_list[0]->circ_lib);
4453         }
4454
4455     } elsif ($for_email) {
4456
4457         $conn->respond_complete(1) if $for_email;  # no sense in waiting
4458
4459         foreach (@$data) {
4460
4461             my $id = $_->{id};
4462
4463             if($is_hold) {
4464
4465                 my $hold = $e->retrieve_action_hold_request($id);
4466                 $U->create_events_for_hook('ahr.format.history.email', $hold, $hold->request_lib, undef, undef, 1);
4467                 # events will be fired from action_trigger_runner
4468
4469             } else {
4470
4471                 my $circ = $e->retrieve_action_circulation($id);
4472                 $U->create_events_for_hook('circ.format.history.email', $circ, $circ->circ_lib, undef, undef, 1);
4473                 # events will be fired from action_trigger_runner
4474             }
4475         }
4476
4477     } else { # just give me the data please
4478
4479         foreach (@$data) {
4480
4481             my $id = $_->{id};
4482
4483             if($is_hold) {
4484
4485                 my $hold = $e->retrieve_action_hold_request($id);
4486                 $conn->respond({hold => $hold});
4487
4488             } else {
4489
4490                 my $circ = $e->retrieve_action_circulation($id);
4491                 $conn->respond({
4492                     circ => $circ,
4493                     summary => $U->create_circ_chain_summary($e, $id)
4494                 });
4495             }
4496         }
4497     }
4498
4499     return undef;
4500 }
4501
4502 __PACKAGE__->register_method(
4503     method     => "user_saved_search_cud",
4504     api_name   => "open-ils.actor.user.saved_search.cud",
4505     stream     => 1,
4506     signature  => {
4507         desc   => 'Create/Update/Delete Access to user saved searches',
4508         params => [
4509             { desc => 'Authentication token', type => 'string' },
4510             { desc => 'Saved Search Object', type => 'object', class => 'auss' }
4511         ],
4512         return => {
4513             desc   => q/The retrieved or updated saved search object, or id of a deleted object; Event on error/,
4514             class  => 'auss'
4515         }
4516     }
4517 );
4518
4519 __PACKAGE__->register_method(
4520     method     => "user_saved_search_cud",
4521     api_name   => "open-ils.actor.user.saved_search.retrieve",
4522     stream     => 1,
4523     signature  => {
4524         desc   => 'Retrieve a saved search object',
4525         params => [
4526             { desc => 'Authentication token', type => 'string' },
4527             { desc => 'Saved Search ID', type => 'number' }
4528         ],
4529         return => {
4530             desc   => q/The saved search object, Event on error/,
4531             class  => 'auss'
4532         }
4533     }
4534 );
4535
4536 sub user_saved_search_cud {
4537     my( $self, $client, $auth, $search ) = @_;
4538     my $e = new_editor( authtoken=>$auth );
4539     return $e->die_event unless $e->checkauth;
4540
4541     my $o_search;      # prior version of the object, if any
4542     my $res;           # to be returned
4543
4544     # branch on the operation type
4545
4546     if( $self->api_name =~ /retrieve/ ) {                    # Retrieve
4547
4548         # Get the old version, to check ownership
4549         $o_search = $e->retrieve_actor_usr_saved_search( $search )
4550             or return $e->die_event;
4551
4552         # You can't read somebody else's search
4553         return OpenILS::Event->new('BAD_PARAMS')
4554             unless $o_search->owner == $e->requestor->id;
4555
4556         $res = $o_search;
4557
4558     } else {
4559
4560         $e->xact_begin;               # start an editor transaction
4561
4562         if( $search->isnew ) {                               # Create
4563
4564             # You can't create a search for somebody else
4565             return OpenILS::Event->new('BAD_PARAMS')
4566                 unless $search->owner == $e->requestor->id;
4567
4568             $e->create_actor_usr_saved_search( $search )
4569                 or return $e->die_event;
4570
4571             $res = $search->id;
4572
4573         } elsif( $search->ischanged ) {                      # Update
4574
4575             # You can't change ownership of a search
4576             return OpenILS::Event->new('BAD_PARAMS')
4577                 unless $search->owner == $e->requestor->id;
4578
4579             # Get the old version, to check ownership
4580             $o_search = $e->retrieve_actor_usr_saved_search( $search->id )
4581                 or return $e->die_event;
4582
4583             # You can't update somebody else's search
4584             return OpenILS::Event->new('BAD_PARAMS')
4585                 unless $o_search->owner == $e->requestor->id;
4586
4587             # Do the update
4588             $e->update_actor_usr_saved_search( $search )
4589                 or return $e->die_event;
4590
4591             $res = $search;
4592
4593         } elsif( $search->isdeleted ) {                      # Delete
4594
4595             # Get the old version, to check ownership
4596             $o_search = $e->retrieve_actor_usr_saved_search( $search->id )
4597                 or return $e->die_event;
4598
4599             # You can't delete somebody else's search
4600             return OpenILS::Event->new('BAD_PARAMS')
4601                 unless $o_search->owner == $e->requestor->id;
4602
4603             # Do the delete
4604             $e->delete_actor_usr_saved_search( $o_search )
4605                 or return $e->die_event;
4606
4607             $res = $search->id;
4608         }
4609
4610         $e->commit;
4611     }
4612
4613     return $res;
4614 }
4615
4616 __PACKAGE__->register_method(
4617     method   => "get_barcodes",
4618     api_name => "open-ils.actor.get_barcodes"
4619 );
4620
4621 sub get_barcodes {
4622     my( $self, $client, $auth, $org_id, $context, $barcode ) = @_;
4623     my $e = new_editor(authtoken => $auth);
4624     return $e->event unless $e->checkauth;
4625     return $e->event unless $e->allowed('STAFF_LOGIN', $org_id);
4626
4627     my $db_result = $e->json_query(
4628         {   from => [
4629                 'evergreen.get_barcodes',
4630                 $org_id, $context, $barcode,
4631             ]
4632         }
4633     );
4634     if($context =~ /actor/) {
4635         my $filter_result = ();
4636         my $patron;
4637         foreach my $result (@$db_result) {
4638             if($result->{type} eq 'actor') {
4639                 if($e->requestor->id != $result->{id}) {
4640                     $patron = $e->retrieve_actor_user($result->{id});
4641                     if(!$patron) {
4642                         push(@$filter_result, $e->event);
4643                         next;
4644                     }
4645                     if($e->allowed('VIEW_USER', $patron->home_ou)) {
4646                         push(@$filter_result, $result);
4647                     }
4648                     else {
4649                         push(@$filter_result, $e->event);
4650                     }
4651                 }
4652                 else {
4653                     push(@$filter_result, $result);
4654                 }
4655             }
4656             else {
4657                 push(@$filter_result, $result);
4658             }
4659         }
4660         return $filter_result;
4661     }
4662     else {
4663         return $db_result;
4664     }
4665 }
4666 __PACKAGE__->register_method(
4667     method   => 'address_alert_test',
4668     api_name => 'open-ils.actor.address_alert.test',
4669     signature => {
4670         desc => "Tests a set of address fields to determine if they match with an address_alert",
4671         params => [
4672             {desc => 'Authentication token', type => 'string'},
4673             {desc => 'Org Unit',             type => 'number'},
4674             {desc => 'Fields',               type => 'hash'},
4675         ],
4676         return => {desc => 'List of matching address_alerts'}
4677     }
4678 );
4679
4680 sub address_alert_test {
4681     my ($self, $client, $auth, $org_unit, $fields) = @_;
4682     return [] unless $fields and grep {$_} values %$fields;
4683
4684     my $e = new_editor(authtoken => $auth);
4685     return $e->event unless $e->checkauth;
4686     return $e->event unless $e->allowed('CREATE_USER', $org_unit);
4687     $org_unit ||= $e->requestor->ws_ou;
4688
4689     my $alerts = $e->json_query({
4690         from => [
4691             'actor.address_alert_matches',
4692             $org_unit,
4693             $$fields{street1},
4694             $$fields{street2},
4695             $$fields{city},
4696             $$fields{county},
4697             $$fields{state},
4698             $$fields{country},
4699             $$fields{post_code},
4700             $$fields{mailing_address},
4701             $$fields{billing_address}
4702         ]
4703     });
4704
4705     # map the json_query hashes to real objects
4706     return [
4707         map {$e->retrieve_actor_address_alert($_)}
4708             (map {$_->{id}} @$alerts)
4709     ];
4710 }
4711
4712 __PACKAGE__->register_method(
4713     method   => "mark_users_contact_invalid",
4714     api_name => "open-ils.actor.invalidate.email",
4715     signature => {
4716         desc => "Given a patron, clear the email field and put the old email address into a note and/or create a standing penalty, depending on OU settings",
4717         params => [
4718             {desc => "Authentication token", type => "string"},
4719             {desc => "Patron ID", type => "number"},
4720             {desc => "Additional note text (optional)", type => "string"},
4721             {desc => "penalty org unit ID (optional)", type => "number"}
4722         ],
4723         return => {desc => "Event describing success or failure", type => "object"}
4724     }
4725 );
4726
4727 __PACKAGE__->register_method(
4728     method   => "mark_users_contact_invalid",
4729     api_name => "open-ils.actor.invalidate.day_phone",
4730     signature => {
4731         desc => "Given a patron, clear the day_phone field and put the old day_phone into a note and/or create a standing penalty, depending on OU settings",
4732         params => [
4733             {desc => "Authentication token", type => "string"},
4734             {desc => "Patron ID", type => "number"},
4735             {desc => "Additional note text (optional)", type => "string"},
4736             {desc => "penalty org unit ID (optional)", type => "number"}
4737         ],
4738         return => {desc => "Event describing success or failure", type => "object"}
4739     }
4740 );
4741
4742 __PACKAGE__->register_method(
4743     method   => "mark_users_contact_invalid",
4744     api_name => "open-ils.actor.invalidate.evening_phone",
4745     signature => {
4746         desc => "Given a patron, clear the evening_phone field and put the old evening_phone into a note and/or create a standing penalty, depending on OU settings",
4747         params => [
4748             {desc => "Authentication token", type => "string"},
4749             {desc => "Patron ID", type => "number"},
4750             {desc => "Additional note text (optional)", type => "string"},
4751             {desc => "penalty org unit ID (optional)", type => "number"}
4752         ],
4753         return => {desc => "Event describing success or failure", type => "object"}
4754     }
4755 );
4756
4757 __PACKAGE__->register_method(
4758     method   => "mark_users_contact_invalid",
4759     api_name => "open-ils.actor.invalidate.other_phone",
4760     signature => {
4761         desc => "Given a patron, clear the other_phone field and put the old other_phone into a note and/or create a standing penalty, depending on OU settings",
4762         params => [
4763             {desc => "Authentication token", type => "string"},
4764             {desc => "Patron ID", type => "number"},
4765             {desc => "Additional note text (optional)", type => "string"},
4766             {desc => "penalty org unit ID (optional, default to top of org tree)",
4767                 type => "number"}
4768         ],
4769         return => {desc => "Event describing success or failure", type => "object"}
4770     }
4771 );
4772
4773 sub mark_users_contact_invalid {
4774     my ($self, $conn, $auth, $patron_id, $addl_note, $penalty_ou) = @_;
4775
4776     # This method invalidates an email address or a phone_number which
4777     # removes the bad email address or phone number, copying its contents
4778     # to a patron note, and institutes a standing penalty for "bad email"
4779     # or "bad phone number" which is cleared when the user is saved or
4780     # optionally only when the user is saved with an email address or
4781     # phone number (or staff manually delete the penalty).
4782
4783     my $contact_type = ($self->api_name =~ /invalidate.(\w+)(\.|$)/)[0];
4784
4785     my $e = new_editor(authtoken => $auth, xact => 1);
4786     return $e->die_event unless $e->checkauth;
4787
4788     return OpenILS::Utils::BadContact->mark_users_contact_invalid(
4789         $e, $contact_type, {usr => $patron_id},
4790         $addl_note, $penalty_ou, $e->requestor->id
4791     );
4792 }
4793
4794 # Putting the following method in open-ils.actor is a bad fit, except in that
4795 # it serves an interface that lives under 'actor' in the templates directory,
4796 # and in that there's nowhere else obvious to put it (open-ils.trigger is
4797 # private).
4798 __PACKAGE__->register_method(
4799     api_name => "open-ils.actor.action_trigger.reactors.all_in_use",
4800     method   => "get_all_at_reactors_in_use",
4801     api_level=> 1,
4802     argc     => 1,
4803     signature=> {
4804         params => [
4805             { name => 'authtoken', type => 'string' }
4806         ],
4807         return => {
4808             desc => 'list of reactor names', type => 'array'
4809         }
4810     }
4811 );
4812
4813 sub get_all_at_reactors_in_use {
4814     my ($self, $conn, $auth) = @_;
4815
4816     my $e = new_editor(authtoken => $auth);
4817     $e->checkauth or return $e->die_event;
4818     return $e->die_event unless $e->allowed('VIEW_TRIGGER_EVENT_DEF');
4819
4820     my $reactors = $e->json_query({
4821         select => {
4822             atevdef => [{column => "reactor", transform => "distinct"}]
4823         },
4824         from => {atevdef => {}}
4825     });
4826
4827     return $e->die_event unless ref $reactors eq "ARRAY";
4828     $e->disconnect;
4829
4830     return [ map { $_->{reactor} } @$reactors ];
4831 }
4832
4833 __PACKAGE__->register_method(
4834     method   => "filter_group_entry_crud",
4835     api_name => "open-ils.actor.filter_group_entry.crud",
4836     signature => {
4837         desc => q/
4838             Provides CRUD access to filter group entry objects.  These are not full accessible
4839             via PCRUD, since they requre "asq" objects for storing the query, and "asq" objects
4840             are not accessible via PCRUD (because they have no fields against which to link perms)
4841             /,
4842         params => [
4843             {desc => "Authentication token", type => "string"},
4844             {desc => "Entry ID / Entry Object", type => "number"},
4845             {desc => "Additional note text (optional)", type => "string"},
4846             {desc => "penalty org unit ID (optional, default to top of org tree)",
4847                 type => "number"}
4848         ],
4849         return => {
4850             desc => "Entry fleshed with query on Create, Retrieve, and Uupdate.  1 on Delete",
4851             type => "object"
4852         }
4853     }
4854 );
4855
4856 sub filter_group_entry_crud {
4857     my ($self, $conn, $auth, $arg) = @_;
4858
4859     return OpenILS::Event->new('BAD_PARAMS') unless $arg;
4860     my $e = new_editor(authtoken => $auth, xact => 1);
4861     return $e->die_event unless $e->checkauth;
4862
4863     if (ref $arg) {
4864
4865         if ($arg->isnew) {
4866
4867             my $grp = $e->retrieve_actor_search_filter_group($arg->grp)
4868                 or return $e->die_event;
4869
4870             return $e->die_event unless $e->allowed(
4871                 'ADMIN_SEARCH_FILTER_GROUP', $grp->owner);
4872
4873             my $query = $arg->query;
4874             $query = $e->create_actor_search_query($query) or return $e->die_event;
4875             $arg->query($query->id);
4876             my $entry = $e->create_actor_search_filter_group_entry($arg) or return $e->die_event;
4877             $entry->query($query);
4878
4879             $e->commit;
4880             return $entry;
4881
4882         } elsif ($arg->ischanged) {
4883
4884             my $entry = $e->retrieve_actor_search_filter_group_entry([
4885                 $arg->id, {
4886                     flesh => 1,
4887                     flesh_fields => {asfge => ['grp']}
4888                 }
4889             ]) or return $e->die_event;
4890
4891             return $e->die_event unless $e->allowed(
4892                 'ADMIN_SEARCH_FILTER_GROUP', $entry->grp->owner);
4893
4894             my $query = $e->update_actor_search_query($arg->query) or return $e->die_event;
4895             $arg->query($arg->query->id);
4896             $e->update_actor_search_filter_group_entry($arg) or return $e->die_event;
4897             $arg->query($query);
4898
4899             $e->commit;
4900             return $arg;
4901
4902         } elsif ($arg->isdeleted) {
4903
4904             my $entry = $e->retrieve_actor_search_filter_group_entry([
4905                 $arg->id, {
4906                     flesh => 1,
4907                     flesh_fields => {asfge => ['grp', 'query']}
4908                 }
4909             ]) or return $e->die_event;
4910
4911             return $e->die_event unless $e->allowed(
4912                 'ADMIN_SEARCH_FILTER_GROUP', $entry->grp->owner);
4913
4914             $e->delete_actor_search_filter_group_entry($entry) or return $e->die_event;
4915             $e->delete_actor_search_query($entry->query) or return $e->die_event;
4916
4917             $e->commit;
4918             return 1;
4919
4920         } else {
4921
4922             $e->rollback;
4923             return undef;
4924         }
4925
4926     } else {
4927
4928         my $entry = $e->retrieve_actor_search_filter_group_entry([
4929             $arg, {
4930                 flesh => 1,
4931                 flesh_fields => {asfge => ['grp', 'query']}
4932             }
4933         ]) or return $e->die_event;
4934
4935         return $e->die_event unless $e->allowed(
4936             ['ADMIN_SEARCH_FILTER_GROUP', 'VIEW_SEARCH_FILTER_GROUP'],
4937             $entry->grp->owner);
4938
4939         $e->rollback;
4940         $entry->grp($entry->grp->id); # for consistency
4941         return $entry;
4942     }
4943 }
4944
4945 1;