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