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