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