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