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 __PACKAGE__->register_method(
3032     method   => "update_penalties",
3033     api_name => "open-ils.actor.user.penalties.update_at_home"
3034 );
3035
3036 sub update_penalties {
3037     my($self, $conn, $auth, $user_id, @penalties) = @_;
3038     my $e = new_editor(authtoken=>$auth, xact => 1);
3039     return $e->die_event unless $e->checkauth;
3040     my $user = $e->retrieve_actor_user($user_id) or return $e->die_event;
3041     return $e->die_event unless $e->allowed('UPDATE_USER', $user->home_ou);
3042     my $context_org = ($self->api_name =~ /_at_home$/) ? $user->home_ou : $e->requestor->ws_ou;
3043     my $evt = OpenILS::Utils::Penalty->calculate_penalties($e, $user_id, $context_org, @penalties);
3044     return $evt if $evt;
3045     $e->commit;
3046     return 1;
3047 }
3048
3049
3050 __PACKAGE__->register_method(
3051     method   => "apply_penalty",
3052     api_name => "open-ils.actor.user.penalty.apply"
3053 );
3054
3055 sub apply_penalty {
3056     my($self, $conn, $auth, $penalty, $msg) = @_;
3057
3058     $msg ||= {};
3059
3060     my $e = new_editor(authtoken=>$auth, xact => 1);
3061     return $e->die_event unless $e->checkauth;
3062
3063     my $user = $e->retrieve_actor_user($penalty->usr) or return $e->die_event;
3064     return $e->die_event unless $e->allowed('UPDATE_USER', $user->home_ou);
3065
3066     my $ptype = $e->retrieve_config_standing_penalty($penalty->standing_penalty) or return $e->die_event;
3067
3068     my $ctx_org = $penalty->org_unit; # csp org_depth is now considered in the UI for the org drop-down menu
3069
3070     if (($msg->{title} || $msg->{message}) && ($msg->{title} ne '' || $msg->{message} ne '')) {
3071         my $aum = Fieldmapper::actor::usr_message->new;
3072
3073         $aum->create_date('now');
3074         $aum->sending_lib($e->requestor->ws_ou);
3075         $aum->title($msg->{title});
3076         $aum->usr($penalty->usr);
3077         $aum->message($msg->{message});
3078         $aum->pub($msg->{pub});
3079
3080         $aum = $e->create_actor_usr_message($aum)
3081             or return $e->die_event;
3082
3083         $penalty->usr_message($aum->id);
3084     }
3085
3086     $penalty->org_unit($ctx_org);
3087     $penalty->staff($e->requestor->id);
3088     $e->create_actor_user_standing_penalty($penalty) or return $e->die_event;
3089
3090     $e->commit;
3091     return $penalty->id;
3092 }
3093
3094 __PACKAGE__->register_method(
3095     method   => "modify_penalty",
3096     api_name => "open-ils.actor.user.penalty.modify"
3097 );
3098
3099 sub modify_penalty {
3100     my($self, $conn, $auth, $penalty, $usr_msg) = @_;
3101
3102     my $e = new_editor(authtoken=>$auth, xact => 1);
3103     return $e->die_event unless $e->checkauth;
3104
3105     my $user = $e->retrieve_actor_user($penalty->usr) or return $e->die_event;
3106     return $e->die_event unless $e->allowed('UPDATE_USER', $user->home_ou);
3107
3108     $usr_msg->editor($e->requestor->id);
3109     $usr_msg->edit_date('now');
3110
3111     if ($usr_msg->isnew) {
3112         $usr_msg = $e->create_actor_usr_message($usr_msg)
3113             or return $e->die_event;
3114         $penalty->usr_message($usr_msg->id);
3115     } else {
3116         $usr_msg = $e->update_actor_usr_message($usr_msg)
3117             or return $e->die_event;
3118     }
3119
3120     if ($penalty->isnew) {
3121         $penalty = $e->create_actor_user_standing_penalty($penalty)
3122             or return $e->die_event;
3123     } else {
3124         $penalty = $e->update_actor_user_standing_penalty($penalty)
3125             or return $e->die_event;
3126     }
3127
3128     $e->commit;
3129     return 1;
3130 }
3131
3132 __PACKAGE__->register_method(
3133     method   => "remove_penalty",
3134     api_name => "open-ils.actor.user.penalty.remove"
3135 );
3136
3137 sub remove_penalty {
3138     my($self, $conn, $auth, $penalty) = @_;
3139     my $e = new_editor(authtoken=>$auth, xact => 1);
3140     return $e->die_event unless $e->checkauth;
3141     my $user = $e->retrieve_actor_user($penalty->usr) or return $e->die_event;
3142     return $e->die_event unless $e->allowed('UPDATE_USER', $user->home_ou);
3143
3144     $e->delete_actor_user_standing_penalty($penalty) or return $e->die_event;
3145     $e->commit;
3146     return 1;
3147 }
3148
3149 __PACKAGE__->register_method(
3150     method   => "update_penalty_note",
3151     api_name => "open-ils.actor.user.penalty.note.update"
3152 );
3153
3154 sub update_penalty_note {
3155     my($self, $conn, $auth, $penalty_ids, $note) = @_;
3156     my $e = new_editor(authtoken=>$auth, xact => 1);
3157     return $e->die_event unless $e->checkauth;
3158     for my $penalty_id (@$penalty_ids) {
3159         my $penalty = $e->search_actor_user_standing_penalty([
3160             { id => $penalty_id },
3161             {   flesh => 1,
3162                 flesh_fields => {aum => ['usr_message']}
3163             }
3164         ])->[0];
3165         if (! $penalty ) { return $e->die_event; }
3166         my $user = $e->retrieve_actor_user($penalty->usr) or return $e->die_event;
3167         return $e->die_event unless $e->allowed('UPDATE_USER', $user->home_ou);
3168
3169         my $aum = $penalty->usr_message();
3170         if (!$aum) {
3171             $aum = Fieldmapper::actor::usr_message->new;
3172
3173             $aum->create_date('now');
3174             $aum->sending_lib($e->requestor->ws_ou);
3175             $aum->title('');
3176             $aum->usr($penalty->usr);
3177             $aum->message($note);
3178             $aum->pub(0);
3179             $aum->isnew(1);
3180
3181             $aum = $e->create_actor_usr_message($aum)
3182                 or return $e->die_event;
3183
3184             $penalty->usr_message($aum->id);
3185             $penalty->ischanged(1);
3186             $e->update_actor_user_standing_penalty($penalty) or return $e->die_event;
3187         } else {
3188             $aum = $e->retrieve_actor_usr_message($aum) or return $e->die_event;
3189             $aum->message($note); $aum->ischanged(1);
3190             $e->update_actor_usr_message($aum) or return $e->die_event;
3191         }
3192     }
3193     $e->commit;
3194     return 1;
3195 }
3196
3197 __PACKAGE__->register_method(
3198     method   => "ranged_penalty_thresholds",
3199     api_name => "open-ils.actor.grp_penalty_threshold.ranged.retrieve",
3200     stream   => 1
3201 );
3202
3203 sub ranged_penalty_thresholds {
3204     my($self, $conn, $auth, $context_org) = @_;
3205     my $e = new_editor(authtoken=>$auth);
3206     return $e->event unless $e->checkauth;
3207     return $e->event unless $e->allowed('VIEW_GROUP_PENALTY_THRESHOLD', $context_org);
3208     my $list = $e->search_permission_grp_penalty_threshold([
3209         {org_unit => $U->get_org_ancestors($context_org)},
3210         {order_by => {pgpt => 'id'}}
3211     ]);
3212     $conn->respond($_) for @$list;
3213     return undef;
3214 }
3215
3216
3217
3218 __PACKAGE__->register_method(
3219     method        => "user_retrieve_fleshed_by_id",
3220     authoritative => 1,
3221     api_name      => "open-ils.actor.user.fleshed.retrieve",
3222 );
3223
3224 sub user_retrieve_fleshed_by_id {
3225     my( $self, $client, $auth, $user_id, $fields ) = @_;
3226     my $e = new_editor(authtoken => $auth);
3227     return $e->event unless $e->checkauth;
3228
3229     if( $e->requestor->id != $user_id ) {
3230         return $e->event unless $e->allowed('VIEW_USER');
3231     }
3232
3233     $fields ||= [
3234         "cards",
3235         "card",
3236         "groups",
3237         "standing_penalties",
3238         "settings",
3239         "addresses",
3240         "billing_address",
3241         "mailing_address",
3242         "stat_cat_entries",
3243         "waiver_entries",
3244         "usr_activity" ];
3245     return new_flesh_user($user_id, $fields, $e);
3246 }
3247
3248
3249 sub new_flesh_user {
3250
3251     my $id = shift;
3252     my $fields = shift || [];
3253     my $e = shift;
3254
3255     my $fetch_penalties = 0;
3256     if(grep {$_ eq 'standing_penalties'} @$fields) {
3257         $fields = [grep {$_ ne 'standing_penalties'} @$fields];
3258         $fetch_penalties = 1;
3259     }
3260
3261     my $fetch_notes = 0;
3262     if(grep {$_ eq 'notes'} @$fields) {
3263         $fields = [grep {$_ ne 'notes'} @$fields];
3264         $fetch_notes = 1;
3265     }
3266
3267     my $fetch_usr_act = 0;
3268     if(grep {$_ eq 'usr_activity'} @$fields) {
3269         $fields = [grep {$_ ne 'usr_activity'} @$fields];
3270         $fetch_usr_act = 1;
3271     }
3272
3273     my $user = $e->retrieve_actor_user(
3274     [
3275         $id,
3276         {
3277             "flesh"             => 1,
3278             "flesh_fields" =>  { "au" => $fields }
3279         }
3280     ]
3281     ) or return $e->die_event;
3282
3283
3284     if( grep { $_ eq 'addresses' } @$fields ) {
3285
3286         $user->addresses([]) unless @{$user->addresses};
3287         # don't expose "replaced" addresses by default
3288         $user->addresses([grep {$_->id >= 0} @{$user->addresses}]);
3289
3290         if( ref $user->billing_address ) {
3291             unless( grep { $user->billing_address->id == $_->id } @{$user->addresses} ) {
3292                 push( @{$user->addresses}, $user->billing_address );
3293             }
3294         }
3295
3296         if( ref $user->mailing_address ) {
3297             unless( grep { $user->mailing_address->id == $_->id } @{$user->addresses} ) {
3298                 push( @{$user->addresses}, $user->mailing_address );
3299             }
3300         }
3301     }
3302
3303     if($fetch_penalties) {
3304         # grab the user penalties ranged for this location
3305         $user->standing_penalties(
3306             $e->search_actor_user_standing_penalty([
3307                 {   usr => $id,
3308                     '-or' => [
3309                         {stop_date => undef},
3310                         {stop_date => {'>' => 'now'}}
3311                     ],
3312                     org_unit => $U->get_org_full_path($e->requestor->ws_ou)
3313                 },
3314                 {   flesh => 1,
3315                     flesh_fields => {ausp => ['standing_penalty','usr_message']}
3316                 }
3317             ])
3318         );
3319     }
3320
3321     if($fetch_notes) {
3322         # grab notes (now actor.usr_message_penalty) that have not hit their stop_date
3323         # NOTE: This is a view that already filters out deleted messages that are not
3324         # attached to a penalty
3325         $user->notes([
3326             @{ $e->search_actor_usr_message_penalty([
3327                 {   usr => $id,
3328                     '-or' => [
3329                         {stop_date => undef},
3330                         {stop_date => {'>' => 'now'}}
3331                     ],
3332                 }, {}
3333             ]) }
3334         ]);
3335     }
3336
3337     # retrieve the most recent usr_activity entry
3338     if ($fetch_usr_act) {
3339
3340         # max number to return for simple patron fleshing
3341         my $limit = $U->ou_ancestor_setting_value(
3342             $e->requestor->ws_ou,
3343             'circ.patron.usr_activity_retrieve.max');
3344
3345         my $opts = {
3346             flesh => 1,
3347             flesh_fields => {auact => ['etype']},
3348             order_by => {auact => 'event_time DESC'},
3349         };
3350
3351         # 0 == none, <0 == return all
3352         $limit = 1 unless defined $limit;
3353         $opts->{limit} = $limit if $limit > 0;
3354
3355         $user->usr_activity(
3356             ($limit == 0) ?
3357                 [] : # skip the DB call
3358                 $e->search_actor_usr_activity([{usr => $user->id}, $opts])
3359         );
3360     }
3361
3362     $e->rollback;
3363     $user->clear_passwd();
3364     return $user;
3365 }
3366
3367
3368
3369
3370 __PACKAGE__->register_method(
3371     method   => "user_retrieve_parts",
3372     api_name => "open-ils.actor.user.retrieve.parts",
3373 );
3374
3375 sub user_retrieve_parts {
3376     my( $self, $client, $auth, $user_id, $fields ) = @_;
3377     my $e = new_editor(authtoken => $auth);
3378     return $e->event unless $e->checkauth;
3379     $user_id ||= $e->requestor->id;
3380     if( $e->requestor->id != $user_id ) {
3381         return $e->event unless $e->allowed('VIEW_USER');
3382     }
3383     my @resp;
3384     my $user = $e->retrieve_actor_user($user_id) or return $e->event;
3385     push(@resp, $user->$_()) for(@$fields);
3386     return \@resp;
3387 }
3388
3389
3390
3391 __PACKAGE__->register_method(
3392     method    => 'user_opt_in_enabled',
3393     api_name  => 'open-ils.actor.user.org_unit_opt_in.enabled',
3394     signature => '@return 1 if user opt-in is globally enabled, 0 otherwise.'
3395 );
3396
3397 sub user_opt_in_enabled {
3398     my($self, $conn) = @_;
3399     my $sc = OpenSRF::Utils::SettingsClient->new;
3400     return 1 if lc($sc->config_value(share => user => 'opt_in')) eq 'true';
3401     return 0;
3402 }
3403
3404
3405 __PACKAGE__->register_method(
3406     method    => 'user_opt_in_at_org',
3407     api_name  => 'open-ils.actor.user.org_unit_opt_in.check',
3408     signature => q/
3409         @param $auth The auth token
3410         @param user_id The ID of the user to test
3411         @return 1 if the user has opted in at the specified org,
3412             2 if opt-in is disallowed for the user's home org,
3413             event on error, and 0 otherwise. /
3414 );
3415 sub user_opt_in_at_org {
3416     my($self, $conn, $auth, $user_id) = @_;
3417
3418     # see if we even need to enforce the opt-in value
3419     return 1 unless user_opt_in_enabled($self);
3420
3421     my $e = new_editor(authtoken => $auth);
3422     return $e->event unless $e->checkauth;
3423
3424     my $user = $e->retrieve_actor_user($user_id) or return $e->event;
3425     return $e->event unless $e->allowed('VIEW_USER', $user->home_ou);
3426
3427     my $ws_org = $e->requestor->ws_ou;
3428     # user is automatically opted-in if they are from the local org
3429     return 1 if $user->home_ou eq $ws_org;
3430
3431     # get the boundary setting
3432     my $opt_boundary = $U->ou_ancestor_setting_value($e->requestor->ws_ou,'org.patron_opt_boundary');
3433
3434     # auto opt in if user falls within the opt boundary
3435     my $opt_orgs = $U->get_org_descendants($ws_org, $opt_boundary);
3436
3437     return 1 if grep $_ eq $user->home_ou, @$opt_orgs;
3438
3439     # check whether opt-in is restricted at the user's home library
3440     my $opt_restrict_depth = $U->ou_ancestor_setting_value($user->home_ou, 'org.restrict_opt_to_depth');
3441     if ($opt_restrict_depth) {
3442         my $restrict_ancestor = $U->org_unit_ancestor_at_depth($user->home_ou, $opt_restrict_depth);
3443         my $unrestricted_orgs = $U->get_org_descendants($restrict_ancestor);
3444
3445         # opt-in is disallowed unless the workstation org is within the home
3446         # library's opt-in scope
3447         return 2 unless grep $_ eq $e->requestor->ws_ou, @$unrestricted_orgs;
3448     }
3449
3450     my $vals = $e->search_actor_usr_org_unit_opt_in(
3451         {org_unit=>$opt_orgs, usr=>$user_id},{idlist=>1});
3452
3453     return 1 if @$vals;
3454     return 0;
3455 }
3456
3457 __PACKAGE__->register_method(
3458     method    => 'create_user_opt_in_at_org',
3459     api_name  => 'open-ils.actor.user.org_unit_opt_in.create',
3460     signature => q/
3461         @param $auth The auth token
3462         @param user_id The ID of the user to test
3463         @return The ID of the newly created object, event on error./
3464 );
3465
3466 sub create_user_opt_in_at_org {
3467     my($self, $conn, $auth, $user_id, $org_id) = @_;
3468
3469     my $e = new_editor(authtoken => $auth, xact=>1);
3470     return $e->die_event unless $e->checkauth;
3471
3472     # if a specific org unit wasn't passed in, get one based on the defaults;
3473     if(!$org_id){
3474         my $wsou = $e->requestor->ws_ou;
3475         # get the default opt depth
3476         my $opt_depth = $U->ou_ancestor_setting_value($wsou,'org.patron_opt_default');
3477         # get the org unit at that depth
3478         my $org = $e->json_query({
3479             from => [ 'actor.org_unit_ancestor_at_depth', $wsou, $opt_depth ]})->[0];
3480         $org_id = $org->{id};
3481     }
3482     if (!$org_id) {
3483         # fall back to the workstation OU, the pre-opt-in-boundary way
3484         $org_id = $e->requestor->ws_ou;
3485     }
3486
3487     my $user = $e->retrieve_actor_user($user_id) or return $e->die_event;
3488     return $e->die_event unless $e->allowed('UPDATE_USER', $user->home_ou);
3489
3490     my $opt_in = Fieldmapper::actor::usr_org_unit_opt_in->new;
3491
3492     $opt_in->org_unit($org_id);
3493     $opt_in->usr($user_id);
3494     $opt_in->staff($e->requestor->id);
3495     $opt_in->opt_in_ts('now');
3496     $opt_in->opt_in_ws($e->requestor->wsid);
3497
3498     $opt_in = $e->create_actor_usr_org_unit_opt_in($opt_in)
3499         or return $e->die_event;
3500
3501     $e->commit;
3502
3503     return $opt_in->id;
3504 }
3505
3506
3507 __PACKAGE__->register_method (
3508     method      => 'retrieve_org_hours',
3509     api_name    => 'open-ils.actor.org_unit.hours_of_operation.retrieve',
3510     signature   => q/
3511         Returns the hours of operation for a specified org unit
3512         @param authtoken The login session key
3513         @param org_id The org_unit ID
3514     /
3515 );
3516
3517 sub retrieve_org_hours {
3518     my($self, $conn, $auth, $org_id) = @_;
3519     my $e = new_editor(authtoken => $auth);
3520     return $e->die_event unless $e->checkauth;
3521     $org_id ||= $e->requestor->ws_ou;
3522     return $e->retrieve_actor_org_unit_hours_of_operation($org_id);
3523 }
3524
3525
3526 __PACKAGE__->register_method (
3527     method      => 'verify_user_password',
3528     api_name    => 'open-ils.actor.verify_user_password',
3529     signature   => q/
3530         Given a barcode or username and the MD5 encoded password,
3531         The password can also be passed without the MD5 hashing.
3532         returns 1 if the password is correct.  Returns 0 otherwise.
3533     /
3534 );
3535
3536 sub verify_user_password {
3537     my($self, $conn, $auth, $barcode, $username, $password, $pass_nohash) = @_;
3538     my $e = new_editor(authtoken => $auth);
3539     return $e->die_event unless $e->checkauth;
3540     my $user;
3541     my $user_by_barcode;
3542     my $user_by_username;
3543     if($barcode) {
3544         my $card = $e->search_actor_card([
3545             {barcode => $barcode},
3546             {flesh => 1, flesh_fields => {ac => ['usr']}}])->[0] or return 0;
3547         $user_by_barcode = $card->usr;
3548         $user = $user_by_barcode;
3549     }
3550     if ($username) {
3551         $user_by_username = $e->search_actor_user({usrname => $username})->[0] or return 0;
3552         $user = $user_by_username;
3553     }
3554     return 0 if (!$user || $U->is_true($user->deleted));
3555     return 0 if ($user_by_username && $user_by_barcode && $user_by_username->id != $user_by_barcode->id);
3556     return $e->event unless $e->allowed('VIEW_USER', $user->home_ou);
3557
3558     if ($pass_nohash) {
3559         return $U->verify_migrated_user_password($e, $user->id, $pass_nohash);
3560     } else {
3561         return $U->verify_migrated_user_password($e, $user->id, $password, 1);
3562     }
3563 }
3564
3565 __PACKAGE__->register_method (
3566     method      => 'retrieve_usr_id_via_barcode_or_usrname',
3567     api_name    => "open-ils.actor.user.retrieve_id_by_barcode_or_username",
3568     signature   => q/
3569         Given a barcode or username returns the id for the user or
3570         a failure event.
3571     /
3572 );
3573
3574 sub retrieve_usr_id_via_barcode_or_usrname {
3575     my($self, $conn, $auth, $barcode, $username) = @_;
3576     my $e = new_editor(authtoken => $auth);
3577     return $e->die_event unless $e->checkauth;
3578     my $id_as_barcode= OpenSRF::Utils::SettingsClient->new->config_value(apps => 'open-ils.actor' => app_settings => 'id_as_barcode');
3579     my $user;
3580     my $user_by_barcode;
3581     my $user_by_username;
3582     $logger->info("$id_as_barcode is the ID as BARCODE");
3583     if($barcode) {
3584         my $card = $e->search_actor_card([
3585             {barcode => $barcode},
3586             {flesh => 1, flesh_fields => {ac => ['usr']}}])->[0];
3587         if ($id_as_barcode =~ /^t/i) {
3588             if (!$card) {
3589                 $user = $e->retrieve_actor_user($barcode);
3590                 return OpenILS::Event->new( 'ACTOR_USER_NOT_FOUND' ) if(!$user);
3591             }else {
3592                 $user_by_barcode = $card->usr;
3593                 $user = $user_by_barcode;
3594             }
3595         }else {
3596             return OpenILS::Event->new( 'ACTOR_USER_NOT_FOUND' ) if(!$card);
3597             $user_by_barcode = $card->usr;
3598             $user = $user_by_barcode;
3599         }
3600     }
3601
3602     if ($username) {
3603         $user_by_username = $e->search_actor_user({usrname => $username})->[0] or return OpenILS::Event->new( 'ACTOR_USR_NOT_FOUND' );
3604
3605         $user = $user_by_username;
3606     }
3607     return OpenILS::Event->new( 'ACTOR_USER_NOT_FOUND' ) if (!$user);
3608     return OpenILS::Event->new( 'ACTOR_USER_NOT_FOUND' ) if ($user_by_username && $user_by_barcode && $user_by_username->id != $user_by_barcode->id);
3609     return $e->event unless $e->allowed('VIEW_USER', $user->home_ou);
3610     return $user->id;
3611 }
3612
3613
3614 __PACKAGE__->register_method (
3615     method      => 'merge_users',
3616     api_name    => 'open-ils.actor.user.merge',
3617     signature   => {
3618         desc => q/
3619             Given a list of source users and destination user, transfer all data from the source
3620             to the dest user and delete the source user.  All user related data is
3621             transferred, including circulations, holds, bookbags, etc.
3622         /
3623     }
3624 );
3625
3626 sub merge_users {
3627     my($self, $conn, $auth, $master_id, $user_ids, $options) = @_;
3628     my $e = new_editor(xact => 1, authtoken => $auth);
3629     return $e->die_event unless $e->checkauth;
3630
3631     # disallow the merge if any subordinate accounts are in collections
3632     my $colls = $e->search_money_collections_tracker({usr => $user_ids}, {idlist => 1});
3633     return OpenILS::Event->new('MERGED_USER_IN_COLLECTIONS', payload => $user_ids) if @$colls;
3634
3635     return OpenILS::Event->new('MERGE_SELF_NOT_ALLOWED')
3636         if $master_id == $e->requestor->id;
3637
3638     my $master_user = $e->retrieve_actor_user($master_id) or return $e->die_event;
3639     my $evt = group_perm_failed($e, $e->requestor, $master_user);
3640     return $evt if $evt;
3641
3642     my $del_addrs = ($U->ou_ancestor_setting_value(
3643         $master_user->home_ou, 'circ.user_merge.delete_addresses', $e)) ? 't' : 'f';
3644     my $del_cards = ($U->ou_ancestor_setting_value(
3645         $master_user->home_ou, 'circ.user_merge.delete_cards', $e)) ? 't' : 'f';
3646     my $deactivate_cards = ($U->ou_ancestor_setting_value(
3647         $master_user->home_ou, 'circ.user_merge.deactivate_cards', $e)) ? 't' : 'f';
3648
3649     for my $src_id (@$user_ids) {
3650
3651         my $src_user = $e->retrieve_actor_user($src_id) or return $e->die_event;
3652         my $evt = group_perm_failed($e, $e->requestor, $src_user);
3653         return $evt if $evt;
3654
3655         return OpenILS::Event->new('MERGE_SELF_NOT_ALLOWED')
3656             if $src_id == $e->requestor->id;
3657
3658         return $e->die_event unless $e->allowed('MERGE_USERS', $src_user->home_ou);
3659         if($src_user->home_ou ne $master_user->home_ou) {
3660             return $e->die_event unless $e->allowed('MERGE_USERS', $master_user->home_ou);
3661         }
3662
3663         return $e->die_event unless
3664             $e->json_query({from => [
3665                 'actor.usr_merge',
3666                 $src_id,
3667                 $master_id,
3668                 $del_addrs,
3669                 $del_cards,
3670                 $deactivate_cards
3671             ]});
3672     }
3673
3674     $e->commit;
3675     return 1;
3676 }
3677
3678
3679 __PACKAGE__->register_method (
3680     method      => 'approve_user_address',
3681     api_name    => 'open-ils.actor.user.pending_address.approve',
3682     signature   => {
3683         desc => q/
3684         /
3685     }
3686 );
3687
3688 sub approve_user_address {
3689     my($self, $conn, $auth, $addr) = @_;
3690     my $e = new_editor(xact => 1, authtoken => $auth);
3691     return $e->die_event unless $e->checkauth;
3692     if(ref $addr) {
3693         # if the caller passes an address object, assume they want to
3694         # update it first before approving it
3695         $e->update_actor_user_address($addr) or return $e->die_event;
3696     } else {
3697         $addr = $e->retrieve_actor_user_address($addr) or return $e->die_event;
3698     }
3699     my $user = $e->retrieve_actor_user($addr->usr);
3700     return $e->die_event unless $e->allowed('UPDATE_USER', $user->home_ou);
3701     my $result = $e->json_query({from => ['actor.approve_pending_address', $addr->id]})->[0]
3702         or return $e->die_event;
3703     $e->commit;
3704     return [values %$result]->[0];
3705 }
3706
3707
3708 __PACKAGE__->register_method (
3709     method      => 'retrieve_friends',
3710     api_name    => 'open-ils.actor.friends.retrieve',
3711     signature   => {
3712         desc => q/
3713             returns { confirmed: [], pending_out: [], pending_in: []}
3714             pending_out are users I'm requesting friendship with
3715             pending_in are users requesting friendship with me
3716         /
3717     }
3718 );
3719
3720 sub retrieve_friends {
3721     my($self, $conn, $auth, $user_id, $options) = @_;
3722     my $e = new_editor(authtoken => $auth);
3723     return $e->event unless $e->checkauth;
3724     $user_id ||= $e->requestor->id;
3725
3726     if($user_id != $e->requestor->id) {
3727         my $user = $e->retrieve_actor_user($user_id) or return $e->event;
3728         return $e->event unless $e->allowed('VIEW_USER', $user->home_ou);
3729     }
3730
3731     return OpenILS::Application::Actor::Friends->retrieve_friends(
3732         $e, $user_id, $options);
3733 }
3734
3735
3736
3737 __PACKAGE__->register_method (
3738     method      => 'apply_friend_perms',
3739     api_name    => 'open-ils.actor.friends.perms.apply',
3740     signature   => {
3741         desc => q/
3742         /
3743     }
3744 );
3745 sub apply_friend_perms {
3746     my($self, $conn, $auth, $user_id, $delegate_id, @perms) = @_;
3747     my $e = new_editor(authtoken => $auth, xact => 1);
3748     return $e->die_event unless $e->checkauth;
3749
3750     if($user_id != $e->requestor->id) {
3751         my $user = $e->retrieve_actor_user($user_id) or return $e->die_event;
3752         return $e->die_event unless $e->allowed('VIEW_USER', $user->home_ou);
3753     }
3754
3755     for my $perm (@perms) {
3756         my $evt =
3757             OpenILS::Application::Actor::Friends->apply_friend_perm(
3758                 $e, $user_id, $delegate_id, $perm);
3759         return $evt if $evt;
3760     }
3761
3762     $e->commit;
3763     return 1;
3764 }
3765
3766
3767 __PACKAGE__->register_method (
3768     method      => 'update_user_pending_address',
3769     api_name    => 'open-ils.actor.user.address.pending.cud'
3770 );
3771
3772 sub update_user_pending_address {
3773     my($self, $conn, $auth, $addr) = @_;
3774     my $e = new_editor(authtoken => $auth, xact => 1);
3775     return $e->die_event unless $e->checkauth;
3776
3777     my $user = $e->retrieve_actor_user($addr->usr) or return $e->die_event;
3778     if($addr->usr != $e->requestor->id) {
3779         return $e->die_event unless $e->allowed('UPDATE_USER', $user->home_ou);
3780     }
3781
3782     if($addr->isnew) {
3783         $e->create_actor_user_address($addr) or return $e->die_event;
3784     } elsif($addr->isdeleted) {
3785         $e->delete_actor_user_address($addr) or return $e->die_event;
3786     } else {
3787         $e->update_actor_user_address($addr) or return $e->die_event;
3788     }
3789
3790     $e->commit;
3791     $U->create_events_for_hook('au.updated', $user, $e->requestor->ws_ou);
3792
3793     return $addr->id;
3794 }
3795
3796
3797 __PACKAGE__->register_method (
3798     method      => 'user_events',
3799     api_name    => 'open-ils.actor.user.events.circ',
3800     stream      => 1,
3801 );
3802 __PACKAGE__->register_method (
3803     method      => 'user_events',
3804     api_name    => 'open-ils.actor.user.events.ahr',
3805     stream      => 1,
3806 );
3807
3808 sub user_events {
3809     my($self, $conn, $auth, $user_id, $filters) = @_;
3810     my $e = new_editor(authtoken => $auth);
3811     return $e->event unless $e->checkauth;
3812
3813     (my $obj_type = $self->api_name) =~ s/.*\.([a-z]+)$/$1/;
3814     my $user_field = 'usr';
3815
3816     $filters ||= {};
3817     $filters->{target} = {
3818         select => { $obj_type => ['id'] },
3819         from => $obj_type,
3820         where => {usr => $user_id}
3821     };
3822
3823     my $user = $e->retrieve_actor_user($user_id) or return $e->event;
3824     if($e->requestor->id != $user_id) {
3825         return $e->event unless $e->allowed('VIEW_USER', $user->home_ou);
3826     }
3827
3828     my $ses = OpenSRF::AppSession->create('open-ils.trigger');
3829     my $req = $ses->request('open-ils.trigger.events_by_target',
3830         $obj_type, $filters, {atevdef => ['reactor', 'validator']}, 2);
3831
3832     while(my $resp = $req->recv) {
3833         my $val = $resp->content;
3834         my $tgt = $val->target;
3835
3836         if($obj_type eq 'circ') {
3837             $tgt->target_copy($e->retrieve_asset_copy($tgt->target_copy));
3838
3839         } elsif($obj_type eq 'ahr') {
3840             $tgt->current_copy($e->retrieve_asset_copy($tgt->current_copy))
3841                 if $tgt->current_copy;
3842         }
3843
3844         $conn->respond($val) if $val;
3845     }
3846
3847     return undef;
3848 }
3849
3850 __PACKAGE__->register_method (
3851     method      => 'copy_events',
3852     api_name    => 'open-ils.actor.copy.events.circ',
3853     stream      => 1,
3854 );
3855 __PACKAGE__->register_method (
3856     method      => 'copy_events',
3857     api_name    => 'open-ils.actor.copy.events.ahr',
3858     stream      => 1,
3859 );
3860
3861 sub copy_events {
3862     my($self, $conn, $auth, $copy_id, $filters) = @_;
3863     my $e = new_editor(authtoken => $auth);
3864     return $e->event unless $e->checkauth;
3865
3866     (my $obj_type = $self->api_name) =~ s/.*\.([a-z]+)$/$1/;
3867
3868     my $copy = $e->retrieve_asset_copy($copy_id) or return $e->event;
3869
3870     my $copy_field = 'target_copy';
3871     $copy_field = 'current_copy' if $obj_type eq 'ahr';
3872
3873     $filters ||= {};
3874     $filters->{target} = {
3875         select => { $obj_type => ['id'] },
3876         from => $obj_type,
3877         where => {$copy_field => $copy_id}
3878     };
3879
3880
3881     my $ses = OpenSRF::AppSession->create('open-ils.trigger');
3882     my $req = $ses->request('open-ils.trigger.events_by_target',
3883         $obj_type, $filters, {atevdef => ['reactor', 'validator']}, 2);
3884
3885     while(my $resp = $req->recv) {
3886         my $val = $resp->content;
3887         my $tgt = $val->target;
3888
3889         my $user = $e->retrieve_actor_user($tgt->usr);
3890         if($e->requestor->id != $user->id) {
3891             return $e->event unless $e->allowed('VIEW_USER', $user->home_ou);
3892         }
3893
3894         $tgt->$copy_field($copy);
3895
3896         $tgt->usr($user);
3897         $conn->respond($val) if $val;
3898     }
3899
3900     return undef;
3901 }
3902
3903
3904 __PACKAGE__->register_method (
3905     method      => 'get_itemsout_notices',
3906     api_name    => 'open-ils.actor.user.itemsout.notices',
3907     stream      => 1,
3908     argc        => 2,
3909     signature   => {
3910         desc => q/Summary counts of circulat notices/,
3911         params => [
3912             {desc => 'authtoken', type => 'string'},
3913             {desc => 'circulation identifiers', type => 'array of numbers'}
3914         ],
3915         return => q/Stream of summary objects/
3916     }
3917 );
3918
3919 sub get_itemsout_notices {
3920     my ($self, $client, $auth, $circ_ids) = @_;
3921
3922     my $e = new_editor(authtoken => $auth);
3923     return $e->event unless $e->checkauth;
3924
3925     $circ_ids = [$circ_ids] unless ref $circ_ids eq 'ARRAY';
3926
3927     for my $circ_id (@$circ_ids) {
3928         my $resp = get_itemsout_notices_impl($e, $circ_id);
3929
3930         if ($U->is_event($resp)) {
3931             $client->respond($resp);
3932             return;
3933         }
3934
3935         $client->respond({circ_id => $circ_id, %$resp});
3936     }
3937
3938     return undef;
3939 }
3940
3941
3942
3943 sub get_itemsout_notices_impl {
3944     my ($e, $circId) = @_;
3945
3946     my $requestorId = $e->requestor->id;
3947
3948     my $circ = $e->retrieve_action_circulation($circId) or return $e->event;
3949
3950     my $patronId = $circ->usr;
3951
3952     if( $patronId ne $requestorId ){
3953         my $user = $e->retrieve_actor_user($requestorId) or return $e->event;
3954         return $e->event unless $e->allowed('VIEW_CIRCULATIONS', $user->home_ou);
3955     }
3956
3957     #my $ses = OpenSRF::AppSession->create('open-ils.trigger');
3958     #my $req = $ses->request('open-ils.trigger.events_by_target',
3959     #   'circ', {target => [$circId], event=> {state=>'complete'}});
3960     # ^ Above removed in favor of faster json_query.
3961     #
3962     # SQL:
3963     # select complete_time
3964     # from action_trigger.event atev
3965     #     JOIN action_trigger.event_definition def ON (def.id = atev.event_def)
3966     #     JOIN action_trigger.hook athook ON (athook.key = def.hook)
3967     # where hook = 'checkout.due' AND state = 'complete' and target = <circId>;
3968     #
3969
3970     my $ctx_loc = $e->requestor->ws_ou;
3971     my $exclude_courtesy_notices = $U->ou_ancestor_setting_value(
3972         $ctx_loc, 'webstaff.circ.itemsout_notice_count_excludes_courtesies');
3973
3974     my $query = {
3975             select => { atev => ["complete_time"] },
3976             from => {
3977                     atev => {
3978                             atevdef => { field => "id",fkey => "event_def"}
3979                     }
3980             },
3981             where => {
3982             "+atevdef" => { active => 't', hook => 'checkout.due' },
3983             "+atev" => { target => $circId, state => 'complete' }
3984         }
3985     };
3986
3987     if ($exclude_courtesy_notices){
3988         $query->{"where"}->{"+atevdef"}->{validator} = { "<>" => "CircIsOpen"};
3989     }
3990
3991     my %resblob = ( numNotices => 0, lastDt => undef );
3992
3993     my $res = $e->json_query($query);
3994     for my $ndate (@$res) {
3995         $resblob{numNotices}++;
3996         if( !defined $resblob{lastDt}){
3997             $resblob{lastDt} = $$ndate{complete_time};
3998         }
3999
4000         if ($resblob{lastDt} lt $$ndate{complete_time}){
4001            $resblob{lastDt} = $$ndate{complete_time};
4002         }
4003    }
4004
4005     return \%resblob;
4006 }
4007
4008 __PACKAGE__->register_method (
4009     method      => 'update_events',
4010     api_name    => 'open-ils.actor.user.event.cancel.batch',
4011     stream      => 1,
4012 );
4013 __PACKAGE__->register_method (
4014     method      => 'update_events',
4015     api_name    => 'open-ils.actor.user.event.reset.batch',
4016     stream      => 1,
4017 );
4018
4019 sub update_events {
4020     my($self, $conn, $auth, $event_ids) = @_;
4021     my $e = new_editor(xact => 1, authtoken => $auth);
4022     return $e->die_event unless $e->checkauth;
4023
4024     my $x = 1;
4025     for my $id (@$event_ids) {
4026
4027         # do a little dance to determine what user we are ultimately affecting
4028         my $event = $e->retrieve_action_trigger_event([
4029             $id,
4030             {   flesh => 2,
4031                 flesh_fields => {atev => ['event_def'], atevdef => ['hook']}
4032             }
4033         ]) or return $e->die_event;
4034
4035         my $user_id;
4036         if($event->event_def->hook->core_type eq 'circ') {
4037             $user_id = $e->retrieve_action_circulation($event->target)->usr;
4038         } elsif($event->event_def->hook->core_type eq 'ahr') {
4039             $user_id = $e->retrieve_action_hold_request($event->target)->usr;
4040         } else {
4041             return 0;
4042         }
4043
4044         my $user = $e->retrieve_actor_user($user_id);
4045         return $e->die_event unless $e->allowed('UPDATE_USER', $user->home_ou);
4046
4047         if($self->api_name =~ /cancel/) {
4048             $event->state('invalid');
4049         } elsif($self->api_name =~ /reset/) {
4050             $event->clear_start_time;
4051             $event->clear_update_time;
4052             $event->state('pending');
4053         }
4054
4055         $e->update_action_trigger_event($event) or return $e->die_event;
4056         $conn->respond({maximum => scalar(@$event_ids), progress => $x++});
4057     }
4058
4059     $e->commit;
4060     return {complete => 1};
4061 }
4062
4063
4064 __PACKAGE__->register_method (
4065     method      => 'really_delete_user',
4066     api_name    => 'open-ils.actor.user.delete.override',
4067     signature   => q/@see open-ils.actor.user.delete/
4068 );
4069
4070 __PACKAGE__->register_method (
4071     method      => 'really_delete_user',
4072     api_name    => 'open-ils.actor.user.delete',
4073     signature   => q/
4074         It anonymizes all personally identifiable information in actor.usr. By calling actor.usr_purge_data()
4075         it also purges related data from other tables, sometimes by transferring it to a designated destination user.
4076         The usrname field (along with first_given_name and family_name) is updated to id '-PURGED-' now().
4077         dest_usr_id is only required when deleting a user that performs staff functions.
4078     /
4079 );
4080
4081 sub really_delete_user {
4082     my($self, $conn, $auth, $user_id, $dest_user_id, $oargs) = @_;
4083     my $e = new_editor(authtoken => $auth, xact => 1);
4084     return $e->die_event unless $e->checkauth;
4085     $oargs = { all => 1 } unless defined $oargs;
4086
4087     # Find all unclosed billings for for user $user_id, thereby, also checking for open circs
4088     my $open_bills = $e->json_query({
4089         select => { mbts => ['id'] },
4090         from => 'mbts',
4091         where => {
4092             xact_finish => { '=' => undef },
4093             usr => { '=' => $user_id },
4094         }
4095     }) or return $e->die_event;
4096
4097     my $user = $e->retrieve_actor_user($user_id) or return $e->die_event;
4098
4099     # No deleting patrons with open billings or checked out copies, unless perm-enabled override
4100     if (@$open_bills) {
4101         return $e->die_event(OpenILS::Event->new('ACTOR_USER_DELETE_OPEN_XACTS'))
4102         unless $self->api_name =~ /override/o && ($oargs->{all} || grep { $_ eq 'ACTOR_USER_DELETE_OPEN_XACTS' } @{$oargs->{events}})
4103         && $e->allowed('ACTOR_USER_DELETE_OPEN_XACTS.override', $user->home_ou);
4104     }
4105     # No deleting yourself - UI is supposed to stop you first, though.
4106     return $e->die_event unless $e->requestor->id != $user->id;
4107     return $e->die_event unless $e->allowed('DELETE_USER', $user->home_ou);
4108     # Check if you are allowed to mess with this patron permission group at all
4109     my $evt = group_perm_failed($e, $e->requestor, $user);
4110     return $e->die_event($evt) if $evt;
4111     my $stat = $e->json_query(
4112         {from => ['actor.usr_delete', $user_id, $dest_user_id]})->[0]
4113         or return $e->die_event;
4114     $e->commit;
4115     return 1;
4116 }
4117
4118
4119 __PACKAGE__->register_method (
4120     method      => 'user_payments',
4121     api_name    => 'open-ils.actor.user.payments.retrieve',
4122     stream => 1,
4123     signature   => q/
4124         Returns all payments for a given user.  Default order is newest payments first.
4125         @param auth Authentication token
4126         @param user_id The user ID
4127         @param filters An optional hash of filters, including limit, offset, and order_by definitions
4128     /
4129 );
4130
4131 sub user_payments {
4132     my($self, $conn, $auth, $user_id, $filters) = @_;
4133     $filters ||= {};
4134
4135     my $e = new_editor(authtoken => $auth);
4136     return $e->die_event unless $e->checkauth;
4137
4138     my $user = $e->retrieve_actor_user($user_id) or return $e->event;
4139     return $e->event unless
4140         $e->requestor->id == $user_id or
4141         $e->allowed('VIEW_USER_TRANSACTIONS', $user->home_ou);
4142
4143     # Find all payments for all transactions for user $user_id
4144     my $query = {
4145         select => {mp => ['id']},
4146         from => 'mp',
4147         where => {
4148             xact => {
4149                 in => {
4150                     select => {mbt => ['id']},
4151                     from => 'mbt',
4152                     where => {usr => $user_id}
4153                 }
4154             }
4155         },
4156         order_by => [
4157             { # by default, order newest payments first
4158                 class => 'mp',
4159                 field => 'payment_ts',
4160                 direction => 'desc'
4161             }, {
4162                 # secondary sort in ID as a tie-breaker, since payments created
4163                 # within the same transaction will have identical payment_ts's
4164                 class => 'mp',
4165                 field => 'id'
4166             }
4167         ]
4168     };
4169
4170     for (qw/order_by limit offset/) {
4171         $query->{$_} = $filters->{$_} if defined $filters->{$_};
4172     }
4173
4174     if(defined $filters->{where}) {
4175         foreach (keys %{$filters->{where}}) {
4176             # don't allow the caller to expand the result set to other users
4177             $query->{where}->{$_} = $filters->{where}->{$_} unless $_ eq 'xact';
4178         }
4179     }
4180
4181     my $payment_ids = $e->json_query($query);
4182     for my $pid (@$payment_ids) {
4183         my $pay = $e->retrieve_money_payment([
4184             $pid->{id},
4185             {   flesh => 6,
4186                 flesh_fields => {
4187                     mp => ['xact'],
4188                     mbt => ['summary', 'circulation', 'grocery'],
4189                     circ => ['target_copy'],
4190                     acp => ['call_number'],
4191                     acn => ['record']
4192                 }
4193             }
4194         ]);
4195
4196         my $resp = {
4197             mp => $pay,
4198             xact_type => $pay->xact->summary->xact_type,
4199             last_billing_type => $pay->xact->summary->last_billing_type,
4200         };
4201
4202         if($pay->xact->summary->xact_type eq 'circulation') {
4203             $resp->{barcode} = $pay->xact->circulation->target_copy->barcode;
4204             $resp->{title} = $U->record_to_mvr($pay->xact->circulation->target_copy->call_number->record)->title;
4205         }
4206
4207         $pay->xact($pay->xact->id); # de-flesh
4208         $conn->respond($resp);
4209     }
4210
4211     return undef;
4212 }
4213
4214
4215
4216 __PACKAGE__->register_method (
4217     method      => 'negative_balance_users',
4218     api_name    => 'open-ils.actor.users.negative_balance',
4219     stream => 1,
4220     signature   => q/
4221         Returns all users that have an overall negative balance
4222         @param auth Authentication token
4223         @param org_id The context org unit as an ID or list of IDs.  This will be the home
4224         library of the user.  If no org_unit is specified, no org unit filter is applied
4225     /
4226 );
4227
4228 sub negative_balance_users {
4229     my($self, $conn, $auth, $org_id, $options) = @_;
4230
4231     $options ||= {};
4232     $options->{limit} = 1000 unless $options->{limit};
4233     $options->{offset} = 0 unless $options->{offset};
4234
4235     my $e = new_editor(authtoken => $auth);
4236     return $e->die_event unless $e->checkauth;
4237     return $e->die_event unless $e->allowed('VIEW_USER', $org_id);
4238
4239     my $query = {
4240         select => {
4241             mous => ['usr', 'balance_owed'],
4242             au => ['home_ou'],
4243             mbts => [
4244                 {column => 'last_billing_ts', transform => 'max', aggregate => 1},
4245                 {column => 'last_payment_ts', transform => 'max', aggregate => 1},
4246             ]
4247         },
4248         from => {
4249             mous => {
4250                 au => {
4251                     fkey => 'usr',
4252                     field => 'id',
4253                     join => {
4254                         mbts => {
4255                             key => 'id',
4256                             field => 'usr'
4257                         }
4258                     }
4259                 }
4260             }
4261         },
4262         where => {'+mous' => {balance_owed => {'<' => 0}}},
4263         offset => $options->{offset},
4264         limit => $options->{limit},
4265         order_by => [{class => 'mous', field => 'usr'}]
4266     };
4267
4268     $org_id = $U->get_org_descendants($org_id) if $options->{org_descendants};
4269
4270     $query->{from}->{mous}->{au}->{filter}->{home_ou} = $org_id if $org_id;
4271
4272     my $list = $e->json_query($query, {timeout => 600});
4273
4274     for my $data (@$list) {
4275         $conn->respond({
4276             usr => $e->retrieve_actor_user([$data->{usr}, {flesh => 1, flesh_fields => {au => ['card']}}]),
4277             balance_owed => $data->{balance_owed},
4278             last_billing_activity => max($data->{last_billing_ts}, $data->{last_payment_ts})
4279         });
4280     }
4281
4282     return undef;
4283 }
4284
4285 __PACKAGE__->register_method(
4286     method  => "request_password_reset",
4287     api_name    => "open-ils.actor.patron.password_reset.request",
4288     signature   => {
4289         desc => "Generates a UUID token usable with the open-ils.actor.patron.password_reset.commit " .
4290                 "method for changing a user's password.  The UUID token is distributed via A/T "      .
4291                 "templates (i.e. email to the user).",
4292         params => [
4293             { desc => 'user_id_type', type => 'string' },
4294             { desc => 'user_id', type => 'string' },
4295             { desc => 'optional (based on library setting) matching email address for authorizing request', type => 'string' },
4296         ],
4297         return => {desc => '1 on success, Event on error'}
4298     }
4299 );
4300 sub request_password_reset {
4301     my($self, $conn, $user_id_type, $user_id, $email) = @_;
4302
4303     # Check to see if password reset requests are already being throttled:
4304     # 0. Check cache to see if we're in throttle mode (avoid hitting database)
4305
4306     my $e = new_editor(xact => 1);
4307     my $user;
4308
4309     # Get the user, if any, depending on the input value
4310     if ($user_id_type eq 'username') {
4311         $user = $e->search_actor_user({usrname => $user_id})->[0];
4312         if (!$user) {
4313             $e->die_event;
4314             return OpenILS::Event->new( 'ACTOR_USER_NOT_FOUND' );
4315         }
4316     } elsif ($user_id_type eq 'barcode') {
4317         my $card = $e->search_actor_card([
4318             {barcode => $user_id},
4319             {flesh => 1, flesh_fields => {ac => ['usr']}}])->[0];
4320         if (!$card) {
4321             $e->die_event;
4322             return OpenILS::Event->new('ACTOR_USER_NOT_FOUND');
4323         }
4324         $user = $card->usr;
4325     }
4326
4327     # If the user doesn't have an email address, we can't help them
4328     if (!$user->email) {
4329         $e->die_event;
4330         return OpenILS::Event->new('PATRON_NO_EMAIL_ADDRESS');
4331     }
4332
4333     my $email_must_match = $U->ou_ancestor_setting_value($user->home_ou, 'circ.password_reset_request_requires_matching_email');
4334     if ($email_must_match) {
4335         if (lc($user->email) ne lc($email)) {
4336             return OpenILS::Event->new('EMAIL_VERIFICATION_FAILED');
4337         }
4338     }
4339
4340     _reset_password_request($conn, $e, $user);
4341 }
4342
4343 # Once we have the user, we can issue the password reset request
4344 # XXX Add a wrapper method that accepts barcode + email input
4345 sub _reset_password_request {
4346     my ($conn, $e, $user) = @_;
4347
4348     # 1. Get throttle threshold and time-to-live from OU_settings
4349     my $aupr_throttle = $U->ou_ancestor_setting_value($user->home_ou, 'circ.password_reset_request_throttle') || 1000;
4350     my $aupr_ttl = $U->ou_ancestor_setting_value($user->home_ou, 'circ.password_reset_request_time_to_live') || 24*60*60;
4351
4352     my $threshold_time = DateTime->now(time_zone => 'local')->subtract(seconds => $aupr_ttl)->iso8601();
4353
4354     # 2. Get time of last request and number of active requests (num_active)
4355     my $active_requests = $e->json_query({
4356         from => 'aupr',
4357         select => {
4358             aupr => [
4359                 {
4360                     column => 'uuid',
4361                     transform => 'COUNT'
4362                 },
4363                 {
4364                     column => 'request_time',
4365                     transform => 'MAX'
4366                 }
4367             ]
4368         },
4369         where => {
4370             has_been_reset => { '=' => 'f' },
4371             request_time => { '>' => $threshold_time }
4372         }
4373     });
4374
4375     # Guard against no active requests
4376     if ($active_requests->[0]->{'request_time'}) {
4377         my $last_request = DateTime::Format::ISO8601->parse_datetime(clean_ISO8601($active_requests->[0]->{'request_time'}));
4378         my $now = DateTime::Format::ISO8601->new();
4379
4380         # 3. if (num_active > throttle_threshold) and (now - last_request < 1 minute)
4381         if (($active_requests->[0]->{'usr'} > $aupr_throttle) &&
4382             ($last_request->add_duration('1 minute') > $now)) {
4383             $cache->put_cache('open-ils.actor.password.throttle', DateTime::Format::ISO8601->new(), 60);
4384             $e->die_event;
4385             return OpenILS::Event->new('PATRON_TOO_MANY_ACTIVE_PASSWORD_RESET_REQUESTS');
4386         }
4387     }
4388
4389     # TODO Check to see if the user is in a password-reset-restricted group
4390
4391     # Otherwise, go ahead and try to get the user.
4392
4393     # Check the number of active requests for this user
4394     $active_requests = $e->json_query({
4395         from => 'aupr',
4396         select => {
4397             aupr => [
4398                 {
4399                     column => 'usr',
4400                     transform => 'COUNT'
4401                 }
4402             ]
4403         },
4404         where => {
4405             usr => { '=' => $user->id },
4406             has_been_reset => { '=' => 'f' },
4407             request_time => { '>' => $threshold_time }
4408         }
4409     });
4410
4411     $logger->info("User " . $user->id . " has " . $active_requests->[0]->{'usr'} . " active password reset requests.");
4412
4413     # if less than or equal to per-user threshold, proceed; otherwise, return event
4414     my $aupr_per_user_limit = $U->ou_ancestor_setting_value($user->home_ou, 'circ.password_reset_request_per_user_limit') || 3;
4415     if ($active_requests->[0]->{'usr'} > $aupr_per_user_limit) {
4416         $e->die_event;
4417         return OpenILS::Event->new('PATRON_TOO_MANY_ACTIVE_PASSWORD_RESET_REQUESTS');
4418     }
4419
4420     # Create the aupr object and insert into the database
4421     my $reset_request = Fieldmapper::actor::usr_password_reset->new;
4422     my $uuid = create_uuid_as_string(UUID_V4);
4423     $reset_request->uuid($uuid);
4424     $reset_request->usr($user->id);
4425
4426     my $aupr = $e->create_actor_usr_password_reset($reset_request) or return $e->die_event;
4427     $e->commit;
4428
4429     # Create an event to notify user of the URL to reset their password
4430
4431     # Can we stuff this in the user_data param for trigger autocreate?
4432     my $hostname = $U->ou_ancestor_setting_value($user->home_ou, 'lib.hostname') || 'localhost';
4433
4434     my $ses = OpenSRF::AppSession->create('open-ils.trigger');
4435     $ses->request('open-ils.trigger.event.autocreate', 'password.reset_request', $aupr, $user->home_ou);
4436
4437     # Trunk only
4438     # $U->create_trigger_event('password.reset_request', $aupr, $user->home_ou);
4439
4440     return 1;
4441 }
4442
4443 __PACKAGE__->register_method(
4444     method  => "commit_password_reset",
4445     api_name    => "open-ils.actor.patron.password_reset.commit",
4446     signature   => {
4447         desc => "Checks a UUID token generated by the open-ils.actor.patron.password_reset.request method for " .
4448                 "validity, and if valid, uses it as authorization for changing the associated user's password " .
4449                 "with the supplied password.",
4450         params => [
4451             { desc => 'uuid', type => 'string' },
4452             { desc => 'password', type => 'string' },
4453         ],
4454         return => {desc => '1 on success, Event on error'}
4455     }
4456 );
4457 sub commit_password_reset {
4458     my($self, $conn, $uuid, $password) = @_;
4459
4460     # Check to see if password reset requests are already being throttled:
4461     # 0. Check cache to see if we're in throttle mode (avoid hitting database)
4462     $cache ||= OpenSRF::Utils::Cache->new("global", 0);
4463     my $throttle = $cache->get_cache('open-ils.actor.password.throttle') || undef;
4464     if ($throttle) {
4465         return OpenILS::Event->new('PATRON_NOT_AN_ACTIVE_PASSWORD_RESET_REQUEST');
4466     }
4467
4468     my $e = new_editor(xact => 1);
4469
4470     my $aupr = $e->search_actor_usr_password_reset({
4471         uuid => $uuid,
4472         has_been_reset => 0
4473     });
4474
4475     if (!$aupr->[0]) {
4476         $e->die_event;
4477         return OpenILS::Event->new('PATRON_NOT_AN_ACTIVE_PASSWORD_RESET_REQUEST');
4478     }
4479     my $user_id = $aupr->[0]->usr;
4480     my $user = $e->retrieve_actor_user($user_id);
4481
4482     # Ensure we're still within the TTL for the request
4483     my $aupr_ttl = $U->ou_ancestor_setting_value($user->home_ou, 'circ.password_reset_request_time_to_live') || 24*60*60;
4484     my $threshold = DateTime::Format::ISO8601->parse_datetime(clean_ISO8601($aupr->[0]->request_time))->add(seconds => $aupr_ttl);
4485     if ($threshold < DateTime->now(time_zone => 'local')) {
4486         $e->die_event;
4487         $logger->info("Password reset request needed to be submitted before $threshold");
4488         return OpenILS::Event->new('PATRON_NOT_AN_ACTIVE_PASSWORD_RESET_REQUEST');
4489     }
4490
4491     # Check complexity of password against OU-defined regex
4492     my $pw_regex = $U->ou_ancestor_setting_value($user->home_ou, 'global.password_regex');
4493
4494     my $is_strong = 0;
4495     if ($pw_regex) {
4496         # Calling JSON2perl on the $pw_regex causes failure, even before the fancy Unicode regex
4497         # ($pw_regex = OpenSRF::Utils::JSON->JSON2perl($pw_regex)) =~ s/\\u([0-9a-fA-F]{4})/\\x{$1}/gs;
4498         $is_strong = check_password_strength_custom($password, $pw_regex);
4499     } else {
4500         $is_strong = check_password_strength_default($password);
4501     }
4502
4503     if (!$is_strong) {
4504         $e->die_event;
4505         return OpenILS::Event->new('PATRON_PASSWORD_WAS_NOT_STRONG');
4506     }
4507
4508     # All is well; update the password
4509     modify_migrated_user_password($e, $user->id, $password);
4510
4511     # And flag that this password reset request has been honoured
4512     $aupr->[0]->has_been_reset('t');
4513     $e->update_actor_usr_password_reset($aupr->[0]);
4514     $e->commit;
4515
4516     return 1;
4517 }
4518
4519 sub check_password_strength_default {
4520     my $password = shift;
4521     # Use the default set of checks
4522     if ( (length($password) < 7) or
4523             ($password !~ m/.*\d+.*/) or
4524             ($password !~ m/.*[A-Za-z]+.*/)
4525     ) {
4526         return 0;
4527     }
4528     return 1;
4529 }
4530
4531 sub check_password_strength_custom {
4532     my ($password, $pw_regex) = @_;
4533
4534     $pw_regex = qr/$pw_regex/;
4535     if ($password !~  /$pw_regex/) {
4536         return 0;
4537     }
4538     return 1;
4539 }
4540
4541 __PACKAGE__->register_method(
4542     method    => "fire_test_notification",
4543     api_name  => "open-ils.actor.event.test_notification"
4544 );
4545
4546 sub fire_test_notification {
4547     my($self, $conn, $auth, $args) = @_;
4548     my $e = new_editor(authtoken => $auth);
4549     return $e->event unless $e->checkauth;
4550     if ($e->requestor->id != $$args{target}) {
4551         my $home_ou = $e->retrieve_actor_user($$args{target})->home_ou;
4552         return $e->die_event unless $home_ou && $e->allowed('VIEW_USER', $home_ou);
4553     }
4554
4555     my $event_hook = $$args{hook} or return $e->event;
4556     return $e->event unless ($event_hook eq 'au.email.test' or $event_hook eq 'au.sms_text.test');
4557
4558     my $usr = $e->retrieve_actor_user($$args{target});
4559     return $e->event unless $usr;
4560
4561     return $U->fire_object_event(undef, $event_hook, $usr, $e->requestor->ws_ou);
4562 }
4563
4564
4565 __PACKAGE__->register_method(
4566     method    => "event_def_opt_in_settings",
4567     api_name  => "open-ils.actor.event_def.opt_in.settings",
4568     stream => 1,
4569     signature => {
4570         desc   => 'Streams the set of "cust" objects that are used as opt-in settings for event definitions',
4571         params => [
4572             { desc => 'Authentication token',  type => 'string'},
4573             {
4574                 desc => 'Org Unit ID.  (optional).  If no org ID is present, the home_ou of the requesting user is used',
4575                 type => 'number'
4576             },
4577         ],
4578         return => {
4579             desc => q/set of "cust" objects that are used as opt-in settings for event definitions at the specified org unit/,
4580             type => 'object',
4581             class => 'cust'
4582         }
4583     }
4584 );
4585
4586 sub event_def_opt_in_settings {
4587     my($self, $conn, $auth, $org_id) = @_;
4588     my $e = new_editor(authtoken => $auth);
4589     return $e->event unless $e->checkauth;
4590
4591     if(defined $org_id and $org_id != $e->requestor->home_ou) {
4592         return $e->event unless
4593             $e->allowed(['VIEW_USER_SETTING_TYPE', 'ADMIN_USER_SETTING_TYPE'], $org_id);
4594     } else {
4595         $org_id = $e->requestor->home_ou;
4596     }
4597
4598     # find all config.user_setting_type's related to event_defs for the requested org unit
4599     my $types = $e->json_query({
4600         select => {cust => ['name']},
4601         from => {atevdef => 'cust'},
4602         where => {
4603             '+atevdef' => {
4604                 owner => $U->get_org_ancestors($org_id), # context org plus parents
4605                 active => 't'
4606             }
4607         }
4608     });
4609
4610     if(@$types) {
4611         $conn->respond($_) for
4612             @{$e->search_config_usr_setting_type({name => [map {$_->{name}} @$types]})};
4613     }
4614
4615     return undef;
4616 }
4617
4618
4619 __PACKAGE__->register_method(
4620     method    => "user_circ_history",
4621     api_name  => "open-ils.actor.history.circ",
4622     stream => 1,
4623     authoritative => 1,
4624     signature => {
4625         desc   => 'Returns user circ history objects for the calling user',
4626         params => [
4627             { desc => 'Authentication token',  type => 'string'},
4628             { desc => 'Options hash.  Supported fields are "limit" and "offset"', type => 'object' },
4629         ],
4630         return => {
4631             desc => q/Stream of 'auch' circ history objects/,
4632             type => 'object',
4633         }
4634     }
4635 );
4636
4637 __PACKAGE__->register_method(
4638     method    => "user_circ_history",
4639     api_name  => "open-ils.actor.history.circ.clear",
4640     stream => 1,
4641     signature => {
4642         desc   => 'Delete all user circ history entries for the calling user',
4643         params => [
4644             { desc => 'Authentication token',  type => 'string'},
4645             { desc => "Options hash. 'circ_ids' is an arrayref of circulation IDs to delete", type => 'object' },
4646         ],
4647         return => {
4648             desc => q/1 on success, event on error/,
4649             type => 'object',
4650         }
4651     }
4652 );
4653
4654 __PACKAGE__->register_method(
4655     method    => "user_circ_history",
4656     api_name  => "open-ils.actor.history.circ.print",
4657     stream => 1,
4658     signature => {
4659         desc   => q/Returns printable output for the caller's circ history objects/,
4660         params => [
4661             { desc => 'Authentication token',  type => 'string'},
4662             { desc => 'Options hash.  Supported fields are "limit" and "offset"', type => 'object' },
4663         ],
4664         return => {
4665             desc => q/An action_trigger.event object or error event./,
4666             type => 'object',
4667         }
4668     }
4669 );
4670
4671 __PACKAGE__->register_method(
4672     method    => "user_circ_history",
4673     api_name  => "open-ils.actor.history.circ.email",
4674     stream => 1,
4675     signature => {
4676         desc   => q/Emails the caller's circ history/,
4677         params => [
4678             { desc => 'Authentication token',  type => 'string'},
4679             { desc => 'User ID.  If no user id is present, the authenticated user is assumed', type => 'number' },
4680             { desc => 'Options hash.  Supported fields are "limit" and "offset"', type => 'object' },
4681         ],
4682         return => {
4683             desc => q/undef, or event on error/
4684         }
4685     }
4686 );
4687
4688 sub user_circ_history {
4689     my ($self, $conn, $auth, $options) = @_;
4690     $options ||= {};
4691
4692     my $for_print = ($self->api_name =~ /print/);
4693     my $for_email = ($self->api_name =~ /email/);
4694     my $for_clear = ($self->api_name =~ /clear/);
4695
4696     # No perm check is performed.  Caller may only access his/her own
4697     # circ history entries.
4698     my $e = new_editor(authtoken => $auth);
4699     return $e->event unless $e->checkauth;
4700
4701     my %limits = ();
4702     if (!$for_clear) { # clear deletes all
4703         $limits{offset} = $options->{offset} if defined $options->{offset};
4704         $limits{limit} = $options->{limit} if defined $options->{limit};
4705     }
4706
4707     my %circ_id_filter = $options->{circ_ids} ?
4708         (id => $options->{circ_ids}) : ();
4709
4710     my $circs = $e->search_action_user_circ_history([
4711         {   usr => $e->requestor->id,
4712             %circ_id_filter
4713         },
4714         {   # order newest to oldest by default
4715             order_by => {auch => 'xact_start DESC'},
4716             %limits
4717         },
4718         {substream => 1} # could be a large list
4719     ]);
4720
4721     if ($for_print) {
4722         return $U->fire_object_event(undef,
4723             'circ.format.history.print', $circs, $e->requestor->home_ou);
4724     }
4725
4726     $e->xact_begin if $for_clear;
4727     $conn->respond_complete(1) if $for_email;  # no sense in waiting
4728
4729     for my $circ (@$circs) {
4730
4731         if ($for_email) {
4732             # events will be fired from action_trigger_runner
4733             $U->create_events_for_hook('circ.format.history.email',
4734                 $circ, $e->editor->home_ou, undef, undef, 1);
4735
4736         } elsif ($for_clear) {
4737
4738             $e->delete_action_user_circ_history($circ)
4739                 or return $e->die_event;
4740
4741         } else {
4742             $conn->respond($circ);
4743         }
4744     }
4745
4746     if ($for_clear) {
4747         $e->commit;
4748         return 1;
4749     }
4750
4751     return undef;
4752 }
4753
4754
4755 __PACKAGE__->register_method(
4756     method    => "user_visible_holds",
4757     api_name  => "open-ils.actor.history.hold.visible",
4758     stream => 1,
4759     signature => {
4760         desc   => 'Returns the set of opt-in visible holds',
4761         params => [
4762             { desc => 'Authentication token',  type => 'string'},
4763             { desc => 'User ID.  If no user id is present, the authenticated user is assumed', type => 'number' },
4764             { desc => 'Options hash.  Supported fields are "limit" and "offset"', type => 'object' },
4765         ],
4766         return => {
4767             desc => q/An object with 1 field: "hold"/,
4768             type => 'object',
4769         }
4770     }
4771 );
4772
4773 __PACKAGE__->register_method(
4774     method    => "user_visible_holds",
4775     api_name  => "open-ils.actor.history.hold.visible.print",
4776     stream => 1,
4777     signature => {
4778         desc   => 'Returns printable output for the set of opt-in visible holds',
4779         params => [
4780             { desc => 'Authentication token',  type => 'string'},
4781             { desc => 'User ID.  If no user id is present, the authenticated user is assumed', type => 'number' },
4782             { desc => 'Options hash.  Supported fields are "limit" and "offset"', type => 'object' },
4783         ],
4784         return => {
4785             desc => q/An action_trigger.event object or error event./,
4786             type => 'object',
4787         }
4788     }
4789 );
4790
4791 __PACKAGE__->register_method(
4792     method    => "user_visible_holds",
4793     api_name  => "open-ils.actor.history.hold.visible.email",
4794     stream => 1,
4795     signature => {
4796         desc   => 'Emails the set of opt-in visible holds to the requestor',
4797         params => [
4798             { desc => 'Authentication token',  type => 'string'},
4799             { desc => 'User ID.  If no user id is present, the authenticated user is assumed', type => 'number' },
4800             { desc => 'Options hash.  Supported fields are "limit" and "offset"', type => 'object' },
4801         ],
4802         return => {
4803             desc => q/undef, or event on error/
4804         }
4805     }
4806 );
4807
4808 sub user_visible_holds {
4809     my($self, $conn, $auth, $user_id, $options) = @_;
4810
4811     my $is_hold = 1;
4812     my $for_print = ($self->api_name =~ /print/);
4813     my $for_email = ($self->api_name =~ /email/);
4814     my $e = new_editor(authtoken => $auth);
4815     return $e->event unless $e->checkauth;
4816
4817     $user_id ||= $e->requestor->id;
4818     $options ||= {};
4819     $options->{limit} ||= 50;
4820     $options->{offset} ||= 0;
4821
4822     if($user_id != $e->requestor->id) {
4823         my $perm = ($is_hold) ? 'VIEW_HOLD' : 'VIEW_CIRCULATIONS';
4824         my $user = $e->retrieve_actor_user($user_id) or return $e->event;
4825         return $e->event unless $e->allowed($perm, $user->home_ou);
4826     }
4827
4828     my $db_func = ($is_hold) ? 'action.usr_visible_holds' : 'action.usr_visible_circs';
4829
4830     my $data = $e->json_query({
4831         from => [$db_func, $user_id],
4832         limit => $$options{limit},
4833         offset => $$options{offset}
4834
4835         # TODO: I only want IDs. code below didn't get me there
4836         # {"select":{"au":[{"column":"id", "result_field":"id",
4837         # "transform":"action.usr_visible_circs"}]}, "where":{"id":10}, "from":"au"}
4838     },{
4839         substream => 1
4840     });
4841
4842     return undef unless @$data;
4843
4844     if ($for_print) {
4845
4846         # collect the batch of objects
4847
4848         if($is_hold) {
4849
4850             my $hold_list = $e->search_action_hold_request({id => [map { $_->{id} } @$data]});
4851             return $U->fire_object_event(undef, 'ahr.format.history.print', $hold_list, $$hold_list[0]->request_lib);
4852
4853         } else {
4854
4855             my $circ_list = $e->search_action_circulation({id => [map { $_->{id} } @$data]});
4856             return $U->fire_object_event(undef, 'circ.format.history.print', $circ_list, $$circ_list[0]->circ_lib);
4857         }
4858
4859     } elsif ($for_email) {
4860
4861         $conn->respond_complete(1) if $for_email;  # no sense in waiting
4862
4863         foreach (@$data) {
4864
4865             my $id = $_->{id};
4866
4867             if($is_hold) {
4868
4869                 my $hold = $e->retrieve_action_hold_request($id);
4870                 $U->create_events_for_hook('ahr.format.history.email', $hold, $hold->request_lib, undef, undef, 1);
4871                 # events will be fired from action_trigger_runner
4872
4873             } else {
4874
4875                 my $circ = $e->retrieve_action_circulation($id);
4876                 $U->create_events_for_hook('circ.format.history.email', $circ, $circ->circ_lib, undef, undef, 1);
4877                 # events will be fired from action_trigger_runner
4878             }
4879         }
4880
4881     } else { # just give me the data please
4882
4883         foreach (@$data) {
4884
4885             my $id = $_->{id};
4886
4887             if($is_hold) {
4888
4889                 my $hold = $e->retrieve_action_hold_request($id);
4890                 $conn->respond({hold => $hold});
4891
4892             } else {
4893
4894                 my $circ = $e->retrieve_action_circulation($id);
4895                 $conn->respond({
4896                     circ => $circ,
4897                     summary => $U->create_circ_chain_summary($e, $id)
4898                 });
4899             }
4900         }
4901     }
4902
4903     return undef;
4904 }
4905
4906 __PACKAGE__->register_method(
4907     method     => "user_saved_search_cud",
4908     api_name   => "open-ils.actor.user.saved_search.cud",
4909     stream     => 1,
4910     signature  => {
4911         desc   => 'Create/Update/Delete Access to user saved searches',
4912         params => [
4913             { desc => 'Authentication token', type => 'string' },
4914             { desc => 'Saved Search Object', type => 'object', class => 'auss' }
4915         ],
4916         return => {
4917             desc   => q/The retrieved or updated saved search object, or id of a deleted object; Event on error/,
4918             class  => 'auss'
4919         }
4920     }
4921 );
4922
4923 __PACKAGE__->register_method(
4924     method     => "user_saved_search_cud",
4925     api_name   => "open-ils.actor.user.saved_search.retrieve",
4926     stream     => 1,
4927     signature  => {
4928         desc   => 'Retrieve a saved search object',
4929         params => [
4930             { desc => 'Authentication token', type => 'string' },
4931             { desc => 'Saved Search ID', type => 'number' }
4932         ],
4933         return => {
4934             desc   => q/The saved search object, Event on error/,
4935             class  => 'auss'
4936         }
4937     }
4938 );
4939
4940 sub user_saved_search_cud {
4941     my( $self, $client, $auth, $search ) = @_;
4942     my $e = new_editor( authtoken=>$auth );
4943     return $e->die_event unless $e->checkauth;
4944
4945     my $o_search;      # prior version of the object, if any
4946     my $res;           # to be returned
4947
4948     # branch on the operation type
4949
4950     if( $self->api_name =~ /retrieve/ ) {                    # Retrieve
4951
4952         # Get the old version, to check ownership
4953         $o_search = $e->retrieve_actor_usr_saved_search( $search )
4954             or return $e->die_event;
4955
4956         # You can't read somebody else's search
4957         return OpenILS::Event->new('BAD_PARAMS')
4958             unless $o_search->owner == $e->requestor->id;
4959
4960         $res = $o_search;
4961
4962     } else {
4963
4964         $e->xact_begin;               # start an editor transaction
4965
4966         if( $search->isnew ) {                               # Create
4967
4968             # You can't create a search for somebody else
4969             return OpenILS::Event->new('BAD_PARAMS')
4970                 unless $search->owner == $e->requestor->id;
4971
4972             $e->create_actor_usr_saved_search( $search )
4973                 or return $e->die_event;
4974
4975             $res = $search->id;
4976
4977         } elsif( $search->ischanged ) {                      # Update
4978
4979             # You can't change ownership of a search
4980             return OpenILS::Event->new('BAD_PARAMS')
4981                 unless $search->owner == $e->requestor->id;
4982
4983             # Get the old version, to check ownership
4984             $o_search = $e->retrieve_actor_usr_saved_search( $search->id )
4985                 or return $e->die_event;
4986
4987             # You can't update somebody else's search
4988             return OpenILS::Event->new('BAD_PARAMS')
4989                 unless $o_search->owner == $e->requestor->id;
4990
4991             # Do the update
4992             $e->update_actor_usr_saved_search( $search )
4993                 or return $e->die_event;
4994
4995             $res = $search;
4996
4997         } elsif( $search->isdeleted ) {                      # Delete
4998
4999             # Get the old version, to check ownership
5000             $o_search = $e->retrieve_actor_usr_saved_search( $search->id )
5001                 or return $e->die_event;
5002
5003             # You can't delete somebody else's search
5004             return OpenILS::Event->new('BAD_PARAMS')
5005                 unless $o_search->owner == $e->requestor->id;
5006
5007             # Do the delete
5008             $e->delete_actor_usr_saved_search( $o_search )
5009                 or return $e->die_event;
5010
5011             $res = $search->id;
5012         }
5013
5014         $e->commit;
5015     }
5016
5017     return $res;
5018 }
5019
5020 __PACKAGE__->register_method(
5021     method   => "get_barcodes",
5022     api_name => "open-ils.actor.get_barcodes"
5023 );
5024
5025 sub get_barcodes {
5026     my( $self, $client, $auth, $org_id, $context, $barcode ) = @_;
5027     my $e = new_editor(authtoken => $auth);
5028     return $e->event unless $e->checkauth;
5029     return $e->event unless $e->allowed('STAFF_LOGIN', $org_id);
5030
5031     my $db_result = $e->json_query(
5032         {   from => [
5033                 'evergreen.get_barcodes',
5034                 $org_id, $context, $barcode,
5035             ]
5036         }
5037     );
5038     if($context =~ /actor/) {
5039         my $filter_result = ();
5040         my $patron;
5041         foreach my $result (@$db_result) {
5042             if($result->{type} eq 'actor') {
5043                 if($e->requestor->id != $result->{id}) {
5044                     $patron = $e->retrieve_actor_user($result->{id});
5045                     if(!$patron) {
5046                         push(@$filter_result, $e->event);
5047                         next;
5048                     }
5049                     if($e->allowed('VIEW_USER', $patron->home_ou)) {
5050                         push(@$filter_result, $result);
5051                     }
5052                     else {
5053                         push(@$filter_result, $e->event);
5054                     }
5055                 }
5056                 else {
5057                     push(@$filter_result, $result);
5058                 }
5059             }
5060             else {
5061                 push(@$filter_result, $result);
5062             }
5063         }
5064         return $filter_result;
5065     }
5066     else {
5067         return $db_result;
5068     }
5069 }
5070 __PACKAGE__->register_method(
5071     method   => 'address_alert_test',
5072     api_name => 'open-ils.actor.address_alert.test',
5073     signature => {
5074         desc => "Tests a set of address fields to determine if they match with an address_alert",
5075         params => [
5076             {desc => 'Authentication token', type => 'string'},
5077             {desc => 'Org Unit',             type => 'number'},
5078             {desc => 'Fields',               type => 'hash'},
5079         ],
5080         return => {desc => 'List of matching address_alerts'}
5081     }
5082 );
5083
5084 sub address_alert_test {
5085     my ($self, $client, $auth, $org_unit, $fields) = @_;
5086     return [] unless $fields and grep {$_} values %$fields;
5087
5088     my $e = new_editor(authtoken => $auth);
5089     return $e->event unless $e->checkauth;
5090     return $e->event unless $e->allowed('CREATE_USER', $org_unit);
5091     $org_unit ||= $e->requestor->ws_ou;
5092
5093     my $alerts = $e->json_query({
5094         from => [
5095             'actor.address_alert_matches',
5096             $org_unit,
5097             $$fields{street1},
5098             $$fields{street2},
5099             $$fields{city},
5100             $$fields{county},
5101             $$fields{state},
5102             $$fields{country},
5103             $$fields{post_code},
5104             $$fields{mailing_address},
5105             $$fields{billing_address}
5106         ]
5107     });
5108
5109     # map the json_query hashes to real objects
5110     return [
5111         map {$e->retrieve_actor_address_alert($_)}
5112             (map {$_->{id}} @$alerts)
5113     ];
5114 }
5115
5116 __PACKAGE__->register_method(
5117     method   => "mark_users_contact_invalid",
5118     api_name => "open-ils.actor.invalidate.email",
5119     signature => {
5120         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",
5121         params => [
5122             {desc => "Authentication token", type => "string"},
5123             {desc => "Patron ID (optional if Email address specified)", type => "number"},
5124             {desc => "Additional note text (optional)", type => "string"},
5125             {desc => "penalty org unit ID (optional)", type => "number"},
5126             {desc => "Email address (optional)", type => "string"}
5127         ],
5128         return => {desc => "Event describing success or failure", type => "object"}
5129     }
5130 );
5131
5132 __PACKAGE__->register_method(
5133     method   => "mark_users_contact_invalid",
5134     api_name => "open-ils.actor.invalidate.day_phone",
5135     signature => {
5136         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",
5137         params => [
5138             {desc => "Authentication token", type => "string"},
5139             {desc => "Patron ID (optional if Phone Number specified)", type => "number"},
5140             {desc => "Additional note text (optional)", type => "string"},
5141             {desc => "penalty org unit ID (optional)", type => "number"},
5142             {desc => "Phone Number (optional)", type => "string"}
5143         ],
5144         return => {desc => "Event describing success or failure", type => "object"}
5145     }
5146 );
5147
5148 __PACKAGE__->register_method(
5149     method   => "mark_users_contact_invalid",
5150     api_name => "open-ils.actor.invalidate.evening_phone",
5151     signature => {
5152         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",
5153         params => [
5154             {desc => "Authentication token", type => "string"},
5155             {desc => "Patron ID (optional if Phone Number specified)", type => "number"},
5156             {desc => "Additional note text (optional)", type => "string"},
5157             {desc => "penalty org unit ID (optional)", type => "number"},
5158             {desc => "Phone Number (optional)", type => "string"}
5159         ],
5160         return => {desc => "Event describing success or failure", type => "object"}
5161     }
5162 );
5163
5164 __PACKAGE__->register_method(
5165     method   => "mark_users_contact_invalid",
5166     api_name => "open-ils.actor.invalidate.other_phone",
5167     signature => {
5168         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",
5169         params => [
5170             {desc => "Authentication token", type => "string"},
5171             {desc => "Patron ID (optional if Phone Number specified)", type => "number"},
5172             {desc => "Additional note text (optional)", type => "string"},
5173             {desc => "penalty org unit ID (optional, default to top of org tree)",
5174                 type => "number"},
5175             {desc => "Phone Number (optional)", type => "string"}
5176         ],
5177         return => {desc => "Event describing success or failure", type => "object"}
5178     }
5179 );
5180
5181 sub mark_users_contact_invalid {
5182     my ($self, $conn, $auth, $patron_id, $addl_note, $penalty_ou, $contact) = @_;
5183
5184     # This method invalidates an email address or a phone_number which
5185     # removes the bad email address or phone number, copying its contents
5186     # to a patron note, and institutes a standing penalty for "bad email"
5187     # or "bad phone number" which is cleared when the user is saved or
5188     # optionally only when the user is saved with an email address or
5189     # phone number (or staff manually delete the penalty).
5190
5191     my $contact_type = ($self->api_name =~ /invalidate.(\w+)(\.|$)/)[0];
5192
5193     my $e = new_editor(authtoken => $auth, xact => 1);
5194     return $e->die_event unless $e->checkauth;
5195
5196     my $howfind = {};
5197     if (defined $patron_id && $patron_id ne "") {
5198         $howfind = {usr => $patron_id};
5199     } elsif (defined $contact && $contact ne "") {
5200         $howfind = {$contact_type => $contact};
5201     } else {
5202         # Error out if no patron id set or no contact is set.
5203         return OpenILS::Event->new('BAD_PARAMS');
5204     }
5205
5206     return OpenILS::Utils::BadContact->mark_users_contact_invalid(
5207         $e, $contact_type, $howfind,
5208         $addl_note, $penalty_ou, $e->requestor->id
5209     );
5210 }
5211
5212 # Putting the following method in open-ils.actor is a bad fit, except in that
5213 # it serves an interface that lives under 'actor' in the templates directory,
5214 # and in that there's nowhere else obvious to put it (open-ils.trigger is
5215 # private).
5216 __PACKAGE__->register_method(
5217     api_name => "open-ils.actor.action_trigger.reactors.all_in_use",
5218     method   => "get_all_at_reactors_in_use",
5219     api_level=> 1,
5220     argc     => 1,
5221     signature=> {
5222         params => [
5223             { name => 'authtoken', type => 'string' }
5224         ],
5225         return => {
5226             desc => 'list of reactor names', type => 'array'
5227         }
5228     }
5229 );
5230
5231 sub get_all_at_reactors_in_use {
5232     my ($self, $conn, $auth) = @_;
5233
5234     my $e = new_editor(authtoken => $auth);
5235     $e->checkauth or return $e->die_event;
5236     return $e->die_event unless $e->allowed('VIEW_TRIGGER_EVENT_DEF');
5237
5238     my $reactors = $e->json_query({
5239         select => {
5240             atevdef => [{column => "reactor", transform => "distinct"}]
5241         },
5242         from => {atevdef => {}}
5243     });
5244
5245     return $e->die_event unless ref $reactors eq "ARRAY";
5246     $e->disconnect;
5247
5248     return [ map { $_->{reactor} } @$reactors ];
5249 }
5250
5251 __PACKAGE__->register_method(
5252     method   => "filter_group_entry_crud",
5253     api_name => "open-ils.actor.filter_group_entry.crud",
5254     signature => {
5255         desc => q/
5256             Provides CRUD access to filter group entry objects.  These are not full accessible
5257             via PCRUD, since they requre "asq" objects for storing the query, and "asq" objects
5258             are not accessible via PCRUD (because they have no fields against which to link perms)
5259             /,
5260         params => [
5261             {desc => "Authentication token", type => "string"},
5262             {desc => "Entry ID / Entry Object", type => "number"},
5263             {desc => "Additional note text (optional)", type => "string"},
5264             {desc => "penalty org unit ID (optional, default to top of org tree)",
5265                 type => "number"}
5266         ],
5267         return => {
5268             desc => "Entry fleshed with query on Create, Retrieve, and Uupdate.  1 on Delete",
5269             type => "object"
5270         }
5271     }
5272 );
5273
5274 sub filter_group_entry_crud {
5275     my ($self, $conn, $auth, $arg) = @_;
5276
5277     return OpenILS::Event->new('BAD_PARAMS') unless $arg;
5278     my $e = new_editor(authtoken => $auth, xact => 1);
5279     return $e->die_event unless $e->checkauth;
5280
5281     if (ref $arg) {
5282
5283         if ($arg->isnew) {
5284
5285             my $grp = $e->retrieve_actor_search_filter_group($arg->grp)
5286                 or return $e->die_event;
5287
5288             return $e->die_event unless $e->allowed(
5289                 'ADMIN_SEARCH_FILTER_GROUP', $grp->owner);
5290
5291             my $query = $arg->query;
5292             $query = $e->create_actor_search_query($query) or return $e->die_event;
5293             $arg->query($query->id);
5294             my $entry = $e->create_actor_search_filter_group_entry($arg) or return $e->die_event;
5295             $entry->query($query);
5296
5297             $e->commit;
5298             return $entry;
5299
5300         } elsif ($arg->ischanged) {
5301
5302             my $entry = $e->retrieve_actor_search_filter_group_entry([
5303                 $arg->id, {
5304                     flesh => 1,
5305                     flesh_fields => {asfge => ['grp']}
5306                 }
5307             ]) or return $e->die_event;
5308
5309             return $e->die_event unless $e->allowed(
5310                 'ADMIN_SEARCH_FILTER_GROUP', $entry->grp->owner);
5311
5312             my $query = $e->update_actor_search_query($arg->query) or return $e->die_event;
5313             $arg->query($arg->query->id);
5314             $e->update_actor_search_filter_group_entry($arg) or return $e->die_event;
5315             $arg->query($query);
5316
5317             $e->commit;
5318             return $arg;
5319
5320         } elsif ($arg->isdeleted) {
5321
5322             my $entry = $e->retrieve_actor_search_filter_group_entry([
5323                 $arg->id, {
5324                     flesh => 1,
5325                     flesh_fields => {asfge => ['grp', 'query']}
5326                 }
5327             ]) or return $e->die_event;
5328
5329             return $e->die_event unless $e->allowed(
5330                 'ADMIN_SEARCH_FILTER_GROUP', $entry->grp->owner);
5331
5332             $e->delete_actor_search_filter_group_entry($entry) or return $e->die_event;
5333             $e->delete_actor_search_query($entry->query) or return $e->die_event;
5334
5335             $e->commit;
5336             return 1;
5337
5338         } else {
5339
5340             $e->rollback;
5341             return undef;
5342         }
5343
5344     } else {
5345
5346         my $entry = $e->retrieve_actor_search_filter_group_entry([
5347             $arg, {
5348                 flesh => 1,
5349                 flesh_fields => {asfge => ['grp', 'query']}
5350             }
5351         ]) or return $e->die_event;
5352
5353         return $e->die_event unless $e->allowed(
5354             ['ADMIN_SEARCH_FILTER_GROUP', 'VIEW_SEARCH_FILTER_GROUP'],
5355             $entry->grp->owner);
5356
5357         $e->rollback;
5358         $entry->grp($entry->grp->id); # for consistency
5359         return $entry;
5360     }
5361 }
5362
5363 1;