Open-ILS/src/perlmods/lib/OpenILS/Application/Actor.pm

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