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