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