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