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