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

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