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

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