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