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