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