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
2793 __PACKAGE__->register_method(
2794     method   => 'slim_tree',
2795     api_name => "open-ils.actor.org_tree.slim_hash.retrieve",
2796 );
2797 sub slim_tree {
2798         my $tree = new_editor()->search_actor_org_unit(
2799                 [
2800                         {"parent_ou" => undef },
2801                         {
2802                                 flesh                           => -1,
2803                                 flesh_fields    => { aou =>  ['children'] },
2804                                 order_by                        => { aou => 'name'},
2805                                 select                  => { aou => ["id","shortname", "name"]},
2806                         }
2807                 ]
2808         )->[0];
2809
2810         return trim_tree($tree);
2811 }
2812
2813
2814 sub trim_tree {
2815         my $tree = shift;
2816         return undef unless $tree;
2817         my $htree = {
2818                 code => $tree->shortname,
2819                 name => $tree->name,
2820         };
2821         if( $tree->children and @{$tree->children} ) {
2822                 $htree->{children} = [];
2823                 for my $c (@{$tree->children}) {
2824                         push( @{$htree->{children}}, trim_tree($c) );
2825                 }
2826         }
2827
2828         return $htree;
2829 }
2830
2831
2832 __PACKAGE__->register_method(
2833     method   => "update_penalties",
2834     api_name => "open-ils.actor.user.penalties.update"
2835 );
2836
2837 sub update_penalties {
2838         my($self, $conn, $auth, $user_id) = @_;
2839         my $e = new_editor(authtoken=>$auth, xact => 1);
2840         return $e->die_event unless $e->checkauth;
2841     my $user = $e->retrieve_actor_user($user_id) or return $e->die_event;
2842     return $e->die_event unless $e->allowed('UPDATE_USER', $user->home_ou);
2843     my $evt = OpenILS::Utils::Penalty->calculate_penalties($e, $user_id, $e->requestor->ws_ou);
2844     return $evt if $evt;
2845     $e->commit;
2846     return 1;
2847 }
2848
2849
2850 __PACKAGE__->register_method(
2851     method   => "apply_penalty",
2852     api_name => "open-ils.actor.user.penalty.apply"
2853 );
2854
2855 sub apply_penalty {
2856         my($self, $conn, $auth, $penalty) = @_;
2857
2858         my $e = new_editor(authtoken=>$auth, xact => 1);
2859         return $e->die_event unless $e->checkauth;
2860
2861     my $user = $e->retrieve_actor_user($penalty->usr) or return $e->die_event;
2862     return $e->die_event unless $e->allowed('UPDATE_USER', $user->home_ou);
2863
2864     my $ptype = $e->retrieve_config_standing_penalty($penalty->standing_penalty) or return $e->die_event;
2865
2866     my $ctx_org =
2867         (defined $ptype->org_depth) ?
2868         $U->org_unit_ancestor_at_depth($penalty->org_unit, $ptype->org_depth) :
2869         $penalty->org_unit;
2870
2871     $penalty->org_unit($ctx_org);
2872     $penalty->staff($e->requestor->id);
2873     $e->create_actor_user_standing_penalty($penalty) or return $e->die_event;
2874
2875     $e->commit;
2876     return $penalty->id;
2877 }
2878
2879 __PACKAGE__->register_method(
2880     method   => "remove_penalty",
2881     api_name => "open-ils.actor.user.penalty.remove"
2882 );
2883
2884 sub remove_penalty {
2885         my($self, $conn, $auth, $penalty) = @_;
2886         my $e = new_editor(authtoken=>$auth, xact => 1);
2887         return $e->die_event unless $e->checkauth;
2888     my $user = $e->retrieve_actor_user($penalty->usr) or return $e->die_event;
2889     return $e->die_event unless $e->allowed('UPDATE_USER', $user->home_ou);
2890
2891     $e->delete_actor_user_standing_penalty($penalty) or return $e->die_event;
2892     $e->commit;
2893     return 1;
2894 }
2895
2896 __PACKAGE__->register_method(
2897     method   => "update_penalty_note",
2898     api_name => "open-ils.actor.user.penalty.note.update"
2899 );
2900
2901 sub update_penalty_note {
2902         my($self, $conn, $auth, $penalty_ids, $note) = @_;
2903         my $e = new_editor(authtoken=>$auth, xact => 1);
2904         return $e->die_event unless $e->checkauth;
2905     for my $penalty_id (@$penalty_ids) {
2906         my $penalty = $e->search_actor_user_standing_penalty( { id => $penalty_id } )->[0];
2907         if (! $penalty ) { return $e->die_event; }
2908         my $user = $e->retrieve_actor_user($penalty->usr) or return $e->die_event;
2909         return $e->die_event unless $e->allowed('UPDATE_USER', $user->home_ou);
2910
2911         $penalty->note( $note ); $penalty->ischanged( 1 );
2912
2913         $e->update_actor_user_standing_penalty($penalty) or return $e->die_event;
2914     }
2915     $e->commit;
2916     return 1;
2917 }
2918
2919 __PACKAGE__->register_method(
2920     method   => "ranged_penalty_thresholds",
2921     api_name => "open-ils.actor.grp_penalty_threshold.ranged.retrieve",
2922     stream   => 1
2923 );
2924
2925 sub ranged_penalty_thresholds {
2926         my($self, $conn, $auth, $context_org) = @_;
2927         my $e = new_editor(authtoken=>$auth);
2928         return $e->event unless $e->checkauth;
2929     return $e->event unless $e->allowed('VIEW_GROUP_PENALTY_THRESHOLD', $context_org);
2930     my $list = $e->search_permission_grp_penalty_threshold([
2931         {org_unit => $U->get_org_ancestors($context_org)},
2932         {order_by => {pgpt => 'id'}}
2933     ]);
2934     $conn->respond($_) for @$list;
2935     return undef;
2936 }
2937
2938
2939
2940 __PACKAGE__->register_method(
2941     method        => "user_retrieve_fleshed_by_id",
2942     authoritative => 1,
2943     api_name      => "open-ils.actor.user.fleshed.retrieve",
2944 );
2945
2946 sub user_retrieve_fleshed_by_id {
2947         my( $self, $client, $auth, $user_id, $fields ) = @_;
2948         my $e = new_editor(authtoken => $auth);
2949         return $e->event unless $e->checkauth;
2950
2951         if( $e->requestor->id != $user_id ) {
2952                 return $e->event unless $e->allowed('VIEW_USER');
2953         }
2954
2955         $fields ||= [
2956                 "cards",
2957                 "card",
2958                 "standing_penalties",
2959                 "addresses",
2960                 "billing_address",
2961                 "mailing_address",
2962                 "stat_cat_entries",
2963                 "usr_activity" ];
2964         return new_flesh_user($user_id, $fields, $e);
2965 }
2966
2967
2968 sub new_flesh_user {
2969
2970         my $id = shift;
2971         my $fields = shift || [];
2972         my $e = shift;
2973
2974     my $fetch_penalties = 0;
2975     if(grep {$_ eq 'standing_penalties'} @$fields) {
2976         $fields = [grep {$_ ne 'standing_penalties'} @$fields];
2977         $fetch_penalties = 1;
2978     }
2979
2980     my $fetch_usr_act = 0;
2981     if(grep {$_ eq 'usr_activity'} @$fields) {
2982         $fields = [grep {$_ ne 'usr_activity'} @$fields];
2983         $fetch_usr_act = 1;
2984     }
2985
2986         my $user = $e->retrieve_actor_user(
2987         [
2988         $id,
2989         {
2990                 "flesh"                         => 1,
2991                 "flesh_fields" =>  { "au" => $fields }
2992         }
2993         ]
2994         ) or return $e->die_event;
2995
2996
2997         if( grep { $_ eq 'addresses' } @$fields ) {
2998
2999                 $user->addresses([]) unless @{$user->addresses};
3000         # don't expose "replaced" addresses by default
3001         $user->addresses([grep {$_->id >= 0} @{$user->addresses}]);
3002
3003                 if( ref $user->billing_address ) {
3004                         unless( grep { $user->billing_address->id == $_->id } @{$user->addresses} ) {
3005                                 push( @{$user->addresses}, $user->billing_address );
3006                         }
3007                 }
3008
3009                 if( ref $user->mailing_address ) {
3010                         unless( grep { $user->mailing_address->id == $_->id } @{$user->addresses} ) {
3011                                 push( @{$user->addresses}, $user->mailing_address );
3012                         }
3013                 }
3014         }
3015
3016     if($fetch_penalties) {
3017         # grab the user penalties ranged for this location
3018         $user->standing_penalties(
3019             $e->search_actor_user_standing_penalty([
3020                 {   usr => $id,
3021                     '-or' => [
3022                         {stop_date => undef},
3023                         {stop_date => {'>' => 'now'}}
3024                     ],
3025                     org_unit => $U->get_org_full_path($e->requestor->ws_ou)
3026                 },
3027                 {   flesh => 1,
3028                     flesh_fields => {ausp => ['standing_penalty']}
3029                 }
3030             ])
3031         );
3032     }
3033
3034     # retrieve the most recent usr_activity entry
3035     if ($fetch_usr_act) {
3036
3037         # max number to return for simple patron fleshing
3038         my $limit = $U->ou_ancestor_setting_value(
3039             $e->requestor->ws_ou,
3040             'circ.patron.usr_activity_retrieve.max');
3041
3042         my $opts = {
3043             flesh => 1,
3044             flesh_fields => {auact => ['etype']},
3045             order_by => {auact => 'event_time DESC'},
3046         };
3047
3048         # 0 == none, <0 == return all
3049         $limit = 1 unless defined $limit;
3050         $opts->{limit} = $limit if $limit > 0;
3051
3052         $user->usr_activity(
3053             ($limit == 0) ?
3054                 [] : # skip the DB call
3055                 $e->search_actor_usr_activity([{usr => $user->id}, $opts])
3056         );
3057     }
3058
3059         $e->rollback;
3060         $user->clear_passwd();
3061         return $user;
3062 }
3063
3064
3065
3066
3067 __PACKAGE__->register_method(
3068     method   => "user_retrieve_parts",
3069     api_name => "open-ils.actor.user.retrieve.parts",
3070 );
3071
3072 sub user_retrieve_parts {
3073         my( $self, $client, $auth, $user_id, $fields ) = @_;
3074         my $e = new_editor(authtoken => $auth);
3075         return $e->event unless $e->checkauth;
3076     $user_id ||= $e->requestor->id;
3077         if( $e->requestor->id != $user_id ) {
3078                 return $e->event unless $e->allowed('VIEW_USER');
3079         }
3080         my @resp;
3081         my $user = $e->retrieve_actor_user($user_id) or return $e->event;
3082         push(@resp, $user->$_()) for(@$fields);
3083         return \@resp;
3084 }
3085
3086
3087
3088 __PACKAGE__->register_method(
3089     method    => 'user_opt_in_enabled',
3090     api_name  => 'open-ils.actor.user.org_unit_opt_in.enabled',
3091     signature => '@return 1 if user opt-in is globally enabled, 0 otherwise.'
3092 );
3093
3094 sub user_opt_in_enabled {
3095     my($self, $conn) = @_;
3096     my $sc = OpenSRF::Utils::SettingsClient->new;
3097     return 1 if lc($sc->config_value(share => user => 'opt_in')) eq 'true';
3098     return 0;
3099 }
3100
3101
3102 __PACKAGE__->register_method(
3103     method    => 'user_opt_in_at_org',
3104     api_name  => 'open-ils.actor.user.org_unit_opt_in.check',
3105     signature => q/
3106         @param $auth The auth token
3107         @param user_id The ID of the user to test
3108         @return 1 if the user has opted in at the specified org,
3109             event on error, and 0 otherwise. /
3110 );
3111 sub user_opt_in_at_org {
3112     my($self, $conn, $auth, $user_id) = @_;
3113
3114     # see if we even need to enforce the opt-in value
3115     return 1 unless user_opt_in_enabled($self);
3116
3117         my $e = new_editor(authtoken => $auth);
3118         return $e->event unless $e->checkauth;
3119
3120     my $user = $e->retrieve_actor_user($user_id) or return $e->event;
3121         return $e->event unless $e->allowed('VIEW_USER', $user->home_ou);
3122
3123     my $ws_org = $e->requestor->ws_ou;
3124     # user is automatically opted-in if they are from the local org
3125     return 1 if $user->home_ou eq $ws_org;
3126
3127     # get the boundary setting
3128     my $opt_boundary = $U->ou_ancestor_setting_value($e->requestor->ws_ou,'org.patron_opt_boundary');
3129
3130     # auto opt in if user falls within the opt boundary
3131     my $opt_orgs = $U->get_org_descendants($ws_org, $opt_boundary);
3132
3133     return 1 if grep $_ eq $user->home_ou, @$opt_orgs;
3134
3135     my $vals = $e->search_actor_usr_org_unit_opt_in(
3136         {org_unit=>$opt_orgs, usr=>$user_id},{idlist=>1});
3137
3138     return 1 if @$vals;
3139     return 0;
3140 }
3141
3142 __PACKAGE__->register_method(
3143     method    => 'create_user_opt_in_at_org',
3144     api_name  => 'open-ils.actor.user.org_unit_opt_in.create',
3145     signature => q/
3146         @param $auth The auth token
3147         @param user_id The ID of the user to test
3148         @return The ID of the newly created object, event on error./
3149 );
3150
3151 sub create_user_opt_in_at_org {
3152     my($self, $conn, $auth, $user_id, $org_id) = @_;
3153
3154         my $e = new_editor(authtoken => $auth, xact=>1);
3155         return $e->die_event unless $e->checkauth;
3156
3157     # if a specific org unit wasn't passed in, get one based on the defaults;
3158     if(!$org_id){
3159         my $wsou = $e->requestor->ws_ou;
3160         # get the default opt depth
3161         my $opt_depth = $U->ou_ancestor_setting_value($wsou,'org.patron_opt_default');
3162         # get the org unit at that depth
3163         my $org = $e->json_query({
3164             from => [ 'actor.org_unit_ancestor_at_depth', $wsou, $opt_depth ]})->[0];
3165
3166         $org_id = $org->{id};
3167     }
3168
3169     my $user = $e->retrieve_actor_user($user_id) or return $e->die_event;
3170         return $e->die_event unless $e->allowed('UPDATE_USER', $user->home_ou);
3171
3172     my $opt_in = Fieldmapper::actor::usr_org_unit_opt_in->new;
3173
3174     $opt_in->org_unit($org_id);
3175     $opt_in->usr($user_id);
3176     $opt_in->staff($e->requestor->id);
3177     $opt_in->opt_in_ts('now');
3178     $opt_in->opt_in_ws($e->requestor->wsid);
3179
3180     $opt_in = $e->create_actor_usr_org_unit_opt_in($opt_in)
3181         or return $e->die_event;
3182
3183     $e->commit;
3184
3185     return $opt_in->id;
3186 }
3187
3188
3189 __PACKAGE__->register_method (
3190         method          => 'retrieve_org_hours',
3191         api_name        => 'open-ils.actor.org_unit.hours_of_operation.retrieve',
3192         signature       => q/
3193         Returns the hours of operation for a specified org unit
3194                 @param authtoken The login session key
3195                 @param org_id The org_unit ID
3196         /
3197 );
3198
3199 sub retrieve_org_hours {
3200     my($self, $conn, $auth, $org_id) = @_;
3201     my $e = new_editor(authtoken => $auth);
3202         return $e->die_event unless $e->checkauth;
3203     $org_id ||= $e->requestor->ws_ou;
3204     return $e->retrieve_actor_org_unit_hours_of_operation($org_id);
3205 }
3206
3207
3208 __PACKAGE__->register_method (
3209         method          => 'verify_user_password',
3210         api_name        => 'open-ils.actor.verify_user_password',
3211         signature       => q/
3212         Given a barcode or username and the MD5 encoded password,
3213         returns 1 if the password is correct.  Returns 0 otherwise.
3214         /
3215 );
3216
3217 sub verify_user_password {
3218     my($self, $conn, $auth, $barcode, $username, $password) = @_;
3219     my $e = new_editor(authtoken => $auth);
3220         return $e->die_event unless $e->checkauth;
3221     my $user;
3222     my $user_by_barcode;
3223     my $user_by_username;
3224     if($barcode) {
3225         my $card = $e->search_actor_card([
3226             {barcode => $barcode},
3227             {flesh => 1, flesh_fields => {ac => ['usr']}}])->[0] or return 0;
3228         $user_by_barcode = $card->usr;
3229         $user = $user_by_barcode;
3230     }
3231     if ($username) {
3232         $user_by_username = $e->search_actor_user({usrname => $username})->[0] or return 0;
3233         $user = $user_by_username;
3234     }
3235     return 0 if (!$user);
3236     return 0 if ($user_by_username && $user_by_barcode && $user_by_username->id != $user_by_barcode->id);
3237     return $e->event unless $e->allowed('VIEW_USER', $user->home_ou);
3238     return 1 if $user->passwd eq $password;
3239     return 0;
3240 }
3241
3242 __PACKAGE__->register_method (
3243         method          => 'retrieve_usr_id_via_barcode_or_usrname',
3244         api_name        => "open-ils.actor.user.retrieve_id_by_barcode_or_username",
3245         signature       => q/
3246         Given a barcode or username returns the id for the user or
3247         a failure event.
3248         /
3249 );
3250
3251 sub retrieve_usr_id_via_barcode_or_usrname {
3252     my($self, $conn, $auth, $barcode, $username) = @_;
3253     my $e = new_editor(authtoken => $auth);
3254         return $e->die_event unless $e->checkauth;
3255     my $id_as_barcode= OpenSRF::Utils::SettingsClient->new->config_value(apps => 'open-ils.actor' => app_settings => 'id_as_barcode');
3256     my $user;
3257     my $user_by_barcode;
3258     my $user_by_username;
3259     $logger->info("$id_as_barcode is the ID as BARCODE");
3260     if($barcode) {
3261         my $card = $e->search_actor_card([
3262             {barcode => $barcode},
3263             {flesh => 1, flesh_fields => {ac => ['usr']}}])->[0];
3264         if ($id_as_barcode =~ /^t/i) {
3265             if (!$card) {
3266                 $user = $e->retrieve_actor_user($barcode);
3267                 return OpenILS::Event->new( 'ACTOR_USER_NOT_FOUND' ) if(!$user);
3268             }else {
3269                 $user_by_barcode = $card->usr;
3270                 $user = $user_by_barcode;
3271             }
3272         }else {
3273             return OpenILS::Event->new( 'ACTOR_USER_NOT_FOUND' ) if(!$card);
3274             $user_by_barcode = $card->usr;
3275             $user = $user_by_barcode;
3276         }
3277     }
3278
3279     if ($username) {
3280         $user_by_username = $e->search_actor_user({usrname => $username})->[0] or return OpenILS::Event->new( 'ACTOR_USR_NOT_FOUND' );
3281
3282         $user = $user_by_username;
3283     }
3284         return OpenILS::Event->new( 'ACTOR_USER_NOT_FOUND' ) if (!$user);
3285         return OpenILS::Event->new( 'ACTOR_USER_NOT_FOUND' ) if ($user_by_username && $user_by_barcode && $user_by_username->id != $user_by_barcode->id);
3286     return $e->event unless $e->allowed('VIEW_USER', $user->home_ou);
3287     return $user->id;
3288 }
3289
3290
3291 __PACKAGE__->register_method (
3292         method          => 'merge_users',
3293         api_name        => 'open-ils.actor.user.merge',
3294         signature       => {
3295         desc => q/
3296             Given a list of source users and destination user, transfer all data from the source
3297             to the dest user and delete the source user.  All user related data is
3298             transferred, including circulations, holds, bookbags, etc.
3299         /
3300     }
3301 );
3302
3303 sub merge_users {
3304     my($self, $conn, $auth, $master_id, $user_ids, $options) = @_;
3305     my $e = new_editor(xact => 1, authtoken => $auth);
3306         return $e->die_event unless $e->checkauth;
3307
3308     # disallow the merge if any subordinate accounts are in collections
3309     my $colls = $e->search_money_collections_tracker({usr => $user_ids}, {idlist => 1});
3310     return OpenILS::Event->new('MERGED_USER_IN_COLLECTIONS', payload => $user_ids) if @$colls;
3311
3312     my $master_user = $e->retrieve_actor_user($master_id) or return $e->die_event;
3313     my $del_addrs = ($U->ou_ancestor_setting_value(
3314         $master_user->home_ou, 'circ.user_merge.delete_addresses', $e)) ? 't' : 'f';
3315     my $del_cards = ($U->ou_ancestor_setting_value(
3316         $master_user->home_ou, 'circ.user_merge.delete_cards', $e)) ? 't' : 'f';
3317     my $deactivate_cards = ($U->ou_ancestor_setting_value(
3318         $master_user->home_ou, 'circ.user_merge.deactivate_cards', $e)) ? 't' : 'f';
3319
3320     for my $src_id (@$user_ids) {
3321         my $src_user = $e->retrieve_actor_user($src_id) or return $e->die_event;
3322
3323         return $e->die_event unless $e->allowed('MERGE_USERS', $src_user->home_ou);
3324         if($src_user->home_ou ne $master_user->home_ou) {
3325             return $e->die_event unless $e->allowed('MERGE_USERS', $master_user->home_ou);
3326         }
3327
3328         return $e->die_event unless
3329             $e->json_query({from => [
3330                 'actor.usr_merge',
3331                 $src_id,
3332                 $master_id,
3333                 $del_addrs,
3334                 $del_cards,
3335                 $deactivate_cards
3336             ]});
3337     }
3338
3339     $e->commit;
3340     return 1;
3341 }
3342
3343
3344 __PACKAGE__->register_method (
3345         method          => 'approve_user_address',
3346         api_name        => 'open-ils.actor.user.pending_address.approve',
3347         signature       => {
3348         desc => q/
3349         /
3350     }
3351 );
3352
3353 sub approve_user_address {
3354     my($self, $conn, $auth, $addr) = @_;
3355     my $e = new_editor(xact => 1, authtoken => $auth);
3356         return $e->die_event unless $e->checkauth;
3357     if(ref $addr) {
3358         # if the caller passes an address object, assume they want to
3359         # update it first before approving it
3360         $e->update_actor_user_address($addr) or return $e->die_event;
3361     } else {
3362         $addr = $e->retrieve_actor_user_address($addr) or return $e->die_event;
3363     }
3364     my $user = $e->retrieve_actor_user($addr->usr);
3365     return $e->die_event unless $e->allowed('UPDATE_USER', $user->home_ou);
3366     my $result = $e->json_query({from => ['actor.approve_pending_address', $addr->id]})->[0]
3367         or return $e->die_event;
3368     $e->commit;
3369     return [values %$result]->[0];
3370 }
3371
3372
3373 __PACKAGE__->register_method (
3374         method          => 'retrieve_friends',
3375         api_name        => 'open-ils.actor.friends.retrieve',
3376         signature       => {
3377         desc => q/
3378             returns { confirmed: [], pending_out: [], pending_in: []}
3379             pending_out are users I'm requesting friendship with
3380             pending_in are users requesting friendship with me
3381         /
3382     }
3383 );
3384
3385 sub retrieve_friends {
3386     my($self, $conn, $auth, $user_id, $options) = @_;
3387     my $e = new_editor(authtoken => $auth);
3388     return $e->event unless $e->checkauth;
3389     $user_id ||= $e->requestor->id;
3390
3391     if($user_id != $e->requestor->id) {
3392         my $user = $e->retrieve_actor_user($user_id) or return $e->event;
3393         return $e->event unless $e->allowed('VIEW_USER', $user->home_ou);
3394     }
3395
3396     return OpenILS::Application::Actor::Friends->retrieve_friends(
3397         $e, $user_id, $options);
3398 }
3399
3400
3401
3402 __PACKAGE__->register_method (
3403         method          => 'apply_friend_perms',
3404         api_name        => 'open-ils.actor.friends.perms.apply',
3405         signature       => {
3406         desc => q/
3407         /
3408     }
3409 );
3410 sub apply_friend_perms {
3411     my($self, $conn, $auth, $user_id, $delegate_id, @perms) = @_;
3412     my $e = new_editor(authtoken => $auth, xact => 1);
3413     return $e->die_event unless $e->checkauth;
3414
3415     if($user_id != $e->requestor->id) {
3416         my $user = $e->retrieve_actor_user($user_id) or return $e->die_event;
3417         return $e->die_event unless $e->allowed('VIEW_USER', $user->home_ou);
3418     }
3419
3420     for my $perm (@perms) {
3421         my $evt =
3422             OpenILS::Application::Actor::Friends->apply_friend_perm(
3423                 $e, $user_id, $delegate_id, $perm);
3424         return $evt if $evt;
3425     }
3426
3427     $e->commit;
3428     return 1;
3429 }
3430
3431
3432 __PACKAGE__->register_method (
3433         method          => 'update_user_pending_address',
3434         api_name        => 'open-ils.actor.user.address.pending.cud'
3435 );
3436
3437 sub update_user_pending_address {
3438     my($self, $conn, $auth, $addr) = @_;
3439     my $e = new_editor(authtoken => $auth, xact => 1);
3440     return $e->die_event unless $e->checkauth;
3441
3442     if($addr->usr != $e->requestor->id) {
3443         my $user = $e->retrieve_actor_user($addr->usr) or return $e->die_event;
3444         return $e->die_event unless $e->allowed('UPDATE_USER', $user->home_ou);
3445     }
3446
3447     if($addr->isnew) {
3448         $e->create_actor_user_address($addr) or return $e->die_event;
3449     } elsif($addr->isdeleted) {
3450         $e->delete_actor_user_address($addr) or return $e->die_event;
3451     } else {
3452         $e->update_actor_user_address($addr) or return $e->die_event;
3453     }
3454
3455     $e->commit;
3456     return $addr->id;
3457 }
3458
3459
3460 __PACKAGE__->register_method (
3461         method          => 'user_events',
3462         api_name    => 'open-ils.actor.user.events.circ',
3463     stream      => 1,
3464 );
3465 __PACKAGE__->register_method (
3466         method          => 'user_events',
3467         api_name    => 'open-ils.actor.user.events.ahr',
3468     stream      => 1,
3469 );
3470
3471 sub user_events {
3472     my($self, $conn, $auth, $user_id, $filters) = @_;
3473     my $e = new_editor(authtoken => $auth);
3474     return $e->event unless $e->checkauth;
3475
3476     (my $obj_type = $self->api_name) =~ s/.*\.([a-z]+)$/$1/;
3477     my $user_field = 'usr';
3478
3479     $filters ||= {};
3480     $filters->{target} = {
3481         select => { $obj_type => ['id'] },
3482         from => $obj_type,
3483         where => {usr => $user_id}
3484     };
3485
3486     my $user = $e->retrieve_actor_user($user_id) or return $e->event;
3487     if($e->requestor->id != $user_id) {
3488         return $e->event unless $e->allowed('VIEW_USER', $user->home_ou);
3489     }
3490
3491     my $ses = OpenSRF::AppSession->create('open-ils.trigger');
3492     my $req = $ses->request('open-ils.trigger.events_by_target',
3493         $obj_type, $filters, {atevdef => ['reactor', 'validator']}, 2);
3494
3495     while(my $resp = $req->recv) {
3496         my $val = $resp->content;
3497         my $tgt = $val->target;
3498
3499         if($obj_type eq 'circ') {
3500             $tgt->target_copy($e->retrieve_asset_copy($tgt->target_copy));
3501
3502         } elsif($obj_type eq 'ahr') {
3503             $tgt->current_copy($e->retrieve_asset_copy($tgt->current_copy))
3504                 if $tgt->current_copy;
3505         }
3506
3507         $conn->respond($val) if $val;
3508     }
3509
3510     return undef;
3511 }
3512
3513 __PACKAGE__->register_method (
3514         method          => 'copy_events',
3515         api_name    => 'open-ils.actor.copy.events.circ',
3516     stream      => 1,
3517 );
3518 __PACKAGE__->register_method (
3519         method          => 'copy_events',
3520         api_name    => 'open-ils.actor.copy.events.ahr',
3521     stream      => 1,
3522 );
3523
3524 sub copy_events {
3525     my($self, $conn, $auth, $copy_id, $filters) = @_;
3526     my $e = new_editor(authtoken => $auth);
3527     return $e->event unless $e->checkauth;
3528
3529     (my $obj_type = $self->api_name) =~ s/.*\.([a-z]+)$/$1/;
3530
3531     my $copy = $e->retrieve_asset_copy($copy_id) or return $e->event;
3532
3533     my $copy_field = 'target_copy';
3534     $copy_field = 'current_copy' if $obj_type eq 'ahr';
3535
3536     $filters ||= {};
3537     $filters->{target} = {
3538         select => { $obj_type => ['id'] },
3539         from => $obj_type,
3540         where => {$copy_field => $copy_id}
3541     };
3542
3543
3544     my $ses = OpenSRF::AppSession->create('open-ils.trigger');
3545     my $req = $ses->request('open-ils.trigger.events_by_target',
3546         $obj_type, $filters, {atevdef => ['reactor', 'validator']}, 2);
3547
3548     while(my $resp = $req->recv) {
3549         my $val = $resp->content;
3550         my $tgt = $val->target;
3551
3552         my $user = $e->retrieve_actor_user($tgt->usr);
3553         if($e->requestor->id != $user->id) {
3554             return $e->event unless $e->allowed('VIEW_USER', $user->home_ou);
3555         }
3556
3557         $tgt->$copy_field($copy);
3558
3559         $tgt->usr($user);
3560         $conn->respond($val) if $val;
3561     }
3562
3563     return undef;
3564 }
3565
3566
3567
3568
3569 __PACKAGE__->register_method (
3570         method          => 'update_events',
3571         api_name    => 'open-ils.actor.user.event.cancel.batch',
3572     stream      => 1,
3573 );
3574 __PACKAGE__->register_method (
3575         method          => 'update_events',
3576         api_name    => 'open-ils.actor.user.event.reset.batch',
3577     stream      => 1,
3578 );
3579
3580 sub update_events {
3581     my($self, $conn, $auth, $event_ids) = @_;
3582     my $e = new_editor(xact => 1, authtoken => $auth);
3583     return $e->die_event unless $e->checkauth;
3584
3585     my $x = 1;
3586     for my $id (@$event_ids) {
3587
3588         # do a little dance to determine what user we are ultimately affecting
3589         my $event = $e->retrieve_action_trigger_event([
3590             $id,
3591             {   flesh => 2,
3592                 flesh_fields => {atev => ['event_def'], atevdef => ['hook']}
3593             }
3594         ]) or return $e->die_event;
3595
3596         my $user_id;
3597         if($event->event_def->hook->core_type eq 'circ') {
3598             $user_id = $e->retrieve_action_circulation($event->target)->usr;
3599         } elsif($event->event_def->hook->core_type eq 'ahr') {
3600             $user_id = $e->retrieve_action_hold_request($event->target)->usr;
3601         } else {
3602             return 0;
3603         }
3604
3605         my $user = $e->retrieve_actor_user($user_id);
3606         return $e->die_event unless $e->allowed('UPDATE_USER', $user->home_ou);
3607
3608         if($self->api_name =~ /cancel/) {
3609             $event->state('invalid');
3610         } elsif($self->api_name =~ /reset/) {
3611             $event->clear_start_time;
3612             $event->clear_update_time;
3613             $event->state('pending');
3614         }
3615
3616         $e->update_action_trigger_event($event) or return $e->die_event;
3617         $conn->respond({maximum => scalar(@$event_ids), progress => $x++});
3618     }
3619
3620     $e->commit;
3621     return {complete => 1};
3622 }
3623
3624
3625 __PACKAGE__->register_method (
3626         method          => 'really_delete_user',
3627         api_name    => 'open-ils.actor.user.delete.override',
3628     signature   => q/@see open-ils.actor.user.delete/
3629 );
3630
3631 __PACKAGE__->register_method (
3632         method          => 'really_delete_user',
3633         api_name    => 'open-ils.actor.user.delete',
3634     signature   => q/
3635         It anonymizes all personally identifiable information in actor.usr. By calling actor.usr_purge_data()
3636         it also purges related data from other tables, sometimes by transferring it to a designated destination user.
3637         The usrname field (along with first_given_name and family_name) is updated to id '-PURGED-' now().
3638         dest_usr_id is only required when deleting a user that performs staff functions.
3639     /
3640 );
3641
3642 sub really_delete_user {
3643     my($self, $conn, $auth, $user_id, $dest_user_id, $oargs) = @_;
3644     my $e = new_editor(authtoken => $auth, xact => 1);
3645     return $e->die_event unless $e->checkauth;
3646     $oargs = { all => 1 } unless defined $oargs;
3647
3648     # Find all unclosed billings for for user $user_id, thereby, also checking for open circs
3649     my $open_bills = $e->json_query({
3650         select => { mbts => ['id'] },
3651         from => 'mbts',
3652         where => {
3653             xact_finish => { '=' => undef },
3654             usr => { '=' => $user_id },
3655         }
3656     }) or return $e->die_event;
3657
3658     my $user = $e->retrieve_actor_user($user_id) or return $e->die_event;
3659
3660     # No deleting patrons with open billings or checked out copies, unless perm-enabled override
3661     if (@$open_bills) {
3662         return $e->die_event(OpenILS::Event->new('ACTOR_USER_DELETE_OPEN_XACTS'))
3663         unless $self->api_name =~ /override/o && ($oargs->{all} || grep { $_ eq 'ACTOR_USER_DELETE_OPEN_XACTS' } @{$oargs->{events}})
3664         && $e->allowed('ACTOR_USER_DELETE_OPEN_XACTS.override', $user->home_ou);
3665     }
3666     # No deleting yourself - UI is supposed to stop you first, though.
3667     return $e->die_event unless $e->requestor->id != $user->id;
3668     return $e->die_event unless $e->allowed('DELETE_USER', $user->home_ou);
3669     # Check if you are allowed to mess with this patron permission group at all
3670     my $session = OpenSRF::AppSession->create( "open-ils.storage" );
3671     my $evt = group_perm_failed($session, $e->requestor, $user);
3672     return $e->die_event($evt) if $evt;
3673     my $stat = $e->json_query(
3674         {from => ['actor.usr_delete', $user_id, $dest_user_id]})->[0]
3675         or return $e->die_event;
3676     $e->commit;
3677     return 1;
3678 }
3679
3680
3681 __PACKAGE__->register_method (
3682         method          => 'user_payments',
3683         api_name    => 'open-ils.actor.user.payments.retrieve',
3684     stream => 1,
3685     signature   => q/
3686         Returns all payments for a given user.  Default order is newest payments first.
3687         @param auth Authentication token
3688         @param user_id The user ID
3689         @param filters An optional hash of filters, including limit, offset, and order_by definitions
3690     /
3691 );
3692
3693 sub user_payments {
3694     my($self, $conn, $auth, $user_id, $filters) = @_;
3695     $filters ||= {};
3696
3697     my $e = new_editor(authtoken => $auth);
3698     return $e->die_event unless $e->checkauth;
3699
3700     my $user = $e->retrieve_actor_user($user_id) or return $e->event;
3701     return $e->event unless
3702         $e->requestor->id == $user_id or
3703         $e->allowed('VIEW_USER_TRANSACTIONS', $user->home_ou);
3704
3705     # Find all payments for all transactions for user $user_id
3706     my $query = {
3707         select => {mp => ['id']},
3708         from => 'mp',
3709         where => {
3710             xact => {
3711                 in => {
3712                     select => {mbt => ['id']},
3713                     from => 'mbt',
3714                     where => {usr => $user_id}
3715                 }
3716             }
3717         },
3718         order_by => [
3719             { # by default, order newest payments first
3720                 class => 'mp',
3721                 field => 'payment_ts',
3722                 direction => 'desc'
3723             }, {
3724                 # secondary sort in ID as a tie-breaker, since payments created
3725                 # within the same transaction will have identical payment_ts's
3726                 class => 'mp',
3727                 field => 'id'
3728             }
3729         ]
3730     };
3731
3732     for (qw/order_by limit offset/) {
3733         $query->{$_} = $filters->{$_} if defined $filters->{$_};
3734     }
3735
3736     if(defined $filters->{where}) {
3737         foreach (keys %{$filters->{where}}) {
3738             # don't allow the caller to expand the result set to other users
3739             $query->{where}->{$_} = $filters->{where}->{$_} unless $_ eq 'xact';
3740         }
3741     }
3742
3743     my $payment_ids = $e->json_query($query);
3744     for my $pid (@$payment_ids) {
3745         my $pay = $e->retrieve_money_payment([
3746             $pid->{id},
3747             {   flesh => 6,
3748                 flesh_fields => {
3749                     mp => ['xact'],
3750                     mbt => ['summary', 'circulation', 'grocery'],
3751                     circ => ['target_copy'],
3752                     acp => ['call_number'],
3753                     acn => ['record']
3754                 }
3755             }
3756         ]);
3757
3758         my $resp = {
3759             mp => $pay,
3760             xact_type => $pay->xact->summary->xact_type,
3761             last_billing_type => $pay->xact->summary->last_billing_type,
3762         };
3763
3764         if($pay->xact->summary->xact_type eq 'circulation') {
3765             $resp->{barcode} = $pay->xact->circulation->target_copy->barcode;
3766             $resp->{title} = $U->record_to_mvr($pay->xact->circulation->target_copy->call_number->record)->title;
3767         }
3768
3769         $pay->xact($pay->xact->id); # de-flesh
3770         $conn->respond($resp);
3771     }
3772
3773     return undef;
3774 }
3775
3776
3777
3778 __PACKAGE__->register_method (
3779         method          => 'negative_balance_users',
3780         api_name    => 'open-ils.actor.users.negative_balance',
3781     stream => 1,
3782     signature   => q/
3783         Returns all users that have an overall negative balance
3784         @param auth Authentication token
3785         @param org_id The context org unit as an ID or list of IDs.  This will be the home
3786         library of the user.  If no org_unit is specified, no org unit filter is applied
3787     /
3788 );
3789
3790 sub negative_balance_users {
3791     my($self, $conn, $auth, $org_id) = @_;
3792
3793     my $e = new_editor(authtoken => $auth);
3794     return $e->die_event unless $e->checkauth;
3795     return $e->die_event unless $e->allowed('VIEW_USER', $org_id);
3796
3797     my $query = {
3798         select => {
3799             mous => ['usr', 'balance_owed'],
3800             au => ['home_ou'],
3801             mbts => [
3802                 {column => 'last_billing_ts', transform => 'max', aggregate => 1},
3803                 {column => 'last_payment_ts', transform => 'max', aggregate => 1},
3804             ]
3805         },
3806         from => {
3807             mous => {
3808                 au => {
3809                     fkey => 'usr',
3810                     field => 'id',
3811                     join => {
3812                         mbts => {
3813                             key => 'id',
3814                             field => 'usr'
3815                         }
3816                     }
3817                 }
3818             }
3819         },
3820         where => {'+mous' => {balance_owed => {'<' => 0}}}
3821     };
3822
3823     $query->{from}->{mous}->{au}->{filter}->{home_ou} = $org_id if $org_id;
3824
3825     my $list = $e->json_query($query, {timeout => 600});
3826
3827     for my $data (@$list) {
3828         $conn->respond({
3829             usr => $e->retrieve_actor_user([$data->{usr}, {flesh => 1, flesh_fields => {au => ['card']}}]),
3830             balance_owed => $data->{balance_owed},
3831             last_billing_activity => max($data->{last_billing_ts}, $data->{last_payment_ts})
3832         });
3833     }
3834
3835     return undef;
3836 }
3837
3838 __PACKAGE__->register_method(
3839         method  => "request_password_reset",
3840         api_name        => "open-ils.actor.patron.password_reset.request",
3841         signature       => {
3842         desc => "Generates a UUID token usable with the open-ils.actor.patron.password_reset.commit " .
3843                 "method for changing a user's password.  The UUID token is distributed via A/T "      .
3844                 "templates (i.e. email to the user).",
3845         params => [
3846             { desc => 'user_id_type', type => 'string' },
3847             { desc => 'user_id', type => 'string' },
3848             { desc => 'optional (based on library setting) matching email address for authorizing request', type => 'string' },
3849         ],
3850         return => {desc => '1 on success, Event on error'}
3851     }
3852 );
3853 sub request_password_reset {
3854     my($self, $conn, $user_id_type, $user_id, $email) = @_;
3855
3856     # Check to see if password reset requests are already being throttled:
3857     # 0. Check cache to see if we're in throttle mode (avoid hitting database)
3858
3859     my $e = new_editor(xact => 1);
3860     my $user;
3861
3862     # Get the user, if any, depending on the input value
3863     if ($user_id_type eq 'username') {
3864         $user = $e->search_actor_user({usrname => $user_id})->[0];
3865         if (!$user) {
3866             $e->die_event;
3867             return OpenILS::Event->new( 'ACTOR_USER_NOT_FOUND' );
3868         }
3869     } elsif ($user_id_type eq 'barcode') {
3870         my $card = $e->search_actor_card([
3871             {barcode => $user_id},
3872             {flesh => 1, flesh_fields => {ac => ['usr']}}])->[0];
3873         if (!$card) {
3874             $e->die_event;
3875             return OpenILS::Event->new('ACTOR_USER_NOT_FOUND');
3876         }
3877         $user = $card->usr;
3878     }
3879
3880     # If the user doesn't have an email address, we can't help them
3881     if (!$user->email) {
3882         $e->die_event;
3883         return OpenILS::Event->new('PATRON_NO_EMAIL_ADDRESS');
3884     }
3885
3886     my $email_must_match = $U->ou_ancestor_setting_value($user->home_ou, 'circ.password_reset_request_requires_matching_email');
3887     if ($email_must_match) {
3888         if ($user->email ne $email) {
3889             return OpenILS::Event->new('EMAIL_VERIFICATION_FAILED');
3890         }
3891     }
3892
3893     _reset_password_request($conn, $e, $user);
3894 }
3895
3896 # Once we have the user, we can issue the password reset request
3897 # XXX Add a wrapper method that accepts barcode + email input
3898 sub _reset_password_request {
3899     my ($conn, $e, $user) = @_;
3900
3901     # 1. Get throttle threshold and time-to-live from OU_settings
3902     my $aupr_throttle = $U->ou_ancestor_setting_value($user->home_ou, 'circ.password_reset_request_throttle') || 1000;
3903     my $aupr_ttl = $U->ou_ancestor_setting_value($user->home_ou, 'circ.password_reset_request_time_to_live') || 24*60*60;
3904
3905     my $threshold_time = DateTime->now(time_zone => 'local')->subtract(seconds => $aupr_ttl)->iso8601();
3906
3907     # 2. Get time of last request and number of active requests (num_active)
3908     my $active_requests = $e->json_query({
3909         from => 'aupr',
3910         select => {
3911             aupr => [
3912                 {
3913                     column => 'uuid',
3914                     transform => 'COUNT'
3915                 },
3916                 {
3917                     column => 'request_time',
3918                     transform => 'MAX'
3919                 }
3920             ]
3921         },
3922         where => {
3923             has_been_reset => { '=' => 'f' },
3924             request_time => { '>' => $threshold_time }
3925         }
3926     });
3927
3928     # Guard against no active requests
3929     if ($active_requests->[0]->{'request_time'}) {
3930         my $last_request = DateTime::Format::ISO8601->parse_datetime(clense_ISO8601($active_requests->[0]->{'request_time'}));
3931         my $now = DateTime::Format::ISO8601->new();
3932
3933         # 3. if (num_active > throttle_threshold) and (now - last_request < 1 minute)
3934         if (($active_requests->[0]->{'usr'} > $aupr_throttle) &&
3935             ($last_request->add_duration('1 minute') > $now)) {
3936             $cache->put_cache('open-ils.actor.password.throttle', DateTime::Format::ISO8601->new(), 60);
3937             $e->die_event;
3938             return OpenILS::Event->new('PATRON_TOO_MANY_ACTIVE_PASSWORD_RESET_REQUESTS');
3939         }
3940     }
3941
3942     # TODO Check to see if the user is in a password-reset-restricted group
3943
3944     # Otherwise, go ahead and try to get the user.
3945
3946     # Check the number of active requests for this user
3947     $active_requests = $e->json_query({
3948         from => 'aupr',
3949         select => {
3950             aupr => [
3951                 {
3952                     column => 'usr',
3953                     transform => 'COUNT'
3954                 }
3955             ]
3956         },
3957         where => {
3958             usr => { '=' => $user->id },
3959             has_been_reset => { '=' => 'f' },
3960             request_time => { '>' => $threshold_time }
3961         }
3962     });
3963
3964     $logger->info("User " . $user->id . " has " . $active_requests->[0]->{'usr'} . " active password reset requests.");
3965
3966     # if less than or equal to per-user threshold, proceed; otherwise, return event
3967     my $aupr_per_user_limit = $U->ou_ancestor_setting_value($user->home_ou, 'circ.password_reset_request_per_user_limit') || 3;
3968     if ($active_requests->[0]->{'usr'} > $aupr_per_user_limit) {
3969         $e->die_event;
3970         return OpenILS::Event->new('PATRON_TOO_MANY_ACTIVE_PASSWORD_RESET_REQUESTS');
3971     }
3972
3973     # Create the aupr object and insert into the database
3974     my $reset_request = Fieldmapper::actor::usr_password_reset->new;
3975     my $uuid = create_uuid_as_string(UUID_V4);
3976     $reset_request->uuid($uuid);
3977     $reset_request->usr($user->id);
3978
3979     my $aupr = $e->create_actor_usr_password_reset($reset_request) or return $e->die_event;
3980     $e->commit;
3981
3982     # Create an event to notify user of the URL to reset their password
3983
3984     # Can we stuff this in the user_data param for trigger autocreate?
3985     my $hostname = $U->ou_ancestor_setting_value($user->home_ou, 'lib.hostname') || 'localhost';
3986
3987     my $ses = OpenSRF::AppSession->create('open-ils.trigger');
3988     $ses->request('open-ils.trigger.event.autocreate', 'password.reset_request', $aupr, $user->home_ou);
3989
3990     # Trunk only
3991     # $U->create_trigger_event('password.reset_request', $aupr, $user->home_ou);
3992
3993     return 1;
3994 }
3995
3996 __PACKAGE__->register_method(
3997         method  => "commit_password_reset",
3998         api_name        => "open-ils.actor.patron.password_reset.commit",
3999         signature       => {
4000         desc => "Checks a UUID token generated by the open-ils.actor.patron.password_reset.request method for " .
4001                 "validity, and if valid, uses it as authorization for changing the associated user's password " .
4002                 "with the supplied password.",
4003         params => [
4004             { desc => 'uuid', type => 'string' },
4005             { desc => 'password', type => 'string' },
4006         ],
4007         return => {desc => '1 on success, Event on error'}
4008     }
4009 );
4010 sub commit_password_reset {
4011     my($self, $conn, $uuid, $password) = @_;
4012
4013     # Check to see if password reset requests are already being throttled:
4014     # 0. Check cache to see if we're in throttle mode (avoid hitting database)
4015     $cache ||= OpenSRF::Utils::Cache->new("global", 0);
4016     my $throttle = $cache->get_cache('open-ils.actor.password.throttle') || undef;
4017     if ($throttle) {
4018         return OpenILS::Event->new('PATRON_NOT_AN_ACTIVE_PASSWORD_RESET_REQUEST');
4019     }
4020
4021     my $e = new_editor(xact => 1);
4022
4023     my $aupr = $e->search_actor_usr_password_reset({
4024         uuid => $uuid,
4025         has_been_reset => 0
4026     });
4027
4028     if (!$aupr->[0]) {
4029         $e->die_event;
4030         return OpenILS::Event->new('PATRON_NOT_AN_ACTIVE_PASSWORD_RESET_REQUEST');
4031     }
4032     my $user_id = $aupr->[0]->usr;
4033     my $user = $e->retrieve_actor_user($user_id);
4034
4035     # Ensure we're still within the TTL for the request
4036     my $aupr_ttl = $U->ou_ancestor_setting_value($user->home_ou, 'circ.password_reset_request_time_to_live') || 24*60*60;
4037     my $threshold = DateTime::Format::ISO8601->parse_datetime(clense_ISO8601($aupr->[0]->request_time))->add(seconds => $aupr_ttl);
4038     if ($threshold < DateTime->now(time_zone => 'local')) {
4039         $e->die_event;
4040         $logger->info("Password reset request needed to be submitted before $threshold");
4041         return OpenILS::Event->new('PATRON_NOT_AN_ACTIVE_PASSWORD_RESET_REQUEST');
4042     }
4043
4044     # Check complexity of password against OU-defined regex
4045     my $pw_regex = $U->ou_ancestor_setting_value($user->home_ou, 'global.password_regex');
4046
4047     my $is_strong = 0;
4048     if ($pw_regex) {
4049         # Calling JSON2perl on the $pw_regex causes failure, even before the fancy Unicode regex
4050         # ($pw_regex = OpenSRF::Utils::JSON->JSON2perl($pw_regex)) =~ s/\\u([0-9a-fA-F]{4})/\\x{$1}/gs;
4051         $is_strong = check_password_strength_custom($password, $pw_regex);
4052     } else {
4053         $is_strong = check_password_strength_default($password);
4054     }
4055
4056     if (!$is_strong) {
4057         $e->die_event;
4058         return OpenILS::Event->new('PATRON_PASSWORD_WAS_NOT_STRONG');
4059     }
4060
4061     # All is well; update the password
4062     $user->passwd($password);
4063     $e->update_actor_user($user);
4064
4065     # And flag that this password reset request has been honoured
4066     $aupr->[0]->has_been_reset('t');
4067     $e->update_actor_usr_password_reset($aupr->[0]);
4068     $e->commit;
4069
4070     return 1;
4071 }
4072
4073 sub check_password_strength_default {
4074     my $password = shift;
4075     # Use the default set of checks
4076     if ( (length($password) < 7) or
4077             ($password !~ m/.*\d+.*/) or
4078             ($password !~ m/.*[A-Za-z]+.*/)
4079        ) {
4080         return 0;
4081     }
4082     return 1;
4083 }
4084
4085 sub check_password_strength_custom {
4086     my ($password, $pw_regex) = @_;
4087
4088     $pw_regex = qr/$pw_regex/;
4089     if ($password !~  /$pw_regex/) {
4090         return 0;
4091     }
4092     return 1;
4093 }
4094
4095
4096
4097 __PACKAGE__->register_method(
4098     method    => "event_def_opt_in_settings",
4099     api_name  => "open-ils.actor.event_def.opt_in.settings",
4100     stream => 1,
4101     signature => {
4102         desc   => 'Streams the set of "cust" objects that are used as opt-in settings for event definitions',
4103         params => [
4104             { desc => 'Authentication token',  type => 'string'},
4105             {
4106                 desc => 'Org Unit ID.  (optional).  If no org ID is present, the home_ou of the requesting user is used',
4107                 type => 'number'
4108             },
4109         ],
4110         return => {
4111             desc => q/set of "cust" objects that are used as opt-in settings for event definitions at the specified org unit/,
4112             type => 'object',
4113             class => 'cust'
4114         }
4115     }
4116 );
4117
4118 sub event_def_opt_in_settings {
4119     my($self, $conn, $auth, $org_id) = @_;
4120     my $e = new_editor(authtoken => $auth);
4121     return $e->event unless $e->checkauth;
4122
4123     if(defined $org_id and $org_id != $e->requestor->home_ou) {
4124         return $e->event unless
4125             $e->allowed(['VIEW_USER_SETTING_TYPE', 'ADMIN_USER_SETTING_TYPE'], $org_id);
4126     } else {
4127         $org_id = $e->requestor->home_ou;
4128     }
4129
4130     # find all config.user_setting_type's related to event_defs for the requested org unit
4131     my $types = $e->json_query({
4132         select => {cust => ['name']},
4133         from => {atevdef => 'cust'},
4134         where => {
4135             '+atevdef' => {
4136                 owner => $U->get_org_ancestors($org_id), # context org plus parents
4137                 active => 't'
4138             }
4139         }
4140     });
4141
4142     if(@$types) {
4143         $conn->respond($_) for
4144             @{$e->search_config_usr_setting_type({name => [map {$_->{name}} @$types]})};
4145     }
4146
4147     return undef;
4148 }
4149
4150
4151 __PACKAGE__->register_method(
4152     method    => "user_visible_circs",
4153     api_name  => "open-ils.actor.history.circ.visible",
4154     stream => 1,
4155     signature => {
4156         desc   => 'Returns the set of opt-in visible circulations accompanied by circulation chain summaries',
4157         params => [
4158             { desc => 'Authentication token',  type => 'string'},
4159             { desc => 'User ID.  If no user id is present, the authenticated user is assumed', type => 'number' },
4160             { desc => 'Options hash.  Supported fields are "limit" and "offset"', type => 'object' },
4161         ],
4162         return => {
4163             desc => q/An object with 2 fields: circulation and summary.
4164                 circulation is the "circ" object.   summary is the related "accs" object/,
4165             type => 'object',
4166         }
4167     }
4168 );
4169
4170 __PACKAGE__->register_method(
4171     method    => "user_visible_circs",
4172     api_name  => "open-ils.actor.history.circ.visible.print",
4173     stream => 1,
4174     signature => {
4175         desc   => 'Returns printable output for the set of opt-in visible circulations',
4176         params => [
4177             { desc => 'Authentication token',  type => 'string'},
4178             { desc => 'User ID.  If no user id is present, the authenticated user is assumed', type => 'number' },
4179             { desc => 'Options hash.  Supported fields are "limit" and "offset"', type => 'object' },
4180         ],
4181         return => {
4182             desc => q/An action_trigger.event object or error event./,
4183             type => 'object',
4184         }
4185     }
4186 );
4187
4188 __PACKAGE__->register_method(
4189     method    => "user_visible_circs",
4190     api_name  => "open-ils.actor.history.circ.visible.email",
4191     stream => 1,
4192     signature => {
4193         desc   => 'Emails the set of opt-in visible circulations to the requestor',
4194         params => [
4195             { desc => 'Authentication token',  type => 'string'},
4196             { desc => 'User ID.  If no user id is present, the authenticated user is assumed', type => 'number' },
4197             { desc => 'Options hash.  Supported fields are "limit" and "offset"', type => 'object' },
4198         ],
4199         return => {
4200             desc => q/undef, or event on error/
4201         }
4202     }
4203 );
4204
4205 __PACKAGE__->register_method(
4206     method    => "user_visible_circs",
4207     api_name  => "open-ils.actor.history.hold.visible",
4208     stream => 1,
4209     signature => {
4210         desc   => 'Returns the set of opt-in visible holds',
4211         params => [
4212             { desc => 'Authentication token',  type => 'string'},
4213             { desc => 'User ID.  If no user id is present, the authenticated user is assumed', type => 'number' },
4214             { desc => 'Options hash.  Supported fields are "limit" and "offset"', type => 'object' },
4215         ],
4216         return => {
4217             desc => q/An object with 1 field: "hold"/,
4218             type => 'object',
4219         }
4220     }
4221 );
4222
4223 __PACKAGE__->register_method(
4224     method    => "user_visible_circs",
4225     api_name  => "open-ils.actor.history.hold.visible.print",
4226     stream => 1,
4227     signature => {
4228         desc   => 'Returns printable output for the set of opt-in visible holds',
4229         params => [
4230             { desc => 'Authentication token',  type => 'string'},
4231             { desc => 'User ID.  If no user id is present, the authenticated user is assumed', type => 'number' },
4232             { desc => 'Options hash.  Supported fields are "limit" and "offset"', type => 'object' },
4233         ],
4234         return => {
4235             desc => q/An action_trigger.event object or error event./,
4236             type => 'object',
4237         }
4238     }
4239 );
4240
4241 __PACKAGE__->register_method(
4242     method    => "user_visible_circs",
4243     api_name  => "open-ils.actor.history.hold.visible.email",
4244     stream => 1,
4245     signature => {
4246         desc   => 'Emails the set of opt-in visible holds to the requestor',
4247         params => [
4248             { desc => 'Authentication token',  type => 'string'},
4249             { desc => 'User ID.  If no user id is present, the authenticated user is assumed', type => 'number' },
4250             { desc => 'Options hash.  Supported fields are "limit" and "offset"', type => 'object' },
4251         ],
4252         return => {
4253             desc => q/undef, or event on error/
4254         }
4255     }
4256 );
4257
4258 sub user_visible_circs {
4259     my($self, $conn, $auth, $user_id, $options) = @_;
4260
4261     my $is_hold = ($self->api_name =~ /hold/);
4262     my $for_print = ($self->api_name =~ /print/);
4263     my $for_email = ($self->api_name =~ /email/);
4264     my $e = new_editor(authtoken => $auth);
4265     return $e->event unless $e->checkauth;
4266
4267     $user_id ||= $e->requestor->id;
4268     $options ||= {};
4269     $options->{limit} ||= 50;
4270     $options->{offset} ||= 0;
4271
4272     if($user_id != $e->requestor->id) {
4273         my $perm = ($is_hold) ? 'VIEW_HOLD' : 'VIEW_CIRCULATIONS';
4274         my $user = $e->retrieve_actor_user($user_id) or return $e->event;
4275         return $e->event unless $e->allowed($perm, $user->home_ou);
4276     }
4277
4278     my $db_func = ($is_hold) ? 'action.usr_visible_holds' : 'action.usr_visible_circs';
4279
4280     my $data = $e->json_query({
4281         from => [$db_func, $user_id],
4282         limit => $$options{limit},
4283         offset => $$options{offset}
4284
4285         # TODO: I only want IDs. code below didn't get me there
4286         # {"select":{"au":[{"column":"id", "result_field":"id",
4287         # "transform":"action.usr_visible_circs"}]}, "where":{"id":10}, "from":"au"}
4288     },{
4289         substream => 1
4290     });
4291
4292     return undef unless @$data;
4293
4294     if ($for_print) {
4295
4296         # collect the batch of objects
4297
4298         if($is_hold) {
4299
4300             my $hold_list = $e->search_action_hold_request({id => [map { $_->{id} } @$data]});
4301             return $U->fire_object_event(undef, 'ahr.format.history.print', $hold_list, $$hold_list[0]->request_lib);
4302
4303         } else {
4304
4305             my $circ_list = $e->search_action_circulation({id => [map { $_->{id} } @$data]});
4306             return $U->fire_object_event(undef, 'circ.format.history.print', $circ_list, $$circ_list[0]->circ_lib);
4307         }
4308
4309     } elsif ($for_email) {
4310
4311         $conn->respond_complete(1) if $for_email;  # no sense in waiting
4312
4313         foreach (@$data) {
4314
4315             my $id = $_->{id};
4316
4317             if($is_hold) {
4318
4319                 my $hold = $e->retrieve_action_hold_request($id);
4320                 $U->create_events_for_hook('ahr.format.history.email', $hold, $hold->request_lib, undef, undef, 1);
4321                 # events will be fired from action_trigger_runner
4322
4323             } else {
4324
4325                 my $circ = $e->retrieve_action_circulation($id);
4326                 $U->create_events_for_hook('circ.format.history.email', $circ, $circ->circ_lib, undef, undef, 1);
4327                 # events will be fired from action_trigger_runner
4328             }
4329         }
4330
4331     } else { # just give me the data please
4332
4333         foreach (@$data) {
4334
4335             my $id = $_->{id};
4336
4337             if($is_hold) {
4338
4339                 my $hold = $e->retrieve_action_hold_request($id);
4340                 $conn->respond({hold => $hold});
4341
4342             } else {
4343
4344                 my $circ = $e->retrieve_action_circulation($id);
4345                 $conn->respond({
4346                     circ => $circ,
4347                     summary => $U->create_circ_chain_summary($e, $id)
4348                 });
4349             }
4350         }
4351     }
4352
4353     return undef;
4354 }
4355
4356 __PACKAGE__->register_method(
4357     method     => "user_saved_search_cud",
4358     api_name   => "open-ils.actor.user.saved_search.cud",
4359     stream     => 1,
4360     signature  => {
4361         desc   => 'Create/Update/Delete Access to user saved searches',
4362         params => [
4363             { desc => 'Authentication token', type => 'string' },
4364             { desc => 'Saved Search Object', type => 'object', class => 'auss' }
4365         ],
4366         return => {
4367             desc   => q/The retrieved or updated saved search object, or id of a deleted object; Event on error/,
4368             class  => 'auss'
4369         }
4370     }
4371 );
4372
4373 __PACKAGE__->register_method(
4374     method     => "user_saved_search_cud",
4375     api_name   => "open-ils.actor.user.saved_search.retrieve",
4376     stream     => 1,
4377     signature  => {
4378         desc   => 'Retrieve a saved search object',
4379         params => [
4380             { desc => 'Authentication token', type => 'string' },
4381             { desc => 'Saved Search ID', type => 'number' }
4382         ],
4383         return => {
4384             desc   => q/The saved search object, Event on error/,
4385             class  => 'auss'
4386         }
4387     }
4388 );
4389
4390 sub user_saved_search_cud {
4391     my( $self, $client, $auth, $search ) = @_;
4392     my $e = new_editor( authtoken=>$auth );
4393     return $e->die_event unless $e->checkauth;
4394
4395     my $o_search;      # prior version of the object, if any
4396     my $res;           # to be returned
4397
4398     # branch on the operation type
4399
4400     if( $self->api_name =~ /retrieve/ ) {                    # Retrieve
4401
4402         # Get the old version, to check ownership
4403         $o_search = $e->retrieve_actor_usr_saved_search( $search )
4404             or return $e->die_event;
4405
4406         # You can't read somebody else's search
4407         return OpenILS::Event->new('BAD_PARAMS')
4408             unless $o_search->owner == $e->requestor->id;
4409
4410         $res = $o_search;
4411
4412     } else {
4413
4414         $e->xact_begin;               # start an editor transaction
4415
4416         if( $search->isnew ) {                               # Create
4417
4418             # You can't create a search for somebody else
4419             return OpenILS::Event->new('BAD_PARAMS')
4420                 unless $search->owner == $e->requestor->id;
4421
4422             $e->create_actor_usr_saved_search( $search )
4423                 or return $e->die_event;
4424
4425             $res = $search->id;
4426
4427         } elsif( $search->ischanged ) {                      # Update
4428
4429             # You can't change ownership of a search
4430             return OpenILS::Event->new('BAD_PARAMS')
4431                 unless $search->owner == $e->requestor->id;
4432
4433             # Get the old version, to check ownership
4434             $o_search = $e->retrieve_actor_usr_saved_search( $search->id )
4435                 or return $e->die_event;
4436
4437             # You can't update somebody else's search
4438             return OpenILS::Event->new('BAD_PARAMS')
4439                 unless $o_search->owner == $e->requestor->id;
4440
4441             # Do the update
4442             $e->update_actor_usr_saved_search( $search )
4443                 or return $e->die_event;
4444
4445             $res = $search;
4446
4447         } elsif( $search->isdeleted ) {                      # Delete
4448
4449             # Get the old version, to check ownership
4450             $o_search = $e->retrieve_actor_usr_saved_search( $search->id )
4451                 or return $e->die_event;
4452
4453             # You can't delete somebody else's search
4454             return OpenILS::Event->new('BAD_PARAMS')
4455                 unless $o_search->owner == $e->requestor->id;
4456
4457             # Do the delete
4458             $e->delete_actor_usr_saved_search( $o_search )
4459                 or return $e->die_event;
4460
4461             $res = $search->id;
4462         }
4463
4464         $e->commit;
4465     }
4466
4467     return $res;
4468 }
4469
4470 __PACKAGE__->register_method(
4471     method   => "get_barcodes",
4472     api_name => "open-ils.actor.get_barcodes"
4473 );
4474
4475 sub get_barcodes {
4476         my( $self, $client, $auth, $org_id, $context, $barcode ) = @_;
4477         my $e = new_editor(authtoken => $auth);
4478     return $e->event unless $e->checkauth;
4479     return $e->event unless $e->allowed('STAFF_LOGIN', $org_id);
4480
4481     my $db_result = $e->json_query(
4482         {   from => [
4483                 'evergreen.get_barcodes',
4484                 $org_id, $context, $barcode,
4485             ]
4486         }
4487     );
4488     if($context =~ /actor/) {
4489         my $filter_result = ();
4490         my $patron;
4491         foreach my $result (@$db_result) {
4492             if($result->{type} eq 'actor') {
4493                 if($e->requestor->id != $result->{id}) {
4494                     $patron = $e->retrieve_actor_user($result->{id});
4495                     if(!$patron) {
4496                         push(@$filter_result, $e->event);
4497                         next;
4498                     }
4499                     if($e->allowed('VIEW_USER', $patron->home_ou)) {
4500                         push(@$filter_result, $result);
4501                     }
4502                     else {
4503                         push(@$filter_result, $e->event);
4504                     }
4505                 }
4506                 else {
4507                     push(@$filter_result, $result);
4508                 }
4509             }
4510             else {
4511                 push(@$filter_result, $result);
4512             }
4513         }
4514         return $filter_result;
4515     }
4516     else {
4517         return $db_result;
4518     }
4519 }
4520 __PACKAGE__->register_method(
4521     method   => 'address_alert_test',
4522     api_name => 'open-ils.actor.address_alert.test',
4523     signature => {
4524         desc => "Tests a set of address fields to determine if they match with an address_alert",
4525         params => [
4526             {desc => 'Authentication token', type => 'string'},
4527             {desc => 'Org Unit',             type => 'number'},
4528             {desc => 'Fields',               type => 'hash'},
4529         ],
4530         return => {desc => 'List of matching address_alerts'}
4531     }
4532 );
4533
4534 sub address_alert_test {
4535     my ($self, $client, $auth, $org_unit, $fields) = @_;
4536     return [] unless $fields and grep {$_} values %$fields;
4537
4538     my $e = new_editor(authtoken => $auth);
4539     return $e->event unless $e->checkauth;
4540     return $e->event unless $e->allowed('CREATE_USER', $org_unit);
4541     $org_unit ||= $e->requestor->ws_ou;
4542
4543     my $alerts = $e->json_query({
4544         from => [
4545             'actor.address_alert_matches',
4546             $org_unit,
4547             $$fields{street1},
4548             $$fields{street2},
4549             $$fields{city},
4550             $$fields{county},
4551             $$fields{state},
4552             $$fields{country},
4553             $$fields{post_code},
4554             $$fields{mailing_address},
4555             $$fields{billing_address}
4556         ]
4557     });
4558
4559     # map the json_query hashes to real objects
4560     return [
4561         map {$e->retrieve_actor_address_alert($_)}
4562             (map {$_->{id}} @$alerts)
4563     ];
4564 }
4565
4566 __PACKAGE__->register_method(
4567     method   => "mark_users_contact_invalid",
4568     api_name => "open-ils.actor.invalidate.email",
4569     signature => {
4570         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",
4571         params => [
4572             {desc => "Authentication token", type => "string"},
4573             {desc => "Patron ID", type => "number"},
4574             {desc => "Additional note text (optional)", type => "string"},
4575             {desc => "penalty org unit ID (optional)", type => "number"}
4576         ],
4577         return => {desc => "Event describing success or failure", type => "object"}
4578     }
4579 );
4580
4581 __PACKAGE__->register_method(
4582     method   => "mark_users_contact_invalid",
4583     api_name => "open-ils.actor.invalidate.day_phone",
4584     signature => {
4585         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",
4586         params => [
4587             {desc => "Authentication token", type => "string"},
4588             {desc => "Patron ID", type => "number"},
4589             {desc => "Additional note text (optional)", type => "string"},
4590             {desc => "penalty org unit ID (optional)", type => "number"}
4591         ],
4592         return => {desc => "Event describing success or failure", type => "object"}
4593     }
4594 );
4595
4596 __PACKAGE__->register_method(
4597     method   => "mark_users_contact_invalid",
4598     api_name => "open-ils.actor.invalidate.evening_phone",
4599     signature => {
4600         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",
4601         params => [
4602             {desc => "Authentication token", type => "string"},
4603             {desc => "Patron ID", type => "number"},
4604             {desc => "Additional note text (optional)", type => "string"},
4605             {desc => "penalty org unit ID (optional)", type => "number"}
4606         ],
4607         return => {desc => "Event describing success or failure", type => "object"}
4608     }
4609 );
4610
4611 __PACKAGE__->register_method(
4612     method   => "mark_users_contact_invalid",
4613     api_name => "open-ils.actor.invalidate.other_phone",
4614     signature => {
4615         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",
4616         params => [
4617             {desc => "Authentication token", type => "string"},
4618             {desc => "Patron ID", type => "number"},
4619             {desc => "Additional note text (optional)", type => "string"},
4620             {desc => "penalty org unit ID (optional, default to top of org tree)",
4621                 type => "number"}
4622         ],
4623         return => {desc => "Event describing success or failure", type => "object"}
4624     }
4625 );
4626
4627 sub mark_users_contact_invalid {
4628     my ($self, $conn, $auth, $patron_id, $addl_note, $penalty_ou) = @_;
4629
4630     # This method invalidates an email address or a phone_number which
4631     # removes the bad email address or phone number, copying its contents
4632     # to a patron note, and institutes a standing penalty for "bad email"
4633     # or "bad phone number" which is cleared when the user is saved or
4634     # optionally only when the user is saved with an email address or
4635     # phone number (or staff manually delete the penalty).
4636
4637     my $contact_type = ($self->api_name =~ /invalidate.(\w+)(\.|$)/)[0];
4638
4639     my $e = new_editor(authtoken => $auth, xact => 1);
4640     return $e->die_event unless $e->checkauth;
4641
4642     return OpenILS::Utils::BadContact->mark_users_contact_invalid(
4643         $e, $contact_type, {usr => $patron_id},
4644         $addl_note, $penalty_ou, $e->requestor->id
4645     );
4646 }
4647
4648 1;