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