LP#1552778: copy some date/time utils from OpenSRF
[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 OpenILS::Utils::DateTime qw/:datetime/;
20 use OpenSRF::Utils::SettingsClient;
21
22 use OpenSRF::Utils::Cache;
23
24 use OpenSRF::Utils::JSON;
25 use DateTime;
26 use DateTime::Format::ISO8601;
27 use OpenILS::Const qw/:const/;
28
29 use OpenILS::Application::Actor::Container;
30 use OpenILS::Application::Actor::ClosedDates;
31 use OpenILS::Application::Actor::UserGroups;
32 use OpenILS::Application::Actor::Friends;
33 use OpenILS::Application::Actor::Stage;
34 use OpenILS::Application::Actor::Settings;
35
36 use OpenILS::Utils::CStoreEditor qw/:funcs/;
37 use OpenILS::Utils::Penalty;
38 use OpenILS::Utils::BadContact;
39 use List::Util qw/max reduce/;
40
41 use UUID::Tiny qw/:std/;
42
43 sub initialize {
44     OpenILS::Application::Actor::Container->initialize();
45     OpenILS::Application::Actor::UserGroups->initialize();
46     OpenILS::Application::Actor::ClosedDates->initialize();
47 }
48
49 my $apputils = "OpenILS::Application::AppUtils";
50 my $U = $apputils;
51
52 sub _d { warn "Patron:\n" . Dumper(shift()); }
53
54 my $cache;
55 my $set_user_settings;
56 my $set_ou_settings;
57
58
59 #__PACKAGE__->register_method(
60 #   method  => "allowed_test",
61 #   api_name    => "open-ils.actor.allowed_test",
62 #);
63 #sub allowed_test {
64 #    my($self, $conn, $auth, $orgid, $permcode) = @_;
65 #    my $e = new_editor(authtoken => $auth);
66 #    return $e->die_event unless $e->checkauth;
67 #
68 #    return {
69 #        orgid => $orgid,
70 #        permcode => $permcode,
71 #        result => $e->allowed($permcode, $orgid)
72 #    };
73 #}
74
75 __PACKAGE__->register_method(
76     method  => "update_user_setting",
77     api_name    => "open-ils.actor.patron.settings.update",
78 );
79 sub update_user_setting {
80     my($self, $conn, $auth, $user_id, $settings) = @_;
81     my $e = new_editor(xact => 1, authtoken => $auth);
82     return $e->die_event unless $e->checkauth;
83
84     $user_id = $e->requestor->id unless defined $user_id;
85
86     unless($e->requestor->id == $user_id) {
87         my $user = $e->retrieve_actor_user($user_id) or return $e->die_event;
88         return $e->die_event unless $e->allowed('UPDATE_USER', $user->home_ou);
89     }
90
91     for my $name (keys %$settings) {
92         my $val = $$settings{$name};
93         my $set = $e->search_actor_user_setting({usr => $user_id, name => $name})->[0];
94
95         if(defined $val) {
96             $val = OpenSRF::Utils::JSON->perl2JSON($val);
97             if($set) {
98                 $set->value($val);
99                 $e->update_actor_user_setting($set) or return $e->die_event;
100             } else {
101                 $set = Fieldmapper::actor::user_setting->new;
102                 $set->usr($user_id);
103                 $set->name($name);
104                 $set->value($val);
105                 $e->create_actor_user_setting($set) or return $e->die_event;
106             }
107         } elsif($set) {
108             $e->delete_actor_user_setting($set) or return $e->die_event;
109         }
110     }
111
112     $e->commit;
113     return 1;
114 }
115
116
117 __PACKAGE__->register_method(
118     method    => "set_ou_settings",
119     api_name  => "open-ils.actor.org_unit.settings.update",
120     signature => {
121         desc => "Updates the value for a given org unit setting.  The permission to update "          .
122                 "an org unit setting is either the UPDATE_ORG_UNIT_SETTING_ALL, or a specific "       .
123                 "permission specified in the update_perm column of the config.org_unit_setting_type " .
124                 "table's row corresponding to the setting being changed." ,
125         params => [
126             {desc => 'Authentication token',             type => 'string'},
127             {desc => 'Org unit ID',                      type => 'number'},
128             {desc => 'Hash of setting name-value pairs', type => 'object'}
129         ],
130         return => {desc => '1 on success, Event on error'}
131     }
132 );
133
134 sub set_ou_settings {
135     my( $self, $client, $auth, $org_id, $settings ) = @_;
136
137     my $e = new_editor(authtoken => $auth, xact => 1);
138     return $e->die_event unless $e->checkauth;
139
140     my $all_allowed = $e->allowed("UPDATE_ORG_UNIT_SETTING_ALL", $org_id);
141
142     for my $name (keys %$settings) {
143         my $val = $$settings{$name};
144
145         my $type = $e->retrieve_config_org_unit_setting_type([
146             $name,
147             {flesh => 1, flesh_fields => {'coust' => ['update_perm']}}
148         ]) or return $e->die_event;
149         my $set = $e->search_actor_org_unit_setting({org_unit => $org_id, name => $name})->[0];
150
151         # If there is no relevant permission, the default assumption will
152         # be, "no, the caller cannot change that value."
153         return $e->die_event unless ($all_allowed ||
154             ($type->update_perm && $e->allowed($type->update_perm->code, $org_id)));
155
156         if(defined $val) {
157             $val = OpenSRF::Utils::JSON->perl2JSON($val);
158             if($set) {
159                 $set->value($val);
160                 $e->update_actor_org_unit_setting($set) or return $e->die_event;
161             } else {
162                 $set = Fieldmapper::actor::org_unit_setting->new;
163                 $set->org_unit($org_id);
164                 $set->name($name);
165                 $set->value($val);
166                 $e->create_actor_org_unit_setting($set) or return $e->die_event;
167             }
168         } elsif($set) {
169             $e->delete_actor_org_unit_setting($set) or return $e->die_event;
170         }
171     }
172
173     $e->commit;
174     return 1;
175 }
176
177 __PACKAGE__->register_method(
178     method   => "user_settings",
179     authoritative => 1,
180     api_name => "open-ils.actor.patron.settings.retrieve",
181 );
182 sub user_settings {
183     my( $self, $client, $auth, $user_id, $setting ) = @_;
184
185     my $e = new_editor(authtoken => $auth);
186     return $e->event unless $e->checkauth;
187     $user_id = $e->requestor->id unless defined $user_id;
188
189     my $patron = $e->retrieve_actor_user($user_id) or return $e->event;
190     if($e->requestor->id != $user_id) {
191         return $e->event unless $e->allowed('VIEW_USER', $patron->home_ou);
192     }
193
194     sub get_setting {
195         my($e, $user_id, $setting) = @_;
196         my $val = $e->search_actor_user_setting({usr => $user_id, name => $setting})->[0];
197         return undef unless $val; # XXX this should really return undef, but needs testing
198         return OpenSRF::Utils::JSON->JSON2perl($val->value);
199     }
200
201     if($setting) {
202         if(ref $setting eq 'ARRAY') {
203             my %settings;
204             $settings{$_} = get_setting($e, $user_id, $_) for @$setting;
205             return \%settings;
206         } else {
207             return get_setting($e, $user_id, $setting);
208         }
209     } else {
210         my $s = $e->search_actor_user_setting({usr => $user_id});
211         return { map { ( $_->name => OpenSRF::Utils::JSON->JSON2perl($_->value) ) } @$s };
212     }
213 }
214
215
216 __PACKAGE__->register_method(
217     method    => "ranged_ou_settings",
218     api_name  => "open-ils.actor.org_unit_setting.values.ranged.retrieve",
219     signature => {
220         desc   => "Retrieves all org unit settings for the given org_id, up to whatever limit " .
221                 "is implied for retrieving OU settings by the authenticated users' permissions.",
222         params => [
223             {desc => 'Authentication token',   type => 'string'},
224             {desc => 'Org unit ID',            type => 'number'},
225         ],
226         return => {desc => 'A hashref of "ranged" settings, event on error'}
227     }
228 );
229 sub ranged_ou_settings {
230     my( $self, $client, $auth, $org_id ) = @_;
231
232     my $e = new_editor(authtoken => $auth);
233     return $e->event unless $e->checkauth;
234
235     my %ranged_settings;
236     my $org_list = $U->get_org_ancestors($org_id);
237     my $settings = $e->search_actor_org_unit_setting({org_unit => $org_list});
238     $org_list = [ reverse @$org_list ];
239
240     # start at the context org and capture the setting value
241     # without clobbering settings we've already captured
242     for my $this_org_id (@$org_list) {
243
244         my @sets = grep { $_->org_unit == $this_org_id } @$settings;
245
246         for my $set (@sets) {
247             my $type = $e->retrieve_config_org_unit_setting_type([
248                 $set->name,
249                 {flesh => 1, flesh_fields => {coust => ['view_perm']}}
250             ]);
251
252             # If there is no relevant permission, the default assumption will
253             # be, "yes, the caller can have that value."
254             if ($type && $type->view_perm) {
255                 next if not $e->allowed($type->view_perm->code, $org_id);
256             }
257
258             $ranged_settings{$set->name} = OpenSRF::Utils::JSON->JSON2perl($set->value)
259                 unless defined $ranged_settings{$set->name};
260         }
261     }
262
263     return \%ranged_settings;
264 }
265
266
267
268 __PACKAGE__->register_method(
269     api_name  => 'open-ils.actor.ou_setting.ancestor_default',
270     method    => 'ou_ancestor_setting',
271     signature => {
272         desc => 'Get the org unit setting value associated with the setting name as seen from the specified org unit.  ' .
273                 'This method will make sure that the given user has permission to view that setting, if there is a '     .
274                 'permission associated with the setting.  If a permission is required and no authtoken is given, or '     .
275                 'the user lacks the permisssion, undef will be returned.'       ,
276         params => [
277             { desc => 'Org unit ID',          type => 'number' },
278             { desc => 'setting name',         type => 'string' },
279             { desc => 'authtoken (optional)', type => 'string' }
280         ],
281         return => {desc => 'A value for the org unit setting, or undef'}
282     }
283 );
284
285 # ------------------------------------------------------------------
286 # Attempts to find the org setting value for a given org.  if not
287 # found at the requested org, searches up the org tree until it
288 # finds a parent that has the requested setting.
289 # when found, returns { org => $id, value => $value }
290 # otherwise, returns NULL
291 # ------------------------------------------------------------------
292 sub ou_ancestor_setting {
293     my( $self, $client, $orgid, $name, $auth ) = @_;
294     # Make sure $auth is set to something if not given.
295     $auth ||= -1;
296     return $U->ou_ancestor_setting($orgid, $name, undef, $auth);
297 }
298
299 __PACKAGE__->register_method(
300     api_name  => 'open-ils.actor.ou_setting.ancestor_default.batch',
301     method    => 'ou_ancestor_setting_batch',
302     signature => {
303         desc => 'Get org unit setting name => value pairs for a list of names, as seen from the specified org unit.  ' .
304                 'This method will make sure that the given user has permission to view that setting, if there is a '     .
305                 'permission associated with the setting.  If a permission is required and no authtoken is given, or '     .
306                 'the user lacks the permisssion, undef will be returned.'       ,
307         params => [
308             { desc => 'Org unit ID',          type => 'number' },
309             { desc => 'setting name list',    type => 'array'  },
310             { desc => 'authtoken (optional)', type => 'string' }
311         ],
312         return => {desc => 'A hash with name => value pairs for the org unit settings'}
313     }
314 );
315 sub ou_ancestor_setting_batch {
316     my( $self, $client, $orgid, $name_list, $auth ) = @_;
317
318     # splitting the list of settings to fetch values
319     # so that ones that *don't* require view_perm checks
320     # can be fetched in one fell swoop, which is
321     # significantly faster in cases where a large
322     # number of settings need to be fetched.
323     my %perm_check_required = ();
324     my @perm_check_not_required = ();
325
326     # Note that ->ou_ancestor_setting also can check
327     # to see if the setting has a view_perm, but testing
328     # suggests that the redundant checks do not significantly
329     # increase the time it takes to fetch the values of
330     # permission-controlled settings.
331     my $e = new_editor();
332     my $res = $e->search_config_org_unit_setting_type({
333         name      => $name_list,
334         view_perm => { "!=" => undef },
335     });
336     %perm_check_required = map { $_->name() => 1 } @$res;
337     foreach my $setting (@$name_list) {
338         push @perm_check_not_required, $setting
339             unless exists($perm_check_required{$setting});
340     }
341
342     my %values;
343     if (@perm_check_not_required) {
344         %values = $U->ou_ancestor_setting_batch_insecure($orgid, \@perm_check_not_required);
345     }
346     $values{$_} = $U->ou_ancestor_setting(
347         $orgid, $_, undef,
348         ($auth ? $auth : -1)
349     ) for keys(%perm_check_required);
350     return \%values;
351 }
352
353
354
355 __PACKAGE__->register_method(
356     method   => "update_patron",
357     api_name => "open-ils.actor.patron.update",
358     signature => {
359         desc   => q/
360             Update an existing user, or create a new one.  Related objects,
361             like cards, addresses, survey responses, and stat cats,
362             can be updated by attaching them to the user object in their
363             respective fields.  For examples, the billing address object
364             may be inserted into the 'billing_address' field, etc.  For each
365             attached object, indicate if the object should be created,
366             updated, or deleted using the built-in 'isnew', 'ischanged',
367             and 'isdeleted' fields on the object.
368         /,
369         params => [
370             { desc => 'Authentication token', type => 'string' },
371             { desc => 'Patron data object',   type => 'object' }
372         ],
373         return => {desc => 'A fleshed user object, event on error'}
374     }
375 );
376
377 sub update_patron {
378     my( $self, $client, $auth, $patron ) = @_;
379
380     my $e = new_editor(xact => 1, authtoken => $auth);
381     return $e->event unless $e->checkauth;
382
383     $logger->info($patron->isnew ? "Creating new patron..." :
384         "Updating Patron: " . $patron->id);
385
386     my $evt = check_group_perm($e, $e->requestor, $patron);
387     return $evt if $evt;
388
389     # $new_patron is the patron in progress.  $patron is the original patron
390     # passed in with the method.  new_patron will change as the components
391     # of patron are added/updated.
392
393     my $new_patron;
394
395     # unflesh the real items on the patron
396     $patron->card( $patron->card->id ) if(ref($patron->card));
397     $patron->billing_address( $patron->billing_address->id )
398         if(ref($patron->billing_address));
399     $patron->mailing_address( $patron->mailing_address->id )
400         if(ref($patron->mailing_address));
401
402     # create/update the patron first so we can use his id
403
404     # $patron is the obj from the client (new data) and $new_patron is the
405     # patron object properly built for db insertion, so we need a third variable
406     # if we want to represent the old patron.
407
408     my $old_patron;
409     my $barred_hook = '';
410
411     if($patron->isnew()) {
412         ( $new_patron, $evt ) = _add_patron($e, _clone_patron($patron));
413         return $evt if $evt;
414         if($U->is_true($patron->barred)) {
415             return $e->die_event unless
416                 $e->allowed('BAR_PATRON', $patron->home_ou);
417         }
418     } else {
419         $new_patron = $patron;
420
421         # Did auth checking above already.
422         $old_patron = $e->retrieve_actor_user($patron->id) or
423             return $e->die_event;
424
425         if($U->is_true($old_patron->barred) != $U->is_true($new_patron->barred)) {
426             my $perm = $U->is_true($old_patron->barred) ? 'UNBAR_PATRON' : 'BAR_PATRON';
427             return $e->die_event unless $e->allowed($perm, $patron->home_ou);
428
429             $barred_hook = $U->is_true($new_patron->barred) ?
430                 'au.barred' : 'au.unbarred';
431         }
432
433         # update the password by itself to avoid the password protection magic
434         if ($patron->passwd && $patron->passwd ne $old_patron->passwd) {
435             modify_migrated_user_password($e, $patron->id, $patron->passwd);
436             $new_patron->passwd(''); # subsequent update will set
437                                      # actor.usr.passwd to MD5('')
438         }
439     }
440
441     ( $new_patron, $evt ) = _add_update_addresses($e, $patron, $new_patron);
442     return $evt if $evt;
443
444     ( $new_patron, $evt ) = _add_update_cards($e, $patron, $new_patron);
445     return $evt if $evt;
446
447     ( $new_patron, $evt ) = _add_survey_responses($e, $patron, $new_patron);
448     return $evt if $evt;
449
450     # re-update the patron if anything has happened to him during this process
451     if($new_patron->ischanged()) {
452         ( $new_patron, $evt ) = _update_patron($e, $new_patron);
453         return $evt if $evt;
454     }
455
456     ( $new_patron, $evt ) = _clear_badcontact_penalties($e, $old_patron, $new_patron);
457     return $evt if $evt;
458
459     ($new_patron, $evt) = _create_stat_maps($e, $patron, $new_patron);
460     return $evt if $evt;
461
462     ($new_patron, $evt) = _create_perm_maps($e, $patron, $new_patron);
463     return $evt if $evt;
464
465     $evt = apply_invalid_addr_penalty($e, $patron);
466     return $evt if $evt;
467
468     $e->commit;
469
470     my $tses = OpenSRF::AppSession->create('open-ils.trigger');
471     if($patron->isnew) {
472         $tses->request('open-ils.trigger.event.autocreate',
473             'au.create', $new_patron, $new_patron->home_ou);
474     } else {
475         $tses->request('open-ils.trigger.event.autocreate',
476             'au.update', $new_patron, $new_patron->home_ou);
477
478         $tses->request('open-ils.trigger.event.autocreate', $barred_hook,
479             $new_patron, $new_patron->home_ou) if $barred_hook;
480     }
481
482     $e->xact_begin; # $e->rollback is called in new_flesh_user
483     return flesh_user($new_patron->id(), $e);
484 }
485
486 sub apply_invalid_addr_penalty {
487     my $e = shift;
488     my $patron = shift;
489
490     # grab the invalid address penalty if set
491     my $penalties = OpenILS::Utils::Penalty->retrieve_usr_penalties($e, $patron->id, $patron->home_ou);
492
493     my ($addr_penalty) = grep
494         { $_->standing_penalty->name eq 'INVALID_PATRON_ADDRESS' } @$penalties;
495
496     # do we enforce invalid address penalty
497     my $enforce = $U->ou_ancestor_setting_value(
498         $patron->home_ou, 'circ.patron_invalid_address_apply_penalty') || 0;
499
500     my $addrs = $e->search_actor_user_address(
501         {usr => $patron->id, valid => 'f', id => {'>' => 0}}, {idlist => 1});
502     my $addr_count = scalar(@$addrs);
503
504     if($addr_count == 0 and $addr_penalty) {
505
506         # regardless of any settings, remove the penalty when the user has no invalid addresses
507         $e->delete_actor_user_standing_penalty($addr_penalty) or return $e->die_event;
508         $e->commit;
509
510     } elsif($enforce and $addr_count > 0 and !$addr_penalty) {
511
512         my $ptype = $e->retrieve_config_standing_penalty(29) or return $e->die_event;
513         my $depth = $ptype->org_depth;
514         my $ctx_org = $U->org_unit_ancestor_at_depth($patron->home_ou, $depth) if defined $depth;
515         $ctx_org = $patron->home_ou unless defined $ctx_org;
516
517         my $penalty = Fieldmapper::actor::user_standing_penalty->new;
518         $penalty->usr($patron->id);
519         $penalty->org_unit($ctx_org);
520         $penalty->standing_penalty(OILS_PENALTY_INVALID_PATRON_ADDRESS);
521
522         $e->create_actor_user_standing_penalty($penalty) or return $e->die_event;
523     }
524
525     return undef;
526 }
527
528
529 sub flesh_user {
530     my $id = shift;
531     my $e = shift;
532     my $home_ou = shift;
533
534     my $fields = [
535         "cards",
536         "card",
537         "standing_penalties",
538         "settings",
539         "addresses",
540         "billing_address",
541         "mailing_address",
542         "stat_cat_entries",
543         "settings",
544         "usr_activity"
545     ];
546     push @$fields, "home_ou" if $home_ou;
547     return new_flesh_user($id, $fields, $e );
548 }
549
550
551
552
553
554
555 # clone and clear stuff that would break the database
556 sub _clone_patron {
557     my $patron = shift;
558
559     my $new_patron = $patron->clone;
560     # clear these
561     $new_patron->clear_billing_address();
562     $new_patron->clear_mailing_address();
563     $new_patron->clear_addresses();
564     $new_patron->clear_card();
565     $new_patron->clear_cards();
566     $new_patron->clear_id();
567     $new_patron->clear_isnew();
568     $new_patron->clear_ischanged();
569     $new_patron->clear_isdeleted();
570     $new_patron->clear_stat_cat_entries();
571     $new_patron->clear_permissions();
572     $new_patron->clear_standing_penalties();
573
574     return $new_patron;
575 }
576
577
578 sub _add_patron {
579
580     my $e          = shift;
581     my $patron      = shift;
582
583     return (undef, $e->die_event) unless
584         $e->allowed('CREATE_USER', $patron->home_ou);
585
586     my $ex = $e->search_actor_user(
587         {usrname => $patron->usrname}, {idlist => 1});
588     return (undef, OpenILS::Event->new('USERNAME_EXISTS')) if @$ex;
589
590     $logger->info("Creating new user in the DB with username: ".$patron->usrname());
591
592     # do a dance to get the password hashed securely
593     my $saved_password = $patron->passwd;
594     $patron->passwd('');
595     $e->create_actor_user($patron) or return (undef, $e->die_event);
596     modify_migrated_user_password($e, $patron->id, $saved_password);
597
598     my $id = $patron->id; # added by CStoreEditor
599
600     $logger->info("Successfully created new user [$id] in DB");
601     return ($e->retrieve_actor_user($id), undef);
602 }
603
604
605 sub check_group_perm {
606     my( $e, $requestor, $patron ) = @_;
607     my $evt;
608
609     # first let's see if the requestor has
610     # priveleges to update this user in any way
611     if( ! $patron->isnew ) {
612         my $p = $e->retrieve_actor_user($patron->id);
613
614         # If we are the requestor (trying to update our own account)
615         # and we are not trying to change our profile, we're good
616         if( $p->id == $requestor->id and
617                 $p->profile == $patron->profile ) {
618             return undef;
619         }
620
621
622         $evt = group_perm_failed($e, $requestor, $p);
623         return $evt if $evt;
624     }
625
626     # They are allowed to edit this patron.. can they put the
627     # patron into the group requested?
628     $evt = group_perm_failed($e, $requestor, $patron);
629     return $evt if $evt;
630     return undef;
631 }
632
633
634 sub group_perm_failed {
635     my( $e, $requestor, $patron ) = @_;
636
637     my $perm;
638     my $grp;
639     my $grpid = $patron->profile;
640
641     do {
642
643         $logger->debug("user update looking for group perm for group $grpid");
644         $grp = $e->retrieve_permission_grp_tree($grpid);
645
646     } while( !($perm = $grp->application_perm) and ($grpid = $grp->parent) );
647
648     $logger->info("user update checking perm $perm on user ".
649         $requestor->id." for update/create on user username=".$patron->usrname);
650
651     return $e->allowed($perm, $patron->home_ou) ? undef : $e->die_event;
652 }
653
654
655
656 sub _update_patron {
657     my( $e, $patron, $noperm) = @_;
658
659     $logger->info("Updating patron ".$patron->id." in DB");
660
661     my $evt;
662
663     if(!$noperm) {
664         return (undef, $e->die_event)
665             unless $e->allowed('UPDATE_USER', $patron->home_ou);
666     }
667
668     if(!$patron->ident_type) {
669         $patron->clear_ident_type;
670         $patron->clear_ident_value;
671     }
672
673     $evt = verify_last_xact($e, $patron);
674     return (undef, $evt) if $evt;
675
676     $e->update_actor_user($patron) or return (undef, $e->die_event);
677
678     # re-fetch the user to pick up the latest last_xact_id value
679     # to avoid collisions.
680     $patron = $e->retrieve_actor_user($patron->id);
681
682     return ($patron);
683 }
684
685 sub verify_last_xact {
686     my( $e, $patron ) = @_;
687     return undef unless $patron->id and $patron->id > 0;
688     my $p = $e->retrieve_actor_user($patron->id);
689     my $xact = $p->last_xact_id;
690     return undef unless $xact;
691     $logger->info("user xact = $xact, saving with xact " . $patron->last_xact_id);
692     return OpenILS::Event->new('XACT_COLLISION')
693         if $xact ne $patron->last_xact_id;
694     return undef;
695 }
696
697
698 sub _check_dup_ident {
699     my( $session, $patron ) = @_;
700
701     return undef unless $patron->ident_value;
702
703     my $search = {
704         ident_type  => $patron->ident_type,
705         ident_value => $patron->ident_value,
706     };
707
708     $logger->debug("patron update searching for dup ident values: " .
709         $patron->ident_type . ':' . $patron->ident_value);
710
711     $search->{id} = {'!=' => $patron->id} if $patron->id and $patron->id > 0;
712
713     my $dups = $session->request(
714         'open-ils.storage.direct.actor.user.search_where.atomic', $search )->gather(1);
715
716
717     return OpenILS::Event->new('PATRON_DUP_IDENT1', payload => $patron )
718         if $dups and @$dups;
719
720     return undef;
721 }
722
723
724 sub _add_update_addresses {
725
726     my $e = shift;
727     my $patron = shift;
728     my $new_patron = shift;
729
730     my $evt;
731
732     my $current_id; # id of the address before creation
733
734     my $addresses = $patron->addresses();
735
736     for my $address (@$addresses) {
737
738         next unless ref $address;
739         $current_id = $address->id();
740
741         if( $patron->billing_address() and
742             $patron->billing_address() == $current_id ) {
743             $logger->info("setting billing addr to $current_id");
744             $new_patron->billing_address($address->id());
745             $new_patron->ischanged(1);
746         }
747
748         if( $patron->mailing_address() and
749             $patron->mailing_address() == $current_id ) {
750             $new_patron->mailing_address($address->id());
751             $logger->info("setting mailing addr to $current_id");
752             $new_patron->ischanged(1);
753         }
754
755
756         if($address->isnew()) {
757
758             $address->usr($new_patron->id());
759
760             ($address, $evt) = _add_address($e,$address);
761             return (undef, $evt) if $evt;
762
763             # we need to get the new id
764             if( $patron->billing_address() and
765                     $patron->billing_address() == $current_id ) {
766                 $new_patron->billing_address($address->id());
767                 $logger->info("setting billing addr to $current_id");
768                 $new_patron->ischanged(1);
769             }
770
771             if( $patron->mailing_address() and
772                     $patron->mailing_address() == $current_id ) {
773                 $new_patron->mailing_address($address->id());
774                 $logger->info("setting mailing addr to $current_id");
775                 $new_patron->ischanged(1);
776             }
777
778         } elsif($address->ischanged() ) {
779
780             ($address, $evt) = _update_address($e, $address);
781             return (undef, $evt) if $evt;
782
783         } elsif($address->isdeleted() ) {
784
785             if( $address->id() == $new_patron->mailing_address() ) {
786                 $new_patron->clear_mailing_address();
787                 ($new_patron, $evt) = _update_patron($e, $new_patron);
788                 return (undef, $evt) if $evt;
789             }
790
791             if( $address->id() == $new_patron->billing_address() ) {
792                 $new_patron->clear_billing_address();
793                 ($new_patron, $evt) = _update_patron($e, $new_patron);
794                 return (undef, $evt) if $evt;
795             }
796
797             $evt = _delete_address($e, $address);
798             return (undef, $evt) if $evt;
799         }
800     }
801
802     return ( $new_patron, undef );
803 }
804
805
806 # adds an address to the db and returns the address with new id
807 sub _add_address {
808     my($e, $address) = @_;
809     $address->clear_id();
810
811     $logger->info("Creating new address at street ".$address->street1);
812
813     # put the address into the database
814     $e->create_actor_user_address($address) or return (undef, $e->die_event);
815     return ($address, undef);
816 }
817
818
819 sub _update_address {
820     my( $e, $address ) = @_;
821
822     $logger->info("Updating address ".$address->id." in the DB");
823
824     $e->update_actor_user_address($address) or return (undef, $e->die_event);
825
826     return ($address, undef);
827 }
828
829
830
831 sub _add_update_cards {
832
833     my $e = shift;
834     my $patron = shift;
835     my $new_patron = shift;
836
837     my $evt;
838
839     my $virtual_id; #id of the card before creation
840
841     my $cards = $patron->cards();
842     for my $card (@$cards) {
843
844         $card->usr($new_patron->id());
845
846         if(ref($card) and $card->isnew()) {
847
848             $virtual_id = $card->id();
849             ( $card, $evt ) = _add_card($e, $card);
850             return (undef, $evt) if $evt;
851
852             #if(ref($patron->card)) { $patron->card($patron->card->id); }
853             if($patron->card() == $virtual_id) {
854                 $new_patron->card($card->id());
855                 $new_patron->ischanged(1);
856             }
857
858         } elsif( ref($card) and $card->ischanged() ) {
859             $evt = _update_card($e, $card);
860             return (undef, $evt) if $evt;
861         }
862     }
863
864     return ( $new_patron, undef );
865 }
866
867
868 # adds an card to the db and returns the card with new id
869 sub _add_card {
870     my( $e, $card ) = @_;
871     $card->clear_id();
872
873     $logger->info("Adding new patron card ".$card->barcode);
874
875     $e->create_actor_card($card) or return (undef, $e->die_event);
876
877     return ( $card, undef );
878 }
879
880
881 # returns event on error.  returns undef otherwise
882 sub _update_card {
883     my( $e, $card ) = @_;
884     $logger->info("Updating patron card ".$card->id);
885
886     $e->update_actor_card($card) or return $e->die_event;
887     return undef;
888 }
889
890
891
892
893 # returns event on error.  returns undef otherwise
894 sub _delete_address {
895     my( $e, $address ) = @_;
896
897     $logger->info("Deleting address ".$address->id." from DB");
898
899     $e->delete_actor_user_address($address) or return $e->die_event;
900     return undef;
901 }
902
903
904
905 sub _add_survey_responses {
906     my ($e, $patron, $new_patron) = @_;
907
908     $logger->info( "Updating survey responses for patron ".$new_patron->id );
909
910     my $responses = $patron->survey_responses;
911
912     if($responses) {
913
914         $_->usr($new_patron->id) for (@$responses);
915
916         my $evt = $U->simplereq( "open-ils.circ",
917             "open-ils.circ.survey.submit.user_id", $responses );
918
919         return (undef, $evt) if defined($U->event_code($evt));
920
921     }
922
923     return ( $new_patron, undef );
924 }
925
926 sub _clear_badcontact_penalties {
927     my ($e, $old_patron, $new_patron) = @_;
928
929     return ($new_patron, undef) unless $old_patron;
930
931     my $PNM = $OpenILS::Utils::BadContact::PENALTY_NAME_MAP;
932
933     # This ignores whether the caller of update_patron has any permission
934     # to remove penalties, but these penalties no longer make sense
935     # if an email address field (for example) is changed (and the caller must
936     # have perms to do *that*) so there's no reason not to clear the penalties.
937
938     my $bad_contact_penalties = $e->search_actor_user_standing_penalty([
939         {
940             "+csp" => {"name" => [values(%$PNM)]},
941             "+ausp" => {"stop_date" => undef, "usr" => $new_patron->id}
942         }, {
943             "join" => {"csp" => {}},
944             "flesh" => 1,
945             "flesh_fields" => {"ausp" => ["standing_penalty"]}
946         }
947     ]) or return (undef, $e->die_event);
948
949     return ($new_patron, undef) unless @$bad_contact_penalties;
950
951     my @penalties_to_clear;
952     my ($field, $penalty_name);
953
954     # For each field that might have an associated bad contact penalty,
955     # check for such penalties and add them to the to-clear list if that
956     # field has changed.
957     while (($field, $penalty_name) = each(%$PNM)) {
958         if ($old_patron->$field ne $new_patron->$field) {
959             push @penalties_to_clear, grep {
960                 $_->standing_penalty->name eq $penalty_name
961             } @$bad_contact_penalties;
962         }
963     }
964
965     foreach (@penalties_to_clear) {
966         # Note that this "archives" penalties, in the terminology of the staff
967         # client, instead of just deleting them.  This may assist reporting,
968         # or preserving old contact information when it is still potentially
969         # of interest.
970         $_->standing_penalty($_->standing_penalty->id); # deflesh
971         $_->stop_date('now');
972         $e->update_actor_user_standing_penalty($_) or return (undef, $e->die_event);
973     }
974
975     return ($new_patron, undef);
976 }
977
978
979 sub _create_stat_maps {
980
981     my($e, $patron, $new_patron) = @_;
982
983     my $maps = $patron->stat_cat_entries();
984
985     for my $map (@$maps) {
986
987         my $method = "update_actor_stat_cat_entry_user_map";
988
989         if ($map->isdeleted()) {
990             $method = "delete_actor_stat_cat_entry_user_map";
991
992         } elsif ($map->isnew()) {
993             $method = "create_actor_stat_cat_entry_user_map";
994             $map->clear_id;
995         }
996
997
998         $map->target_usr($new_patron->id);
999
1000         $logger->info("Updating stat entry with method $method and map $map");
1001
1002         $e->$method($map) or return (undef, $e->die_event);
1003     }
1004
1005     return ($new_patron, undef);
1006 }
1007
1008 sub _create_perm_maps {
1009
1010     my($e, $patron, $new_patron) = @_;
1011
1012     my $maps = $patron->permissions;
1013
1014     for my $map (@$maps) {
1015
1016         my $method = "update_permission_usr_perm_map";
1017         if ($map->isdeleted()) {
1018             $method = "delete_permission_usr_perm_map";
1019         } elsif ($map->isnew()) {
1020             $method = "create_permission_usr_perm_map";
1021             $map->clear_id;
1022         }
1023
1024         $map->usr($new_patron->id);
1025
1026         $logger->info( "Updating permissions with method $method and map $map" );
1027
1028         $e->$method($map) or return (undef, $e->die_event);
1029     }
1030
1031     return ($new_patron, undef);
1032 }
1033
1034
1035 __PACKAGE__->register_method(
1036     method   => "set_user_work_ous",
1037     api_name => "open-ils.actor.user.work_ous.update",
1038 );
1039
1040 sub set_user_work_ous {
1041     my $self   = shift;
1042     my $client = shift;
1043     my $ses    = shift;
1044     my $maps   = shift;
1045
1046     my( $requestor, $evt ) = $apputils->checksesperm( $ses, 'ASSIGN_WORK_ORG_UNIT' );
1047     return $evt if $evt;
1048
1049     my $session = $apputils->start_db_session();
1050     $apputils->set_audit_info($session, $ses, $requestor->id, $requestor->wsid);
1051
1052     for my $map (@$maps) {
1053
1054         my $method = "open-ils.storage.direct.permission.usr_work_ou_map.update";
1055         if ($map->isdeleted()) {
1056             $method = "open-ils.storage.direct.permission.usr_work_ou_map.delete";
1057         } elsif ($map->isnew()) {
1058             $method = "open-ils.storage.direct.permission.usr_work_ou_map.create";
1059             $map->clear_id;
1060         }
1061
1062         #warn( "Updating permissions with method $method and session $ses and map $map" );
1063         $logger->info( "Updating work_ou map with method $method and map $map" );
1064
1065         my $stat = $session->request($method, $map)->gather(1);
1066         $logger->warn( "update failed: ".$U->DB_UPDATE_FAILED($map) ) unless defined($stat);
1067
1068     }
1069
1070     $apputils->commit_db_session($session);
1071
1072     return scalar(@$maps);
1073 }
1074
1075
1076 __PACKAGE__->register_method(
1077     method   => "set_user_perms",
1078     api_name => "open-ils.actor.user.permissions.update",
1079 );
1080
1081 sub set_user_perms {
1082     my $self = shift;
1083     my $client = shift;
1084     my $ses = shift;
1085     my $maps = shift;
1086
1087     my $session = $apputils->start_db_session();
1088
1089     my( $user_obj, $evt ) = $U->checkses($ses);
1090     return $evt if $evt;
1091     $apputils->set_audit_info($session, $ses, $user_obj->id, $user_obj->wsid);
1092
1093     my $perms = $session->request('open-ils.storage.permission.user_perms.atomic', $user_obj->id)->gather(1);
1094
1095     my $all = undef;
1096     $all = 1 if ($U->is_true($user_obj->super_user()));
1097     $all = 1 unless ($U->check_perms($user_obj->id, $user_obj->home_ou, 'EVERYTHING'));
1098
1099     for my $map (@$maps) {
1100
1101         my $method = "open-ils.storage.direct.permission.usr_perm_map.update";
1102         if ($map->isdeleted()) {
1103             $method = "open-ils.storage.direct.permission.usr_perm_map.delete";
1104         } elsif ($map->isnew()) {
1105             $method = "open-ils.storage.direct.permission.usr_perm_map.create";
1106             $map->clear_id;
1107         }
1108
1109         next if (!$all and !grep { $_->perm eq $map->perm and $U->is_true($_->grantable) and $_->depth <= $map->depth } @$perms);
1110         #warn( "Updating permissions with method $method and session $ses and map $map" );
1111         $logger->info( "Updating permissions with method $method and map $map" );
1112
1113         my $stat = $session->request($method, $map)->gather(1);
1114         $logger->warn( "update failed: ".$U->DB_UPDATE_FAILED($map) ) unless defined($stat);
1115
1116     }
1117
1118     $apputils->commit_db_session($session);
1119
1120     return scalar(@$maps);
1121 }
1122
1123
1124 __PACKAGE__->register_method(
1125     method  => "user_retrieve_by_barcode",
1126     authoritative => 1,
1127     api_name    => "open-ils.actor.user.fleshed.retrieve_by_barcode",);
1128
1129 sub user_retrieve_by_barcode {
1130     my($self, $client, $auth, $barcode, $flesh_home_ou) = @_;
1131
1132     my $e = new_editor(authtoken => $auth);
1133     return $e->event unless $e->checkauth;
1134
1135     my $card = $e->search_actor_card({barcode => $barcode})->[0]
1136         or return $e->event;
1137
1138     my $user = flesh_user($card->usr, $e, $flesh_home_ou);
1139     return $e->event unless $e->allowed(
1140         "VIEW_USER", $flesh_home_ou ? $user->home_ou->id : $user->home_ou
1141     );
1142     return $user;
1143 }
1144
1145
1146
1147 __PACKAGE__->register_method(
1148     method        => "get_user_by_id",
1149     authoritative => 1,
1150     api_name      => "open-ils.actor.user.retrieve",
1151 );
1152
1153 sub get_user_by_id {
1154     my ($self, $client, $auth, $id) = @_;
1155     my $e = new_editor(authtoken=>$auth);
1156     return $e->event unless $e->checkauth;
1157     my $user = $e->retrieve_actor_user($id) or return $e->event;
1158     return $e->event unless $e->allowed('VIEW_USER', $user->home_ou);
1159     return $user;
1160 }
1161
1162
1163 __PACKAGE__->register_method(
1164     method   => "get_org_types",
1165     api_name => "open-ils.actor.org_types.retrieve",
1166 );
1167 sub get_org_types {
1168     return $U->get_org_types();
1169 }
1170
1171
1172 __PACKAGE__->register_method(
1173     method   => "get_user_ident_types",
1174     api_name => "open-ils.actor.user.ident_types.retrieve",
1175 );
1176 my $ident_types;
1177 sub get_user_ident_types {
1178     return $ident_types if $ident_types;
1179     return $ident_types =
1180         new_editor()->retrieve_all_config_identification_type();
1181 }
1182
1183
1184 __PACKAGE__->register_method(
1185     method   => "get_org_unit",
1186     api_name => "open-ils.actor.org_unit.retrieve",
1187 );
1188
1189 sub get_org_unit {
1190     my( $self, $client, $user_session, $org_id ) = @_;
1191     my $e = new_editor(authtoken => $user_session);
1192     if(!$org_id) {
1193         return $e->event unless $e->checkauth;
1194         $org_id = $e->requestor->ws_ou;
1195     }
1196     my $o = $e->retrieve_actor_org_unit($org_id)
1197         or return $e->event;
1198     return $o;
1199 }
1200
1201 __PACKAGE__->register_method(
1202     method   => "search_org_unit",
1203     api_name => "open-ils.actor.org_unit_list.search",
1204 );
1205
1206 sub search_org_unit {
1207
1208     my( $self, $client, $field, $value ) = @_;
1209
1210     my $list = OpenILS::Application::AppUtils->simple_scalar_request(
1211         "open-ils.cstore",
1212         "open-ils.cstore.direct.actor.org_unit.search.atomic",
1213         { $field => $value } );
1214
1215     return $list;
1216 }
1217
1218
1219 # build the org tree
1220
1221 __PACKAGE__->register_method(
1222     method  => "get_org_tree",
1223     api_name    => "open-ils.actor.org_tree.retrieve",
1224     argc        => 0,
1225     note        => "Returns the entire org tree structure",
1226 );
1227
1228 sub get_org_tree {
1229     my $self = shift;
1230     my $client = shift;
1231     return $U->get_org_tree($client->session->session_locale);
1232 }
1233
1234
1235 __PACKAGE__->register_method(
1236     method  => "get_org_descendants",
1237     api_name    => "open-ils.actor.org_tree.descendants.retrieve"
1238 );
1239
1240 # depth is optional.  org_unit is the id
1241 sub get_org_descendants {
1242     my( $self, $client, $org_unit, $depth ) = @_;
1243
1244     if(ref $org_unit eq 'ARRAY') {
1245         $depth ||= [];
1246         my @trees;
1247         for my $i (0..scalar(@$org_unit)-1) {
1248             my $list = $U->simple_scalar_request(
1249                 "open-ils.storage",
1250                 "open-ils.storage.actor.org_unit.descendants.atomic",
1251                 $org_unit->[$i], $depth->[$i] );
1252             push(@trees, $U->build_org_tree($list));
1253         }
1254         return \@trees;
1255
1256     } else {
1257         my $orglist = $apputils->simple_scalar_request(
1258                 "open-ils.storage",
1259                 "open-ils.storage.actor.org_unit.descendants.atomic",
1260                 $org_unit, $depth );
1261         return $U->build_org_tree($orglist);
1262     }
1263 }
1264
1265
1266 __PACKAGE__->register_method(
1267     method  => "get_org_ancestors",
1268     api_name    => "open-ils.actor.org_tree.ancestors.retrieve"
1269 );
1270
1271 # depth is optional.  org_unit is the id
1272 sub get_org_ancestors {
1273     my( $self, $client, $org_unit, $depth ) = @_;
1274     my $orglist = $apputils->simple_scalar_request(
1275             "open-ils.storage",
1276             "open-ils.storage.actor.org_unit.ancestors.atomic",
1277             $org_unit, $depth );
1278     return $U->build_org_tree($orglist);
1279 }
1280
1281
1282 __PACKAGE__->register_method(
1283     method  => "get_standings",
1284     api_name    => "open-ils.actor.standings.retrieve"
1285 );
1286
1287 my $user_standings;
1288 sub get_standings {
1289     return $user_standings if $user_standings;
1290     return $user_standings =
1291         $apputils->simple_scalar_request(
1292             "open-ils.cstore",
1293             "open-ils.cstore.direct.config.standing.search.atomic",
1294             { id => { "!=" => undef } }
1295         );
1296 }
1297
1298
1299 __PACKAGE__->register_method(
1300     method   => "get_my_org_path",
1301     api_name => "open-ils.actor.org_unit.full_path.retrieve"
1302 );
1303
1304 sub get_my_org_path {
1305     my( $self, $client, $auth, $org_id ) = @_;
1306     my $e = new_editor(authtoken=>$auth);
1307     return $e->event unless $e->checkauth;
1308     $org_id = $e->requestor->ws_ou unless defined $org_id;
1309
1310     return $apputils->simple_scalar_request(
1311         "open-ils.storage",
1312         "open-ils.storage.actor.org_unit.full_path.atomic",
1313         $org_id );
1314 }
1315
1316
1317 __PACKAGE__->register_method(
1318     method   => "patron_adv_search",
1319     api_name => "open-ils.actor.patron.search.advanced"
1320 );
1321
1322 __PACKAGE__->register_method(
1323     method   => "patron_adv_search",
1324     api_name => "open-ils.actor.patron.search.advanced.fleshed",
1325     stream => 1,
1326     # Flush the response stream at most 5 patrons in for UI responsiveness.
1327     max_bundle_count => 5,
1328     signature => {
1329         desc => q/Returns a stream of fleshed user objects instead of
1330             a pile of identifiers/
1331     }
1332 );
1333
1334 sub patron_adv_search {
1335     my( $self, $client, $auth, $search_hash, $search_limit,
1336         $search_sort, $include_inactive, $search_ou, $flesh_fields, $offset) = @_;
1337
1338     # API params sanity checks.
1339     # Exit early with empty result if no filter exists.
1340     # .fleshed call is streaming.  Non-fleshed is effectively atomic.
1341     my $fleshed = ($self->api_name =~ /fleshed/);
1342     return ($fleshed ? undef : []) unless (ref $search_hash ||'') eq 'HASH';
1343     my $search_ok = 0;
1344     for my $key (keys %$search_hash) {
1345         next if $search_hash->{$key}{value} =~ /^\s*$/; # empty filter
1346         $search_ok = 1;
1347         last;
1348     }
1349     return ($fleshed ? undef : []) unless $search_ok;
1350
1351     my $e = new_editor(authtoken=>$auth);
1352     return $e->event unless $e->checkauth;
1353     return $e->event unless $e->allowed('VIEW_USER');
1354
1355     # depth boundary outside of which patrons must opt-in, default to 0
1356     my $opt_boundary = 0;
1357     $opt_boundary = $U->ou_ancestor_setting_value($e->requestor->ws_ou,'org.patron_opt_boundary') if user_opt_in_enabled($self);
1358
1359     if (not defined $search_ou) {
1360         my $depth = $U->ou_ancestor_setting_value(
1361             $e->requestor->ws_ou,
1362             'circ.patron_edit.duplicate_patron_check_depth'
1363         );
1364
1365         if (defined $depth) {
1366             $search_ou = $U->org_unit_ancestor_at_depth(
1367                 $e->requestor->ws_ou, $depth
1368             );
1369         }
1370     }
1371
1372     my $ids = $U->storagereq(
1373         "open-ils.storage.actor.user.crazy_search", $search_hash,
1374         $search_limit, $search_sort, $include_inactive,
1375         $e->requestor->ws_ou, $search_ou, $opt_boundary, $offset);
1376
1377     return $ids unless $self->api_name =~ /fleshed/;
1378
1379     $client->respond(new_flesh_user($_, $flesh_fields, $e)) for @$ids;
1380
1381     return;
1382 }
1383
1384
1385 # A migrated (main) password has the form:
1386 # CRYPT( MD5( pw_salt || MD5(real_password) ), pw_salt )
1387 sub modify_migrated_user_password {
1388     my ($e, $user_id, $passwd) = @_;
1389
1390     # new password gets a new salt
1391     my $new_salt = $e->json_query({
1392         from => ['actor.create_salt', 'main']})->[0];
1393     $new_salt = $new_salt->{'actor.create_salt'};
1394
1395     $e->json_query({
1396         from => [
1397             'actor.set_passwd',
1398             $user_id,
1399             'main',
1400             md5_hex($new_salt . md5_hex($passwd)),
1401             $new_salt
1402         ]
1403     });
1404 }
1405
1406
1407
1408 __PACKAGE__->register_method(
1409     method    => "update_passwd",
1410     api_name  => "open-ils.actor.user.password.update",
1411     signature => {
1412         desc   => "Update the operator's password",
1413         params => [
1414             { desc => 'Authentication token', type => 'string' },
1415             { desc => 'New password',         type => 'string' },
1416             { desc => 'Current password',     type => 'string' }
1417         ],
1418         return => {desc => '1 on success, Event on error or incorrect current password'}
1419     }
1420 );
1421
1422 __PACKAGE__->register_method(
1423     method    => "update_passwd",
1424     api_name  => "open-ils.actor.user.username.update",
1425     signature => {
1426         desc   => "Update the operator's username",
1427         params => [
1428             { desc => 'Authentication token', type => 'string' },
1429             { desc => 'New username',         type => 'string' },
1430             { desc => 'Current password',     type => 'string' }
1431         ],
1432         return => {desc => '1 on success, Event on error or incorrect current password'}
1433     }
1434 );
1435
1436 __PACKAGE__->register_method(
1437     method    => "update_passwd",
1438     api_name  => "open-ils.actor.user.email.update",
1439     signature => {
1440         desc   => "Update the operator's email address",
1441         params => [
1442             { desc => 'Authentication token', type => 'string' },
1443             { desc => 'New email address',    type => 'string' },
1444             { desc => 'Current password',     type => 'string' }
1445         ],
1446         return => {desc => '1 on success, Event on error or incorrect current password'}
1447     }
1448 );
1449
1450 sub update_passwd {
1451     my( $self, $conn, $auth, $new_val, $orig_pw ) = @_;
1452     my $e = new_editor(xact=>1, authtoken=>$auth);
1453     return $e->die_event unless $e->checkauth;
1454
1455     my $db_user = $e->retrieve_actor_user($e->requestor->id)
1456         or return $e->die_event;
1457     my $api = $self->api_name;
1458
1459     if (!$U->verify_migrated_user_password($e, $db_user->id, $orig_pw)) {
1460         $e->rollback;
1461         return new OpenILS::Event('INCORRECT_PASSWORD');
1462     }
1463
1464     if( $api =~ /password/o ) {
1465         # NOTE: with access to the plain text password we could crypt
1466         # the password without the extra MD5 pre-hashing.  Other changes
1467         # would be required.  Noting here for future reference.
1468         modify_migrated_user_password($e, $db_user->id, $new_val);
1469         $db_user->passwd('');
1470
1471     } else {
1472
1473         # if we don't clear the password, the user will be updated with
1474         # a hashed version of the hashed version of their password
1475         $db_user->clear_passwd;
1476
1477         if( $api =~ /username/o ) {
1478
1479             # make sure no one else has this username
1480             my $exist = $e->search_actor_user({usrname=>$new_val},{idlist=>1});
1481             if (@$exist) {
1482                 $e->rollback;
1483                 return new OpenILS::Event('USERNAME_EXISTS');
1484             }
1485             $db_user->usrname($new_val);
1486
1487         } elsif( $api =~ /email/o ) {
1488             $db_user->email($new_val);
1489         }
1490     }
1491
1492     $e->update_actor_user($db_user) or return $e->die_event;
1493     $e->commit;
1494
1495     # update the cached user to pick up these changes
1496     $U->simplereq('open-ils.auth', 'open-ils.auth.session.reset_timeout', $auth, 1);
1497     return 1;
1498 }
1499
1500
1501
1502 __PACKAGE__->register_method(
1503     method   => "check_user_perms",
1504     api_name => "open-ils.actor.user.perm.check",
1505     notes    => <<"    NOTES");
1506     Takes a login session, user id, an org id, and an array of perm type strings.  For each
1507     perm type, if the user does *not* have the given permission it is added
1508     to a list which is returned from the method.  If all permissions
1509     are allowed, an empty list is returned
1510     if the logged in user does not match 'user_id', then the logged in user must
1511     have VIEW_PERMISSION priveleges.
1512     NOTES
1513
1514 sub check_user_perms {
1515     my( $self, $client, $login_session, $user_id, $org_id, $perm_types ) = @_;
1516
1517     my( $staff, $evt ) = $apputils->checkses($login_session);
1518     return $evt if $evt;
1519
1520     if($staff->id ne $user_id) {
1521         if( $evt = $apputils->check_perms(
1522             $staff->id, $org_id, 'VIEW_PERMISSION') ) {
1523             return $evt;
1524         }
1525     }
1526
1527     my @not_allowed;
1528     for my $perm (@$perm_types) {
1529         if($apputils->check_perms($user_id, $org_id, $perm)) {
1530             push @not_allowed, $perm;
1531         }
1532     }
1533
1534     return \@not_allowed
1535 }
1536
1537 __PACKAGE__->register_method(
1538     method  => "check_user_perms2",
1539     api_name    => "open-ils.actor.user.perm.check.multi_org",
1540     notes       => q/
1541         Checks the permissions on a list of perms and orgs for a user
1542         @param authtoken The login session key
1543         @param user_id The id of the user to check
1544         @param orgs The array of org ids
1545         @param perms The array of permission names
1546         @return An array of  [ orgId, permissionName ] arrays that FAILED the check
1547         if the logged in user does not match 'user_id', then the logged in user must
1548         have VIEW_PERMISSION priveleges.
1549     /);
1550
1551 sub check_user_perms2 {
1552     my( $self, $client, $authtoken, $user_id, $orgs, $perms ) = @_;
1553
1554     my( $staff, $target, $evt ) = $apputils->checkses_requestor(
1555         $authtoken, $user_id, 'VIEW_PERMISSION' );
1556     return $evt if $evt;
1557
1558     my @not_allowed;
1559     for my $org (@$orgs) {
1560         for my $perm (@$perms) {
1561             if($apputils->check_perms($user_id, $org, $perm)) {
1562                 push @not_allowed, [ $org, $perm ];
1563             }
1564         }
1565     }
1566
1567     return \@not_allowed
1568 }
1569
1570
1571 __PACKAGE__->register_method(
1572     method => 'check_user_perms3',
1573     api_name    => 'open-ils.actor.user.perm.highest_org',
1574     notes       => q/
1575         Returns the highest org unit id at which a user has a given permission
1576         If the requestor does not match the target user, the requestor must have
1577         'VIEW_PERMISSION' rights at the home org unit of the target user
1578         @param authtoken The login session key
1579         @param userid The id of the user in question
1580         @param perm The permission to check
1581         @return The org unit highest in the org tree within which the user has
1582         the requested permission
1583     /);
1584
1585 sub check_user_perms3 {
1586     my($self, $client, $authtoken, $user_id, $perm) = @_;
1587     my $e = new_editor(authtoken=>$authtoken);
1588     return $e->event unless $e->checkauth;
1589
1590     my $tree = $U->get_org_tree();
1591
1592     unless($e->requestor->id == $user_id) {
1593         my $user = $e->retrieve_actor_user($user_id)
1594             or return $e->event;
1595         return $e->event unless $e->allowed('VIEW_PERMISSION', $user->home_ou);
1596         return $U->find_highest_perm_org($perm, $user_id, $user->home_ou, $tree );
1597     }
1598
1599     return $U->find_highest_perm_org($perm, $user_id, $e->requestor->ws_ou, $tree);
1600 }
1601
1602 __PACKAGE__->register_method(
1603     method => 'user_has_work_perm_at',
1604     api_name    => 'open-ils.actor.user.has_work_perm_at',
1605     authoritative => 1,
1606     signature => {
1607         desc => q/
1608             Returns a set of org unit IDs which represent the highest orgs in
1609             the org tree where the user has the requested permission.  The
1610             purpose of this method is to return the smallest set of org units
1611             which represent the full expanse of the user's ability to perform
1612             the requested action.  The user whose perms this method should
1613             check is implied by the authtoken. /,
1614         params => [
1615             {desc => 'authtoken', type => 'string'},
1616             {desc => 'permission name', type => 'string'},
1617             {desc => q/user id, optional.  If present, check perms for
1618                 this user instead of the logged in user/, type => 'number'},
1619         ],
1620         return => {desc => 'An array of org IDs'}
1621     }
1622 );
1623
1624 sub user_has_work_perm_at {
1625     my($self, $conn, $auth, $perm, $user_id) = @_;
1626     my $e = new_editor(authtoken=>$auth);
1627     return $e->event unless $e->checkauth;
1628     if(defined $user_id) {
1629         my $user = $e->retrieve_actor_user($user_id) or return $e->event;
1630         return $e->event unless $e->allowed('VIEW_PERMISSION', $user->home_ou);
1631     }
1632     return $U->user_has_work_perm_at($e, $perm, undef, $user_id);
1633 }
1634
1635 __PACKAGE__->register_method(
1636     method => 'user_has_work_perm_at_batch',
1637     api_name    => 'open-ils.actor.user.has_work_perm_at.batch',
1638     authoritative => 1,
1639 );
1640
1641 sub user_has_work_perm_at_batch {
1642     my($self, $conn, $auth, $perms, $user_id) = @_;
1643     my $e = new_editor(authtoken=>$auth);
1644     return $e->event unless $e->checkauth;
1645     if(defined $user_id) {
1646         my $user = $e->retrieve_actor_user($user_id) or return $e->event;
1647         return $e->event unless $e->allowed('VIEW_PERMISSION', $user->home_ou);
1648     }
1649     my $map = {};
1650     $map->{$_} = $U->user_has_work_perm_at($e, $_) for @$perms;
1651     return $map;
1652 }
1653
1654
1655
1656 __PACKAGE__->register_method(
1657     method => 'check_user_perms4',
1658     api_name    => 'open-ils.actor.user.perm.highest_org.batch',
1659     notes       => q/
1660         Returns the highest org unit id at which a user has a given permission
1661         If the requestor does not match the target user, the requestor must have
1662         'VIEW_PERMISSION' rights at the home org unit of the target user
1663         @param authtoken The login session key
1664         @param userid The id of the user in question
1665         @param perms An array of perm names to check
1666         @return An array of orgId's  representing the org unit
1667         highest in the org tree within which the user has the requested permission
1668         The arrah of orgId's has matches the order of the perms array
1669     /);
1670
1671 sub check_user_perms4 {
1672     my( $self, $client, $authtoken, $userid, $perms ) = @_;
1673
1674     my( $staff, $target, $org, $evt );
1675
1676     ( $staff, $target, $evt ) = $apputils->checkses_requestor(
1677         $authtoken, $userid, 'VIEW_PERMISSION' );
1678     return $evt if $evt;
1679
1680     my @arr;
1681     return [] unless ref($perms);
1682     my $tree = $U->get_org_tree();
1683
1684     for my $p (@$perms) {
1685         push( @arr, $U->find_highest_perm_org( $p, $userid, $target->home_ou, $tree ) );
1686     }
1687     return \@arr;
1688 }
1689
1690
1691 __PACKAGE__->register_method(
1692     method        => "user_fines_summary",
1693     api_name      => "open-ils.actor.user.fines.summary",
1694     authoritative => 1,
1695     signature     => {
1696         desc   => 'Returns a short summary of the users total open fines, '  .
1697                 'excluding voided fines Params are login_session, user_id' ,
1698         params => [
1699             {desc => 'Authentication token', type => 'string'},
1700             {desc => 'User ID',              type => 'string'}  # number?
1701         ],
1702         return => {
1703             desc => "a 'mous' object, event on error",
1704         }
1705     }
1706 );
1707
1708 sub user_fines_summary {
1709     my( $self, $client, $auth, $user_id ) = @_;
1710
1711     my $e = new_editor(authtoken=>$auth);
1712     return $e->event unless $e->checkauth;
1713
1714     if( $user_id ne $e->requestor->id ) {
1715         my $user = $e->retrieve_actor_user($user_id) or return $e->event;
1716         return $e->event unless
1717             $e->allowed('VIEW_USER_FINES_SUMMARY', $user->home_ou);
1718     }
1719
1720     return $e->search_money_open_user_summary({usr => $user_id})->[0];
1721 }
1722
1723
1724 __PACKAGE__->register_method(
1725     method        => "user_opac_vitals",
1726     api_name      => "open-ils.actor.user.opac.vital_stats",
1727     argc          => 1,
1728     authoritative => 1,
1729     signature     => {
1730         desc   => 'Returns a short summary of the users vital stats, including '  .
1731                 'identification information, accumulated balance, number of holds, ' .
1732                 'and current open circulation stats' ,
1733         params => [
1734             {desc => 'Authentication token',                          type => 'string'},
1735             {desc => 'Optional User ID, for use in the staff client', type => 'number'}  # number?
1736         ],
1737         return => {
1738             desc => "An object with four properties: user, fines, checkouts and holds."
1739         }
1740     }
1741 );
1742
1743 sub user_opac_vitals {
1744     my( $self, $client, $auth, $user_id ) = @_;
1745
1746     my $e = new_editor(authtoken=>$auth);
1747     return $e->event unless $e->checkauth;
1748
1749     $user_id ||= $e->requestor->id;
1750
1751     my $user = $e->retrieve_actor_user( $user_id );
1752
1753     my ($fines) = $self
1754         ->method_lookup('open-ils.actor.user.fines.summary')
1755         ->run($auth => $user_id);
1756     return $fines if (defined($U->event_code($fines)));
1757
1758     if (!$fines) {
1759         $fines = new Fieldmapper::money::open_user_summary ();
1760         $fines->balance_owed(0.00);
1761         $fines->total_owed(0.00);
1762         $fines->total_paid(0.00);
1763         $fines->usr($user_id);
1764     }
1765
1766     my ($holds) = $self
1767         ->method_lookup('open-ils.actor.user.hold_requests.count')
1768         ->run($auth => $user_id);
1769     return $holds if (defined($U->event_code($holds)));
1770
1771     my ($out) = $self
1772         ->method_lookup('open-ils.actor.user.checked_out.count')
1773         ->run($auth => $user_id);
1774     return $out if (defined($U->event_code($out)));
1775
1776     $out->{"total_out"} = reduce { $a + $out->{$b} } 0, qw/out overdue/;
1777
1778     my $unread_msgs = $e->search_actor_usr_message([
1779         {usr => $user_id, read_date => undef, deleted => 'f'},
1780         {idlist => 1}
1781     ]);
1782
1783     return {
1784         user => {
1785             first_given_name  => $user->first_given_name,
1786             second_given_name => $user->second_given_name,
1787             family_name       => $user->family_name,
1788             alias             => $user->alias,
1789             usrname           => $user->usrname
1790         },
1791         fines => $fines->to_bare_hash,
1792         checkouts => $out,
1793         holds => $holds,
1794         messages => { unread => scalar(@$unread_msgs) }
1795     };
1796 }
1797
1798
1799 ##### a small consolidation of related method registrations
1800 my $common_params = [
1801     { desc => 'Authentication token', type => 'string' },
1802     { desc => 'User ID',              type => 'string' },
1803     { desc => 'Transactions type (optional, defaults to all)', type => 'string' },
1804     { desc => 'Options hash.  May contain limit and offset for paged results.', type => 'object' },
1805 ];
1806 my %methods = (
1807     'open-ils.actor.user.transactions'                      => '',
1808     'open-ils.actor.user.transactions.fleshed'              => '',
1809     'open-ils.actor.user.transactions.have_charge'          => ' that have an initial charge',
1810     'open-ils.actor.user.transactions.have_charge.fleshed'  => ' that have an initial charge',
1811     'open-ils.actor.user.transactions.have_balance'         => ' that have an outstanding balance',
1812     'open-ils.actor.user.transactions.have_balance.fleshed' => ' that have an outstanding balance',
1813 );
1814
1815 foreach (keys %methods) {
1816     my %args = (
1817         method    => "user_transactions",
1818         api_name  => $_,
1819         signature => {
1820             desc   => 'For a given user, retrieve a list of '
1821                     . (/\.fleshed/ ? 'fleshed ' : '')
1822                     . 'transactions' . $methods{$_}
1823                     . ' optionally limited to transactions of a given type.',
1824             params => $common_params,
1825             return => {
1826                 desc => "List of objects, or event on error.  Each object is a hash containing: transaction, circ, record. "
1827                     . 'These represent the relevant (mbts) transaction, attached circulation and title pointed to in the circ, respectively.',
1828             }
1829         }
1830     );
1831     $args{authoritative} = 1;
1832     __PACKAGE__->register_method(%args);
1833 }
1834
1835 # Now for the counts
1836 %methods = (
1837     'open-ils.actor.user.transactions.count'              => '',
1838     'open-ils.actor.user.transactions.have_charge.count'  => ' that have an initial charge',
1839     'open-ils.actor.user.transactions.have_balance.count' => ' that have an outstanding balance',
1840 );
1841
1842 foreach (keys %methods) {
1843     my %args = (
1844         method    => "user_transactions",
1845         api_name  => $_,
1846         signature => {
1847             desc   => 'For a given user, retrieve a count of open '
1848                     . 'transactions' . $methods{$_}
1849                     . ' optionally limited to transactions of a given type.',
1850             params => $common_params,
1851             return => { desc => "Integer count of transactions, or event on error" }
1852         }
1853     );
1854     /\.have_balance/ and $args{authoritative} = 1;     # FIXME: I don't know why have_charge isn't authoritative
1855     __PACKAGE__->register_method(%args);
1856 }
1857
1858 __PACKAGE__->register_method(
1859     method        => "user_transactions",
1860     api_name      => "open-ils.actor.user.transactions.have_balance.total",
1861     authoritative => 1,
1862     signature     => {
1863         desc   => 'For a given user, retrieve the total balance owed for open transactions,'
1864                 . ' optionally limited to transactions of a given type.',
1865         params => $common_params,
1866         return => { desc => "Decimal balance value, or event on error" }
1867     }
1868 );
1869
1870
1871 sub user_transactions {
1872     my( $self, $client, $auth, $user_id, $type, $options ) = @_;
1873     $options ||= {};
1874
1875     my $e = new_editor(authtoken => $auth);
1876     return $e->event unless $e->checkauth;
1877
1878     my $user = $e->retrieve_actor_user($user_id) or return $e->event;
1879
1880     return $e->event unless
1881         $e->requestor->id == $user_id or
1882         $e->allowed('VIEW_USER_TRANSACTIONS', $user->home_ou);
1883
1884     my $api = $self->api_name();
1885
1886     my $filter = ($api =~ /have_balance/o) ?
1887         { 'balance_owed' => { '<>' => 0 } }:
1888         { 'total_owed' => { '>' => 0 } };
1889
1890     my $method = 'open-ils.actor.user.transactions.history.still_open';
1891     $method = "$method.authoritative" if $api =~ /authoritative/;
1892     my ($trans) = $self->method_lookup($method)->run($auth, $user_id, $type, $filter, $options);
1893
1894     if($api =~ /total/o) {
1895         my $total = 0.0;
1896         $total += $_->balance_owed for @$trans;
1897         return $total;
1898     }
1899
1900     ($api =~ /count/o  ) and return scalar @$trans;
1901     ($api !~ /fleshed/o) and return $trans;
1902
1903     my @resp;
1904     for my $t (@$trans) {
1905
1906         if( $t->xact_type ne 'circulation' ) {
1907             push @resp, {transaction => $t};
1908             next;
1909         }
1910
1911         my $circ_data = flesh_circ($e, $t->id);
1912         push @resp, {transaction => $t, %$circ_data};
1913     }
1914
1915     return \@resp;
1916 }
1917
1918
1919 __PACKAGE__->register_method(
1920     method   => "user_transaction_retrieve",
1921     api_name => "open-ils.actor.user.transaction.fleshed.retrieve",
1922     argc     => 1,
1923     authoritative => 1,
1924     notes    => "Returns a fleshed transaction record"
1925 );
1926
1927 __PACKAGE__->register_method(
1928     method   => "user_transaction_retrieve",
1929     api_name => "open-ils.actor.user.transaction.retrieve",
1930     argc     => 1,
1931     authoritative => 1,
1932     notes    => "Returns a transaction record"
1933 );
1934
1935 sub user_transaction_retrieve {
1936     my($self, $client, $auth, $bill_id) = @_;
1937
1938     my $e = new_editor(authtoken => $auth);
1939     return $e->event unless $e->checkauth;
1940
1941     my $trans = $e->retrieve_money_billable_transaction_summary(
1942         [$bill_id, {flesh => 1, flesh_fields => {mbts => ['usr']}}]) or return $e->event;
1943
1944     return $e->event unless $e->allowed('VIEW_USER_TRANSACTIONS', $trans->usr->home_ou);
1945
1946     $trans->usr($trans->usr->id); # de-flesh for backwards compat
1947
1948     return $trans unless $self->api_name =~ /flesh/;
1949     return {transaction => $trans} if $trans->xact_type ne 'circulation';
1950
1951     my $circ_data = flesh_circ($e, $trans->id, 1);
1952
1953     return {transaction => $trans, %$circ_data};
1954 }
1955
1956 sub flesh_circ {
1957     my $e = shift;
1958     my $circ_id = shift;
1959     my $flesh_copy = shift;
1960
1961     my $circ = $e->retrieve_action_circulation([
1962         $circ_id, {
1963             flesh => 3,
1964             flesh_fields => {
1965                 circ => ['target_copy'],
1966                 acp => ['call_number'],
1967                 acn => ['record']
1968             }
1969         }
1970     ]);
1971
1972     my $mods;
1973     my $copy = $circ->target_copy;
1974
1975     if($circ->target_copy->call_number->id == OILS_PRECAT_CALL_NUMBER) {
1976         $mods = new Fieldmapper::metabib::virtual_record;
1977         $mods->doc_id(OILS_PRECAT_RECORD);
1978         $mods->title($copy->dummy_title);
1979         $mods->author($copy->dummy_author);
1980
1981     } else {
1982         $mods = $U->record_to_mvr($circ->target_copy->call_number->record);
1983     }
1984
1985     # more de-fleshiing
1986     $circ->target_copy($circ->target_copy->id);
1987     $copy->call_number($copy->call_number->id);
1988
1989     return {circ => $circ, record => $mods, copy => ($flesh_copy) ? $copy : undef };
1990 }
1991
1992
1993 __PACKAGE__->register_method(
1994     method        => "hold_request_count",
1995     api_name      => "open-ils.actor.user.hold_requests.count",
1996     authoritative => 1,
1997     argc          => 1,
1998     notes         => q/
1999         Returns hold ready vs. total counts.
2000         If a context org unit is provided, a third value
2001         is returned with key 'behind_desk', which reports
2002         how many holds are ready at the pickup library
2003         with the behind_desk flag set to true.
2004     /
2005 );
2006
2007 sub hold_request_count {
2008     my( $self, $client, $authtoken, $user_id, $ctx_org ) = @_;
2009     my $e = new_editor(authtoken => $authtoken);
2010     return $e->event unless $e->checkauth;
2011
2012     $user_id = $e->requestor->id unless defined $user_id;
2013
2014     if($e->requestor->id ne $user_id) {
2015         my $user = $e->retrieve_actor_user($user_id);
2016         return $e->event unless $e->allowed('VIEW_HOLD', $user->home_ou);
2017     }
2018
2019     my $holds = $e->json_query({
2020         select => {ahr => ['pickup_lib', 'current_shelf_lib', 'behind_desk']},
2021         from => 'ahr',
2022         where => {
2023             usr => $user_id,
2024             fulfillment_time => {"=" => undef },
2025             cancel_time => undef,
2026         }
2027     });
2028
2029     my @ready = grep {
2030         $_->{current_shelf_lib} and # avoid undef warnings
2031         $_->{pickup_lib} eq $_->{current_shelf_lib}
2032     } @$holds;
2033
2034     my $resp = {
2035         total => scalar(@$holds),
2036         ready => scalar(@ready)
2037     };
2038
2039     if ($ctx_org) {
2040         # count of holds ready at pickup lib with behind_desk true.
2041         $resp->{behind_desk} = scalar(
2042             grep {
2043                 $_->{pickup_lib} == $ctx_org and
2044                 $U->is_true($_->{behind_desk})
2045             } @ready
2046         );
2047     }
2048
2049     return $resp;
2050 }
2051
2052 __PACKAGE__->register_method(
2053     method        => "checked_out",
2054     api_name      => "open-ils.actor.user.checked_out",
2055     authoritative => 1,
2056     argc          => 2,
2057     signature     => {
2058         desc => "For a given user, returns a structure of circulations objects sorted by out, overdue, lost, claims_returned, long_overdue. "
2059             . "A list of IDs are returned of each type.  Circs marked lost, long_overdue, and claims_returned will not be 'finished' "
2060             . "(i.e., outstanding balance or some other pending action on the circ). "
2061             . "The .count method also includes a 'total' field which sums all open circs.",
2062         params => [
2063             { desc => 'Authentication Token', type => 'string'},
2064             { desc => 'User ID',              type => 'string'},
2065         ],
2066         return => {
2067             desc => 'Returns event on error, or an object with ID lists, like: '
2068                 . '{"out":[12552,451232], "claims_returned":[], "long_overdue":[23421] "overdue":[], "lost":[]}'
2069         },
2070     }
2071 );
2072
2073 __PACKAGE__->register_method(
2074     method        => "checked_out",
2075     api_name      => "open-ils.actor.user.checked_out.count",
2076     authoritative => 1,
2077     argc          => 2,
2078     signature     => q/@see open-ils.actor.user.checked_out/
2079 );
2080
2081 sub checked_out {
2082     my( $self, $conn, $auth, $userid ) = @_;
2083
2084     my $e = new_editor(authtoken=>$auth);
2085     return $e->event unless $e->checkauth;
2086
2087     if( $userid ne $e->requestor->id ) {
2088         my $user = $e->retrieve_actor_user($userid) or return $e->event;
2089         unless($e->allowed('VIEW_CIRCULATIONS', $user->home_ou)) {
2090
2091             # see if there is a friend link allowing circ.view perms
2092             my $allowed = OpenILS::Application::Actor::Friends->friend_perm_allowed(
2093                 $e, $userid, $e->requestor->id, 'circ.view');
2094             return $e->event unless $allowed;
2095         }
2096     }
2097
2098     my $count = $self->api_name =~ /count/;
2099     return _checked_out( $count, $e, $userid );
2100 }
2101
2102 sub _checked_out {
2103     my( $iscount, $e, $userid ) = @_;
2104
2105     my %result = (
2106         out => [],
2107         overdue => [],
2108         lost => [],
2109         claims_returned => [],
2110         long_overdue => []
2111     );
2112     my $meth = 'retrieve_action_open_circ_';
2113
2114     if ($iscount) {
2115         $meth .= 'count';
2116         %result = (
2117             out => 0,
2118             overdue => 0,
2119             lost => 0,
2120             claims_returned => 0,
2121             long_overdue => 0
2122         );
2123     } else {
2124         $meth .= 'list';
2125     }
2126
2127     my $data = $e->$meth($userid);
2128
2129     if ($data) {
2130         if ($iscount) {
2131             $result{$_} += $data->$_() for (keys %result);
2132             $result{total} += $data->$_() for (keys %result);
2133         } else {
2134             for my $k (keys %result) {
2135                 $result{$k} = [ grep { $_ > 0 } split( ',', $data->$k()) ];
2136             }
2137         }
2138     }
2139
2140     return \%result;
2141 }
2142
2143
2144
2145 __PACKAGE__->register_method(
2146     method        => "checked_in_with_fines",
2147     api_name      => "open-ils.actor.user.checked_in_with_fines",
2148     authoritative => 1,
2149     argc          => 2,
2150     signature     => q/@see open-ils.actor.user.checked_out/
2151 );
2152
2153 sub checked_in_with_fines {
2154     my( $self, $conn, $auth, $userid ) = @_;
2155
2156     my $e = new_editor(authtoken=>$auth);
2157     return $e->event unless $e->checkauth;
2158
2159     if( $userid ne $e->requestor->id ) {
2160         return $e->event unless $e->allowed('VIEW_CIRCULATIONS');
2161     }
2162
2163     # money is owed on these items and they are checked in
2164     my $open = $e->search_action_circulation(
2165         {
2166             usr             => $userid,
2167             xact_finish     => undef,
2168             checkin_time    => { "!=" => undef },
2169         }
2170     );
2171
2172
2173     my( @lost, @cr, @lo );
2174     for my $c (@$open) {
2175         push( @lost, $c->id ) if ($c->stop_fines eq 'LOST');
2176         push( @cr, $c->id ) if $c->stop_fines eq 'CLAIMSRETURNED';
2177         push( @lo, $c->id ) if $c->stop_fines eq 'LONGOVERDUE';
2178     }
2179
2180     return {
2181         lost        => \@lost,
2182         claims_returned => \@cr,
2183         long_overdue        => \@lo
2184     };
2185 }
2186
2187
2188 sub _sigmaker {
2189     my ($api, $desc, $auth) = @_;
2190     $desc = $desc ? (" " . $desc) : '';
2191     my $ids = ($api =~ /ids$/) ? 1 : 0;
2192     my @sig = (
2193         argc      => 1,
2194         method    => "user_transaction_history",
2195         api_name  => "open-ils.actor.user.transactions.$api",
2196         signature => {
2197             desc   => "For a given User ID, returns a list of billable transaction" .
2198                     ($ids ? " id" : '') .
2199                     "s$desc, optionally filtered by type and/or fields in money.billable_xact_summary.  " .
2200                     "The VIEW_USER_TRANSACTIONS permission is required to view another user's transactions",
2201             params => [
2202                 {desc => 'Authentication token',        type => 'string'},
2203                 {desc => 'User ID',                     type => 'number'},
2204                 {desc => 'Transaction type (optional)', type => 'number'},
2205                 {desc => 'Hash of Billable Transaction Summary filters (optional)', type => 'object'}
2206             ],
2207             return => {
2208                 desc => 'List of transaction' . ($ids ? " id" : '') . 's, Event on error'
2209             },
2210         }
2211     );
2212     $auth and push @sig, (authoritative => 1);
2213     return @sig;
2214 }
2215
2216 my %auth_hist_methods = (
2217     'history'             => '',
2218     'history.have_charge' => 'that have an initial charge',
2219     'history.still_open'  => 'that are not finished',
2220     'history.have_balance'         => 'that have a balance',
2221     'history.have_bill'            => 'that have billings',
2222     'history.have_bill_or_payment' => 'that have non-zero-sum billings or at least 1 payment',
2223     'history.have_payment' => 'that have at least 1 payment',
2224 );
2225
2226 foreach (keys %auth_hist_methods) {
2227     __PACKAGE__->register_method(_sigmaker($_,       $auth_hist_methods{$_}, 1));
2228     __PACKAGE__->register_method(_sigmaker("$_.ids", $auth_hist_methods{$_}, 1));
2229     __PACKAGE__->register_method(_sigmaker("$_.fleshed", $auth_hist_methods{$_}, 1));
2230 }
2231
2232 sub user_transaction_history {
2233     my( $self, $conn, $auth, $userid, $type, $filter, $options ) = @_;
2234     $filter ||= {};
2235     $options ||= {};
2236
2237     my $e = new_editor(authtoken=>$auth);
2238     return $e->die_event unless $e->checkauth;
2239
2240     if ($e->requestor->id ne $userid) {
2241         return $e->die_event unless $e->allowed('VIEW_USER_TRANSACTIONS');
2242     }
2243
2244     my $api = $self->api_name;
2245     my @xact_finish  = (xact_finish => undef ) if ($api =~ /history\.still_open$/);     # What about history.still_open.ids?
2246
2247     if(defined($type)) {
2248         $filter->{'xact_type'} = $type;
2249     }
2250
2251     if($api =~ /have_bill_or_payment/o) {
2252
2253         # transactions that have a non-zero sum across all billings or at least 1 payment
2254         $filter->{'-or'} = {
2255             'balance_owed' => { '<>' => 0 },
2256             'last_payment_ts' => { '<>' => undef }
2257         };
2258
2259     } elsif($api =~ /have_payment/) {
2260
2261         $filter->{last_payment_ts} ||= {'<>' => undef};
2262
2263     } elsif( $api =~ /have_balance/o) {
2264
2265         # transactions that have a non-zero overall balance
2266         $filter->{'balance_owed'} = { '<>' => 0 };
2267
2268     } elsif( $api =~ /have_charge/o) {
2269
2270         # transactions that have at least 1 billing, regardless of whether it was voided
2271         $filter->{'last_billing_ts'} = { '<>' => undef };
2272
2273     } elsif( $api =~ /have_bill/o) {    # needs to be an elsif, or we double-match have_bill_or_payment!
2274
2275         # transactions that have non-zero sum across all billings.  This will exclude
2276         # xacts where all billings have been voided
2277         $filter->{'total_owed'} = { '<>' => 0 };
2278     }
2279
2280     my $options_clause = { order_by => { mbt => 'xact_start DESC' } };
2281     $options_clause->{'limit'} = $options->{'limit'} if $options->{'limit'};
2282     $options_clause->{'offset'} = $options->{'offset'} if $options->{'offset'};
2283
2284     my $mbts = $e->search_money_billable_transaction_summary(
2285         [   { usr => $userid, @xact_finish, %$filter },
2286             $options_clause
2287         ]
2288     );
2289
2290     return [map {$_->id} @$mbts] if $api =~ /\.ids/;
2291     return $mbts unless $api =~ /fleshed/;
2292
2293     my @resp;
2294     for my $t (@$mbts) {
2295
2296         if( $t->xact_type ne 'circulation' ) {
2297             push @resp, {transaction => $t};
2298             next;
2299         }
2300
2301         my $circ_data = flesh_circ($e, $t->id);
2302         push @resp, {transaction => $t, %$circ_data};
2303     }
2304
2305     return \@resp;
2306 }
2307
2308
2309
2310 __PACKAGE__->register_method(
2311     method   => "user_perms",
2312     api_name => "open-ils.actor.permissions.user_perms.retrieve",
2313     argc     => 1,
2314     notes    => "Returns a list of permissions"
2315 );
2316
2317 sub user_perms {
2318     my( $self, $client, $authtoken, $user ) = @_;
2319
2320     my( $staff, $evt ) = $apputils->checkses($authtoken);
2321     return $evt if $evt;
2322
2323     $user ||= $staff->id;
2324
2325     if( $user != $staff->id and $evt = $apputils->check_perms( $staff->id, $staff->home_ou, 'VIEW_PERMISSION') ) {
2326         return $evt;
2327     }
2328
2329     return $apputils->simple_scalar_request(
2330         "open-ils.storage",
2331         "open-ils.storage.permission.user_perms.atomic",
2332         $user);
2333 }
2334
2335 __PACKAGE__->register_method(
2336     method   => "retrieve_perms",
2337     api_name => "open-ils.actor.permissions.retrieve",
2338     notes    => "Returns a list of permissions"
2339 );
2340 sub retrieve_perms {
2341     my( $self, $client ) = @_;
2342     return $apputils->simple_scalar_request(
2343         "open-ils.cstore",
2344         "open-ils.cstore.direct.permission.perm_list.search.atomic",
2345         { id => { '!=' => undef } }
2346     );
2347 }
2348
2349 __PACKAGE__->register_method(
2350     method   => "retrieve_groups",
2351     api_name => "open-ils.actor.groups.retrieve",
2352     notes    => "Returns a list of user groups"
2353 );
2354 sub retrieve_groups {
2355     my( $self, $client ) = @_;
2356     return new_editor()->retrieve_all_permission_grp_tree();
2357 }
2358
2359 __PACKAGE__->register_method(
2360     method  => "retrieve_org_address",
2361     api_name    => "open-ils.actor.org_unit.address.retrieve",
2362     notes        => <<'    NOTES');
2363     Returns an org_unit address by ID
2364     @param An org_address ID
2365     NOTES
2366 sub retrieve_org_address {
2367     my( $self, $client, $id ) = @_;
2368     return $apputils->simple_scalar_request(
2369         "open-ils.cstore",
2370         "open-ils.cstore.direct.actor.org_address.retrieve",
2371         $id
2372     );
2373 }
2374
2375 __PACKAGE__->register_method(
2376     method   => "retrieve_groups_tree",
2377     api_name => "open-ils.actor.groups.tree.retrieve",
2378     notes    => "Returns a list of user groups"
2379 );
2380
2381 sub retrieve_groups_tree {
2382     my( $self, $client ) = @_;
2383     return new_editor()->search_permission_grp_tree(
2384         [
2385             { parent => undef},
2386             {
2387                 flesh               => -1,
2388                 flesh_fields    => { pgt => ["children"] },
2389                 order_by            => { pgt => 'name'}
2390             }
2391         ]
2392     )->[0];
2393 }
2394
2395
2396 __PACKAGE__->register_method(
2397     method   => "add_user_to_groups",
2398     api_name => "open-ils.actor.user.set_groups",
2399     notes    => "Adds a user to one or more permission groups"
2400 );
2401
2402 sub add_user_to_groups {
2403     my( $self, $client, $authtoken, $userid, $groups ) = @_;
2404
2405     my( $requestor, $target, $evt ) = $apputils->checkses_requestor(
2406         $authtoken, $userid, 'CREATE_USER_GROUP_LINK' );
2407     return $evt if $evt;
2408
2409     ( $requestor, $target, $evt ) = $apputils->checkses_requestor(
2410         $authtoken, $userid, 'REMOVE_USER_GROUP_LINK' );
2411     return $evt if $evt;
2412
2413     $apputils->simplereq(
2414         'open-ils.storage',
2415         'open-ils.storage.direct.permission.usr_grp_map.mass_delete', { usr => $userid } );
2416
2417     for my $group (@$groups) {
2418         my $link = Fieldmapper::permission::usr_grp_map->new;
2419         $link->grp($group);
2420         $link->usr($userid);
2421
2422         my $id = $apputils->simplereq(
2423             'open-ils.storage',
2424             'open-ils.storage.direct.permission.usr_grp_map.create', $link );
2425     }
2426
2427     return 1;
2428 }
2429
2430 __PACKAGE__->register_method(
2431     method   => "get_user_perm_groups",
2432     api_name => "open-ils.actor.user.get_groups",
2433     notes    => "Retrieve a user's permission groups."
2434 );
2435
2436
2437 sub get_user_perm_groups {
2438     my( $self, $client, $authtoken, $userid ) = @_;
2439
2440     my( $requestor, $target, $evt ) = $apputils->checkses_requestor(
2441         $authtoken, $userid, 'VIEW_PERM_GROUPS' );
2442     return $evt if $evt;
2443
2444     return $apputils->simplereq(
2445         'open-ils.cstore',
2446         'open-ils.cstore.direct.permission.usr_grp_map.search.atomic', { usr => $userid } );
2447 }
2448
2449
2450 __PACKAGE__->register_method(
2451     method   => "get_user_work_ous",
2452     api_name => "open-ils.actor.user.get_work_ous",
2453     notes    => "Retrieve a user's work org units."
2454 );
2455
2456 __PACKAGE__->register_method(
2457     method   => "get_user_work_ous",
2458     api_name => "open-ils.actor.user.get_work_ous.ids",
2459     notes    => "Retrieve a user's work org units."
2460 );
2461
2462 sub get_user_work_ous {
2463     my( $self, $client, $auth, $userid ) = @_;
2464     my $e = new_editor(authtoken=>$auth);
2465     return $e->event unless $e->checkauth;
2466     $userid ||= $e->requestor->id;
2467
2468     if($e->requestor->id != $userid) {
2469         my $user = $e->retrieve_actor_user($userid)
2470             or return $e->event;
2471         return $e->event unless $e->allowed('ASSIGN_WORK_ORG_UNIT', $user->home_ou);
2472     }
2473
2474     return $e->search_permission_usr_work_ou_map({usr => $userid})
2475         unless $self->api_name =~ /.ids$/;
2476
2477     # client just wants a list of org IDs
2478     return $U->get_user_work_ou_ids($e, $userid);
2479 }
2480
2481
2482
2483 __PACKAGE__->register_method(
2484     method    => 'register_workstation',
2485     api_name  => 'open-ils.actor.workstation.register.override',
2486     signature => q/@see open-ils.actor.workstation.register/
2487 );
2488
2489 __PACKAGE__->register_method(
2490     method    => 'register_workstation',
2491     api_name  => 'open-ils.actor.workstation.register',
2492     signature => q/
2493         Registers a new workstion in the system
2494         @param authtoken The login session key
2495         @param name The name of the workstation id
2496         @param owner The org unit that owns this workstation
2497         @return The workstation id on success, WORKSTATION_NAME_EXISTS
2498         if the name is already in use.
2499     /
2500 );
2501
2502 sub register_workstation {
2503     my( $self, $conn, $authtoken, $name, $owner, $oargs ) = @_;
2504
2505     my $e = new_editor(authtoken=>$authtoken, xact=>1);
2506     return $e->die_event unless $e->checkauth;
2507     return $e->die_event unless $e->allowed('REGISTER_WORKSTATION', $owner);
2508     my $existing = $e->search_actor_workstation({name => $name})->[0];
2509     $oargs = { all => 1 } unless defined $oargs;
2510
2511     if( $existing ) {
2512
2513         if( $self->api_name =~ /override/o && ($oargs->{all} || grep { $_ eq 'WORKSTATION_NAME_EXISTS' } @{$oargs->{events}}) ) {
2514             # workstation with the given name exists.
2515
2516             if($owner ne $existing->owning_lib) {
2517                 # if necessary, update the owning_lib of the workstation
2518
2519                 $logger->info("changing owning lib of workstation ".$existing->id.
2520                     " from ".$existing->owning_lib." to $owner");
2521                 return $e->die_event unless
2522                     $e->allowed('UPDATE_WORKSTATION', $existing->owning_lib);
2523
2524                 return $e->die_event unless $e->allowed('UPDATE_WORKSTATION', $owner);
2525
2526                 $existing->owning_lib($owner);
2527                 return $e->die_event unless $e->update_actor_workstation($existing);
2528
2529                 $e->commit;
2530
2531             } else {
2532                 $logger->info(
2533                     "attempt to register an existing workstation.  returning existing ID");
2534             }
2535
2536             return $existing->id;
2537
2538         } else {
2539             return OpenILS::Event->new('WORKSTATION_NAME_EXISTS')
2540         }
2541     }
2542
2543     my $ws = Fieldmapper::actor::workstation->new;
2544     $ws->owning_lib($owner);
2545     $ws->name($name);
2546     $e->create_actor_workstation($ws) or return $e->die_event;
2547     $e->commit;
2548     return $ws->id; # note: editor sets the id on the new object for us
2549 }
2550
2551 __PACKAGE__->register_method(
2552     method    => 'workstation_list',
2553     api_name  => 'open-ils.actor.workstation.list',
2554     signature => q/
2555         Returns a list of workstations registered at the given location
2556         @param authtoken The login session key
2557         @param ids A list of org_unit.id's for the workstation owners
2558     /
2559 );
2560
2561 sub workstation_list {
2562     my( $self, $conn, $authtoken, @orgs ) = @_;
2563
2564     my $e = new_editor(authtoken=>$authtoken);
2565     return $e->event unless $e->checkauth;
2566     my %results;
2567
2568     for my $o (@orgs) {
2569         return $e->event
2570             unless $e->allowed('REGISTER_WORKSTATION', $o);
2571         $results{$o} = $e->search_actor_workstation({owning_lib=>$o});
2572     }
2573     return \%results;
2574 }
2575
2576
2577 __PACKAGE__->register_method(
2578     method        => 'fetch_patron_note',
2579     api_name      => 'open-ils.actor.note.retrieve.all',
2580     authoritative => 1,
2581     signature     => q/
2582         Returns a list of notes for a given user
2583         Requestor must have VIEW_USER permission if pub==false and
2584         @param authtoken The login session key
2585         @param args Hash of params including
2586             patronid : the patron's id
2587             pub : true if retrieving only public notes
2588     /
2589 );
2590
2591 sub fetch_patron_note {
2592     my( $self, $conn, $authtoken, $args ) = @_;
2593     my $patronid = $$args{patronid};
2594
2595     my($reqr, $evt) = $U->checkses($authtoken);
2596     return $evt if $evt;
2597
2598     my $patron;
2599     ($patron, $evt) = $U->fetch_user($patronid);
2600     return $evt if $evt;
2601
2602     if($$args{pub}) {
2603         if( $patronid ne $reqr->id ) {
2604             $evt = $U->check_perms($reqr->id, $patron->home_ou, 'VIEW_USER');
2605             return $evt if $evt;
2606         }
2607         return $U->cstorereq(
2608             'open-ils.cstore.direct.actor.usr_note.search.atomic',
2609             { usr => $patronid, pub => 't' } );
2610     }
2611
2612     $evt = $U->check_perms($reqr->id, $patron->home_ou, 'VIEW_USER');
2613     return $evt if $evt;
2614
2615     return $U->cstorereq(
2616         'open-ils.cstore.direct.actor.usr_note.search.atomic', { usr => $patronid } );
2617 }
2618
2619 __PACKAGE__->register_method(
2620     method    => 'create_user_note',
2621     api_name  => 'open-ils.actor.note.create',
2622     signature => q/
2623         Creates a new note for the given user
2624         @param authtoken The login session key
2625         @param note The note object
2626     /
2627 );
2628 sub create_user_note {
2629     my( $self, $conn, $authtoken, $note ) = @_;
2630     my $e = new_editor(xact=>1, authtoken=>$authtoken);
2631     return $e->die_event unless $e->checkauth;
2632
2633     my $user = $e->retrieve_actor_user($note->usr)
2634         or return $e->die_event;
2635
2636     return $e->die_event unless
2637         $e->allowed('UPDATE_USER',$user->home_ou);
2638
2639     $note->creator($e->requestor->id);
2640     $e->create_actor_usr_note($note) or return $e->die_event;
2641     $e->commit;
2642     return $note->id;
2643 }
2644
2645
2646 __PACKAGE__->register_method(
2647     method    => 'delete_user_note',
2648     api_name  => 'open-ils.actor.note.delete',
2649     signature => q/
2650         Deletes a note for the given user
2651         @param authtoken The login session key
2652         @param noteid The note id
2653     /
2654 );
2655 sub delete_user_note {
2656     my( $self, $conn, $authtoken, $noteid ) = @_;
2657
2658     my $e = new_editor(xact=>1, authtoken=>$authtoken);
2659     return $e->die_event unless $e->checkauth;
2660     my $note = $e->retrieve_actor_usr_note($noteid)
2661         or return $e->die_event;
2662     my $user = $e->retrieve_actor_user($note->usr)
2663         or return $e->die_event;
2664     return $e->die_event unless
2665         $e->allowed('UPDATE_USER', $user->home_ou);
2666
2667     $e->delete_actor_usr_note($note) or return $e->die_event;
2668     $e->commit;
2669     return 1;
2670 }
2671
2672
2673 __PACKAGE__->register_method(
2674     method    => 'update_user_note',
2675     api_name  => 'open-ils.actor.note.update',
2676     signature => q/
2677         @param authtoken The login session key
2678         @param note The note
2679     /
2680 );
2681
2682 sub update_user_note {
2683     my( $self, $conn, $auth, $note ) = @_;
2684     my $e = new_editor(authtoken=>$auth, xact=>1);
2685     return $e->die_event unless $e->checkauth;
2686     my $patron = $e->retrieve_actor_user($note->usr)
2687         or return $e->die_event;
2688     return $e->die_event unless
2689         $e->allowed('UPDATE_USER', $patron->home_ou);
2690     $e->update_actor_user_note($note)
2691         or return $e->die_event;
2692     $e->commit;
2693     return 1;
2694 }
2695
2696 __PACKAGE__->register_method(
2697     method        => 'fetch_patron_messages',
2698     api_name      => 'open-ils.actor.message.retrieve',
2699     authoritative => 1,
2700     signature     => q/
2701         Returns a list of notes for a given user, not
2702         including ones marked deleted
2703         @param authtoken The login session key
2704         @param patronid patron ID
2705         @param options hash containing optional limit and offset
2706     /
2707 );
2708
2709 sub fetch_patron_messages {
2710     my( $self, $conn, $auth, $patronid, $options ) = @_;
2711
2712     $options ||= {};
2713
2714     my $e = new_editor(authtoken => $auth);
2715     return $e->die_event unless $e->checkauth;
2716
2717     if ($e->requestor->id ne $patronid) {
2718         return $e->die_event unless $e->allowed('VIEW_USER');
2719     }
2720
2721     my $select_clause = { usr => $patronid };
2722     my $options_clause = { order_by => { aum => 'create_date DESC' } };
2723     $options_clause->{'limit'} = $options->{'limit'} if $options->{'limit'};
2724     $options_clause->{'offset'} = $options->{'offset'} if $options->{'offset'};
2725
2726     my $aum = $e->search_actor_usr_message([ $select_clause, $options_clause ]);
2727     return $aum;
2728 }
2729
2730
2731 __PACKAGE__->register_method(
2732     method    => 'usrname_exists',
2733     api_name  => 'open-ils.actor.username.exists',
2734     signature => {
2735         desc  => 'Check if a username is already taken (by an undeleted patron)',
2736         param => [
2737             {desc => 'Authentication token', type => 'string'},
2738             {desc => 'Username',             type => 'string'}
2739         ],
2740         return => {
2741             desc => 'id of existing user if username exists, undef otherwise.  Event on error'
2742         },
2743     }
2744 );
2745
2746 sub usrname_exists {
2747     my( $self, $conn, $auth, $usrname ) = @_;
2748     my $e = new_editor(authtoken=>$auth);
2749     return $e->event unless $e->checkauth;
2750     my $a = $e->search_actor_user({usrname => $usrname}, {idlist=>1});
2751     return $$a[0] if $a and @$a;
2752     return undef;
2753 }
2754
2755 __PACKAGE__->register_method(
2756     method        => 'barcode_exists',
2757     api_name      => 'open-ils.actor.barcode.exists',
2758     authoritative => 1,
2759     signature     => 'Returns 1 if the requested barcode exists, returns 0 otherwise'
2760 );
2761
2762 sub barcode_exists {
2763     my( $self, $conn, $auth, $barcode ) = @_;
2764     my $e = new_editor(authtoken=>$auth);
2765     return $e->event unless $e->checkauth;
2766     my $card = $e->search_actor_card({barcode => $barcode});
2767     if (@$card) {
2768         return 1;
2769     } else {
2770         return 0;
2771     }
2772     #return undef unless @$card;
2773     #return $card->[0]->usr;
2774 }
2775
2776
2777 __PACKAGE__->register_method(
2778     method   => 'retrieve_net_levels',
2779     api_name => 'open-ils.actor.net_access_level.retrieve.all',
2780 );
2781
2782 sub retrieve_net_levels {
2783     my( $self, $conn, $auth ) = @_;
2784     my $e = new_editor(authtoken=>$auth);
2785     return $e->event unless $e->checkauth;
2786     return $e->retrieve_all_config_net_access_level();
2787 }
2788
2789 # Retain the old typo API name just in case
2790 __PACKAGE__->register_method(
2791     method   => 'fetch_org_by_shortname',
2792     api_name => 'open-ils.actor.org_unit.retrieve_by_shorname',
2793 );
2794 __PACKAGE__->register_method(
2795     method   => 'fetch_org_by_shortname',
2796     api_name => 'open-ils.actor.org_unit.retrieve_by_shortname',
2797 );
2798 sub fetch_org_by_shortname {
2799     my( $self, $conn, $sname ) = @_;
2800     my $e = new_editor();
2801     my $org = $e->search_actor_org_unit({ shortname => uc($sname)})->[0];
2802     return $e->event unless $org;
2803     return $org;
2804 }
2805
2806
2807 __PACKAGE__->register_method(
2808     method   => 'session_home_lib',
2809     api_name => 'open-ils.actor.session.home_lib',
2810 );
2811
2812 sub session_home_lib {
2813     my( $self, $conn, $auth ) = @_;
2814     my $e = new_editor(authtoken=>$auth);
2815     return undef unless $e->checkauth;
2816     my $org = $e->retrieve_actor_org_unit($e->requestor->home_ou);
2817     return $org->shortname;
2818 }
2819
2820 __PACKAGE__->register_method(
2821     method    => 'session_safe_token',
2822     api_name  => 'open-ils.actor.session.safe_token',
2823     signature => q/
2824         Returns a hashed session ID that is safe for export to the world.
2825         This safe token will expire after 1 hour of non-use.
2826         @param auth Active authentication token
2827     /
2828 );
2829
2830 sub session_safe_token {
2831     my( $self, $conn, $auth ) = @_;
2832     my $e = new_editor(authtoken=>$auth);
2833     return undef unless $e->checkauth;
2834
2835     my $safe_token = md5_hex($auth);
2836
2837     $cache ||= OpenSRF::Utils::Cache->new("global", 0);
2838
2839     # add more user fields as needed
2840     $cache->put_cache(
2841         "safe-token-user-$safe_token", {
2842             id => $e->requestor->id,
2843             home_ou_shortname => $e->retrieve_actor_org_unit(
2844                 $e->requestor->home_ou)->shortname,
2845         },
2846         60 * 60
2847     );
2848
2849     return $safe_token;
2850 }
2851
2852
2853 __PACKAGE__->register_method(
2854     method    => 'safe_token_home_lib',
2855     api_name  => 'open-ils.actor.safe_token.home_lib.shortname',
2856     signature => q/
2857         Returns the home library shortname from the session
2858         asscociated with a safe token from generated by
2859         open-ils.actor.session.safe_token.
2860         @param safe_token Active safe token
2861         @param who Optional user activity "ewho" value
2862     /
2863 );
2864
2865 sub safe_token_home_lib {
2866     my( $self, $conn, $safe_token, $who ) = @_;
2867     $cache ||= OpenSRF::Utils::Cache->new("global", 0);
2868
2869     my $blob = $cache->get_cache("safe-token-user-$safe_token");
2870     return unless $blob;
2871
2872     $U->log_user_activity($blob->{id}, $who, 'verify');
2873     return $blob->{home_ou_shortname};
2874 }
2875
2876
2877 __PACKAGE__->register_method(
2878     method   => "update_penalties",
2879     api_name => "open-ils.actor.user.penalties.update"
2880 );
2881
2882 sub update_penalties {
2883     my($self, $conn, $auth, $user_id) = @_;
2884     my $e = new_editor(authtoken=>$auth, xact => 1);
2885     return $e->die_event unless $e->checkauth;
2886     my $user = $e->retrieve_actor_user($user_id) or return $e->die_event;
2887     return $e->die_event unless $e->allowed('UPDATE_USER', $user->home_ou);
2888     my $evt = OpenILS::Utils::Penalty->calculate_penalties($e, $user_id, $e->requestor->ws_ou);
2889     return $evt if $evt;
2890     $e->commit;
2891     return 1;
2892 }
2893
2894
2895 __PACKAGE__->register_method(
2896     method   => "apply_penalty",
2897     api_name => "open-ils.actor.user.penalty.apply"
2898 );
2899
2900 sub apply_penalty {
2901     my($self, $conn, $auth, $penalty) = @_;
2902
2903     my $e = new_editor(authtoken=>$auth, xact => 1);
2904     return $e->die_event unless $e->checkauth;
2905
2906     my $user = $e->retrieve_actor_user($penalty->usr) or return $e->die_event;
2907     return $e->die_event unless $e->allowed('UPDATE_USER', $user->home_ou);
2908
2909     my $ptype = $e->retrieve_config_standing_penalty($penalty->standing_penalty) or return $e->die_event;
2910
2911     my $ctx_org =
2912         (defined $ptype->org_depth) ?
2913         $U->org_unit_ancestor_at_depth($penalty->org_unit, $ptype->org_depth) :
2914         $penalty->org_unit;
2915
2916     $penalty->org_unit($ctx_org);
2917     $penalty->staff($e->requestor->id);
2918     $e->create_actor_user_standing_penalty($penalty) or return $e->die_event;
2919
2920     $e->commit;
2921     return $penalty->id;
2922 }
2923
2924 __PACKAGE__->register_method(
2925     method   => "remove_penalty",
2926     api_name => "open-ils.actor.user.penalty.remove"
2927 );
2928
2929 sub remove_penalty {
2930     my($self, $conn, $auth, $penalty) = @_;
2931     my $e = new_editor(authtoken=>$auth, xact => 1);
2932     return $e->die_event unless $e->checkauth;
2933     my $user = $e->retrieve_actor_user($penalty->usr) or return $e->die_event;
2934     return $e->die_event unless $e->allowed('UPDATE_USER', $user->home_ou);
2935
2936     $e->delete_actor_user_standing_penalty($penalty) or return $e->die_event;
2937     $e->commit;
2938     return 1;
2939 }
2940
2941 __PACKAGE__->register_method(
2942     method   => "update_penalty_note",
2943     api_name => "open-ils.actor.user.penalty.note.update"
2944 );
2945
2946 sub update_penalty_note {
2947     my($self, $conn, $auth, $penalty_ids, $note) = @_;
2948     my $e = new_editor(authtoken=>$auth, xact => 1);
2949     return $e->die_event unless $e->checkauth;
2950     for my $penalty_id (@$penalty_ids) {
2951         my $penalty = $e->search_actor_user_standing_penalty( { id => $penalty_id } )->[0];
2952         if (! $penalty ) { return $e->die_event; }
2953         my $user = $e->retrieve_actor_user($penalty->usr) or return $e->die_event;
2954         return $e->die_event unless $e->allowed('UPDATE_USER', $user->home_ou);
2955
2956         $penalty->note( $note ); $penalty->ischanged( 1 );
2957
2958         $e->update_actor_user_standing_penalty($penalty) or return $e->die_event;
2959     }
2960     $e->commit;
2961     return 1;
2962 }
2963
2964 __PACKAGE__->register_method(
2965     method   => "ranged_penalty_thresholds",
2966     api_name => "open-ils.actor.grp_penalty_threshold.ranged.retrieve",
2967     stream   => 1
2968 );
2969
2970 sub ranged_penalty_thresholds {
2971     my($self, $conn, $auth, $context_org) = @_;
2972     my $e = new_editor(authtoken=>$auth);
2973     return $e->event unless $e->checkauth;
2974     return $e->event unless $e->allowed('VIEW_GROUP_PENALTY_THRESHOLD', $context_org);
2975     my $list = $e->search_permission_grp_penalty_threshold([
2976         {org_unit => $U->get_org_ancestors($context_org)},
2977         {order_by => {pgpt => 'id'}}
2978     ]);
2979     $conn->respond($_) for @$list;
2980     return undef;
2981 }
2982
2983
2984
2985 __PACKAGE__->register_method(
2986     method        => "user_retrieve_fleshed_by_id",
2987     authoritative => 1,
2988     api_name      => "open-ils.actor.user.fleshed.retrieve",
2989 );
2990
2991 sub user_retrieve_fleshed_by_id {
2992     my( $self, $client, $auth, $user_id, $fields ) = @_;
2993     my $e = new_editor(authtoken => $auth);
2994     return $e->event unless $e->checkauth;
2995
2996     if( $e->requestor->id != $user_id ) {
2997         return $e->event unless $e->allowed('VIEW_USER');
2998     }
2999
3000     $fields ||= [
3001         "cards",
3002         "card",
3003         "groups",
3004         "standing_penalties",
3005         "settings",
3006         "addresses",
3007         "billing_address",
3008         "mailing_address",
3009         "stat_cat_entries",
3010         "usr_activity" ];
3011     return new_flesh_user($user_id, $fields, $e);
3012 }
3013
3014
3015 sub new_flesh_user {
3016
3017     my $id = shift;
3018     my $fields = shift || [];
3019     my $e = shift;
3020
3021     my $fetch_penalties = 0;
3022     if(grep {$_ eq 'standing_penalties'} @$fields) {
3023         $fields = [grep {$_ ne 'standing_penalties'} @$fields];
3024         $fetch_penalties = 1;
3025     }
3026
3027     my $fetch_usr_act = 0;
3028     if(grep {$_ eq 'usr_activity'} @$fields) {
3029         $fields = [grep {$_ ne 'usr_activity'} @$fields];
3030         $fetch_usr_act = 1;
3031     }
3032
3033     my $user = $e->retrieve_actor_user(
3034     [
3035         $id,
3036         {
3037             "flesh"             => 1,
3038             "flesh_fields" =>  { "au" => $fields }
3039         }
3040     ]
3041     ) or return $e->die_event;
3042
3043
3044     if( grep { $_ eq 'addresses' } @$fields ) {
3045
3046         $user->addresses([]) unless @{$user->addresses};
3047         # don't expose "replaced" addresses by default
3048         $user->addresses([grep {$_->id >= 0} @{$user->addresses}]);
3049
3050         if( ref $user->billing_address ) {
3051             unless( grep { $user->billing_address->id == $_->id } @{$user->addresses} ) {
3052                 push( @{$user->addresses}, $user->billing_address );
3053             }
3054         }
3055
3056         if( ref $user->mailing_address ) {
3057             unless( grep { $user->mailing_address->id == $_->id } @{$user->addresses} ) {
3058                 push( @{$user->addresses}, $user->mailing_address );
3059             }
3060         }
3061     }
3062
3063     if($fetch_penalties) {
3064         # grab the user penalties ranged for this location
3065         $user->standing_penalties(
3066             $e->search_actor_user_standing_penalty([
3067                 {   usr => $id,
3068                     '-or' => [
3069                         {stop_date => undef},
3070                         {stop_date => {'>' => 'now'}}
3071                     ],
3072                     org_unit => $U->get_org_full_path($e->requestor->ws_ou)
3073                 },
3074                 {   flesh => 1,
3075                     flesh_fields => {ausp => ['standing_penalty']}
3076                 }
3077             ])
3078         );
3079     }
3080
3081     # retrieve the most recent usr_activity entry
3082     if ($fetch_usr_act) {
3083
3084         # max number to return for simple patron fleshing
3085         my $limit = $U->ou_ancestor_setting_value(
3086             $e->requestor->ws_ou,
3087             'circ.patron.usr_activity_retrieve.max');
3088
3089         my $opts = {
3090             flesh => 1,
3091             flesh_fields => {auact => ['etype']},
3092             order_by => {auact => 'event_time DESC'},
3093         };
3094
3095         # 0 == none, <0 == return all
3096         $limit = 1 unless defined $limit;
3097         $opts->{limit} = $limit if $limit > 0;
3098
3099         $user->usr_activity(
3100             ($limit == 0) ?
3101                 [] : # skip the DB call
3102                 $e->search_actor_usr_activity([{usr => $user->id}, $opts])
3103         );
3104     }
3105
3106     $e->rollback;
3107     $user->clear_passwd();
3108     return $user;
3109 }
3110
3111
3112
3113
3114 __PACKAGE__->register_method(
3115     method   => "user_retrieve_parts",
3116     api_name => "open-ils.actor.user.retrieve.parts",
3117 );
3118
3119 sub user_retrieve_parts {
3120     my( $self, $client, $auth, $user_id, $fields ) = @_;
3121     my $e = new_editor(authtoken => $auth);
3122     return $e->event unless $e->checkauth;
3123     $user_id ||= $e->requestor->id;
3124     if( $e->requestor->id != $user_id ) {
3125         return $e->event unless $e->allowed('VIEW_USER');
3126     }
3127     my @resp;
3128     my $user = $e->retrieve_actor_user($user_id) or return $e->event;
3129     push(@resp, $user->$_()) for(@$fields);
3130     return \@resp;
3131 }
3132
3133
3134
3135 __PACKAGE__->register_method(
3136     method    => 'user_opt_in_enabled',
3137     api_name  => 'open-ils.actor.user.org_unit_opt_in.enabled',
3138     signature => '@return 1 if user opt-in is globally enabled, 0 otherwise.'
3139 );
3140
3141 sub user_opt_in_enabled {
3142     my($self, $conn) = @_;
3143     my $sc = OpenSRF::Utils::SettingsClient->new;
3144     return 1 if lc($sc->config_value(share => user => 'opt_in')) eq 'true';
3145     return 0;
3146 }
3147
3148
3149 __PACKAGE__->register_method(
3150     method    => 'user_opt_in_at_org',
3151     api_name  => 'open-ils.actor.user.org_unit_opt_in.check',
3152     signature => q/
3153         @param $auth The auth token
3154         @param user_id The ID of the user to test
3155         @return 1 if the user has opted in at the specified org,
3156             2 if opt-in is disallowed for the user's home org,
3157             event on error, and 0 otherwise. /
3158 );
3159 sub user_opt_in_at_org {
3160     my($self, $conn, $auth, $user_id) = @_;
3161
3162     # see if we even need to enforce the opt-in value
3163     return 1 unless user_opt_in_enabled($self);
3164
3165     my $e = new_editor(authtoken => $auth);
3166     return $e->event unless $e->checkauth;
3167
3168     my $user = $e->retrieve_actor_user($user_id) or return $e->event;
3169     return $e->event unless $e->allowed('VIEW_USER', $user->home_ou);
3170
3171     my $ws_org = $e->requestor->ws_ou;
3172     # user is automatically opted-in if they are from the local org
3173     return 1 if $user->home_ou eq $ws_org;
3174
3175     # get the boundary setting
3176     my $opt_boundary = $U->ou_ancestor_setting_value($e->requestor->ws_ou,'org.patron_opt_boundary');
3177
3178     # auto opt in if user falls within the opt boundary
3179     my $opt_orgs = $U->get_org_descendants($ws_org, $opt_boundary);
3180
3181     return 1 if grep $_ eq $user->home_ou, @$opt_orgs;
3182
3183     # check whether opt-in is restricted at the user's home library
3184     my $opt_restrict_depth = $U->ou_ancestor_setting_value($user->home_ou, 'org.restrict_opt_to_depth');
3185     if ($opt_restrict_depth) {
3186         my $restrict_ancestor = $U->org_unit_ancestor_at_depth($user->home_ou, $opt_restrict_depth);
3187         my $unrestricted_orgs = $U->get_org_descendants($restrict_ancestor);
3188
3189         # opt-in is disallowed unless the workstation org is within the home
3190         # library's opt-in scope
3191         return 2 unless grep $_ eq $e->requestor->ws_ou, @$unrestricted_orgs;
3192     }
3193
3194     my $vals = $e->search_actor_usr_org_unit_opt_in(
3195         {org_unit=>$opt_orgs, usr=>$user_id},{idlist=>1});
3196
3197     return 1 if @$vals;
3198     return 0;
3199 }
3200
3201 __PACKAGE__->register_method(
3202     method    => 'create_user_opt_in_at_org',
3203     api_name  => 'open-ils.actor.user.org_unit_opt_in.create',
3204     signature => q/
3205         @param $auth The auth token
3206         @param user_id The ID of the user to test
3207         @return The ID of the newly created object, event on error./
3208 );
3209
3210 sub create_user_opt_in_at_org {
3211     my($self, $conn, $auth, $user_id, $org_id) = @_;
3212
3213     my $e = new_editor(authtoken => $auth, xact=>1);
3214     return $e->die_event unless $e->checkauth;
3215
3216     # if a specific org unit wasn't passed in, get one based on the defaults;
3217     if(!$org_id){
3218         my $wsou = $e->requestor->ws_ou;
3219         # get the default opt depth
3220         my $opt_depth = $U->ou_ancestor_setting_value($wsou,'org.patron_opt_default');
3221         # get the org unit at that depth
3222         my $org = $e->json_query({
3223             from => [ 'actor.org_unit_ancestor_at_depth', $wsou, $opt_depth ]})->[0];
3224         $org_id = $org->{id};
3225     }
3226     if (!$org_id) {
3227         # fall back to the workstation OU, the pre-opt-in-boundary way
3228         $org_id = $e->requestor->ws_ou;
3229     }
3230
3231     my $user = $e->retrieve_actor_user($user_id) or return $e->die_event;
3232     return $e->die_event unless $e->allowed('UPDATE_USER', $user->home_ou);
3233
3234     my $opt_in = Fieldmapper::actor::usr_org_unit_opt_in->new;
3235
3236     $opt_in->org_unit($org_id);
3237     $opt_in->usr($user_id);
3238     $opt_in->staff($e->requestor->id);
3239     $opt_in->opt_in_ts('now');