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