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