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