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     if (not defined $search_ou) {
1333         my $depth = $U->ou_ancestor_setting_value(
1334             $e->requestor->ws_ou,
1335             'circ.patron_edit.duplicate_patron_check_depth'
1336         );
1337
1338         if (defined $depth) {
1339             $search_ou = $U->org_unit_ancestor_at_depth(
1340                 $e->requestor->ws_ou, $depth
1341             );
1342         }
1343     }
1344     return $U->storagereq(
1345         "open-ils.storage.actor.user.crazy_search", $search_hash,
1346             $search_limit, $search_sort, $include_inactive, $e->requestor->ws_ou, $search_ou, $opt_boundary);
1347 }
1348
1349
1350 __PACKAGE__->register_method(
1351     method    => "update_passwd",
1352     api_name  => "open-ils.actor.user.password.update",
1353     signature => {
1354         desc   => "Update the operator's password",
1355         params => [
1356             { desc => 'Authentication token', type => 'string' },
1357             { desc => 'New password',         type => 'string' },
1358             { desc => 'Current password',     type => 'string' }
1359         ],
1360         return => {desc => '1 on success, Event on error or incorrect current password'}
1361     }
1362 );
1363
1364 __PACKAGE__->register_method(
1365     method    => "update_passwd",
1366     api_name  => "open-ils.actor.user.username.update",
1367     signature => {
1368         desc   => "Update the operator's username",
1369         params => [
1370             { desc => 'Authentication token', type => 'string' },
1371             { desc => 'New username',         type => 'string' },
1372             { desc => 'Current password',     type => 'string' }
1373         ],
1374         return => {desc => '1 on success, Event on error or incorrect current password'}
1375     }
1376 );
1377
1378 __PACKAGE__->register_method(
1379     method    => "update_passwd",
1380     api_name  => "open-ils.actor.user.email.update",
1381     signature => {
1382         desc   => "Update the operator's email address",
1383         params => [
1384             { desc => 'Authentication token', type => 'string' },
1385             { desc => 'New email address',    type => 'string' },
1386             { desc => 'Current password',     type => 'string' }
1387         ],
1388         return => {desc => '1 on success, Event on error or incorrect current password'}
1389     }
1390 );
1391
1392 sub update_passwd {
1393     my( $self, $conn, $auth, $new_val, $orig_pw ) = @_;
1394     my $e = new_editor(xact=>1, authtoken=>$auth);
1395     return $e->die_event unless $e->checkauth;
1396
1397     my $db_user = $e->retrieve_actor_user($e->requestor->id)
1398         or return $e->die_event;
1399     my $api = $self->api_name;
1400
1401     # make sure the original password matches the in-database password
1402     if (md5_hex($orig_pw) ne $db_user->passwd) {
1403         $e->rollback;
1404         return new OpenILS::Event('INCORRECT_PASSWORD');
1405     }
1406
1407     if( $api =~ /password/o ) {
1408
1409         $db_user->passwd($new_val);
1410
1411     } else {
1412
1413         # if we don't clear the password, the user will be updated with
1414         # a hashed version of the hashed version of their password
1415         $db_user->clear_passwd;
1416
1417         if( $api =~ /username/o ) {
1418
1419             # make sure no one else has this username
1420             my $exist = $e->search_actor_user({usrname=>$new_val},{idlist=>1});
1421             if (@$exist) {
1422                 $e->rollback;
1423                 return new OpenILS::Event('USERNAME_EXISTS');
1424             }
1425             $db_user->usrname($new_val);
1426
1427         } elsif( $api =~ /email/o ) {
1428             $db_user->email($new_val);
1429         }
1430     }
1431
1432     $e->update_actor_user($db_user) or return $e->die_event;
1433     $e->commit;
1434
1435     # update the cached user to pick up these changes
1436     $U->simplereq('open-ils.auth', 'open-ils.auth.session.reset_timeout', $auth, 1);
1437     return 1;
1438 }
1439
1440
1441
1442 __PACKAGE__->register_method(
1443     method   => "check_user_perms",
1444     api_name => "open-ils.actor.user.perm.check",
1445     notes    => <<"    NOTES");
1446     Takes a login session, user id, an org id, and an array of perm type strings.  For each
1447     perm type, if the user does *not* have the given permission it is added
1448     to a list which is returned from the method.  If all permissions
1449     are allowed, an empty list is returned
1450     if the logged in user does not match 'user_id', then the logged in user must
1451     have VIEW_PERMISSION priveleges.
1452     NOTES
1453
1454 sub check_user_perms {
1455     my( $self, $client, $login_session, $user_id, $org_id, $perm_types ) = @_;
1456
1457     my( $staff, $evt ) = $apputils->checkses($login_session);
1458     return $evt if $evt;
1459
1460     if($staff->id ne $user_id) {
1461         if( $evt = $apputils->check_perms(
1462             $staff->id, $org_id, 'VIEW_PERMISSION') ) {
1463             return $evt;
1464         }
1465     }
1466
1467     my @not_allowed;
1468     for my $perm (@$perm_types) {
1469         if($apputils->check_perms($user_id, $org_id, $perm)) {
1470             push @not_allowed, $perm;
1471         }
1472     }
1473
1474     return \@not_allowed
1475 }
1476
1477 __PACKAGE__->register_method(
1478     method  => "check_user_perms2",
1479     api_name    => "open-ils.actor.user.perm.check.multi_org",
1480     notes       => q/
1481         Checks the permissions on a list of perms and orgs for a user
1482         @param authtoken The login session key
1483         @param user_id The id of the user to check
1484         @param orgs The array of org ids
1485         @param perms The array of permission names
1486         @return An array of  [ orgId, permissionName ] arrays that FAILED the check
1487         if the logged in user does not match 'user_id', then the logged in user must
1488         have VIEW_PERMISSION priveleges.
1489     /);
1490
1491 sub check_user_perms2 {
1492     my( $self, $client, $authtoken, $user_id, $orgs, $perms ) = @_;
1493
1494     my( $staff, $target, $evt ) = $apputils->checkses_requestor(
1495         $authtoken, $user_id, 'VIEW_PERMISSION' );
1496     return $evt if $evt;
1497
1498     my @not_allowed;
1499     for my $org (@$orgs) {
1500         for my $perm (@$perms) {
1501             if($apputils->check_perms($user_id, $org, $perm)) {
1502                 push @not_allowed, [ $org, $perm ];
1503             }
1504         }
1505     }
1506
1507     return \@not_allowed
1508 }
1509
1510
1511 __PACKAGE__->register_method(
1512     method => 'check_user_perms3',
1513     api_name    => 'open-ils.actor.user.perm.highest_org',
1514     notes       => q/
1515         Returns the highest org unit id at which a user has a given permission
1516         If the requestor does not match the target user, the requestor must have
1517         'VIEW_PERMISSION' rights at the home org unit of the target user
1518         @param authtoken The login session key
1519         @param userid The id of the user in question
1520         @param perm The permission to check
1521         @return The org unit highest in the org tree within which the user has
1522         the requested permission
1523     /);
1524
1525 sub check_user_perms3 {
1526     my($self, $client, $authtoken, $user_id, $perm) = @_;
1527     my $e = new_editor(authtoken=>$authtoken);
1528     return $e->event unless $e->checkauth;
1529
1530     my $tree = $U->get_org_tree();
1531
1532     unless($e->requestor->id == $user_id) {
1533         my $user = $e->retrieve_actor_user($user_id)
1534             or return $e->event;
1535         return $e->event unless $e->allowed('VIEW_PERMISSION', $user->home_ou);
1536         return $U->find_highest_perm_org($perm, $user_id, $user->home_ou, $tree );
1537     }
1538
1539     return $U->find_highest_perm_org($perm, $user_id, $e->requestor->ws_ou, $tree);
1540 }
1541
1542 __PACKAGE__->register_method(
1543     method => 'user_has_work_perm_at',
1544     api_name    => 'open-ils.actor.user.has_work_perm_at',
1545     authoritative => 1,
1546     signature => {
1547         desc => q/
1548             Returns a set of org unit IDs which represent the highest orgs in
1549             the org tree where the user has the requested permission.  The
1550             purpose of this method is to return the smallest set of org units
1551             which represent the full expanse of the user's ability to perform
1552             the requested action.  The user whose perms this method should
1553             check is implied by the authtoken. /,
1554         params => [
1555             {desc => 'authtoken', type => 'string'},
1556             {desc => 'permission name', type => 'string'},
1557             {desc => q/user id, optional.  If present, check perms for
1558                 this user instead of the logged in user/, type => 'number'},
1559         ],
1560         return => {desc => 'An array of org IDs'}
1561     }
1562 );
1563
1564 sub user_has_work_perm_at {
1565     my($self, $conn, $auth, $perm, $user_id) = @_;
1566     my $e = new_editor(authtoken=>$auth);
1567     return $e->event unless $e->checkauth;
1568     if(defined $user_id) {
1569         my $user = $e->retrieve_actor_user($user_id) or return $e->event;
1570         return $e->event unless $e->allowed('VIEW_PERMISSION', $user->home_ou);
1571     }
1572     return $U->user_has_work_perm_at($e, $perm, undef, $user_id);
1573 }
1574
1575 __PACKAGE__->register_method(
1576     method => 'user_has_work_perm_at_batch',
1577     api_name    => 'open-ils.actor.user.has_work_perm_at.batch',
1578     authoritative => 1,
1579 );
1580
1581 sub user_has_work_perm_at_batch {
1582     my($self, $conn, $auth, $perms, $user_id) = @_;
1583     my $e = new_editor(authtoken=>$auth);
1584     return $e->event unless $e->checkauth;
1585     if(defined $user_id) {
1586         my $user = $e->retrieve_actor_user($user_id) or return $e->event;
1587         return $e->event unless $e->allowed('VIEW_PERMISSION', $user->home_ou);
1588     }
1589     my $map = {};
1590     $map->{$_} = $U->user_has_work_perm_at($e, $_) for @$perms;
1591     return $map;
1592 }
1593
1594
1595
1596 __PACKAGE__->register_method(
1597     method => 'check_user_perms4',
1598     api_name    => 'open-ils.actor.user.perm.highest_org.batch',
1599     notes       => q/
1600         Returns the highest org unit id at which a user has a given permission
1601         If the requestor does not match the target user, the requestor must have
1602         'VIEW_PERMISSION' rights at the home org unit of the target user
1603         @param authtoken The login session key
1604         @param userid The id of the user in question
1605         @param perms An array of perm names to check
1606         @return An array of orgId's  representing the org unit
1607         highest in the org tree within which the user has the requested permission
1608         The arrah of orgId's has matches the order of the perms array
1609     /);
1610
1611 sub check_user_perms4 {
1612     my( $self, $client, $authtoken, $userid, $perms ) = @_;
1613
1614     my( $staff, $target, $org, $evt );
1615
1616     ( $staff, $target, $evt ) = $apputils->checkses_requestor(
1617         $authtoken, $userid, 'VIEW_PERMISSION' );
1618     return $evt if $evt;
1619
1620     my @arr;
1621     return [] unless ref($perms);
1622     my $tree = $U->get_org_tree();
1623
1624     for my $p (@$perms) {
1625         push( @arr, $U->find_highest_perm_org( $p, $userid, $target->home_ou, $tree ) );
1626     }
1627     return \@arr;
1628 }
1629
1630
1631 __PACKAGE__->register_method(
1632     method        => "user_fines_summary",
1633     api_name      => "open-ils.actor.user.fines.summary",
1634     authoritative => 1,
1635     signature     => {
1636         desc   => 'Returns a short summary of the users total open fines, '  .
1637                   'excluding voided fines Params are login_session, user_id' ,
1638         params => [
1639             {desc => 'Authentication token', type => 'string'},
1640             {desc => 'User ID',              type => 'string'}  # number?
1641         ],
1642         return => {
1643             desc => "a 'mous' object, event on error",
1644         }
1645     }
1646 );
1647
1648 sub user_fines_summary {
1649     my( $self, $client, $auth, $user_id ) = @_;
1650
1651     my $e = new_editor(authtoken=>$auth);
1652     return $e->event unless $e->checkauth;
1653
1654     if( $user_id ne $e->requestor->id ) {
1655         my $user = $e->retrieve_actor_user($user_id) or return $e->event;
1656         return $e->event unless
1657             $e->allowed('VIEW_USER_FINES_SUMMARY', $user->home_ou);
1658     }
1659
1660     return $e->search_money_open_user_summary({usr => $user_id})->[0];
1661 }
1662
1663
1664 __PACKAGE__->register_method(
1665     method        => "user_opac_vitals",
1666     api_name      => "open-ils.actor.user.opac.vital_stats",
1667     argc          => 1,
1668     authoritative => 1,
1669     signature     => {
1670         desc   => 'Returns a short summary of the users vital stats, including '  .
1671                   'identification information, accumulated balance, number of holds, ' .
1672                   'and current open circulation stats' ,
1673         params => [
1674             {desc => 'Authentication token',                          type => 'string'},
1675             {desc => 'Optional User ID, for use in the staff client', type => 'number'}  # number?
1676         ],
1677         return => {
1678             desc => "An object with four properties: user, fines, checkouts and holds."
1679         }
1680     }
1681 );
1682
1683 sub user_opac_vitals {
1684     my( $self, $client, $auth, $user_id ) = @_;
1685
1686     my $e = new_editor(authtoken=>$auth);
1687     return $e->event unless $e->checkauth;
1688
1689     $user_id ||= $e->requestor->id;
1690
1691     my $user = $e->retrieve_actor_user( $user_id );
1692
1693     my ($fines) = $self
1694         ->method_lookup('open-ils.actor.user.fines.summary')
1695         ->run($auth => $user_id);
1696     return $fines if (defined($U->event_code($fines)));
1697
1698     if (!$fines) {
1699         $fines = new Fieldmapper::money::open_user_summary ();
1700         $fines->balance_owed(0.00);
1701         $fines->total_owed(0.00);
1702         $fines->total_paid(0.00);
1703         $fines->usr($user_id);
1704     }
1705
1706     my ($holds) = $self
1707         ->method_lookup('open-ils.actor.user.hold_requests.count')
1708         ->run($auth => $user_id);
1709     return $holds if (defined($U->event_code($holds)));
1710
1711     my ($out) = $self
1712         ->method_lookup('open-ils.actor.user.checked_out.count')
1713         ->run($auth => $user_id);
1714     return $out if (defined($U->event_code($out)));
1715
1716     $out->{"total_out"} = reduce { $a + $out->{$b} } 0, qw/out overdue long_overdue/;
1717
1718     return {
1719         user => {
1720             first_given_name  => $user->first_given_name,
1721             second_given_name => $user->second_given_name,
1722             family_name       => $user->family_name,
1723             alias             => $user->alias,
1724             usrname           => $user->usrname
1725         },
1726         fines => $fines->to_bare_hash,
1727         checkouts => $out,
1728         holds => $holds
1729     };
1730 }
1731
1732
1733 ##### a small consolidation of related method registrations
1734 my $common_params = [
1735     { desc => 'Authentication token', type => 'string' },
1736     { desc => 'User ID',              type => 'string' },
1737     { desc => 'Transactions type (optional, defaults to all)', type => 'string' },
1738     { desc => 'Options hash.  May contain limit and offset for paged results.', type => 'object' },
1739 ];
1740 my %methods = (
1741     'open-ils.actor.user.transactions'                      => '',
1742     'open-ils.actor.user.transactions.fleshed'              => '',
1743     'open-ils.actor.user.transactions.have_charge'          => ' that have an initial charge',
1744     'open-ils.actor.user.transactions.have_charge.fleshed'  => ' that have an initial charge',
1745     'open-ils.actor.user.transactions.have_balance'         => ' that have an outstanding balance',
1746     'open-ils.actor.user.transactions.have_balance.fleshed' => ' that have an outstanding balance',
1747 );
1748
1749 foreach (keys %methods) {
1750     my %args = (
1751         method    => "user_transactions",
1752         api_name  => $_,
1753         signature => {
1754             desc   => 'For a given user, retrieve a list of '
1755                     . (/\.fleshed/ ? 'fleshed ' : '')
1756                     . 'transactions' . $methods{$_}
1757                     . ' optionally limited to transactions of a given type.',
1758             params => $common_params,
1759             return => {
1760                 desc => "List of objects, or event on error.  Each object is a hash containing: transaction, circ, record. "
1761                       . 'These represent the relevant (mbts) transaction, attached circulation and title pointed to in the circ, respectively.',
1762             }
1763         }
1764     );
1765     $args{authoritative} = 1;
1766     __PACKAGE__->register_method(%args);
1767 }
1768
1769 # Now for the counts
1770 %methods = (
1771     'open-ils.actor.user.transactions.count'              => '',
1772     'open-ils.actor.user.transactions.have_charge.count'  => ' that have an initial charge',
1773     'open-ils.actor.user.transactions.have_balance.count' => ' that have an outstanding balance',
1774 );
1775
1776 foreach (keys %methods) {
1777     my %args = (
1778         method    => "user_transactions",
1779         api_name  => $_,
1780         signature => {
1781             desc   => 'For a given user, retrieve a count of open '
1782                     . 'transactions' . $methods{$_}
1783                     . ' optionally limited to transactions of a given type.',
1784             params => $common_params,
1785             return => { desc => "Integer count of transactions, or event on error" }
1786         }
1787     );
1788     /\.have_balance/ and $args{authoritative} = 1;     # FIXME: I don't know why have_charge isn't authoritative
1789     __PACKAGE__->register_method(%args);
1790 }
1791
1792 __PACKAGE__->register_method(
1793     method        => "user_transactions",
1794     api_name      => "open-ils.actor.user.transactions.have_balance.total",
1795     authoritative => 1,
1796     signature     => {
1797         desc   => 'For a given user, retrieve the total balance owed for open transactions,'
1798                 . ' optionally limited to transactions of a given type.',
1799         params => $common_params,
1800         return => { desc => "Decimal balance value, or event on error" }
1801     }
1802 );
1803
1804
1805 sub user_transactions {
1806     my( $self, $client, $auth, $user_id, $type, $options ) = @_;
1807     $options ||= {};
1808
1809     my $e = new_editor(authtoken => $auth);
1810     return $e->event unless $e->checkauth;
1811
1812     my $user = $e->retrieve_actor_user($user_id) or return $e->event;
1813
1814     return $e->event unless
1815         $e->requestor->id == $user_id or
1816         $e->allowed('VIEW_USER_TRANSACTIONS', $user->home_ou);
1817
1818     my $api = $self->api_name();
1819
1820     my $filter = ($api =~ /have_balance/o) ?
1821         { 'balance_owed' => { '<>' => 0 } }:
1822         { 'total_owed' => { '>' => 0 } };
1823
1824     my $method = 'open-ils.actor.user.transactions.history.still_open';
1825     $method = "$method.authoritative" if $api =~ /authoritative/;
1826     my ($trans) = $self->method_lookup($method)->run($auth, $user_id, $type, $filter, $options);
1827
1828     if($api =~ /total/o) {
1829         my $total = 0.0;
1830         $total += $_->balance_owed for @$trans;
1831         return $total;
1832     }
1833
1834     ($api =~ /count/o  ) and return scalar @$trans;
1835     ($api !~ /fleshed/o) and return $trans;
1836
1837     my @resp;
1838     for my $t (@$trans) {
1839
1840         if( $t->xact_type ne 'circulation' ) {
1841             push @resp, {transaction => $t};
1842             next;
1843         }
1844
1845         my $circ_data = flesh_circ($e, $t->id);
1846         push @resp, {transaction => $t, %$circ_data};
1847     }
1848
1849     return \@resp;
1850 }
1851
1852
1853 __PACKAGE__->register_method(
1854     method   => "user_transaction_retrieve",
1855     api_name => "open-ils.actor.user.transaction.fleshed.retrieve",
1856     argc     => 1,
1857     authoritative => 1,
1858     notes    => "Returns a fleshed transaction record"
1859 );
1860
1861 __PACKAGE__->register_method(
1862     method   => "user_transaction_retrieve",
1863     api_name => "open-ils.actor.user.transaction.retrieve",
1864     argc     => 1,
1865     authoritative => 1,
1866     notes    => "Returns a transaction record"
1867 );
1868
1869 sub user_transaction_retrieve {
1870     my($self, $client, $auth, $bill_id) = @_;
1871
1872     my $e = new_editor(authtoken => $auth);
1873     return $e->event unless $e->checkauth;
1874
1875     my $trans = $e->retrieve_money_billable_transaction_summary(
1876         [$bill_id, {flesh => 1, flesh_fields => {mbts => ['usr']}}]) or return $e->event;
1877
1878     return $e->event unless $e->allowed('VIEW_USER_TRANSACTIONS', $trans->usr->home_ou);
1879
1880     $trans->usr($trans->usr->id); # de-flesh for backwards compat
1881
1882     return $trans unless $self->api_name =~ /flesh/;
1883     return {transaction => $trans} if $trans->xact_type ne 'circulation';
1884
1885     my $circ_data = flesh_circ($e, $trans->id, 1);
1886
1887     return {transaction => $trans, %$circ_data};
1888 }
1889
1890 sub flesh_circ {
1891     my $e = shift;
1892     my $circ_id = shift;
1893     my $flesh_copy = shift;
1894
1895     my $circ = $e->retrieve_action_circulation([
1896         $circ_id, {
1897             flesh => 3,
1898             flesh_fields => {
1899                 circ => ['target_copy'],
1900                 acp => ['call_number'],
1901                 acn => ['record']
1902             }
1903         }
1904     ]);
1905
1906     my $mods;
1907     my $copy = $circ->target_copy;
1908
1909     if($circ->target_copy->call_number->id == OILS_PRECAT_CALL_NUMBER) {
1910         $mods = new Fieldmapper::metabib::virtual_record;
1911         $mods->doc_id(OILS_PRECAT_RECORD);
1912         $mods->title($copy->dummy_title);
1913         $mods->author($copy->dummy_author);
1914
1915     } else {
1916         $mods = $U->record_to_mvr($circ->target_copy->call_number->record);
1917     }
1918
1919     # more de-fleshiing
1920     $circ->target_copy($circ->target_copy->id);
1921     $copy->call_number($copy->call_number->id);
1922
1923     return {circ => $circ, record => $mods, copy => ($flesh_copy) ? $copy : undef };
1924 }
1925
1926
1927 __PACKAGE__->register_method(
1928     method        => "hold_request_count",
1929     api_name      => "open-ils.actor.user.hold_requests.count",
1930     authoritative => 1,
1931     argc          => 1,
1932     notes         => 'Returns hold ready/total counts'
1933 );
1934
1935 sub hold_request_count {
1936     my( $self, $client, $authtoken, $user_id ) = @_;
1937     my $e = new_editor(authtoken => $authtoken);
1938     return $e->event unless $e->checkauth;
1939
1940     $user_id = $e->requestor->id unless defined $user_id;
1941
1942     if($e->requestor->id ne $user_id) {
1943         my $user = $e->retrieve_actor_user($user_id);
1944         return $e->event unless $e->allowed('VIEW_HOLD', $user->home_ou);
1945     }
1946
1947     my $holds = $e->json_query({
1948         select => {ahr => ['pickup_lib', 'current_shelf_lib']},
1949         from => 'ahr',
1950         where => {
1951             usr => $user_id,
1952             fulfillment_time => {"=" => undef },
1953             cancel_time => undef,
1954         }
1955     });
1956
1957     return {
1958         total => scalar(@$holds),
1959         ready => scalar(
1960             grep {
1961                 $_->{current_shelf_lib} and # avoid undef warnings
1962                 $_->{pickup_lib} eq $_->{current_shelf_lib}
1963             } @$holds
1964         )
1965     };
1966 }
1967
1968 __PACKAGE__->register_method(
1969     method        => "checked_out",
1970     api_name      => "open-ils.actor.user.checked_out",
1971     authoritative => 1,
1972     argc          => 2,
1973     signature     => {
1974         desc => "For a given user, returns a structure of circulations objects sorted by out, overdue, lost, claims_returned, long_overdue. "
1975               . "A list of IDs are returned of each type.  Circs marked lost, long_overdue, and claims_returned will not be 'finished' "
1976               . "(i.e., outstanding balance or some other pending action on the circ). "
1977               . "The .count method also includes a 'total' field which sums all open circs.",
1978         params => [
1979             { desc => 'Authentication Token', type => 'string'},
1980             { desc => 'User ID',              type => 'string'},
1981         ],
1982         return => {
1983             desc => 'Returns event on error, or an object with ID lists, like: '
1984                   . '{"out":[12552,451232], "claims_returned":[], "long_overdue":[23421] "overdue":[], "lost":[]}'
1985         },
1986     }
1987 );
1988
1989 __PACKAGE__->register_method(
1990     method        => "checked_out",
1991     api_name      => "open-ils.actor.user.checked_out.count",
1992     authoritative => 1,
1993     argc          => 2,
1994     signature     => q/@see open-ils.actor.user.checked_out/
1995 );
1996
1997 sub checked_out {
1998     my( $self, $conn, $auth, $userid ) = @_;
1999
2000     my $e = new_editor(authtoken=>$auth);
2001     return $e->event unless $e->checkauth;
2002
2003     if( $userid ne $e->requestor->id ) {
2004         my $user = $e->retrieve_actor_user($userid) or return $e->event;
2005         unless($e->allowed('VIEW_CIRCULATIONS', $user->home_ou)) {
2006
2007             # see if there is a friend link allowing circ.view perms
2008             my $allowed = OpenILS::Application::Actor::Friends->friend_perm_allowed(
2009                 $e, $userid, $e->requestor->id, 'circ.view');
2010             return $e->event unless $allowed;
2011         }
2012     }
2013
2014     my $count = $self->api_name =~ /count/;
2015     return _checked_out( $count, $e, $userid );
2016 }
2017
2018 sub _checked_out {
2019     my( $iscount, $e, $userid ) = @_;
2020
2021     my %result = (
2022         out => [],
2023         overdue => [],
2024         lost => [],
2025         claims_returned => [],
2026         long_overdue => []
2027     );
2028     my $meth = 'retrieve_action_open_circ_';
2029
2030     if ($iscount) {
2031         $meth .= 'count';
2032         %result = (
2033             out => 0,
2034             overdue => 0,
2035             lost => 0,
2036             claims_returned => 0,
2037             long_overdue => 0
2038         );
2039     } else {
2040         $meth .= 'list';
2041     }
2042
2043     my $data = $e->$meth($userid);
2044
2045     if ($data) {
2046         if ($iscount) {
2047             $result{$_} += $data->$_() for (keys %result);
2048             $result{total} += $data->$_() for (keys %result);
2049         } else {
2050             for my $k (keys %result) {
2051                 $result{$k} = [ grep { $_ > 0 } split( ',', $data->$k()) ];
2052             }
2053         }
2054     }
2055
2056     return \%result;
2057 }
2058
2059
2060
2061 __PACKAGE__->register_method(
2062     method        => "checked_in_with_fines",
2063     api_name      => "open-ils.actor.user.checked_in_with_fines",
2064     authoritative => 1,
2065     argc          => 2,
2066     signature     => q/@see open-ils.actor.user.checked_out/
2067 );
2068
2069 sub checked_in_with_fines {
2070     my( $self, $conn, $auth, $userid ) = @_;
2071
2072     my $e = new_editor(authtoken=>$auth);
2073     return $e->event unless $e->checkauth;
2074
2075     if( $userid ne $e->requestor->id ) {
2076         return $e->event unless $e->allowed('VIEW_CIRCULATIONS');
2077     }
2078
2079     # money is owed on these items and they are checked in
2080     my $open = $e->search_action_circulation(
2081         {
2082             usr             => $userid,
2083             xact_finish     => undef,
2084             checkin_time    => { "!=" => undef },
2085         }
2086     );
2087
2088
2089     my( @lost, @cr, @lo );
2090     for my $c (@$open) {
2091         push( @lost, $c->id ) if $c->stop_fines eq 'LOST';
2092         push( @cr, $c->id ) if $c->stop_fines eq 'CLAIMSRETURNED';
2093         push( @lo, $c->id ) if $c->stop_fines eq 'LONGOVERDUE';
2094     }
2095
2096     return {
2097         lost        => \@lost,
2098         claims_returned => \@cr,
2099         long_overdue        => \@lo
2100     };
2101 }
2102
2103
2104 sub _sigmaker {
2105     my ($api, $desc, $auth) = @_;
2106     $desc = $desc ? (" " . $desc) : '';
2107     my $ids = ($api =~ /ids$/) ? 1 : 0;
2108     my @sig = (
2109         argc      => 1,
2110         method    => "user_transaction_history",
2111         api_name  => "open-ils.actor.user.transactions.$api",
2112         signature => {
2113             desc   => "For a given User ID, returns a list of billable transaction" .
2114                       ($ids ? " id" : '') .
2115                       "s$desc, optionally filtered by type and/or fields in money.billable_xact_summary.  " .
2116                       "The VIEW_USER_TRANSACTIONS permission is required to view another user's transactions",
2117             params => [
2118                 {desc => 'Authentication token',        type => 'string'},
2119                 {desc => 'User ID',                     type => 'number'},
2120                 {desc => 'Transaction type (optional)', type => 'number'},
2121                 {desc => 'Hash of Billable Transaction Summary filters (optional)', type => 'object'}
2122             ],
2123             return => {
2124                 desc => 'List of transaction' . ($ids ? " id" : '') . 's, Event on error'
2125             },
2126         }
2127     );
2128     $auth and push @sig, (authoritative => 1);
2129     return @sig;
2130 }
2131
2132 my %auth_hist_methods = (
2133     'history'             => '',
2134     'history.have_charge' => 'that have an initial charge',
2135     'history.still_open'  => 'that are not finished',
2136     'history.have_balance'         => 'that have a balance',
2137     'history.have_bill'            => 'that have billings',
2138     'history.have_bill_or_payment' => 'that have non-zero-sum billings or at least 1 payment',
2139     'history.have_payment' => 'that have at least 1 payment',
2140 );
2141
2142 foreach (keys %auth_hist_methods) {
2143     __PACKAGE__->register_method(_sigmaker($_,       $auth_hist_methods{$_}, 1));
2144     __PACKAGE__->register_method(_sigmaker("$_.ids", $auth_hist_methods{$_}, 1));
2145     __PACKAGE__->register_method(_sigmaker("$_.fleshed", $auth_hist_methods{$_}, 1));
2146 }
2147
2148 sub user_transaction_history {
2149     my( $self, $conn, $auth, $userid, $type, $filter, $options ) = @_;
2150     $filter ||= {};
2151     $options ||= {};
2152
2153     my $e = new_editor(authtoken=>$auth);
2154     return $e->die_event unless $e->checkauth;
2155
2156     if ($e->requestor->id ne $userid) {
2157         return $e->die_event unless $e->allowed('VIEW_USER_TRANSACTIONS');
2158     }
2159
2160     my $api = $self->api_name;
2161     my @xact_finish  = (xact_finish => undef ) if ($api =~ /history\.still_open$/);     # What about history.still_open.ids?
2162
2163     if(defined($type)) {
2164         $filter->{'xact_type'} = $type;
2165     }
2166
2167     if($api =~ /have_bill_or_payment/o) {
2168
2169         # transactions that have a non-zero sum across all billings or at least 1 payment
2170         $filter->{'-or'} = {
2171             'balance_owed' => { '<>' => 0 },
2172             'last_payment_ts' => { '<>' => undef }
2173         };
2174
2175     } elsif($api =~ /have_payment/) {
2176
2177         $filter->{last_payment_ts} ||= {'<>' => undef};
2178
2179     } elsif( $api =~ /have_balance/o) {
2180
2181         # transactions that have a non-zero overall balance
2182         $filter->{'balance_owed'} = { '<>' => 0 };
2183
2184     } elsif( $api =~ /have_charge/o) {
2185
2186         # transactions that have at least 1 billing, regardless of whether it was voided
2187         $filter->{'last_billing_ts'} = { '<>' => undef };
2188
2189     } elsif( $api =~ /have_bill/o) {    # needs to be an elsif, or we double-match have_bill_or_payment!
2190
2191         # transactions that have non-zero sum across all billings.  This will exclude
2192         # xacts where all billings have been voided
2193         $filter->{'total_owed'} = { '<>' => 0 };
2194     }
2195
2196     my $options_clause = { order_by => { mbt => 'xact_start DESC' } };
2197     $options_clause->{'limit'} = $options->{'limit'} if $options->{'limit'};
2198     $options_clause->{'offset'} = $options->{'offset'} if $options->{'offset'};
2199
2200     my $mbts = $e->search_money_billable_transaction_summary(
2201         [   { usr => $userid, @xact_finish, %$filter },
2202             $options_clause
2203         ]
2204     );
2205
2206     return [map {$_->id} @$mbts] if $api =~ /\.ids/;
2207     return $mbts unless $api =~ /fleshed/;
2208
2209     my @resp;
2210     for my $t (@$mbts) {
2211
2212         if( $t->xact_type ne 'circulation' ) {
2213             push @resp, {transaction => $t};
2214             next;
2215         }
2216
2217         my $circ_data = flesh_circ($e, $t->id);
2218         push @resp, {transaction => $t, %$circ_data};
2219     }
2220
2221     return \@resp;
2222 }
2223
2224
2225
2226 __PACKAGE__->register_method(
2227     method   => "user_perms",
2228     api_name => "open-ils.actor.permissions.user_perms.retrieve",
2229     argc     => 1,
2230     notes    => "Returns a list of permissions"
2231 );
2232
2233 sub user_perms {
2234     my( $self, $client, $authtoken, $user ) = @_;
2235
2236     my( $staff, $evt ) = $apputils->checkses($authtoken);
2237     return $evt if $evt;
2238
2239     $user ||= $staff->id;
2240
2241     if( $user != $staff->id and $evt = $apputils->check_perms( $staff->id, $staff->home_ou, 'VIEW_PERMISSION') ) {
2242         return $evt;
2243     }
2244
2245     return $apputils->simple_scalar_request(
2246         "open-ils.storage",
2247         "open-ils.storage.permission.user_perms.atomic",
2248         $user);
2249 }
2250
2251 __PACKAGE__->register_method(
2252     method   => "retrieve_perms",
2253     api_name => "open-ils.actor.permissions.retrieve",
2254     notes    => "Returns a list of permissions"
2255 );
2256 sub retrieve_perms {
2257     my( $self, $client ) = @_;
2258     return $apputils->simple_scalar_request(
2259         "open-ils.cstore",
2260         "open-ils.cstore.direct.permission.perm_list.search.atomic",
2261         { id => { '!=' => undef } }
2262     );
2263 }
2264
2265 __PACKAGE__->register_method(
2266     method   => "retrieve_groups",
2267     api_name => "open-ils.actor.groups.retrieve",
2268     notes    => "Returns a list of user groups"
2269 );
2270 sub retrieve_groups {
2271     my( $self, $client ) = @_;
2272     return new_editor()->retrieve_all_permission_grp_tree();
2273 }
2274
2275 __PACKAGE__->register_method(
2276     method  => "retrieve_org_address",
2277     api_name    => "open-ils.actor.org_unit.address.retrieve",
2278     notes        => <<'    NOTES');
2279     Returns an org_unit address by ID
2280     @param An org_address ID
2281     NOTES
2282 sub retrieve_org_address {
2283     my( $self, $client, $id ) = @_;
2284     return $apputils->simple_scalar_request(
2285         "open-ils.cstore",
2286         "open-ils.cstore.direct.actor.org_address.retrieve",
2287         $id
2288     );
2289 }
2290
2291 __PACKAGE__->register_method(
2292     method   => "retrieve_groups_tree",
2293     api_name => "open-ils.actor.groups.tree.retrieve",
2294     notes    => "Returns a list of user groups"
2295 );
2296
2297 sub retrieve_groups_tree {
2298     my( $self, $client ) = @_;
2299     return new_editor()->search_permission_grp_tree(
2300         [
2301             { parent => undef},
2302             {
2303                 flesh               => -1,
2304                 flesh_fields    => { pgt => ["children"] },
2305                 order_by            => { pgt => 'name'}
2306             }
2307         ]
2308     )->[0];
2309 }
2310
2311
2312 __PACKAGE__->register_method(
2313     method   => "add_user_to_groups",
2314     api_name => "open-ils.actor.user.set_groups",
2315     notes    => "Adds a user to one or more permission groups"
2316 );
2317
2318 sub add_user_to_groups {
2319     my( $self, $client, $authtoken, $userid, $groups ) = @_;
2320
2321     my( $requestor, $target, $evt ) = $apputils->checkses_requestor(
2322         $authtoken, $userid, 'CREATE_USER_GROUP_LINK' );
2323     return $evt if $evt;
2324
2325     ( $requestor, $target, $evt ) = $apputils->checkses_requestor(
2326         $authtoken, $userid, 'REMOVE_USER_GROUP_LINK' );
2327     return $evt if $evt;
2328
2329     $apputils->simplereq(
2330         'open-ils.storage',
2331         'open-ils.storage.direct.permission.usr_grp_map.mass_delete', { usr => $userid } );
2332
2333     for my $group (@$groups) {
2334         my $link = Fieldmapper::permission::usr_grp_map->new;
2335         $link->grp($group);
2336         $link->usr($userid);
2337
2338         my $id = $apputils->simplereq(
2339             'open-ils.storage',
2340             'open-ils.storage.direct.permission.usr_grp_map.create', $link );
2341     }
2342
2343     return 1;
2344 }
2345
2346 __PACKAGE__->register_method(
2347     method   => "get_user_perm_groups",
2348     api_name => "open-ils.actor.user.get_groups",
2349     notes    => "Retrieve a user's permission groups."
2350 );
2351
2352
2353 sub get_user_perm_groups {
2354     my( $self, $client, $authtoken, $userid ) = @_;
2355
2356     my( $requestor, $target, $evt ) = $apputils->checkses_requestor(
2357         $authtoken, $userid, 'VIEW_PERM_GROUPS' );
2358     return $evt if $evt;
2359
2360     return $apputils->simplereq(
2361         'open-ils.cstore',
2362         'open-ils.cstore.direct.permission.usr_grp_map.search.atomic', { usr => $userid } );
2363 }
2364
2365
2366 __PACKAGE__->register_method(
2367     method   => "get_user_work_ous",
2368     api_name => "open-ils.actor.user.get_work_ous",
2369     notes    => "Retrieve a user's work org units."
2370 );
2371
2372 __PACKAGE__->register_method(
2373     method   => "get_user_work_ous",
2374     api_name => "open-ils.actor.user.get_work_ous.ids",
2375     notes    => "Retrieve a user's work org units."
2376 );
2377
2378 sub get_user_work_ous {
2379     my( $self, $client, $auth, $userid ) = @_;
2380     my $e = new_editor(authtoken=>$auth);
2381     return $e->event unless $e->checkauth;
2382     $userid ||= $e->requestor->id;
2383
2384     if($e->requestor->id != $userid) {
2385         my $user = $e->retrieve_actor_user($userid)
2386             or return $e->event;
2387         return $e->event unless $e->allowed('ASSIGN_WORK_ORG_UNIT', $user->home_ou);
2388     }
2389
2390     return $e->search_permission_usr_work_ou_map({usr => $userid})
2391         unless $self->api_name =~ /.ids$/;
2392
2393     # client just wants a list of org IDs
2394     return $U->get_user_work_ou_ids($e, $userid);
2395 }
2396
2397
2398
2399 __PACKAGE__->register_method(
2400     method    => 'register_workstation',
2401     api_name  => 'open-ils.actor.workstation.register.override',
2402     signature => q/@see open-ils.actor.workstation.register/
2403 );
2404
2405 __PACKAGE__->register_method(
2406     method    => 'register_workstation',
2407     api_name  => 'open-ils.actor.workstation.register',
2408     signature => q/
2409         Registers a new workstion in the system
2410         @param authtoken The login session key
2411         @param name The name of the workstation id
2412         @param owner The org unit that owns this workstation
2413         @return The workstation id on success, WORKSTATION_NAME_EXISTS
2414         if the name is already in use.
2415     /
2416 );
2417
2418 sub register_workstation {
2419     my( $self, $conn, $authtoken, $name, $owner, $oargs ) = @_;
2420
2421     my $e = new_editor(authtoken=>$authtoken, xact=>1);
2422     return $e->die_event unless $e->checkauth;
2423     return $e->die_event unless $e->allowed('REGISTER_WORKSTATION', $owner);
2424     my $existing = $e->search_actor_workstation({name => $name})->[0];
2425     $oargs = { all => 1 } unless defined $oargs;
2426
2427     if( $existing ) {
2428
2429         if( $self->api_name =~ /override/o && ($oargs->{all} || grep { $_ eq 'WORKSTATION_NAME_EXISTS' } @{$oargs->{events}}) ) {
2430             # workstation with the given name exists.
2431
2432             if($owner ne $existing->owning_lib) {
2433                 # if necessary, update the owning_lib of the workstation
2434
2435                 $logger->info("changing owning lib of workstation ".$existing->id.
2436                     " from ".$existing->owning_lib." to $owner");
2437                 return $e->die_event unless
2438                     $e->allowed('UPDATE_WORKSTATION', $existing->owning_lib);
2439
2440                 return $e->die_event unless $e->allowed('UPDATE_WORKSTATION', $owner);
2441
2442                 $existing->owning_lib($owner);
2443                 return $e->die_event unless $e->update_actor_workstation($existing);
2444
2445                 $e->commit;
2446
2447             } else {
2448                 $logger->info(
2449                     "attempt to register an existing workstation.  returning existing ID");
2450             }
2451
2452             return $existing->id;
2453
2454         } else {
2455             return OpenILS::Event->new('WORKSTATION_NAME_EXISTS')
2456         }
2457     }
2458
2459     my $ws = Fieldmapper::actor::workstation->new;
2460     $ws->owning_lib($owner);
2461     $ws->name($name);
2462     $e->create_actor_workstation($ws) or return $e->die_event;
2463     $e->commit;
2464     return $ws->id; # note: editor sets the id on the new object for us
2465 }
2466
2467 __PACKAGE__->register_method(
2468     method    => 'workstation_list',
2469     api_name  => 'open-ils.actor.workstation.list',
2470     signature => q/
2471         Returns a list of workstations registered at the given location
2472         @param authtoken The login session key
2473         @param ids A list of org_unit.id's for the workstation owners
2474     /
2475 );
2476
2477 sub workstation_list {
2478     my( $self, $conn, $authtoken, @orgs ) = @_;
2479
2480     my $e = new_editor(authtoken=>$authtoken);
2481     return $e->event unless $e->checkauth;
2482     my %results;
2483
2484     for my $o (@orgs) {
2485         return $e->event
2486             unless $e->allowed('REGISTER_WORKSTATION', $o);
2487         $results{$o} = $e->search_actor_workstation({owning_lib=>$o});
2488     }
2489     return \%results;
2490 }
2491
2492
2493 __PACKAGE__->register_method(
2494     method        => 'fetch_patron_note',
2495     api_name      => 'open-ils.actor.note.retrieve.all',
2496     authoritative => 1,
2497     signature     => q/
2498         Returns a list of notes for a given user
2499         Requestor must have VIEW_USER permission if pub==false and
2500         @param authtoken The login session key
2501         @param args Hash of params including
2502             patronid : the patron's id
2503             pub : true if retrieving only public notes
2504     /
2505 );
2506
2507 sub fetch_patron_note {
2508     my( $self, $conn, $authtoken, $args ) = @_;
2509     my $patronid = $$args{patronid};
2510
2511     my($reqr, $evt) = $U->checkses($authtoken);
2512     return $evt if $evt;
2513
2514     my $patron;
2515     ($patron, $evt) = $U->fetch_user($patronid);
2516     return $evt if $evt;
2517
2518     if($$args{pub}) {
2519         if( $patronid ne $reqr->id ) {
2520             $evt = $U->check_perms($reqr->id, $patron->home_ou, 'VIEW_USER');
2521             return $evt if $evt;
2522         }
2523         return $U->cstorereq(
2524             'open-ils.cstore.direct.actor.usr_note.search.atomic',
2525             { usr => $patronid, pub => 't' } );
2526     }
2527
2528     $evt = $U->check_perms($reqr->id, $patron->home_ou, 'VIEW_USER');
2529     return $evt if $evt;
2530
2531     return $U->cstorereq(
2532         'open-ils.cstore.direct.actor.usr_note.search.atomic', { usr => $patronid } );
2533 }
2534
2535 __PACKAGE__->register_method(
2536     method    => 'create_user_note',
2537     api_name  => 'open-ils.actor.note.create',
2538     signature => q/
2539         Creates a new note for the given user
2540         @param authtoken The login session key
2541         @param note The note object
2542     /
2543 );
2544 sub create_user_note {
2545     my( $self, $conn, $authtoken, $note ) = @_;
2546     my $e = new_editor(xact=>1, authtoken=>$authtoken);
2547     return $e->die_event unless $e->checkauth;
2548
2549     my $user = $e->retrieve_actor_user($note->usr)
2550         or return $e->die_event;
2551
2552     return $e->die_event unless
2553         $e->allowed('UPDATE_USER',$user->home_ou);
2554
2555     $note->creator($e->requestor->id);
2556     $e->create_actor_usr_note($note) or return $e->die_event;
2557     $e->commit;
2558     return $note->id;
2559 }
2560
2561
2562 __PACKAGE__->register_method(
2563     method    => 'delete_user_note',
2564     api_name  => 'open-ils.actor.note.delete',
2565     signature => q/
2566         Deletes a note for the given user
2567         @param authtoken The login session key
2568         @param noteid The note id
2569     /
2570 );
2571 sub delete_user_note {
2572     my( $self, $conn, $authtoken, $noteid ) = @_;
2573
2574     my $e = new_editor(xact=>1, authtoken=>$authtoken);
2575     return $e->die_event unless $e->checkauth;
2576     my $note = $e->retrieve_actor_usr_note($noteid)
2577         or return $e->die_event;
2578     my $user = $e->retrieve_actor_user($note->usr)
2579         or return $e->die_event;
2580     return $e->die_event unless
2581         $e->allowed('UPDATE_USER', $user->home_ou);
2582
2583     $e->delete_actor_usr_note($note) or return $e->die_event;
2584     $e->commit;
2585     return 1;
2586 }
2587
2588
2589 __PACKAGE__->register_method(
2590     method    => 'update_user_note',
2591     api_name  => 'open-ils.actor.note.update',
2592     signature => q/
2593         @param authtoken The login session key
2594         @param note The note
2595     /
2596 );
2597
2598 sub update_user_note {
2599     my( $self, $conn, $auth, $note ) = @_;
2600     my $e = new_editor(authtoken=>$auth, xact=>1);
2601     return $e->die_event unless $e->checkauth;
2602     my $patron = $e->retrieve_actor_user($note->usr)
2603         or return $e->die_event;
2604     return $e->die_event unless
2605         $e->allowed('UPDATE_USER', $patron->home_ou);
2606     $e->update_actor_user_note($note)
2607         or return $e->die_event;
2608     $e->commit;
2609     return 1;
2610 }
2611
2612
2613
2614 __PACKAGE__->register_method(
2615     method    => 'create_closed_date',
2616     api_name  => 'open-ils.actor.org_unit.closed_date.create',
2617     signature => q/
2618         Creates a new closing entry for the given org_unit
2619         @param authtoken The login session key
2620         @param note The closed_date object
2621     /
2622 );
2623 sub create_closed_date {
2624     my( $self, $conn, $authtoken, $cd ) = @_;
2625
2626     my( $user, $evt ) = $U->checkses($authtoken);
2627     return $evt if $evt;
2628
2629     $evt = $U->check_perms($user->id, $cd->org_unit, 'CREATE_CLOSEING');
2630     return $evt if $evt;
2631
2632     $logger->activity("user ".$user->id." creating library closing for ".$cd->org_unit);
2633
2634     my $id = $U->storagereq(
2635         'open-ils.storage.direct.actor.org_unit.closed_date.create', $cd );
2636     return $U->DB_UPDATE_FAILED($cd) unless $id;
2637     return $id;
2638 }
2639
2640
2641 __PACKAGE__->register_method(
2642     method    => 'delete_closed_date',
2643     api_name  => 'open-ils.actor.org_unit.closed_date.delete',
2644     signature => q/
2645         Deletes a closing entry for the given org_unit
2646         @param authtoken The login session key
2647         @param noteid The close_date id
2648     /
2649 );
2650 sub delete_closed_date {
2651     my( $self, $conn, $authtoken, $cd ) = @_;
2652
2653     my( $user, $evt ) = $U->checkses($authtoken);
2654     return $evt if $evt;
2655
2656     my $cd_obj;
2657     ($cd_obj, $evt) = fetch_closed_date($cd);
2658     return $evt if $evt;
2659
2660     $evt = $U->check_perms($user->id, $cd->org_unit, 'DELETE_CLOSEING');
2661     return $evt if $evt;
2662
2663     $logger->activity("user ".$user->id." deleting library closing for ".$cd->org_unit);
2664
2665     my $stat = $U->storagereq(
2666         'open-ils.storage.direct.actor.org_unit.closed_date.delete', $cd );
2667     return $U->DB_UPDATE_FAILED($cd) unless $stat;
2668     return $stat;
2669 }
2670
2671
2672 __PACKAGE__->register_method(
2673     method    => 'usrname_exists',
2674     api_name  => 'open-ils.actor.username.exists',
2675     signature => {
2676         desc  => 'Check if a username is already taken (by an undeleted patron)',
2677         param => [
2678             {desc => 'Authentication token', type => 'string'},
2679             {desc => 'Username',             type => 'string'}
2680         ],
2681         return => {
2682             desc => 'id of existing user if username exists, undef otherwise.  Event on error'
2683         },
2684     }
2685 );
2686
2687 sub usrname_exists {
2688     my( $self, $conn, $auth, $usrname ) = @_;
2689     my $e = new_editor(authtoken=>$auth);
2690     return $e->event unless $e->checkauth;
2691     my $a = $e->search_actor_user({usrname => $usrname}, {idlist=>1});
2692     return $$a[0] if $a and @$a;
2693     return undef;
2694 }
2695
2696 __PACKAGE__->register_method(
2697     method        => 'barcode_exists',
2698     api_name      => 'open-ils.actor.barcode.exists',
2699     authoritative => 1,
2700     signature     => 'Returns 1 if the requested barcode exists, returns 0 otherwise'
2701 );
2702
2703 sub barcode_exists {
2704     my( $self, $conn, $auth, $barcode ) = @_;
2705     my $e = new_editor(authtoken=>$auth);
2706     return $e->event unless $e->checkauth;
2707     my $card = $e->search_actor_card({barcode => $barcode});
2708     if (@$card) {
2709         return 1;
2710     } else {
2711         return 0;
2712     }
2713     #return undef unless @$card;
2714     #return $card->[0]->usr;
2715 }
2716
2717
2718 __PACKAGE__->register_method(
2719     method   => 'retrieve_net_levels',
2720     api_name => 'open-ils.actor.net_access_level.retrieve.all',
2721 );
2722
2723 sub retrieve_net_levels {
2724     my( $self, $conn, $auth ) = @_;
2725     my $e = new_editor(authtoken=>$auth);
2726     return $e->event unless $e->checkauth;
2727     return $e->retrieve_all_config_net_access_level();
2728 }
2729
2730 # Retain the old typo API name just in case
2731 __PACKAGE__->register_method(
2732     method   => 'fetch_org_by_shortname',
2733     api_name => 'open-ils.actor.org_unit.retrieve_by_shorname',
2734 );
2735 __PACKAGE__->register_method(
2736     method   => 'fetch_org_by_shortname',
2737     api_name => 'open-ils.actor.org_unit.retrieve_by_shortname',
2738 );
2739 sub fetch_org_by_shortname {
2740     my( $self, $conn, $sname ) = @_;
2741     my $e = new_editor();
2742     my $org = $e->search_actor_org_unit({ shortname => uc($sname)})->[0];
2743     return $e->event unless $org;
2744     return $org;
2745 }
2746
2747
2748 __PACKAGE__->register_method(
2749     method   => 'session_home_lib',
2750     api_name => 'open-ils.actor.session.home_lib',
2751 );
2752
2753 sub session_home_lib {
2754     my( $self, $conn, $auth ) = @_;
2755     my $e = new_editor(authtoken=>$auth);
2756     return undef unless $e->checkauth;
2757     my $org = $e->retrieve_actor_org_unit($e->requestor->home_ou);
2758     return $org->shortname;
2759 }
2760
2761 __PACKAGE__->register_method(
2762     method    => 'session_safe_token',
2763     api_name  => 'open-ils.actor.session.safe_token',
2764     signature => q/
2765         Returns a hashed session ID that is safe for export to the world.
2766         This safe token will expire after 1 hour of non-use.
2767         @param auth Active authentication token
2768     /
2769 );
2770
2771 sub session_safe_token {
2772     my( $self, $conn, $auth ) = @_;
2773     my $e = new_editor(authtoken=>$auth);
2774     return undef unless $e->checkauth;
2775
2776     my $safe_token = md5_hex($auth);
2777
2778     $cache ||= OpenSRF::Utils::Cache->new("global", 0);
2779
2780     # Add more like the following if needed...
2781     $cache->put_cache(
2782         "safe-token-home_lib-shortname-$safe_token",
2783         $e->retrieve_actor_org_unit(
2784             $e->requestor->home_ou
2785         )->shortname,
2786         60 * 60
2787     );
2788
2789     return $safe_token;
2790 }
2791
2792
2793 __PACKAGE__->register_method(
2794     method    => 'safe_token_home_lib',
2795     api_name  => 'open-ils.actor.safe_token.home_lib.shortname',
2796     signature => q/
2797         Returns the home library shortname from the session
2798         asscociated with a safe token from generated by
2799         open-ils.actor.session.safe_token.
2800         @param safe_token Active safe token
2801     /
2802 );
2803
2804 sub safe_token_home_lib {
2805     my( $self, $conn, $safe_token ) = @_;
2806
2807     $cache ||= OpenSRF::Utils::Cache->new("global", 0);
2808     return $cache->get_cache( 'safe-token-home_lib-shortname-'. $safe_token );
2809 }
2810
2811
2812 __PACKAGE__->register_method(
2813     method   => "update_penalties",
2814     api_name => "open-ils.actor.user.penalties.update"
2815 );
2816
2817 sub update_penalties {
2818     my($self, $conn, $auth, $user_id) = @_;
2819     my $e = new_editor(authtoken=>$auth, xact => 1);
2820     return $e->die_event unless $e->checkauth;
2821     my $user = $e->retrieve_actor_user($user_id) or return $e->die_event;
2822     return $e->die_event unless $e->allowed('UPDATE_USER', $user->home_ou);
2823     my $evt = OpenILS::Utils::Penalty->calculate_penalties($e, $user_id, $e->requestor->ws_ou);
2824     return $evt if $evt;
2825     $e->commit;
2826     return 1;
2827 }
2828
2829
2830 __PACKAGE__->register_method(
2831     method   => "apply_penalty",
2832     api_name => "open-ils.actor.user.penalty.apply"
2833 );
2834
2835 sub apply_penalty {
2836     my($self, $conn, $auth, $penalty) = @_;
2837
2838     my $e = new_editor(authtoken=>$auth, xact => 1);
2839     return $e->die_event unless $e->checkauth;
2840
2841     my $user = $e->retrieve_actor_user($penalty->usr) or return $e->die_event;
2842     return $e->die_event unless $e->allowed('UPDATE_USER', $user->home_ou);
2843
2844     my $ptype = $e->retrieve_config_standing_penalty($penalty->standing_penalty) or return $e->die_event;
2845
2846     my $ctx_org =
2847         (defined $ptype->org_depth) ?
2848         $U->org_unit_ancestor_at_depth($penalty->org_unit, $ptype->org_depth) :
2849         $penalty->org_unit;
2850
2851     $penalty->org_unit($ctx_org);
2852     $penalty->staff($e->requestor->id);
2853     $e->create_actor_user_standing_penalty($penalty) or return $e->die_event;
2854
2855     $e->commit;
2856     return $penalty->id;
2857 }
2858
2859 __PACKAGE__->register_method(
2860     method   => "remove_penalty",
2861     api_name => "open-ils.actor.user.penalty.remove"
2862 );
2863
2864 sub remove_penalty {
2865     my($self, $conn, $auth, $penalty) = @_;
2866     my $e = new_editor(authtoken=>$auth, xact => 1);
2867     return $e->die_event unless $e->checkauth;
2868     my $user = $e->retrieve_actor_user($penalty->usr) or return $e->die_event;
2869     return $e->die_event unless $e->allowed('UPDATE_USER', $user->home_ou);
2870
2871     $e->delete_actor_user_standing_penalty($penalty) or return $e->die_event;
2872     $e->commit;
2873     return 1;
2874 }
2875
2876 __PACKAGE__->register_method(
2877     method   => "update_penalty_note",
2878     api_name => "open-ils.actor.user.penalty.note.update"
2879 );
2880
2881 sub update_penalty_note {
2882     my($self, $conn, $auth, $penalty_ids, $note) = @_;
2883     my $e = new_editor(authtoken=>$auth, xact => 1);
2884     return $e->die_event unless $e->checkauth;
2885     for my $penalty_id (@$penalty_ids) {
2886         my $penalty = $e->search_actor_user_standing_penalty( { id => $penalty_id } )->[0];
2887         if (! $penalty ) { return $e->die_event; }
2888         my $user = $e->retrieve_actor_user($penalty->usr) or return $e->die_event;
2889         return $e->die_event unless $e->allowed('UPDATE_USER', $user->home_ou);
2890
2891         $penalty->note( $note ); $penalty->ischanged( 1 );
2892
2893         $e->update_actor_user_standing_penalty($penalty) or return $e->die_event;
2894     }
2895     $e->commit;
2896     return 1;
2897 }
2898
2899 __PACKAGE__->register_method(
2900     method   => "ranged_penalty_thresholds",
2901     api_name => "open-ils.actor.grp_penalty_threshold.ranged.retrieve",
2902     stream   => 1
2903 );
2904
2905 sub ranged_penalty_thresholds {
2906     my($self, $conn, $auth, $context_org) = @_;
2907     my $e = new_editor(authtoken=>$auth);
2908     return $e->event unless $e->checkauth;
2909     return $e->event unless $e->allowed('VIEW_GROUP_PENALTY_THRESHOLD', $context_org);
2910     my $list = $e->search_permission_grp_penalty_threshold([
2911         {org_unit => $U->get_org_ancestors($context_org)},
2912         {order_by => {pgpt => 'id'}}
2913     ]);
2914     $conn->respond($_) for @$list;
2915     return undef;
2916 }
2917
2918
2919
2920 __PACKAGE__->register_method(
2921     method        => "user_retrieve_fleshed_by_id",
2922     authoritative => 1,
2923     api_name      => "open-ils.actor.user.fleshed.retrieve",
2924 );
2925
2926 sub user_retrieve_fleshed_by_id {
2927     my( $self, $client, $auth, $user_id, $fields ) = @_;
2928     my $e = new_editor(authtoken => $auth);
2929     return $e->event unless $e->checkauth;
2930
2931     if( $e->requestor->id != $user_id ) {
2932         return $e->event unless $e->allowed('VIEW_USER');
2933     }
2934
2935     $fields ||= [
2936         "cards",
2937         "card",
2938         "standing_penalties",
2939         "addresses",
2940         "billing_address",
2941         "mailing_address",
2942         "stat_cat_entries",
2943         "usr_activity" ];
2944     return new_flesh_user($user_id, $fields, $e);
2945 }
2946
2947
2948 sub new_flesh_user {
2949
2950     my $id = shift;
2951     my $fields = shift || [];
2952     my $e = shift;
2953
2954     my $fetch_penalties = 0;
2955     if(grep {$_ eq 'standing_penalties'} @$fields) {
2956         $fields = [grep {$_ ne 'standing_penalties'} @$fields];
2957         $fetch_penalties = 1;
2958     }
2959
2960     my $fetch_usr_act = 0;
2961     if(grep {$_ eq 'usr_activity'} @$fields) {
2962         $fields = [grep {$_ ne 'usr_activity'} @$fields];
2963         $fetch_usr_act = 1;
2964     }
2965
2966     my $user = $e->retrieve_actor_user(
2967     [
2968         $id,
2969         {
2970             "flesh"             => 1,
2971             "flesh_fields" =>  { "au" => $fields }
2972         }
2973     ]
2974     ) or return $e->die_event;
2975
2976
2977     if( grep { $_ eq 'addresses' } @$fields ) {
2978
2979         $user->addresses([]) unless @{$user->addresses};
2980         # don't expose "replaced" addresses by default
2981         $user->addresses([grep {$_->id >= 0} @{$user->addresses}]);
2982
2983         if( ref $user->billing_address ) {
2984             unless( grep { $user->billing_address->id == $_->id } @{$user->addresses} ) {
2985                 push( @{$user->addresses}, $user->billing_address );
2986             }
2987         }
2988
2989         if( ref $user->mailing_address ) {
2990             unless( grep { $user->mailing_address->id == $_->id } @{$user->addresses} ) {
2991                 push( @{$user->addresses}, $user->mailing_address );
2992             }
2993         }
2994     }
2995
2996     if($fetch_penalties) {
2997         # grab the user penalties ranged for this location
2998         $user->standing_penalties(
2999             $e->search_actor_user_standing_penalty([
3000                 {   usr => $id,
3001                     '-or' => [
3002                         {stop_date => undef},
3003                         {stop_date => {'>' => 'now'}}
3004                     ],
3005                     org_unit => $U->get_org_full_path($e->requestor->ws_ou)
3006                 },
3007                 {   flesh => 1,
3008                     flesh_fields => {ausp => ['standing_penalty']}
3009                 }
3010             ])
3011         );
3012     }
3013
3014     # retrieve the most recent usr_activity entry
3015     if ($fetch_usr_act) {
3016
3017         # max number to return for simple patron fleshing
3018         my $limit = $U->ou_ancestor_setting_value(
3019             $e->requestor->ws_ou,
3020             'circ.patron.usr_activity_retrieve.max');
3021
3022         my $opts = {
3023             flesh => 1,
3024             flesh_fields => {auact => ['etype']},
3025             order_by => {auact => 'event_time DESC'},
3026         };
3027
3028         # 0 == none, <0 == return all
3029         $limit = 1 unless defined $limit;
3030         $opts->{limit} = $limit if $limit > 0;
3031
3032         $user->usr_activity(
3033             ($limit == 0) ?
3034                 [] : # skip the DB call
3035                 $e->search_actor_usr_activity([{usr => $user->id}, $opts])
3036         );
3037     }
3038
3039     $e->rollback;
3040     $user->clear_passwd();
3041     return $user;
3042 }
3043
3044
3045
3046
3047 __PACKAGE__->register_method(
3048     method   => "user_retrieve_parts",
3049     api_name => "open-ils.actor.user.retrieve.parts",
3050 );
3051
3052 sub user_retrieve_parts {
3053     my( $self, $client, $auth, $user_id, $fields ) = @_;
3054     my $e = new_editor(authtoken => $auth);
3055     return $e->event unless $e->checkauth;
3056     $user_id ||= $e->requestor->id;
3057     if( $e->requestor->id != $user_id ) {
3058         return $e->event unless $e->allowed('VIEW_USER');
3059     }
3060     my @resp;
3061     my $user = $e->retrieve_actor_user($user_id) or return $e->event;
3062     push(@resp, $user->$_()) for(@$fields);
3063     return \@resp;
3064 }
3065
3066
3067
3068 __PACKAGE__->register_method(
3069     method    => 'user_opt_in_enabled',
3070     api_name  => 'open-ils.actor.user.org_unit_opt_in.enabled',
3071     signature => '@return 1 if user opt-in is globally enabled, 0 otherwise.'
3072 );
3073
3074 sub user_opt_in_enabled {
3075     my($self, $conn) = @_;
3076     my $sc = OpenSRF::Utils::SettingsClient->new;
3077     return 1 if lc($sc->config_value(share => user => 'opt_in')) eq 'true';
3078     return 0;
3079 }
3080
3081
3082 __PACKAGE__->register_method(
3083     method    => 'user_opt_in_at_org',
3084     api_name  => 'open-ils.actor.user.org_unit_opt_in.check',
3085     signature => q/
3086         @param $auth The auth token
3087         @param user_id The ID of the user to test
3088         @return 1 if the user has opted in at the specified org,
3089             event on error, and 0 otherwise. /
3090 );
3091 sub user_opt_in_at_org {
3092     my($self, $conn, $auth, $user_id) = @_;
3093
3094     # see if we even need to enforce the opt-in value
3095     return 1 unless user_opt_in_enabled($self);
3096
3097     my $e = new_editor(authtoken => $auth);
3098     return $e->event unless $e->checkauth;
3099
3100     my $user = $e->retrieve_actor_user($user_id) or return $e->event;
3101     return $e->event unless $e->allowed('VIEW_USER', $user->home_ou);
3102
3103     my $ws_org = $e->requestor->ws_ou;
3104     # user is automatically opted-in if they are from the local org
3105     return 1 if $user->home_ou eq $ws_org;
3106
3107     # get the boundary setting
3108     my $opt_boundary = $U->ou_ancestor_setting_value($e->requestor->ws_ou,'org.patron_opt_boundary');
3109
3110     # auto opt in if user falls within the opt boundary
3111     my $opt_orgs = $U->get_org_descendants($ws_org, $opt_boundary);
3112
3113     return 1 if grep $_ eq $user->home_ou, @$opt_orgs;
3114
3115     my $vals = $e->search_actor_usr_org_unit_opt_in(
3116         {org_unit=>$opt_orgs, usr=>$user_id},{idlist=>1});
3117
3118     return 1 if @$vals;
3119     return 0;
3120 }
3121
3122 __PACKAGE__->register_method(
3123     method    => 'create_user_opt_in_at_org',
3124     api_name  => 'open-ils.actor.user.org_unit_opt_in.create',
3125     signature => q/
3126         @param $auth The auth token
3127         @param user_id The ID of the user to test
3128         @return The ID of the newly created object, event on error./
3129 );
3130
3131 sub create_user_opt_in_at_org {
3132     my($self, $conn, $auth, $user_id, $org_id) = @_;
3133
3134     my $e = new_editor(authtoken => $auth, xact=>1);
3135     return $e->die_event unless $e->checkauth;
3136
3137     # if a specific org unit wasn't passed in, get one based on the defaults;
3138     if(!$org_id){
3139         my $wsou = $e->requestor->ws_ou;
3140         # get the default opt depth
3141         my $opt_depth = $U->ou_ancestor_setting_value($wsou,'org.patron_opt_default');
3142         # get the org unit at that depth
3143         my $org = $e->json_query({
3144             from => [ 'actor.org_unit_ancestor_at_depth', $wsou, $opt_depth ]})->[0];
3145         $org_id = $org->{id};
3146     }
3147     if (!$org_id) {
3148         # fall back to the workstation OU, the pre-opt-in-boundary way
3149         $org_id = $e->requestor->ws_ou;
3150     }
3151
3152     my $user = $e->retrieve_actor_user($user_id) or return $e->die_event;
3153     return $e->die_event unless $e->allowed('UPDATE_USER', $user->home_ou);
3154
3155     my $opt_in = Fieldmapper::actor::usr_org_unit_opt_in->new;
3156
3157     $opt_in->org_unit($org_id);
3158     $opt_in->usr($user_id);
3159     $opt_in->staff($e->requestor->id);
3160     $opt_in->opt_in_ts('now');
3161     $opt_in->opt_in_ws($e->requestor->wsid);
3162
3163     $opt_in = $e->create_actor_usr_org_unit_opt_in($opt_in)
3164         or return $e->die_event;
3165
3166     $e->commit;
3167
3168     return $opt_in->id;
3169 }
3170
3171
3172 __PACKAGE__->register_method (
3173     method      => 'retrieve_org_hours',
3174     api_name    => 'open-ils.actor.org_unit.hours_of_operation.retrieve',
3175     signature   => q/
3176         Returns the hours of operation for a specified org unit
3177         @param authtoken The login session key
3178         @param org_id The org_unit ID
3179     /
3180 );
3181
3182 sub retrieve_org_hours {
3183     my($self, $conn, $auth, $org_id) = @_;
3184     my $e = new_editor(authtoken => $auth);
3185     return $e->die_event unless $e->checkauth;
3186     $org_id ||= $e->requestor->ws_ou;
3187     return $e->retrieve_actor_org_unit_hours_of_operation($org_id);
3188 }
3189
3190
3191 __PACKAGE__->register_method (
3192     method      => 'verify_user_password',
3193     api_name    => 'open-ils.actor.verify_user_password',
3194     signature   => q/
3195         Given a barcode or username and the MD5 encoded password,
3196         returns 1 if the password is correct.  Returns 0 otherwise.
3197     /
3198 );
3199
3200 sub verify_user_password {
3201     my($self, $conn, $auth, $barcode, $username, $password) = @_;
3202     my $e = new_editor(authtoken => $auth);
3203     return $e->die_event unless $e->checkauth;
3204     my $user;
3205     my $user_by_barcode;
3206     my $user_by_username;
3207     if($barcode) {
3208         my $card = $e->search_actor_card([
3209             {barcode => $barcode},
3210             {flesh => 1, flesh_fields => {ac => ['usr']}}])->[0] or return 0;
3211         $user_by_barcode = $card->usr;
3212         $user = $user_by_barcode;
3213     }
3214     if ($username) {
3215         $user_by_username = $e->search_actor_user({usrname => $username})->[0] or return 0;
3216         $user = $user_by_username;
3217     }
3218     return 0 if (!$user);
3219     return 0 if ($user_by_username && $user_by_barcode && $user_by_username->id != $user_by_barcode->id);
3220     return $e->event unless $e->allowed('VIEW_USER', $user->home_ou);
3221     return 1 if $user->passwd eq $password;
3222     return 0;
3223 }
3224
3225 __PACKAGE__->register_method (
3226     method      => 'retrieve_usr_id_via_barcode_or_usrname',
3227     api_name    => "open-ils.actor.user.retrieve_id_by_barcode_or_username",
3228     signature   => q/
3229         Given a barcode or username returns the id for the user or
3230         a failure event.
3231     /
3232 );
3233
3234 sub retrieve_usr_id_via_barcode_or_usrname {
3235     my($self, $conn, $auth, $barcode, $username) = @_;
3236     my $e = new_editor(authtoken => $auth);
3237     return $e->die_event unless $e->checkauth;
3238     my $id_as_barcode= OpenSRF::Utils::SettingsClient->new->config_value(apps => 'open-ils.actor' => app_settings => 'id_as_barcode');
3239     my $user;
3240     my $user_by_barcode;
3241     my $user_by_username;
3242     $logger->info("$id_as_barcode is the ID as BARCODE");
3243     if($barcode) {
3244         my $card = $e->search_actor_card([
3245             {barcode => $barcode},
3246             {flesh => 1, flesh_fields => {ac => ['usr']}}])->[0];
3247         if ($id_as_barcode =~ /^t/i) {
3248             if (!$card) {
3249                 $user = $e->retrieve_actor_user($barcode);
3250                 return OpenILS::Event->new( 'ACTOR_USER_NOT_FOUND' ) if(!$user);
3251             }else {
3252                 $user_by_barcode = $card->usr;
3253                 $user = $user_by_barcode;
3254             }
3255         }else {
3256             return OpenILS::Event->new( 'ACTOR_USER_NOT_FOUND' ) if(!$card);
3257             $user_by_barcode = $card->usr;
3258             $user = $user_by_barcode;
3259         }
3260     }
3261
3262     if ($username) {
3263         $user_by_username = $e->search_actor_user({usrname => $username})->[0] or return OpenILS::Event->new( 'ACTOR_USR_NOT_FOUND' );
3264
3265         $user = $user_by_username;
3266     }
3267     return OpenILS::Event->new( 'ACTOR_USER_NOT_FOUND' ) if (!$user);
3268     return OpenILS::Event->new( 'ACTOR_USER_NOT_FOUND' ) if ($user_by_username && $user_by_barcode && $user_by_username->id != $user_by_barcode->id);
3269     return $e->event unless $e->allowed('VIEW_USER', $user->home_ou);
3270     return $user->id;
3271 }
3272
3273
3274 __PACKAGE__->register_method (
3275     method      => 'merge_users',
3276     api_name    => 'open-ils.actor.user.merge',
3277     signature   => {
3278         desc => q/
3279             Given a list of source users and destination user, transfer all data from the source
3280             to the dest user and delete the source user.  All user related data is
3281             transferred, including circulations, holds, bookbags, etc.
3282         /
3283     }
3284 );
3285
3286 sub merge_users {
3287     my($self, $conn, $auth, $master_id, $user_ids, $options) = @_;
3288     my $e = new_editor(xact => 1, authtoken => $auth);
3289     return $e->die_event unless $e->checkauth;
3290
3291     # disallow the merge if any subordinate accounts are in collections
3292     my $colls = $e->search_money_collections_tracker({usr => $user_ids}, {idlist => 1});
3293     return OpenILS::Event->new('MERGED_USER_IN_COLLECTIONS', payload => $user_ids) if @$colls;
3294
3295     my $master_user = $e->retrieve_actor_user($master_id) or return $e->die_event;
3296     my $del_addrs = ($U->ou_ancestor_setting_value(
3297         $master_user->home_ou, 'circ.user_merge.delete_addresses', $e)) ? 't' : 'f';
3298     my $del_cards = ($U->ou_ancestor_setting_value(
3299         $master_user->home_ou, 'circ.user_merge.delete_cards', $e)) ? 't' : 'f';
3300     my $deactivate_cards = ($U->ou_ancestor_setting_value(
3301         $master_user->home_ou, 'circ.user_merge.deactivate_cards', $e)) ? 't' : 'f';
3302
3303     for my $src_id (@$user_ids) {
3304         my $src_user = $e->retrieve_actor_user($src_id) or return $e->die_event;
3305
3306         return $e->die_event unless $e->allowed('MERGE_USERS', $src_user->home_ou);
3307         if($src_user->home_ou ne $master_user->home_ou) {
3308             return $e->die_event unless $e->allowed('MERGE_USERS', $master_user->home_ou);
3309         }
3310
3311         return $e->die_event unless
3312             $e->json_query({from => [
3313                 'actor.usr_merge',
3314                 $src_id,
3315                 $master_id,
3316                 $del_addrs,
3317                 $del_cards,
3318                 $deactivate_cards
3319             ]});
3320     }
3321
3322     $e->commit;
3323     return 1;
3324 }
3325
3326
3327 __PACKAGE__->register_method (
3328     method      => 'approve_user_address',
3329     api_name    => 'open-ils.actor.user.pending_address.approve',
3330     signature   => {
3331         desc => q/
3332         /
3333     }
3334 );
3335
3336 sub approve_user_address {
3337     my($self, $conn, $auth, $addr) = @_;
3338     my $e = new_editor(xact => 1, authtoken => $auth);
3339     return $e->die_event unless $e->checkauth;
3340     if(ref $addr) {
3341         # if the caller passes an address object, assume they want to
3342         # update it first before approving it
3343         $e->update_actor_user_address($addr) or return $e->die_event;
3344     } else {
3345         $addr = $e->retrieve_actor_user_address($addr) or return $e->die_event;
3346     }
3347     my $user = $e->retrieve_actor_user($addr->usr);
3348     return $e->die_event unless $e->allowed('UPDATE_USER', $user->home_ou);
3349     my $result = $e->json_query({from => ['actor.approve_pending_address', $addr->id]})->[0]
3350         or return $e->die_event;
3351     $e->commit;
3352     return [values %$result]->[0];
3353 }
3354
3355
3356 __PACKAGE__->register_method (
3357     method      => 'retrieve_friends',
3358     api_name    => 'open-ils.actor.friends.retrieve',
3359     signature   => {
3360         desc => q/
3361             returns { confirmed: [], pending_out: [], pending_in: []}
3362             pending_out are users I'm requesting friendship with
3363             pending_in are users requesting friendship with me
3364         /
3365     }
3366 );
3367
3368 sub retrieve_friends {
3369     my($self, $conn, $auth, $user_id, $options) = @_;
3370     my $e = new_editor(authtoken => $auth);
3371     return $e->event unless $e->checkauth;
3372     $user_id ||= $e->requestor->id;
3373
3374     if($user_id != $e->requestor->id) {
3375         my $user = $e->retrieve_actor_user($user_id) or return $e->event;
3376         return $e->event unless $e->allowed('VIEW_USER', $user->home_ou);
3377     }
3378
3379     return OpenILS::Application::Actor::Friends->retrieve_friends(
3380         $e, $user_id, $options);
3381 }
3382
3383
3384
3385 __PACKAGE__->register_method (
3386     method      => 'apply_friend_perms',
3387     api_name    => 'open-ils.actor.friends.perms.apply',
3388     signature   => {
3389         desc => q/
3390         /
3391     }
3392 );
3393 sub apply_friend_perms {
3394     my($self, $conn, $auth, $user_id, $delegate_id, @perms) = @_;
3395     my $e = new_editor(authtoken => $auth, xact => 1);
3396     return $e->die_event unless $e->checkauth;
3397
3398     if($user_id != $e->requestor->id) {
3399         my $user = $e->retrieve_actor_user($user_id) or return $e->die_event;
3400         return $e->die_event unless $e->allowed('VIEW_USER', $user->home_ou);
3401     }
3402
3403     for my $perm (@perms) {
3404         my $evt =
3405             OpenILS::Application::Actor::Friends->apply_friend_perm(
3406                 $e, $user_id, $delegate_id, $perm);
3407         return $evt if $evt;
3408     }
3409
3410     $e->commit;
3411     return 1;
3412 }
3413
3414
3415 __PACKAGE__->register_method (
3416     method      => 'update_user_pending_address',
3417     api_name    => 'open-ils.actor.user.address.pending.cud'
3418 );
3419
3420 sub update_user_pending_address {
3421     my($self, $conn, $auth, $addr) = @_;
3422     my $e = new_editor(authtoken => $auth, xact => 1);
3423     return $e->die_event unless $e->checkauth;
3424
3425     if($addr->usr != $e->requestor->id) {
3426         my $user = $e->retrieve_actor_user($addr->usr) or return $e->die_event;
3427         return $e->die_event unless $e->allowed('UPDATE_USER', $user->home_ou);
3428     }
3429
3430     if($addr->isnew) {
3431         $e->create_actor_user_address($addr) or return $e->die_event;
3432     } elsif($addr->isdeleted) {
3433         $e->delete_actor_user_address($addr) or return $e->die_event;
3434     } else {
3435         $e->update_actor_user_address($addr) or return $e->die_event;
3436     }
3437
3438     $e->commit;
3439     return $addr->id;
3440 }
3441
3442
3443 __PACKAGE__->register_method (
3444     method      => 'user_events',
3445     api_name    => 'open-ils.actor.user.events.circ',
3446     stream      => 1,
3447 );
3448 __PACKAGE__->register_method (
3449     method      => 'user_events',
3450     api_name    => 'open-ils.actor.user.events.ahr',
3451     stream      => 1,
3452 );
3453
3454 sub user_events {
3455     my($self, $conn, $auth, $user_id, $filters) = @_;
3456     my $e = new_editor(authtoken => $auth);
3457     return $e->event unless $e->checkauth;
3458
3459     (my $obj_type = $self->api_name) =~ s/.*\.([a-z]+)$/$1/;
3460     my $user_field = 'usr';
3461
3462     $filters ||= {};
3463     $filters->{target} = {
3464         select => { $obj_type => ['id'] },
3465         from => $obj_type,
3466         where => {usr => $user_id}
3467     };
3468
3469     my $user = $e->retrieve_actor_user($user_id) or return $e->event;
3470     if($e->requestor->id != $user_id) {
3471         return $e->event unless $e->allowed('VIEW_USER', $user->home_ou);
3472     }
3473
3474     my $ses = OpenSRF::AppSession->create('open-ils.trigger');
3475     my $req = $ses->request('open-ils.trigger.events_by_target',
3476         $obj_type, $filters, {atevdef => ['reactor', 'validator']}, 2);
3477
3478     while(my $resp = $req->recv) {
3479         my $val = $resp->content;
3480         my $tgt = $val->target;
3481
3482         if($obj_type eq 'circ') {
3483             $tgt->target_copy($e->retrieve_asset_copy($tgt->target_copy));
3484
3485         } elsif($obj_type eq 'ahr') {
3486             $tgt->current_copy($e->retrieve_asset_copy($tgt->current_copy))
3487                 if $tgt->current_copy;
3488         }
3489
3490         $conn->respond($val) if $val;
3491     }
3492
3493     return undef;
3494 }
3495
3496 __PACKAGE__->register_method (
3497     method      => 'copy_events',
3498     api_name    => 'open-ils.actor.copy.events.circ',
3499     stream      => 1,
3500 );
3501 __PACKAGE__->register_method (
3502     method      => 'copy_events',
3503     api_name    => 'open-ils.actor.copy.events.ahr',
3504     stream      => 1,
3505 );
3506
3507 sub copy_events {
3508     my($self, $conn, $auth, $copy_id, $filters) = @_;
3509     my $e = new_editor(authtoken => $auth);
3510     return $e->event unless $e->checkauth;
3511
3512     (my $obj_type = $self->api_name) =~ s/.*\.([a-z]+)$/$1/;
3513
3514     my $copy = $e->retrieve_asset_copy($copy_id) or return $e->event;
3515
3516     my $copy_field = 'target_copy';
3517     $copy_field = 'current_copy' if $obj_type eq 'ahr';
3518
3519     $filters ||= {};
3520     $filters->{target} = {
3521         select => { $obj_type => ['id'] },
3522         from => $obj_type,
3523         where => {$copy_field => $copy_id}
3524     };
3525
3526
3527     my $ses = OpenSRF::AppSession->create('open-ils.trigger');
3528     my $req = $ses->request('open-ils.trigger.events_by_target',
3529         $obj_type, $filters, {atevdef => ['reactor', 'validator']}, 2);
3530
3531     while(my $resp = $req->recv) {
3532         my $val = $resp->content;
3533         my $tgt = $val->target;
3534
3535         my $user = $e->retrieve_actor_user($tgt->usr);
3536         if($e->requestor->id != $user->id) {
3537             return $e->event unless $e->allowed('VIEW_USER', $user->home_ou);
3538         }
3539
3540         $tgt->$copy_field($copy);
3541
3542         $tgt->usr($user);
3543         $conn->respond($val) if $val;
3544     }
3545
3546     return undef;
3547 }
3548
3549
3550
3551
3552 __PACKAGE__->register_method (
3553     method      => 'update_events',
3554     api_name    => 'open-ils.actor.user.event.cancel.batch',
3555     stream      => 1,
3556 );
3557 __PACKAGE__->register_method (
3558     method      => 'update_events',
3559     api_name    => 'open-ils.actor.user.event.reset.batch',
3560     stream      => 1,
3561 );
3562
3563 sub update_events {
3564     my($self, $conn, $auth, $event_ids) = @_;
3565     my $e = new_editor(xact => 1, authtoken => $auth);
3566     return $e->die_event unless $e->checkauth;
3567
3568     my $x = 1;
3569     for my $id (@$event_ids) {
3570
3571         # do a little dance to determine what user we are ultimately affecting
3572         my $event = $e->retrieve_action_trigger_event([
3573             $id,
3574             {   flesh => 2,
3575                 flesh_fields => {atev => ['event_def'], atevdef => ['hook']}
3576             }
3577         ]) or return $e->die_event;
3578
3579         my $user_id;
3580         if($event->event_def->hook->core_type eq 'circ') {
3581             $user_id = $e->retrieve_action_circulation($event->target)->usr;
3582         } elsif($event->event_def->hook->core_type eq 'ahr') {
3583             $user_id = $e->retrieve_action_hold_request($event->target)->usr;
3584         } else {
3585             return 0;
3586         }
3587
3588         my $user = $e->retrieve_actor_user($user_id);
3589         return $e->die_event unless $e->allowed('UPDATE_USER', $user->home_ou);
3590
3591         if($self->api_name =~ /cancel/) {
3592             $event->state('invalid');
3593         } elsif($self->api_name =~ /reset/) {
3594             $event->clear_start_time;
3595             $event->clear_update_time;
3596             $event->state('pending');
3597         }
3598
3599         $e->update_action_trigger_event($event) or return $e->die_event;
3600         $conn->respond({maximum => scalar(@$event_ids), progress => $x++});
3601     }
3602
3603     $e->commit;
3604     return {complete => 1};
3605 }
3606
3607
3608 __PACKAGE__->register_method (
3609     method      => 'really_delete_user',
3610     api_name    => 'open-ils.actor.user.delete.override',
3611     signature   => q/@see open-ils.actor.user.delete/
3612 );
3613
3614 __PACKAGE__->register_method (
3615     method      => 'really_delete_user',
3616     api_name    => 'open-ils.actor.user.delete',
3617     signature   => q/
3618         It anonymizes all personally identifiable information in actor.usr. By calling actor.usr_purge_data()
3619         it also purges related data from other tables, sometimes by transferring it to a designated destination user.
3620         The usrname field (along with first_given_name and family_name) is updated to id '-PURGED-' now().
3621         dest_usr_id is only required when deleting a user that performs staff functions.
3622     /
3623 );
3624
3625 sub really_delete_user {
3626     my($self, $conn, $auth, $user_id, $dest_user_id, $oargs) = @_;
3627     my $e = new_editor(authtoken => $auth, xact => 1);
3628     return $e->die_event unless $e->checkauth;
3629     $oargs = { all => 1 } unless defined $oargs;
3630
3631     # Find all unclosed billings for for user $user_id, thereby, also checking for open circs
3632     my $open_bills = $e->json_query({
3633         select => { mbts => ['id'] },
3634         from => 'mbts',
3635         where => {
3636             xact_finish => { '=' => undef },
3637             usr => { '=' => $user_id },
3638         }
3639     }) or return $e->die_event;
3640
3641     my $user = $e->retrieve_actor_user($user_id) or return $e->die_event;
3642
3643     # No deleting patrons with open billings or checked out copies, unless perm-enabled override
3644     if (@$open_bills) {
3645         return $e->die_event(OpenILS::Event->new('ACTOR_USER_DELETE_OPEN_XACTS'))
3646         unless $self->api_name =~ /override/o && ($oargs->{all} || grep { $_ eq 'ACTOR_USER_DELETE_OPEN_XACTS' } @{$oargs->{events}})
3647         && $e->allowed('ACTOR_USER_DELETE_OPEN_XACTS.override', $user->home_ou);
3648     }
3649     # No deleting yourself - UI is supposed to stop you first, though.
3650     return $e->die_event unless $e->requestor->id != $user->id;
3651     return $e->die_event unless $e->allowed('DELETE_USER', $user->home_ou);
3652     # Check if you are allowed to mess with this patron permission group at all
3653     my $session = OpenSRF::AppSession->create( "open-ils.storage" );
3654     my $evt = group_perm_failed($session, $e->requestor, $user);
3655     return $e->die_event($evt) if $evt;
3656     my $stat = $e->json_query(
3657         {from => ['actor.usr_delete', $user_id, $dest_user_id]})->[0]
3658         or return $e->die_event;
3659     $e->commit;
3660     return 1;
3661 }
3662
3663
3664 __PACKAGE__->register_method (
3665     method      => 'user_payments',
3666     api_name    => 'open-ils.actor.user.payments.retrieve',
3667     stream => 1,
3668     signature   => q/
3669         Returns all payments for a given user.  Default order is newest payments first.
3670         @param auth Authentication token
3671         @param user_id The user ID
3672         @param filters An optional hash of filters, including limit, offset, and order_by definitions
3673     /
3674 );
3675
3676 sub user_payments {
3677     my($self, $conn, $auth, $user_id, $filters) = @_;
3678     $filters ||= {};
3679
3680     my $e = new_editor(authtoken => $auth);
3681     return $e->die_event unless $e->checkauth;
3682
3683     my $user = $e->retrieve_actor_user($user_id) or return $e->event;
3684     return $e->event unless
3685         $e->requestor->id == $user_id or
3686         $e->allowed('VIEW_USER_TRANSACTIONS', $user->home_ou);
3687
3688     # Find all payments for all transactions for user $user_id
3689     my $query = {
3690         select => {mp => ['id']},
3691         from => 'mp',
3692         where => {
3693             xact => {
3694                 in => {
3695                     select => {mbt => ['id']},
3696                     from => 'mbt',
3697                     where => {usr => $user_id}
3698                 }
3699             }
3700         },
3701         order_by => [
3702             { # by default, order newest payments first
3703                 class => 'mp',
3704                 field => 'payment_ts',
3705                 direction => 'desc'
3706             }, {
3707                 # secondary sort in ID as a tie-breaker, since payments created
3708                 # within the same transaction will have identical payment_ts's
3709                 class => 'mp',
3710                 field => 'id'
3711             }
3712         ]
3713     };
3714
3715     for (qw/order_by limit offset/) {
3716         $query->{$_} = $filters->{$_} if defined $filters->{$_};
3717     }
3718
3719     if(defined $filters->{where}) {
3720         foreach (keys %{$filters->{where}}) {
3721             # don't allow the caller to expand the result set to other users
3722             $query->{where}->{$_} = $filters->{where}->{$_} unless $_ eq 'xact';
3723         }
3724     }
3725
3726     my $payment_ids = $e->json_query($query);
3727     for my $pid (@$payment_ids) {
3728         my $pay = $e->retrieve_money_payment([
3729             $pid->{id},
3730             {   flesh => 6,
3731                 flesh_fields => {
3732                     mp => ['xact'],
3733                     mbt => ['summary', 'circulation', 'grocery'],
3734                     circ => ['target_copy'],
3735                     acp => ['call_number'],
3736                     acn => ['record']
3737                 }
3738             }
3739         ]);
3740
3741         my $resp = {
3742             mp => $pay,
3743             xact_type => $pay->xact->summary->xact_type,
3744             last_billing_type => $pay->xact->summary->last_billing_type,
3745         };
3746
3747         if($pay->xact->summary->xact_type eq 'circulation') {
3748             $resp->{barcode} = $pay->xact->circulation->target_copy->barcode;
3749             $resp->{title} = $U->record_to_mvr($pay->xact->circulation->target_copy->call_number->record)->title;
3750         }
3751
3752         $pay->xact($pay->xact->id); # de-flesh
3753         $conn->respond($resp);
3754     }
3755
3756     return undef;
3757 }
3758
3759
3760
3761 __PACKAGE__->register_method (
3762     method      => 'negative_balance_users',
3763     api_name    => 'open-ils.actor.users.negative_balance',
3764     stream => 1,
3765     signature   => q/
3766         Returns all users that have an overall negative balance
3767         @param auth Authentication token
3768         @param org_id The context org unit as an ID or list of IDs.  This will be the home
3769         library of the user.  If no org_unit is specified, no org unit filter is applied
3770     /
3771 );
3772
3773 sub negative_balance_users {
3774     my($self, $conn, $auth, $org_id) = @_;
3775
3776     my $e = new_editor(authtoken => $auth);
3777     return $e->die_event unless $e->checkauth;
3778     return $e->die_event unless $e->allowed('VIEW_USER', $org_id);
3779
3780     my $query = {
3781         select => {
3782             mous => ['usr', 'balance_owed'],
3783             au => ['home_ou'],
3784             mbts => [
3785                 {column => 'last_billing_ts', transform => 'max', aggregate => 1},
3786                 {column => 'last_payment_ts', transform => 'max', aggregate => 1},
3787             ]
3788         },
3789         from => {
3790             mous => {
3791                 au => {
3792                     fkey => 'usr',
3793                     field => 'id',
3794                     join => {
3795                         mbts => {
3796                             key => 'id',
3797                             field => 'usr'
3798                         }
3799                     }
3800                 }
3801             }
3802         },
3803         where => {'+mous' => {balance_owed => {'<' => 0}}}
3804     };
3805
3806     $query->{from}->{mous}->{au}->{filter}->{home_ou} = $org_id if $org_id;
3807
3808     my $list = $e->json_query($query, {timeout => 600});
3809
3810     for my $data (@$list) {
3811         $conn->respond({
3812             usr => $e->retrieve_actor_user([$data->{usr}, {flesh => 1, flesh_fields => {au => ['card']}}]),
3813             balance_owed => $data->{balance_owed},
3814             last_billing_activity => max($data->{last_billing_ts}, $data->{last_payment_ts})
3815         });
3816     }
3817
3818     return undef;
3819 }
3820
3821 __PACKAGE__->register_method(
3822     method  => "request_password_reset",
3823     api_name    => "open-ils.actor.patron.password_reset.request",
3824     signature   => {
3825         desc => "Generates a UUID token usable with the open-ils.actor.patron.password_reset.commit " .
3826                 "method for changing a user's password.  The UUID token is distributed via A/T "      .
3827                 "templates (i.e. email to the user).",
3828         params => [
3829             { desc => 'user_id_type', type => 'string' },
3830             { desc => 'user_id', type => 'string' },
3831             { desc => 'optional (based on library setting) matching email address for authorizing request', type => 'string' },
3832         ],
3833         return => {desc => '1 on success, Event on error'}
3834     }
3835 );
3836 sub request_password_reset {
3837     my($self, $conn, $user_id_type, $user_id, $email) = @_;
3838
3839     # Check to see if password reset requests are already being throttled:
3840     # 0. Check cache to see if we're in throttle mode (avoid hitting database)
3841
3842     my $e = new_editor(xact => 1);
3843     my $user;
3844
3845     # Get the user, if any, depending on the input value
3846     if ($user_id_type eq 'username') {
3847         $user = $e->search_actor_user({usrname => $user_id})->[0];
3848         if (!$user) {
3849             $e->die_event;
3850             return OpenILS::Event->new( 'ACTOR_USER_NOT_FOUND' );
3851         }
3852     } elsif ($user_id_type eq 'barcode') {
3853         my $card = $e->search_actor_card([
3854             {barcode => $user_id},
3855             {flesh => 1, flesh_fields => {ac => ['usr']}}])->[0];
3856         if (!$card) {
3857             $e->die_event;
3858             return OpenILS::Event->new('ACTOR_USER_NOT_FOUND');
3859         }
3860         $user = $card->usr;
3861     }
3862
3863     # If the user doesn't have an email address, we can't help them
3864     if (!$user->email) {
3865         $e->die_event;
3866         return OpenILS::Event->new('PATRON_NO_EMAIL_ADDRESS');
3867     }
3868
3869     my $email_must_match = $U->ou_ancestor_setting_value($user->home_ou, 'circ.password_reset_request_requires_matching_email');
3870     if ($email_must_match) {
3871         if ($user->email ne $email) {
3872             return OpenILS::Event->new('EMAIL_VERIFICATION_FAILED');
3873         }
3874     }
3875
3876     _reset_password_request($conn, $e, $user);
3877 }
3878
3879 # Once we have the user, we can issue the password reset request
3880 # XXX Add a wrapper method that accepts barcode + email input
3881 sub _reset_password_request {
3882     my ($conn, $e, $user) = @_;
3883
3884     # 1. Get throttle threshold and time-to-live from OU_settings
3885     my $aupr_throttle = $U->ou_ancestor_setting_value($user->home_ou, 'circ.password_reset_request_throttle') || 1000;
3886     my $aupr_ttl = $U->ou_ancestor_setting_value($user->home_ou, 'circ.password_reset_request_time_to_live') || 24*60*60;
3887
3888     my $threshold_time = DateTime->now(time_zone => 'local')->subtract(seconds => $aupr_ttl)->iso8601();
3889
3890     # 2. Get time of last request and number of active requests (num_active)
3891     my $active_requests = $e->json_query({
3892         from => 'aupr',
3893         select => {
3894             aupr => [
3895                 {
3896                     column => 'uuid',
3897                     transform => 'COUNT'
3898                 },
3899                 {
3900                     column => 'request_time',
3901                     transform => 'MAX'
3902                 }
3903             ]
3904         },
3905         where => {
3906             has_been_reset => { '=' => 'f' },
3907             request_time => { '>' => $threshold_time }
3908         }
3909     });
3910
3911     # Guard against no active requests
3912     if ($active_requests->[0]->{'request_time'}) {
3913         my $last_request = DateTime::Format::ISO8601->parse_datetime(clense_ISO8601($active_requests->[0]->{'request_time'}));
3914         my $now = DateTime::Format::ISO8601->new();
3915
3916         # 3. if (num_active > throttle_threshold) and (now - last_request < 1 minute)
3917         if (($active_requests->[0]->{'usr'} > $aupr_throttle) &&
3918             ($last_request->add_duration('1 minute') > $now)) {
3919             $cache->put_cache('open-ils.actor.password.throttle', DateTime::Format::ISO8601->new(), 60);
3920             $e->die_event;
3921             return OpenILS::Event->new('PATRON_TOO_MANY_ACTIVE_PASSWORD_RESET_REQUESTS');
3922         }
3923     }
3924
3925     # TODO Check to see if the user is in a password-reset-restricted group
3926
3927     # Otherwise, go ahead and try to get the user.
3928
3929     # Check the number of active requests for this user
3930     $active_requests = $e->json_query({
3931         from => 'aupr',
3932         select => {
3933             aupr => [
3934                 {
3935                     column => 'usr',
3936                     transform => 'COUNT'
3937                 }
3938             ]
3939         },
3940         where => {
3941             usr => { '=' => $user->id },
3942             has_been_reset => { '=' => 'f' },
3943             request_time => { '>' => $threshold_time }
3944         }
3945     });
3946
3947     $logger->info("User " . $user->id . " has " . $active_requests->[0]->{'usr'} . " active password reset requests.");
3948
3949     # if less than or equal to per-user threshold, proceed; otherwise, return event
3950     my $aupr_per_user_limit = $U->ou_ancestor_setting_value($user->home_ou, 'circ.password_reset_request_per_user_limit') || 3;
3951     if ($active_requests->[0]->{'usr'} > $aupr_per_user_limit) {
3952         $e->die_event;
3953         return OpenILS::Event->new('PATRON_TOO_MANY_ACTIVE_PASSWORD_RESET_REQUESTS');
3954     }
3955
3956     # Create the aupr object and insert into the database
3957     my $reset_request = Fieldmapper::actor::usr_password_reset->new;
3958     my $uuid = create_uuid_as_string(UUID_V4);
3959     $reset_request->uuid($uuid);
3960     $reset_request->usr($user->id);
3961
3962     my $aupr = $e->create_actor_usr_password_reset($reset_request) or return $e->die_event;
3963     $e->commit;
3964
3965     # Create an event to notify user of the URL to reset their password
3966
3967     # Can we stuff this in the user_data param for trigger autocreate?
3968     my $hostname = $U->ou_ancestor_setting_value($user->home_ou, 'lib.hostname') || 'localhost';
3969
3970     my $ses = OpenSRF::AppSession->create('open-ils.trigger');
3971     $ses->request('open-ils.trigger.event.autocreate', 'password.reset_request', $aupr, $user->home_ou);
3972
3973     # Trunk only
3974     # $U->create_trigger_event('password.reset_request', $aupr, $user->home_ou);
3975
3976     return 1;
3977 }
3978
3979 __PACKAGE__->register_method(
3980     method  => "commit_password_reset",
3981     api_name    => "open-ils.actor.patron.password_reset.commit",
3982     signature   => {
3983         desc => "Checks a UUID token generated by the open-ils.actor.patron.password_reset.request method for " .
3984                 "validity, and if valid, uses it as authorization for changing the associated user's password " .
3985                 "with the supplied password.",
3986         params => [
3987             { desc => 'uuid', type => 'string' },
3988             { desc => 'password', type => 'string' },
3989         ],
3990         return => {desc => '1 on success, Event on error'}
3991     }
3992 );
3993 sub commit_password_reset {
3994     my($self, $conn, $uuid, $password) = @_;
3995
3996     # Check to see if password reset requests are already being throttled:
3997     # 0. Check cache to see if we're in throttle mode (avoid hitting database)
3998     $cache ||= OpenSRF::Utils::Cache->new("global", 0);
3999     my $throttle = $cache->get_cache('open-ils.actor.password.throttle') || undef;
4000     if ($throttle) {
4001         return OpenILS::Event->new('PATRON_NOT_AN_ACTIVE_PASSWORD_RESET_REQUEST');
4002     }
4003
4004     my $e = new_editor(xact => 1);
4005
4006     my $aupr = $e->search_actor_usr_password_reset({
4007         uuid => $uuid,
4008         has_been_reset => 0
4009     });
4010
4011     if (!$aupr->[0]) {
4012         $e->die_event;
4013         return OpenILS::Event->new('PATRON_NOT_AN_ACTIVE_PASSWORD_RESET_REQUEST');
4014     }
4015     my $user_id = $aupr->[0]->usr;
4016     my $user = $e->retrieve_actor_user($user_id);
4017
4018     # Ensure we're still within the TTL for the request
4019     my $aupr_ttl = $U->ou_ancestor_setting_value($user->home_ou, 'circ.password_reset_request_time_to_live') || 24*60*60;
4020     my $threshold = DateTime::Format::ISO8601->parse_datetime(clense_ISO8601($aupr->[0]->request_time))->add(seconds => $aupr_ttl);
4021     if ($threshold < DateTime->now(time_zone => 'local')) {
4022         $e->die_event;
4023         $logger->info("Password reset request needed to be submitted before $threshold");
4024         return OpenILS::Event->new('PATRON_NOT_AN_ACTIVE_PASSWORD_RESET_REQUEST');
4025     }
4026
4027     # Check complexity of password against OU-defined regex
4028     my $pw_regex = $U->ou_ancestor_setting_value($user->home_ou, 'global.password_regex');
4029
4030     my $is_strong = 0;
4031     if ($pw_regex) {
4032         # Calling JSON2perl on the $pw_regex causes failure, even before the fancy Unicode regex
4033         # ($pw_regex = OpenSRF::Utils::JSON->JSON2perl($pw_regex)) =~ s/\\u([0-9a-fA-F]{4})/\\x{$1}/gs;
4034         $is_strong = check_password_strength_custom($password, $pw_regex);
4035     } else {
4036         $is_strong = check_password_strength_default($password);
4037     }
4038
4039     if (!$is_strong) {
4040         $e->die_event;
4041         return OpenILS::Event->new('PATRON_PASSWORD_WAS_NOT_STRONG');
4042     }
4043
4044     # All is well; update the password
4045     $user->passwd($password);
4046     $e->update_actor_user($user);
4047
4048     # And flag that this password reset request has been honoured
4049     $aupr->[0]->has_been_reset('t');
4050     $e->update_actor_usr_password_reset($aupr->[0]);
4051     $e->commit;
4052
4053     return 1;
4054 }
4055
4056 sub check_password_strength_default {
4057     my $password = shift;
4058     # Use the default set of checks
4059     if ( (length($password) < 7) or
4060             ($password !~ m/.*\d+.*/) or
4061             ($password !~ m/.*[A-Za-z]+.*/)
4062        ) {
4063         return 0;
4064     }
4065     return 1;
4066 }
4067
4068 sub check_password_strength_custom {
4069     my ($password, $pw_regex) = @_;
4070
4071     $pw_regex = qr/$pw_regex/;
4072     if ($password !~  /$pw_regex/) {
4073         return 0;
4074     }
4075     return 1;
4076 }
4077
4078
4079
4080 __PACKAGE__->register_method(
4081     method    => "event_def_opt_in_settings",
4082     api_name  => "open-ils.actor.event_def.opt_in.settings",
4083     stream => 1,
4084     signature => {
4085         desc   => 'Streams the set of "cust" objects that are used as opt-in settings for event definitions',
4086         params => [
4087             { desc => 'Authentication token',  type => 'string'},
4088             {
4089                 desc => 'Org Unit ID.  (optional).  If no org ID is present, the home_ou of the requesting user is used',
4090                 type => 'number'
4091             },
4092         ],
4093         return => {
4094             desc => q/set of "cust" objects that are used as opt-in settings for event definitions at the specified org unit/,
4095             type => 'object',
4096             class => 'cust'
4097         }
4098     }
4099 );
4100
4101 sub event_def_opt_in_settings {
4102     my($self, $conn, $auth, $org_id) = @_;
4103     my $e = new_editor(authtoken => $auth);
4104     return $e->event unless $e->checkauth;
4105
4106     if(defined $org_id and $org_id != $e->requestor->home_ou) {
4107         return $e->event unless
4108             $e->allowed(['VIEW_USER_SETTING_TYPE', 'ADMIN_USER_SETTING_TYPE'], $org_id);
4109     } else {
4110         $org_id = $e->requestor->home_ou;
4111     }
4112
4113     # find all config.user_setting_type's related to event_defs for the requested org unit
4114     my $types = $e->json_query({
4115         select => {cust => ['name']},
4116         from => {atevdef => 'cust'},
4117         where => {
4118             '+atevdef' => {
4119                 owner => $U->get_org_ancestors($org_id), # context org plus parents
4120                 active => 't'
4121             }
4122         }
4123     });
4124
4125     if(@$types) {
4126         $conn->respond($_) for
4127             @{$e->search_config_usr_setting_type({name => [map {$_->{name}} @$types]})};
4128     }
4129
4130     return undef;
4131 }
4132
4133
4134 __PACKAGE__->register_method(
4135     method    => "user_visible_circs",
4136     api_name  => "open-ils.actor.history.circ.visible",
4137     stream => 1,
4138     signature => {
4139         desc   => 'Returns the set of opt-in visible circulations accompanied by circulation chain summaries',
4140         params => [
4141             { desc => 'Authentication token',  type => 'string'},
4142             { desc => 'User ID.  If no user id is present, the authenticated user is assumed', type => 'number' },
4143             { desc => 'Options hash.  Supported fields are "limit" and "offset"', type => 'object' },
4144         ],
4145         return => {
4146             desc => q/An object with 2 fields: circulation and summary.
4147                 circulation is the "circ" object.   summary is the related "accs" object/,
4148             type => 'object',
4149         }
4150     }
4151 );
4152
4153 __PACKAGE__->register_method(
4154     method    => "user_visible_circs",
4155     api_name  => "open-ils.actor.history.circ.visible.print",
4156     stream => 1,
4157     signature => {
4158         desc   => 'Returns printable output for the set of opt-in visible circulations',
4159         params => [
4160             { desc => 'Authentication token',  type => 'string'},
4161             { desc => 'User ID.  If no user id is present, the authenticated user is assumed', type => 'number' },
4162             { desc => 'Options hash.  Supported fields are "limit" and "offset"', type => 'object' },
4163         ],
4164         return => {
4165             desc => q/An action_trigger.event object or error event./,
4166             type => 'object',
4167         }
4168     }
4169 );
4170
4171 __PACKAGE__->register_method(
4172     method    => "user_visible_circs",
4173     api_name  => "open-ils.actor.history.circ.visible.email",
4174     stream => 1,
4175     signature => {
4176         desc   => 'Emails the set of opt-in visible circulations to the requestor',
4177         params => [
4178             { desc => 'Authentication token',  type => 'string'},
4179             { desc => 'User ID.  If no user id is present, the authenticated user is assumed', type => 'number' },
4180             { desc => 'Options hash.  Supported fields are "limit" and "offset"', type => 'object' },
4181         ],
4182         return => {
4183             desc => q/undef, or event on error/
4184         }
4185     }
4186 );
4187
4188 __PACKAGE__->register_method(
4189     method    => "user_visible_circs",
4190     api_name  => "open-ils.actor.history.hold.visible",
4191     stream => 1,
4192     signature => {
4193         desc   => 'Returns the set of opt-in visible holds',
4194         params => [
4195             { desc => 'Authentication token',  type => 'string'},
4196             { desc => 'User ID.  If no user id is present, the authenticated user is assumed', type => 'number' },
4197             { desc => 'Options hash.  Supported fields are "limit" and "offset"', type => 'object' },
4198         ],
4199         return => {
4200             desc => q/An object with 1 field: "hold"/,
4201             type => 'object',
4202         }
4203     }
4204 );
4205
4206 __PACKAGE__->register_method(
4207     method    => "user_visible_circs",
4208     api_name  => "open-ils.actor.history.hold.visible.print",
4209     stream => 1,
4210     signature => {
4211         desc   => 'Returns printable output for the set of opt-in visible holds',
4212         params => [
4213             { desc => 'Authentication token',  type => 'string'},
4214             { desc => 'User ID.  If no user id is present, the authenticated user is assumed', type => 'number' },
4215             { desc => 'Options hash.  Supported fields are "limit" and "offset"', type => 'object' },
4216         ],
4217         return => {
4218             desc => q/An action_trigger.event object or error event./,
4219             type => 'object',
4220         }
4221     }
4222 );
4223
4224 __PACKAGE__->register_method(
4225     method    => "user_visible_circs",
4226     api_name  => "open-ils.actor.history.hold.visible.email",
4227     stream => 1,
4228     signature => {
4229         desc   => 'Emails the set of opt-in visible holds to the requestor',
4230         params => [
4231             { desc => 'Authentication token',  type => 'string'},
4232             { desc => 'User ID.  If no user id is present, the authenticated user is assumed', type => 'number' },
4233             { desc => 'Options hash.  Supported fields are "limit" and "offset"', type => 'object' },
4234         ],
4235         return => {
4236             desc => q/undef, or event on error/
4237         }
4238     }
4239 );
4240
4241 sub user_visible_circs {
4242     my($self, $conn, $auth, $user_id, $options) = @_;
4243
4244     my $is_hold = ($self->api_name =~ /hold/);
4245     my $for_print = ($self->api_name =~ /print/);
4246     my $for_email = ($self->api_name =~ /email/);
4247     my $e = new_editor(authtoken => $auth);
4248     return $e->event unless $e->checkauth;
4249
4250     $user_id ||= $e->requestor->id;
4251     $options ||= {};
4252     $options->{limit} ||= 50;
4253     $options->{offset} ||= 0;
4254
4255     if($user_id != $e->requestor->id) {
4256         my $perm = ($is_hold) ? 'VIEW_HOLD' : 'VIEW_CIRCULATIONS';
4257         my $user = $e->retrieve_actor_user($user_id) or return $e->event;
4258         return $e->event unless $e->allowed($perm, $user->home_ou);
4259     }
4260
4261     my $db_func = ($is_hold) ? 'action.usr_visible_holds' : 'action.usr_visible_circs';
4262
4263     my $data = $e->json_query({
4264         from => [$db_func, $user_id],
4265         limit => $$options{limit},
4266         offset => $$options{offset}
4267
4268         # TODO: I only want IDs. code below didn't get me there
4269         # {"select":{"au":[{"column":"id", "result_field":"id",
4270         # "transform":"action.usr_visible_circs"}]}, "where":{"id":10}, "from":"au"}
4271     },{
4272         substream => 1
4273     });
4274
4275     return undef unless @$data;
4276
4277     if ($for_print) {
4278
4279         # collect the batch of objects
4280
4281         if($is_hold) {
4282
4283             my $hold_list = $e->search_action_hold_request({id => [map { $_->{id} } @$data]});
4284             return $U->fire_object_event(undef, 'ahr.format.history.print', $hold_list, $$hold_list[0]->request_lib);
4285
4286         } else {
4287
4288             my $circ_list = $e->search_action_circulation({id => [map { $_->{id} } @$data]});
4289             return $U->fire_object_event(undef, 'circ.format.history.print', $circ_list, $$circ_list[0]->circ_lib);
4290         }
4291
4292     } elsif ($for_email) {
4293
4294         $conn->respond_complete(1) if $for_email;  # no sense in waiting
4295
4296         foreach (@$data) {
4297
4298             my $id = $_->{id};
4299
4300             if($is_hold) {
4301
4302                 my $hold = $e->retrieve_action_hold_request($id);
4303                 $U->create_events_for_hook('ahr.format.history.email', $hold, $hold->request_lib, undef, undef, 1);
4304                 # events will be fired from action_trigger_runner
4305
4306             } else {
4307
4308                 my $circ = $e->retrieve_action_circulation($id);
4309                 $U->create_events_for_hook('circ.format.history.email', $circ, $circ->circ_lib, undef, undef, 1);
4310                 # events will be fired from action_trigger_runner
4311             }
4312         }
4313
4314     } else { # just give me the data please
4315
4316         foreach (@$data) {
4317
4318             my $id = $_->{id};
4319
4320             if($is_hold) {
4321
4322                 my $hold = $e->retrieve_action_hold_request($id);
4323                 $conn->respond({hold => $hold});
4324
4325             } else {
4326
4327                 my $circ = $e->retrieve_action_circulation($id);
4328                 $conn->respond({
4329                     circ => $circ,
4330                     summary => $U->create_circ_chain_summary($e, $id)
4331                 });
4332             }
4333         }
4334     }
4335
4336     return undef;
4337 }
4338
4339 __PACKAGE__->register_method(
4340     method     => "user_saved_search_cud",
4341     api_name   => "open-ils.actor.user.saved_search.cud",
4342     stream     => 1,
4343     signature  => {
4344         desc   => 'Create/Update/Delete Access to user saved searches',
4345         params => [
4346             { desc => 'Authentication token', type => 'string' },
4347             { desc => 'Saved Search Object', type => 'object', class => 'auss' }
4348         ],
4349         return => {
4350             desc   => q/The retrieved or updated saved search object, or id of a deleted object; Event on error/,
4351             class  => 'auss'
4352         }
4353     }
4354 );
4355
4356 __PACKAGE__->register_method(
4357     method     => "user_saved_search_cud",
4358     api_name   => "open-ils.actor.user.saved_search.retrieve",
4359     stream     => 1,
4360     signature  => {
4361         desc   => 'Retrieve a saved search object',
4362         params => [
4363             { desc => 'Authentication token', type => 'string' },
4364             { desc => 'Saved Search ID', type => 'number' }
4365         ],
4366         return => {
4367             desc   => q/The saved search object, Event on error/,
4368             class  => 'auss'
4369         }
4370     }
4371 );
4372
4373 sub user_saved_search_cud {
4374     my( $self, $client, $auth, $search ) = @_;
4375     my $e = new_editor( authtoken=>$auth );
4376     return $e->die_event unless $e->checkauth;
4377
4378     my $o_search;      # prior version of the object, if any
4379     my $res;           # to be returned
4380
4381     # branch on the operation type
4382
4383     if( $self->api_name =~ /retrieve/ ) {                    # Retrieve
4384
4385         # Get the old version, to check ownership
4386         $o_search = $e->retrieve_actor_usr_saved_search( $search )
4387             or return $e->die_event;
4388
4389         # You can't read somebody else's search
4390         return OpenILS::Event->new('BAD_PARAMS')
4391             unless $o_search->owner == $e->requestor->id;
4392
4393         $res = $o_search;
4394
4395     } else {
4396
4397         $e->xact_begin;               # start an editor transaction
4398
4399         if( $search->isnew ) {                               # Create
4400
4401             # You can't create a search for somebody else
4402             return OpenILS::Event->new('BAD_PARAMS')
4403                 unless $search->owner == $e->requestor->id;
4404
4405             $e->create_actor_usr_saved_search( $search )
4406                 or return $e->die_event;
4407
4408             $res = $search->id;
4409
4410         } elsif( $search->ischanged ) {                      # Update
4411
4412             # You can't change ownership of a search
4413             return OpenILS::Event->new('BAD_PARAMS')
4414                 unless $search->owner == $e->requestor->id;
4415
4416             # Get the old version, to check ownership
4417             $o_search = $e->retrieve_actor_usr_saved_search( $search->id )
4418                 or return $e->die_event;
4419
4420             # You can't update somebody else's search
4421             return OpenILS::Event->new('BAD_PARAMS')
4422                 unless $o_search->owner == $e->requestor->id;
4423
4424             # Do the update
4425             $e->update_actor_usr_saved_search( $search )
4426                 or return $e->die_event;
4427
4428             $res = $search;
4429
4430         } elsif( $search->isdeleted ) {                      # Delete
4431
4432             # Get the old version, to check ownership
4433             $o_search = $e->retrieve_actor_usr_saved_search( $search->id )
4434                 or return $e->die_event;
4435
4436             # You can't delete somebody else's search
4437             return OpenILS::Event->new('BAD_PARAMS')
4438                 unless $o_search->owner == $e->requestor->id;
4439
4440             # Do the delete
4441             $e->delete_actor_usr_saved_search( $o_search )
4442                 or return $e->die_event;
4443
4444             $res = $search->id;
4445         }
4446
4447         $e->commit;
4448     }
4449
4450     return $res;
4451 }
4452
4453 __PACKAGE__->register_method(
4454     method   => "get_barcodes",
4455     api_name => "open-ils.actor.get_barcodes"
4456 );
4457
4458 sub get_barcodes {
4459     my( $self, $client, $auth, $org_id, $context, $barcode ) = @_;
4460     my $e = new_editor(authtoken => $auth);
4461     return $e->event unless $e->checkauth;
4462     return $e->event unless $e->allowed('STAFF_LOGIN', $org_id);
4463
4464     my $db_result = $e->json_query(
4465         {   from => [
4466                 'evergreen.get_barcodes',
4467                 $org_id, $context, $barcode,
4468             ]
4469         }
4470     );
4471     if($context =~ /actor/) {
4472         my $filter_result = ();
4473         my $patron;
4474         foreach my $result (@$db_result) {
4475             if($result->{type} eq 'actor') {
4476                 if($e->requestor->id != $result->{id}) {
4477                     $patron = $e->retrieve_actor_user($result->{id});
4478                     if(!$patron) {
4479                         push(@$filter_result, $e->event);
4480                         next;
4481                     }
4482                     if($e->allowed('VIEW_USER', $patron->home_ou)) {
4483                         push(@$filter_result, $result);
4484                     }
4485                     else {
4486                         push(@$filter_result, $e->event);
4487                     }
4488                 }
4489                 else {
4490                     push(@$filter_result, $result);
4491                 }
4492             }
4493             else {
4494                 push(@$filter_result, $result);
4495             }
4496         }
4497         return $filter_result;
4498     }
4499     else {
4500         return $db_result;
4501     }
4502 }
4503 __PACKAGE__->register_method(
4504     method   => 'address_alert_test',
4505     api_name => 'open-ils.actor.address_alert.test',
4506     signature => {
4507         desc => "Tests a set of address fields to determine if they match with an address_alert",
4508         params => [
4509             {desc => 'Authentication token', type => 'string'},
4510             {desc => 'Org Unit',             type => 'number'},
4511             {desc => 'Fields',               type => 'hash'},
4512         ],
4513         return => {desc => 'List of matching address_alerts'}
4514     }
4515 );
4516
4517 sub address_alert_test {
4518     my ($self, $client, $auth, $org_unit, $fields) = @_;
4519     return [] unless $fields and grep {$_} values %$fields;
4520
4521     my $e = new_editor(authtoken => $auth);
4522     return $e->event unless $e->checkauth;
4523     return $e->event unless $e->allowed('CREATE_USER', $org_unit);
4524     $org_unit ||= $e->requestor->ws_ou;
4525
4526     my $alerts = $e->json_query({
4527         from => [
4528             'actor.address_alert_matches',
4529             $org_unit,
4530             $$fields{street1},
4531             $$fields{street2},
4532             $$fields{city},
4533             $$fields{county},
4534             $$fields{state},
4535             $$fields{country},
4536             $$fields{post_code},
4537             $$fields{mailing_address},
4538             $$fields{billing_address}
4539         ]
4540     });
4541
4542     # map the json_query hashes to real objects
4543     return [
4544         map {$e->retrieve_actor_address_alert($_)}
4545             (map {$_->{id}} @$alerts)
4546     ];
4547 }
4548
4549 __PACKAGE__->register_method(
4550     method   => "mark_users_contact_invalid",
4551     api_name => "open-ils.actor.invalidate.email",
4552     signature => {
4553         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",
4554         params => [
4555             {desc => "Authentication token", type => "string"},
4556             {desc => "Patron ID", type => "number"},
4557             {desc => "Additional note text (optional)", type => "string"},
4558             {desc => "penalty org unit ID (optional)", type => "number"}
4559         ],
4560         return => {desc => "Event describing success or failure", type => "object"}
4561     }
4562 );
4563
4564 __PACKAGE__->register_method(
4565     method   => "mark_users_contact_invalid",
4566     api_name => "open-ils.actor.invalidate.day_phone",
4567     signature => {
4568         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",
4569         params => [
4570             {desc => "Authentication token", type => "string"},
4571             {desc => "Patron ID", type => "number"},
4572             {desc => "Additional note text (optional)", type => "string"},
4573             {desc => "penalty org unit ID (optional)", type => "number"}
4574         ],
4575         return => {desc => "Event describing success or failure", type => "object"}
4576     }
4577 );
4578
4579 __PACKAGE__->register_method(
4580     method   => "mark_users_contact_invalid",
4581     api_name => "open-ils.actor.invalidate.evening_phone",
4582     signature => {
4583         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",
4584         params => [
4585             {desc => "Authentication token", type => "string"},
4586             {desc => "Patron ID", type => "number"},
4587             {desc => "Additional note text (optional)", type => "string"},
4588             {desc => "penalty org unit ID (optional)", type => "number"}
4589         ],
4590         return => {desc => "Event describing success or failure", type => "object"}
4591     }
4592 );
4593
4594 __PACKAGE__->register_method(
4595     method   => "mark_users_contact_invalid",
4596     api_name => "open-ils.actor.invalidate.other_phone",
4597     signature => {
4598         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",
4599         params => [
4600             {desc => "Authentication token", type => "string"},
4601             {desc => "Patron ID", type => "number"},
4602             {desc => "Additional note text (optional)", type => "string"},
4603             {desc => "penalty org unit ID (optional, default to top of org tree)",
4604                 type => "number"}
4605         ],
4606         return => {desc => "Event describing success or failure", type => "object"}
4607     }
4608 );
4609
4610 sub mark_users_contact_invalid {
4611     my ($self, $conn, $auth, $patron_id, $addl_note, $penalty_ou) = @_;
4612
4613     # This method invalidates an email address or a phone_number which
4614     # removes the bad email address or phone number, copying its contents
4615     # to a patron note, and institutes a standing penalty for "bad email"
4616     # or "bad phone number" which is cleared when the user is saved or
4617     # optionally only when the user is saved with an email address or
4618     # phone number (or staff manually delete the penalty).
4619
4620     my $contact_type = ($self->api_name =~ /invalidate.(\w+)(\.|$)/)[0];
4621
4622     my $e = new_editor(authtoken => $auth, xact => 1);
4623     return $e->die_event unless $e->checkauth;
4624
4625     return OpenILS::Utils::BadContact->mark_users_contact_invalid(
4626         $e, $contact_type, {usr => $patron_id},
4627         $addl_note, $penalty_ou, $e->requestor->id
4628     );
4629 }
4630
4631 # Putting the following method in open-ils.actor is a bad fit, except in that
4632 # it serves an interface that lives under 'actor' in the templates directory,
4633 # and in that there's nowhere else obvious to put it (open-ils.trigger is
4634 # private).
4635 __PACKAGE__->register_method(
4636     api_name => "open-ils.actor.action_trigger.reactors.all_in_use",
4637     method   => "get_all_at_reactors_in_use",
4638     api_level=> 1,
4639     argc     => 1,
4640     signature=> {
4641         params => [
4642             { name => 'authtoken', type => 'string' }
4643         ],
4644         return => {
4645             desc => 'list of reactor names', type => 'array'
4646         }
4647     }
4648 );
4649
4650 sub get_all_at_reactors_in_use {
4651     my ($self, $conn, $auth) = @_;
4652
4653     my $e = new_editor(authtoken => $auth);
4654     $e->checkauth or return $e->die_event;
4655     return $e->die_event unless $e->allowed('VIEW_TRIGGER_EVENT_DEF');
4656
4657     my $reactors = $e->json_query({
4658         select => {
4659             atevdef => [{column => "reactor", transform => "distinct"}]
4660         },
4661         from => {atevdef => {}}
4662     });
4663
4664     return $e->die_event unless ref $reactors eq "ARRAY";
4665     $e->disconnect;
4666
4667     return [ map { $_->{reactor} } @$reactors ];
4668 }
4669
4670 __PACKAGE__->register_method(
4671     method   => "filter_group_entry_crud",
4672     api_name => "open-ils.actor.filter_group_entry.crud",
4673     signature => {
4674         desc => q/
4675             Provides CRUD access to filter group entry objects.  These are not full accessible
4676             via PCRUD, since they requre "asq" objects for storing the query, and "asq" objects
4677             are not accessible via PCRUD (because they have no fields against which to link perms)
4678             /,
4679         params => [
4680             {desc => "Authentication token", type => "string"},
4681             {desc => "Entry ID / Entry Object", type => "number"},
4682             {desc => "Additional note text (optional)", type => "string"},
4683             {desc => "penalty org unit ID (optional, default to top of org tree)",
4684                 type => "number"}
4685         ],
4686         return => {
4687             desc => "Entry fleshed with query on Create, Retrieve, and Uupdate.  1 on Delete",
4688             type => "object"
4689         }
4690     }
4691 );
4692
4693 sub filter_group_entry_crud {
4694     my ($self, $conn, $auth, $arg) = @_;
4695
4696     return OpenILS::Event->new('BAD_PARAMS') unless $arg;
4697     my $e = new_editor(authtoken => $auth, xact => 1);
4698     return $e->die_event unless $e->checkauth;
4699
4700     if (ref $arg) {
4701
4702         if ($arg->isnew) {
4703
4704             my $grp = $e->retrieve_actor_search_filter_group($arg->grp)
4705                 or return $e->die_event;
4706
4707             return $e->die_event unless $e->allowed(
4708                 'ADMIN_SEARCH_FILTER_GROUP', $grp->owner);
4709
4710             my $query = $arg->query;
4711             $query = $e->create_actor_search_query($query) or return $e->die_event;
4712             $arg->query($query->id);
4713             my $entry = $e->create_actor_search_filter_group_entry($arg) or return $e->die_event;
4714             $entry->query($query);
4715
4716             $e->commit;
4717             return $entry;
4718
4719         } elsif ($arg->ischanged) {
4720
4721             my $entry = $e->retrieve_actor_search_filter_group_entry([
4722                 $arg->id, {
4723                     flesh => 1,
4724                     flesh_fields => {asfge => ['grp']}
4725                 }
4726             ]) or return $e->die_event;
4727
4728             return $e->die_event unless $e->allowed(
4729                 'ADMIN_SEARCH_FILTER_GROUP', $entry->grp->owner);
4730
4731             my $query = $e->update_actor_search_query($arg->query) or return $e->die_event;
4732             $arg->query($arg->query->id);
4733             $e->update_actor_search_filter_group_entry($arg) or return $e->die_event;
4734             $arg->query($query);
4735
4736             $e->commit;
4737             return $arg;
4738
4739         } elsif ($arg->isdeleted) {
4740
4741             my $entry = $e->retrieve_actor_search_filter_group_entry([
4742                 $arg->id, {
4743                     flesh => 1,
4744                     flesh_fields => {asfge => ['grp', 'query']}
4745                 }
4746             ]) or return $e->die_event;
4747
4748             return $e->die_event unless $e->allowed(
4749                 'ADMIN_SEARCH_FILTER_GROUP', $entry->grp->owner);
4750
4751             $e->delete_actor_search_filter_group_entry($entry) or return $e->die_event;
4752             $e->delete_actor_search_query($entry->query) or return $e->die_event;
4753
4754             $e->commit;
4755             return 1;
4756
4757         } else {
4758
4759             $e->rollback;
4760             return undef;
4761         }
4762
4763     } else {
4764
4765         my $entry = $e->retrieve_actor_search_filter_group_entry([
4766             $arg, {
4767                 flesh => 1,
4768                 flesh_fields => {asfge => ['grp', 'query']}
4769             }
4770         ]) or return $e->die_event;
4771
4772         return $e->die_event unless $e->allowed(
4773             ['ADMIN_SEARCH_FILTER_GROUP', 'VIEW_SEARCH_FILTER_GROUP'],
4774             $entry->grp->owner);
4775
4776         $e->rollback;
4777         $entry->grp($entry->grp->id); # for consistency
4778         return $entry;
4779     }
4780 }
4781
4782 1;