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