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

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