LP#1557621 Verify password barcode / deleted users repair
[Evergreen.git] / Open-ILS / src / perlmods / lib / OpenILS / Application / Actor.pm
1 package OpenILS::Application::Actor;
2 use OpenILS::Application;
3 use base qw/OpenILS::Application/;
4 use strict; use warnings;
5 use Data::Dumper;
6 $Data::Dumper::Indent = 0;
7 use OpenILS::Event;
8
9 use Digest::MD5 qw(md5_hex);
10
11 use OpenSRF::EX qw(:try);
12 use OpenILS::Perm;
13
14 use OpenILS::Application::AppUtils;
15
16 use OpenILS::Utils::Fieldmapper;
17 use OpenILS::Utils::ModsParser;
18 use OpenSRF::Utils::Logger qw/$logger/;
19 use OpenSRF::Utils qw/:datetime/;
20 use OpenSRF::Utils::SettingsClient;
21
22 use OpenSRF::Utils::Cache;
23
24 use OpenSRF::Utils::JSON;
25 use DateTime;
26 use DateTime::Format::ISO8601;
27 use OpenILS::Const qw/:const/;
28
29 use OpenILS::Application::Actor::Container;
30 use OpenILS::Application::Actor::ClosedDates;
31 use OpenILS::Application::Actor::UserGroups;
32 use OpenILS::Application::Actor::Friends;
33 use OpenILS::Application::Actor::Stage;
34
35 use OpenILS::Utils::CStoreEditor qw/:funcs/;
36 use OpenILS::Utils::Penalty;
37 use OpenILS::Utils::BadContact;
38 use List::Util qw/max reduce/;
39
40 use UUID::Tiny qw/:std/;
41
42 sub initialize {
43     OpenILS::Application::Actor::Container->initialize();
44     OpenILS::Application::Actor::UserGroups->initialize();
45     OpenILS::Application::Actor::ClosedDates->initialize();
46 }
47
48 my $apputils = "OpenILS::Application::AppUtils";
49 my $U = $apputils;
50
51 sub _d { warn "Patron:\n" . Dumper(shift()); }
52
53 my $cache;
54 my $set_user_settings;
55 my $set_ou_settings;
56
57
58 #__PACKAGE__->register_method(
59 #   method  => "allowed_test",
60 #   api_name    => "open-ils.actor.allowed_test",
61 #);
62 #sub allowed_test {
63 #    my($self, $conn, $auth, $orgid, $permcode) = @_;
64 #    my $e = new_editor(authtoken => $auth);
65 #    return $e->die_event unless $e->checkauth;
66 #
67 #    return {
68 #        orgid => $orgid,
69 #        permcode => $permcode,
70 #        result => $e->allowed($permcode, $orgid)
71 #    };
72 #}
73
74 __PACKAGE__->register_method(
75     method  => "update_user_setting",
76     api_name    => "open-ils.actor.patron.settings.update",
77 );
78 sub update_user_setting {
79     my($self, $conn, $auth, $user_id, $settings) = @_;
80     my $e = new_editor(xact => 1, authtoken => $auth);
81     return $e->die_event unless $e->checkauth;
82
83     $user_id = $e->requestor->id unless defined $user_id;
84
85     unless($e->requestor->id == $user_id) {
86         my $user = $e->retrieve_actor_user($user_id) or return $e->die_event;
87         return $e->die_event unless $e->allowed('UPDATE_USER', $user->home_ou);
88     }
89
90     for my $name (keys %$settings) {
91         my $val = $$settings{$name};
92         my $set = $e->search_actor_user_setting({usr => $user_id, name => $name})->[0];
93
94         if(defined $val) {
95             $val = OpenSRF::Utils::JSON->perl2JSON($val);
96             if($set) {
97                 $set->value($val);
98                 $e->update_actor_user_setting($set) or return $e->die_event;
99             } else {
100                 $set = Fieldmapper::actor::user_setting->new;
101                 $set->usr($user_id);
102                 $set->name($name);
103                 $set->value($val);
104                 $e->create_actor_user_setting($set) or return $e->die_event;
105             }
106         } elsif($set) {
107             $e->delete_actor_user_setting($set) or return $e->die_event;
108         }
109     }
110
111     $e->commit;
112     return 1;
113 }
114
115
116 __PACKAGE__->register_method(
117     method    => "set_ou_settings",
118     api_name  => "open-ils.actor.org_unit.settings.update",
119     signature => {
120         desc => "Updates the value for a given org unit setting.  The permission to update "          .
121                 "an org unit setting is either the UPDATE_ORG_UNIT_SETTING_ALL, or a specific "       .
122                 "permission specified in the update_perm column of the config.org_unit_setting_type " .
123                 "table's row corresponding to the setting being changed." ,
124         params => [
125             {desc => 'Authentication token',             type => 'string'},
126             {desc => 'Org unit ID',                      type => 'number'},
127             {desc => 'Hash of setting name-value pairs', type => 'object'}
128         ],
129         return => {desc => '1 on success, Event on error'}
130     }
131 );
132
133 sub set_ou_settings {
134     my( $self, $client, $auth, $org_id, $settings ) = @_;
135
136     my $e = new_editor(authtoken => $auth, xact => 1);
137     return $e->die_event unless $e->checkauth;
138
139     my $all_allowed = $e->allowed("UPDATE_ORG_UNIT_SETTING_ALL", $org_id);
140
141     for my $name (keys %$settings) {
142         my $val = $$settings{$name};
143
144         my $type = $e->retrieve_config_org_unit_setting_type([
145             $name,
146             {flesh => 1, flesh_fields => {'coust' => ['update_perm']}}
147         ]) or return $e->die_event;
148         my $set = $e->search_actor_org_unit_setting({org_unit => $org_id, name => $name})->[0];
149
150         # If there is no relevant permission, the default assumption will
151         # be, "no, the caller cannot change that value."
152         return $e->die_event unless ($all_allowed ||
153             ($type->update_perm && $e->allowed($type->update_perm->code, $org_id)));
154
155         if(defined $val) {
156             $val = OpenSRF::Utils::JSON->perl2JSON($val);
157             if($set) {
158                 $set->value($val);
159                 $e->update_actor_org_unit_setting($set) or return $e->die_event;
160             } else {
161                 $set = Fieldmapper::actor::org_unit_setting->new;
162                 $set->org_unit($org_id);
163                 $set->name($name);
164                 $set->value($val);
165                 $e->create_actor_org_unit_setting($set) or return $e->die_event;
166             }
167         } elsif($set) {
168             $e->delete_actor_org_unit_setting($set) or return $e->die_event;
169         }
170     }
171
172     $e->commit;
173     return 1;
174 }
175
176 __PACKAGE__->register_method(
177     method   => "user_settings",
178     authoritative => 1,
179     api_name => "open-ils.actor.patron.settings.retrieve",
180 );
181 sub user_settings {
182     my( $self, $client, $auth, $user_id, $setting ) = @_;
183
184     my $e = new_editor(authtoken => $auth);
185     return $e->event unless $e->checkauth;
186     $user_id = $e->requestor->id unless defined $user_id;
187
188     my $patron = $e->retrieve_actor_user($user_id) or return $e->event;
189     if($e->requestor->id != $user_id) {
190         return $e->event unless $e->allowed('VIEW_USER', $patron->home_ou);
191     }
192
193     sub get_setting {
194         my($e, $user_id, $setting) = @_;
195         my $val = $e->search_actor_user_setting({usr => $user_id, name => $setting})->[0];
196         return undef unless $val; # XXX this should really return undef, but needs testing
197         return OpenSRF::Utils::JSON->JSON2perl($val->value);
198     }
199
200     if($setting) {
201         if(ref $setting eq 'ARRAY') {
202             my %settings;
203             $settings{$_} = get_setting($e, $user_id, $_) for @$setting;
204             return \%settings;
205         } else {
206             return get_setting($e, $user_id, $setting);
207         }
208     } else {
209         my $s = $e->search_actor_user_setting({usr => $user_id});
210         return { map { ( $_->name => OpenSRF::Utils::JSON->JSON2perl($_->value) ) } @$s };
211     }
212 }
213
214
215 __PACKAGE__->register_method(
216     method    => "ranged_ou_settings",
217     api_name  => "open-ils.actor.org_unit_setting.values.ranged.retrieve",
218     signature => {
219         desc   => "Retrieves all org unit settings for the given org_id, up to whatever limit " .
220                 "is implied for retrieving OU settings by the authenticated users' permissions.",
221         params => [
222             {desc => 'Authentication token',   type => 'string'},
223             {desc => 'Org unit ID',            type => 'number'},
224         ],
225         return => {desc => 'A hashref of "ranged" settings, event on error'}
226     }
227 );
228 sub ranged_ou_settings {
229     my( $self, $client, $auth, $org_id ) = @_;
230
231     my $e = new_editor(authtoken => $auth);
232     return $e->event unless $e->checkauth;
233
234     my %ranged_settings;
235     my $org_list = $U->get_org_ancestors($org_id);
236     my $settings = $e->search_actor_org_unit_setting({org_unit => $org_list});
237     $org_list = [ reverse @$org_list ];
238
239     # start at the context org and capture the setting value
240     # without clobbering settings we've already captured
241     for my $this_org_id (@$org_list) {
242
243         my @sets = grep { $_->org_unit == $this_org_id } @$settings;
244
245         for my $set (@sets) {
246             my $type = $e->retrieve_config_org_unit_setting_type([
247                 $set->name,
248                 {flesh => 1, flesh_fields => {coust => ['view_perm']}}
249             ]);
250
251             # If there is no relevant permission, the default assumption will
252             # be, "yes, the caller can have that value."
253             if ($type && $type->view_perm) {
254                 next if not $e->allowed($type->view_perm->code, $org_id);
255             }
256
257             $ranged_settings{$set->name} = OpenSRF::Utils::JSON->JSON2perl($set->value)
258                 unless defined $ranged_settings{$set->name};
259         }
260     }
261
262     return \%ranged_settings;
263 }
264
265
266
267 __PACKAGE__->register_method(
268     api_name  => 'open-ils.actor.ou_setting.ancestor_default',
269     method    => 'ou_ancestor_setting',
270     signature => {
271         desc => 'Get the org unit setting value associated with the setting name as seen from the specified org unit.  ' .
272                 'This method will make sure that the given user has permission to view that setting, if there is a '     .
273                 'permission associated with the setting.  If a permission is required and no authtoken is given, or '     .
274                 'the user lacks the permisssion, undef will be returned.'       ,
275         params => [
276             { desc => 'Org unit ID',          type => 'number' },
277             { desc => 'setting name',         type => 'string' },
278             { desc => 'authtoken (optional)', type => 'string' }
279         ],
280         return => {desc => 'A value for the org unit setting, or undef'}
281     }
282 );
283
284 # ------------------------------------------------------------------
285 # Attempts to find the org setting value for a given org.  if not
286 # found at the requested org, searches up the org tree until it
287 # finds a parent that has the requested setting.
288 # when found, returns { org => $id, value => $value }
289 # otherwise, returns NULL
290 # ------------------------------------------------------------------
291 sub ou_ancestor_setting {
292     my( $self, $client, $orgid, $name, $auth ) = @_;
293     # Make sure $auth is set to something if not given.
294     $auth ||= -1;
295     return $U->ou_ancestor_setting($orgid, $name, undef, $auth);
296 }
297
298 __PACKAGE__->register_method(
299     api_name  => 'open-ils.actor.ou_setting.ancestor_default.batch',
300     method    => 'ou_ancestor_setting_batch',
301     signature => {
302         desc => 'Get org unit setting name => value pairs for a list of names, as seen from the specified org unit.  ' .
303                 'This method will make sure that the given user has permission to view that setting, if there is a '     .
304                 'permission associated with the setting.  If a permission is required and no authtoken is given, or '     .
305                 'the user lacks the permisssion, undef will be returned.'       ,
306         params => [
307             { desc => 'Org unit ID',          type => 'number' },
308             { desc => 'setting name list',    type => 'array'  },
309             { desc => 'authtoken (optional)', type => 'string' }
310         ],
311         return => {desc => 'A hash with name => value pairs for the org unit settings'}
312     }
313 );
314 sub ou_ancestor_setting_batch {
315     my( $self, $client, $orgid, $name_list, $auth ) = @_;
316
317     # splitting the list of settings to fetch values
318     # so that ones that *don't* require view_perm checks
319     # can be fetched in one fell swoop, which is
320     # significantly faster in cases where a large
321     # number of settings need to be fetched.
322     my %perm_check_required = ();
323     my @perm_check_not_required = ();
324
325     # Note that ->ou_ancestor_setting also can check
326     # to see if the setting has a view_perm, but testing
327     # suggests that the redundant checks do not significantly
328     # increase the time it takes to fetch the values of
329     # permission-controlled settings.
330     my $e = new_editor();
331     my $res = $e->search_config_org_unit_setting_type({
332         name      => $name_list,
333         view_perm => { "!=" => undef },
334     });
335     %perm_check_required = map { $_->name() => 1 } @$res;
336     foreach my $setting (@$name_list) {
337         push @perm_check_not_required, $setting
338             unless exists($perm_check_required{$setting});
339     }
340
341     my %values;
342     if (@perm_check_not_required) {
343         %values = $U->ou_ancestor_setting_batch_insecure($orgid, \@perm_check_not_required);
344     }
345     $values{$_} = $U->ou_ancestor_setting(
346         $orgid, $_, undef,
347         ($auth ? $auth : -1)
348     ) for keys(%perm_check_required);
349     return \%values;
350 }
351
352
353
354 __PACKAGE__->register_method(
355     method   => "update_patron",
356     api_name => "open-ils.actor.patron.update",
357     signature => {
358         desc   => q/
359             Update an existing user, or create a new one.  Related objects,
360             like cards, addresses, survey responses, and stat cats,
361             can be updated by attaching them to the user object in their
362             respective fields.  For examples, the billing address object
363             may be inserted into the 'billing_address' field, etc.  For each
364             attached object, indicate if the object should be created,
365             updated, or deleted using the built-in 'isnew', 'ischanged',
366             and 'isdeleted' fields on the object.
367         /,
368         params => [
369             { desc => 'Authentication token', type => 'string' },
370             { desc => 'Patron data object',   type => 'object' }
371         ],
372         return => {desc => 'A fleshed user object, event on error'}
373     }
374 );
375
376 sub update_patron {
377     my( $self, $client, $auth, $patron ) = @_;
378
379     my $e = new_editor(xact => 1, authtoken => $auth);
380     return $e->event unless $e->checkauth;
381
382     $logger->info($patron->isnew ? "Creating new patron..." :
383         "Updating Patron: " . $patron->id);
384
385     my $evt = check_group_perm($e, $e->requestor, $patron);
386     return $evt if $evt;
387
388     # $new_patron is the patron in progress.  $patron is the original patron
389     # passed in with the method.  new_patron will change as the components
390     # of patron are added/updated.
391
392     my $new_patron;
393
394     # unflesh the real items on the patron
395     $patron->card( $patron->card->id ) if(ref($patron->card));
396     $patron->billing_address( $patron->billing_address->id )
397         if(ref($patron->billing_address));
398     $patron->mailing_address( $patron->mailing_address->id )
399         if(ref($patron->mailing_address));
400
401     # create/update the patron first so we can use his id
402
403     # $patron is the obj from the client (new data) and $new_patron is the
404     # patron object properly built for db insertion, so we need a third variable
405     # if we want to represent the old patron.
406
407     my $old_patron;
408     my $barred_hook = '';
409
410     if($patron->isnew()) {
411         ( $new_patron, $evt ) = _add_patron($e, _clone_patron($patron));
412         return $evt if $evt;
413         if($U->is_true($patron->barred)) {
414             return $e->die_event unless
415                 $e->allowed('BAR_PATRON', $patron->home_ou);
416         }
417     } else {
418         $new_patron = $patron;
419
420         # Did auth checking above already.
421         $old_patron = $e->retrieve_actor_user($patron->id) or
422             return $e->die_event;
423
424         if($U->is_true($old_patron->barred) != $U->is_true($new_patron->barred)) {
425             my $perm = $U->is_true($old_patron->barred) ? 'UNBAR_PATRON' : 'BAR_PATRON';
426             return $e->die_event unless $e->allowed($perm, $patron->home_ou);
427
428             $barred_hook = $U->is_true($new_patron->barred) ?
429                 'au.barred' : 'au.unbarred';
430         }
431     }
432
433     ( $new_patron, $evt ) = _add_update_addresses($e, $patron, $new_patron);
434     return $evt if $evt;
435
436     ( $new_patron, $evt ) = _add_update_cards($e, $patron, $new_patron);
437     return $evt if $evt;
438
439     ( $new_patron, $evt ) = _add_survey_responses($e, $patron, $new_patron);
440     return $evt if $evt;
441
442     # re-update the patron if anything has happened to him during this process
443     if($new_patron->ischanged()) {
444         ( $new_patron, $evt ) = _update_patron($e, $new_patron);
445         return $evt if $evt;
446     }
447
448     ( $new_patron, $evt ) = _clear_badcontact_penalties($e, $old_patron, $new_patron);
449     return $evt if $evt;
450
451     ($new_patron, $evt) = _create_stat_maps($e, $patron, $new_patron);
452     return $evt if $evt;
453
454     ($new_patron, $evt) = _create_perm_maps($e, $patron, $new_patron);
455     return $evt if $evt;
456
457     $evt = apply_invalid_addr_penalty($e, $patron);
458     return $evt if $evt;
459
460     $e->commit;
461
462     my $tses = OpenSRF::AppSession->create('open-ils.trigger');
463     if($patron->isnew) {
464         $tses->request('open-ils.trigger.event.autocreate',
465             'au.create', $new_patron, $new_patron->home_ou);
466     } else {
467         $tses->request('open-ils.trigger.event.autocreate',
468             'au.update', $new_patron, $new_patron->home_ou);
469
470         $tses->request('open-ils.trigger.event.autocreate', $barred_hook,
471             $new_patron, $new_patron->home_ou) if $barred_hook;
472     }
473
474     $e->xact_begin; # $e->rollback is called in new_flesh_user
475     return flesh_user($new_patron->id(), $e);
476 }
477
478 sub apply_invalid_addr_penalty {
479     my $e = shift;
480     my $patron = shift;
481
482     # grab the invalid address penalty if set
483     my $penalties = OpenILS::Utils::Penalty->retrieve_usr_penalties($e, $patron->id, $patron->home_ou);
484
485     my ($addr_penalty) = grep
486         { $_->standing_penalty->name eq 'INVALID_PATRON_ADDRESS' } @$penalties;
487
488     # do we enforce invalid address penalty
489     my $enforce = $U->ou_ancestor_setting_value(
490         $patron->home_ou, 'circ.patron_invalid_address_apply_penalty') || 0;
491
492     my $addrs = $e->search_actor_user_address(
493         {usr => $patron->id, valid => 'f', id => {'>' => 0}}, {idlist => 1});
494     my $addr_count = scalar(@$addrs);
495
496     if($addr_count == 0 and $addr_penalty) {
497
498         # regardless of any settings, remove the penalty when the user has no invalid addresses
499         $e->delete_actor_user_standing_penalty($addr_penalty) or return $e->die_event;
500         $e->commit;
501
502     } elsif($enforce and $addr_count > 0 and !$addr_penalty) {
503
504         my $ptype = $e->retrieve_config_standing_penalty(29) or return $e->die_event;
505         my $depth = $ptype->org_depth;
506         my $ctx_org = $U->org_unit_ancestor_at_depth($patron->home_ou, $depth) if defined $depth;
507         $ctx_org = $patron->home_ou unless defined $ctx_org;
508
509         my $penalty = Fieldmapper::actor::user_standing_penalty->new;
510         $penalty->usr($patron->id);
511         $penalty->org_unit($ctx_org);
512         $penalty->standing_penalty(OILS_PENALTY_INVALID_PATRON_ADDRESS);
513
514         $e->create_actor_user_standing_penalty($penalty) or return $e->die_event;
515     }
516
517     return undef;
518 }
519
520
521 sub flesh_user {
522     my $id = shift;
523     my $e = shift;
524     my $home_ou = shift;
525
526     my $fields = [
527         "cards",
528         "card",
529         "standing_penalties",
530         "addresses",
531         "billing_address",
532         "mailing_address",
533         "stat_cat_entries",
534         "settings",
535         "usr_activity"
536     ];
537     push @$fields, "home_ou" if $home_ou;
538     return new_flesh_user($id, $fields, $e );
539 }
540
541
542
543
544
545
546 # clone and clear stuff that would break the database
547 sub _clone_patron {
548     my $patron = shift;
549
550     my $new_patron = $patron->clone;
551     # clear these
552     $new_patron->clear_billing_address();
553     $new_patron->clear_mailing_address();
554     $new_patron->clear_addresses();
555     $new_patron->clear_card();
556     $new_patron->clear_cards();
557     $new_patron->clear_id();
558     $new_patron->clear_isnew();
559     $new_patron->clear_ischanged();
560     $new_patron->clear_isdeleted();
561     $new_patron->clear_stat_cat_entries();
562     $new_patron->clear_permissions();
563     $new_patron->clear_standing_penalties();
564
565     return $new_patron;
566 }
567
568
569 sub _add_patron {
570
571     my $e          = shift;
572     my $patron      = shift;
573
574     return (undef, $e->die_event) unless
575         $e->allowed('CREATE_USER', $patron->home_ou);
576
577     my $ex = $e->search_actor_user(
578         {usrname => $patron->usrname}, {idlist => 1});
579     return (undef, OpenILS::Event->new('USERNAME_EXISTS')) if @$ex;
580
581     $logger->info("Creating new user in the DB with username: ".$patron->usrname());
582
583     $e->create_actor_user($patron) or return $e->die_event;
584     my $id = $patron->id; # added by CStoreEditor
585
586     $logger->info("Successfully created new user [$id] in DB");
587     return ($e->retrieve_actor_user($id), undef);
588 }
589
590
591 sub check_group_perm {
592     my( $e, $requestor, $patron ) = @_;
593     my $evt;
594
595     # first let's see if the requestor has
596     # priveleges to update this user in any way
597     if( ! $patron->isnew ) {
598         my $p = $e->retrieve_actor_user($patron->id);
599
600         # If we are the requestor (trying to update our own account)
601         # and we are not trying to change our profile, we're good
602         if( $p->id == $requestor->id and
603                 $p->profile == $patron->profile ) {
604             return undef;
605         }
606
607
608         $evt = group_perm_failed($e, $requestor, $p);
609         return $evt if $evt;
610     }
611
612     # They are allowed to edit this patron.. can they put the
613     # patron into the group requested?
614     $evt = group_perm_failed($e, $requestor, $patron);
615     return $evt if $evt;
616     return undef;
617 }
618
619
620 sub group_perm_failed {
621     my( $e, $requestor, $patron ) = @_;
622
623     my $perm;
624     my $grp;
625     my $grpid = $patron->profile;
626
627     do {
628
629         $logger->debug("user update looking for group perm for group $grpid");
630         $grp = $e->retrieve_permission_grp_tree($grpid);
631
632     } while( !($perm = $grp->application_perm) and ($grpid = $grp->parent) );
633
634     $logger->info("user update checking perm $perm on user ".
635         $requestor->id." for update/create on user username=".$patron->usrname);
636
637     return $e->allowed($perm, $patron->home_ou) ? undef : $e->die_event;
638 }
639
640
641
642 sub _update_patron {
643     my( $e, $patron, $noperm) = @_;
644
645     $logger->info("Updating patron ".$patron->id." in DB");
646
647     my $evt;
648
649     if(!$noperm) {
650         return (undef, $e->die_event)
651             unless $e->allowed('UPDATE_USER', $patron->home_ou);
652     }
653
654     # update the password by itself to avoid the password protection magic
655     if( $patron->passwd ) {
656         modify_migrated_user_password($e, $patron->id, $patron->passwd);
657         $patron->clear_passwd;
658     }
659
660     if(!$patron->ident_type) {
661         $patron->clear_ident_type;
662         $patron->clear_ident_value;
663     }
664
665     $evt = verify_last_xact($e, $patron);
666     return (undef, $evt) if $evt;
667
668     $e->update_actor_user($patron) or return (undef, $e->die_event);
669
670     # re-fetch the user to pick up the latest last_xact_id value
671     # to avoid collisions.
672     $patron = $e->retrieve_actor_user($patron->id);
673
674     return ($patron);
675 }
676
677 sub verify_last_xact {
678     my( $e, $patron ) = @_;
679     return undef unless $patron->id and $patron->id > 0;
680     my $p = $e->retrieve_actor_user($patron->id);
681     my $xact = $p->last_xact_id;
682     return undef unless $xact;
683     $logger->info("user xact = $xact, saving with xact " . $patron->last_xact_id);
684     return OpenILS::Event->new('XACT_COLLISION')
685         if $xact ne $patron->last_xact_id;
686     return undef;
687 }
688
689
690 sub _check_dup_ident {
691     my( $session, $patron ) = @_;
692
693     return undef unless $patron->ident_value;
694
695     my $search = {
696         ident_type  => $patron->ident_type,
697         ident_value => $patron->ident_value,
698     };
699
700     $logger->debug("patron update searching for dup ident values: " .
701         $patron->ident_type . ':' . $patron->ident_value);
702
703     $search->{id} = {'!=' => $patron->id} if $patron->id and $patron->id > 0;
704
705     my $dups = $session->request(
706         'open-ils.storage.direct.actor.user.search_where.atomic', $search )->gather(1);
707
708
709     return OpenILS::Event->new('PATRON_DUP_IDENT1', payload => $patron )
710         if $dups and @$dups;
711
712     return undef;
713 }
714
715
716 sub _add_update_addresses {
717
718     my $e = shift;
719     my $patron = shift;
720     my $new_patron = shift;
721
722     my $evt;
723
724     my $current_id; # id of the address before creation
725
726     my $addresses = $patron->addresses();
727
728     for my $address (@$addresses) {
729
730         next unless ref $address;
731         $current_id = $address->id();
732
733         if( $patron->billing_address() and
734             $patron->billing_address() == $current_id ) {
735             $logger->info("setting billing addr to $current_id");
736             $new_patron->billing_address($address->id());
737             $new_patron->ischanged(1);
738         }
739
740         if( $patron->mailing_address() and
741             $patron->mailing_address() == $current_id ) {
742             $new_patron->mailing_address($address->id());
743             $logger->info("setting mailing addr to $current_id");
744             $new_patron->ischanged(1);
745         }
746
747
748         if($address->isnew()) {
749
750             $address->usr($new_patron->id());
751
752             ($address, $evt) = _add_address($e,$address);
753             return (undef, $evt) if $evt;
754
755             # we need to get the new id
756             if( $patron->billing_address() and
757                     $patron->billing_address() == $current_id ) {
758                 $new_patron->billing_address($address->id());
759                 $logger->info("setting billing addr to $current_id");
760                 $new_patron->ischanged(1);
761             }
762
763             if( $patron->mailing_address() and
764                     $patron->mailing_address() == $current_id ) {
765                 $new_patron->mailing_address($address->id());
766                 $logger->info("setting mailing addr to $current_id");
767                 $new_patron->ischanged(1);
768             }
769
770         } elsif($address->ischanged() ) {
771
772             ($address, $evt) = _update_address($e, $address);
773             return (undef, $evt) if $evt;
774
775         } elsif($address->isdeleted() ) {
776
777             if( $address->id() == $new_patron->mailing_address() ) {
778                 $new_patron->clear_mailing_address();
779                 ($new_patron, $evt) = _update_patron($e, $new_patron);
780                 return (undef, $evt) if $evt;
781             }
782
783             if( $address->id() == $new_patron->billing_address() ) {
784                 $new_patron->clear_billing_address();
785                 ($new_patron, $evt) = _update_patron($e, $new_patron);
786                 return (undef, $evt) if $evt;
787             }
788
789             $evt = _delete_address($e, $address);
790             return (undef, $evt) if $evt;
791         }
792     }
793
794     return ( $new_patron, undef );
795 }
796
797
798 # adds an address to the db and returns the address with new id
799 sub _add_address {
800     my($e, $address) = @_;
801     $address->clear_id();
802
803     $logger->info("Creating new address at street ".$address->street1);
804
805     # put the address into the database
806     $e->create_actor_user_address($address) or return (undef, $e->die_event);
807     return ($address, undef);
808 }
809
810
811 sub _update_address {
812     my( $e, $address ) = @_;
813
814     $logger->info("Updating address ".$address->id." in the DB");
815
816     $e->update_actor_user_address($address) or return (undef, $e->die_event);
817
818     return ($address, undef);
819 }
820
821
822
823 sub _add_update_cards {
824
825     my $e = shift;
826     my $patron = shift;
827     my $new_patron = shift;
828
829     my $evt;
830
831     my $virtual_id; #id of the card before creation
832
833     my $cards = $patron->cards();
834     for my $card (@$cards) {
835
836         $card->usr($new_patron->id());
837
838         if(ref($card) and $card->isnew()) {
839
840             $virtual_id = $card->id();
841             ( $card, $evt ) = _add_card($e, $card);
842             return (undef, $evt) if $evt;
843
844             #if(ref($patron->card)) { $patron->card($patron->card->id); }
845             if($patron->card() == $virtual_id) {
846                 $new_patron->card($card->id());
847                 $new_patron->ischanged(1);
848             }
849
850         } elsif( ref($card) and $card->ischanged() ) {
851             $evt = _update_card($e, $card);
852             return (undef, $evt) if $evt;
853         }
854     }
855
856     return ( $new_patron, undef );
857 }
858
859
860 # adds an card to the db and returns the card with new id
861 sub _add_card {
862     my( $e, $card ) = @_;
863     $card->clear_id();
864
865     $logger->info("Adding new patron card ".$card->barcode);
866
867     $e->create_actor_card($card) or return (undef, $e->die_event);
868
869     return ( $card, undef );
870 }
871
872
873 # returns event on error.  returns undef otherwise
874 sub _update_card {
875     my( $e, $card ) = @_;
876     $logger->info("Updating patron card ".$card->id);
877
878     $e->update_actor_card($card) or return $e->die_event;
879     return undef;
880 }
881
882
883
884
885 # returns event on error.  returns undef otherwise
886 sub _delete_address {
887     my( $e, $address ) = @_;
888
889     $logger->info("Deleting address ".$address->id." from DB");
890
891     $e->delete_actor_user_address($address) or return $e->die_event;
892     return undef;
893 }
894
895
896
897 sub _add_survey_responses {
898     my ($e, $patron, $new_patron) = @_;
899
900     $logger->info( "Updating survey responses for patron ".$new_patron->id );
901
902     my $responses = $patron->survey_responses;
903
904     if($responses) {
905
906         $_->usr($new_patron->id) for (@$responses);
907
908         my $evt = $U->simplereq( "open-ils.circ",
909             "open-ils.circ.survey.submit.user_id", $responses );
910
911         return (undef, $evt) if defined($U->event_code($evt));
912
913     }
914
915     return ( $new_patron, undef );
916 }
917
918 sub _clear_badcontact_penalties {
919     my ($e, $old_patron, $new_patron) = @_;
920
921     return ($new_patron, undef) unless $old_patron;
922
923     my $PNM = $OpenILS::Utils::BadContact::PENALTY_NAME_MAP;
924
925     # This ignores whether the caller of update_patron has any permission
926     # to remove penalties, but these penalties no longer make sense
927     # if an email address field (for example) is changed (and the caller must
928     # have perms to do *that*) so there's no reason not to clear the penalties.
929
930     my $bad_contact_penalties = $e->search_actor_user_standing_penalty([
931         {
932             "+csp" => {"name" => [values(%$PNM)]},
933             "+ausp" => {"stop_date" => undef, "usr" => $new_patron->id}
934         }, {
935             "join" => {"csp" => {}},
936             "flesh" => 1,
937             "flesh_fields" => {"ausp" => ["standing_penalty"]}
938         }
939     ]) or return (undef, $e->die_event);
940
941     return ($new_patron, undef) unless @$bad_contact_penalties;
942
943     my @penalties_to_clear;
944     my ($field, $penalty_name);
945
946     # For each field that might have an associated bad contact penalty,
947     # check for such penalties and add them to the to-clear list if that
948     # field has changed.
949     while (($field, $penalty_name) = each(%$PNM)) {
950         if ($old_patron->$field ne $new_patron->$field) {
951             push @penalties_to_clear, grep {
952                 $_->standing_penalty->name eq $penalty_name
953             } @$bad_contact_penalties;
954         }
955     }
956
957     foreach (@penalties_to_clear) {
958         # Note that this "archives" penalties, in the terminology of the staff
959         # client, instead of just deleting them.  This may assist reporting,
960         # or preserving old contact information when it is still potentially
961         # of interest.
962         $_->standing_penalty($_->standing_penalty->id); # deflesh
963         $_->stop_date('now');
964         $e->update_actor_user_standing_penalty($_) or return (undef, $e->die_event);
965     }
966
967     return ($new_patron, undef);
968 }
969
970
971 sub _create_stat_maps {
972
973     my($e, $patron, $new_patron) = @_;
974
975     my $maps = $patron->stat_cat_entries();
976
977     for my $map (@$maps) {
978
979         my $method = "update_actor_stat_cat_entry_user_map";
980
981         if ($map->isdeleted()) {
982             $method = "delete_actor_stat_cat_entry_user_map";
983
984         } elsif ($map->isnew()) {
985             $method = "create_actor_stat_cat_entry_user_map";
986             $map->clear_id;
987         }
988
989
990         $map->target_usr($new_patron->id);
991
992         $logger->info("Updating stat entry with method $method and map $map");
993
994         $e->$method($map) or return (undef, $e->die_event);
995     }
996
997     return ($new_patron, undef);
998 }
999
1000 sub _create_perm_maps {
1001
1002     my($e, $patron, $new_patron) = @_;
1003
1004     my $maps = $patron->permissions;
1005
1006     for my $map (@$maps) {
1007
1008         my $method = "update_permission_usr_perm_map";
1009         if ($map->isdeleted()) {
1010             $method = "delete_permission_usr_perm_map";
1011         } elsif ($map->isnew()) {
1012             $method = "create_permission_usr_perm_map";
1013             $map->clear_id;
1014         }
1015
1016         $map->usr($new_patron->id);
1017
1018         $logger->info( "Updating permissions with method $method and map $map" );
1019
1020         $e->$method($map) or return (undef, $e->die_event);
1021     }
1022
1023     return ($new_patron, undef);
1024 }
1025
1026
1027 __PACKAGE__->register_method(
1028     method   => "set_user_work_ous",
1029     api_name => "open-ils.actor.user.work_ous.update",
1030 );
1031
1032 sub set_user_work_ous {
1033     my $self   = shift;
1034     my $client = shift;
1035     my $ses    = shift;
1036     my $maps   = shift;
1037
1038     my( $requestor, $evt ) = $apputils->checksesperm( $ses, 'ASSIGN_WORK_ORG_UNIT' );
1039     return $evt if $evt;
1040
1041     my $session = $apputils->start_db_session();
1042     $apputils->set_audit_info($session, $ses, $requestor->id, $requestor->wsid);
1043
1044     for my $map (@$maps) {
1045
1046         my $method = "open-ils.storage.direct.permission.usr_work_ou_map.update";
1047         if ($map->isdeleted()) {
1048             $method = "open-ils.storage.direct.permission.usr_work_ou_map.delete";
1049         } elsif ($map->isnew()) {
1050             $method = "open-ils.storage.direct.permission.usr_work_ou_map.create";
1051             $map->clear_id;
1052         }
1053
1054         #warn( "Updating permissions with method $method and session $ses and map $map" );
1055         $logger->info( "Updating work_ou map with method $method and map $map" );
1056
1057         my $stat = $session->request($method, $map)->gather(1);
1058         $logger->warn( "update failed: ".$U->DB_UPDATE_FAILED($map) ) unless defined($stat);
1059
1060     }
1061
1062     $apputils->commit_db_session($session);
1063
1064     return scalar(@$maps);
1065 }
1066
1067
1068 __PACKAGE__->register_method(
1069     method   => "set_user_perms",
1070     api_name => "open-ils.actor.user.permissions.update",
1071 );
1072
1073 sub set_user_perms {
1074     my $self = shift;
1075     my $client = shift;
1076     my $ses = shift;
1077     my $maps = shift;
1078
1079     my $session = $apputils->start_db_session();
1080
1081     my( $user_obj, $evt ) = $U->checkses($ses);
1082     return $evt if $evt;
1083     $apputils->set_audit_info($session, $ses, $user_obj->id, $user_obj->wsid);
1084
1085     my $perms = $session->request('open-ils.storage.permission.user_perms.atomic', $user_obj->id)->gather(1);
1086
1087     my $all = undef;
1088     $all = 1 if ($U->is_true($user_obj->super_user()));
1089     $all = 1 unless ($U->check_perms($user_obj->id, $user_obj->home_ou, 'EVERYTHING'));
1090
1091     for my $map (@$maps) {
1092
1093         my $method = "open-ils.storage.direct.permission.usr_perm_map.update";
1094         if ($map->isdeleted()) {
1095             $method = "open-ils.storage.direct.permission.usr_perm_map.delete";
1096         } elsif ($map->isnew()) {
1097             $method = "open-ils.storage.direct.permission.usr_perm_map.create";
1098             $map->clear_id;
1099         }
1100
1101         next if (!$all and !grep { $_->perm eq $map->perm and $U->is_true($_->grantable) and $_->depth <= $map->depth } @$perms);
1102         #warn( "Updating permissions with method $method and session $ses and map $map" );
1103         $logger->info( "Updating permissions with method $method and map $map" );
1104
1105         my $stat = $session->request($method, $map)->gather(1);
1106         $logger->warn( "update failed: ".$U->DB_UPDATE_FAILED($map) ) unless defined($stat);
1107
1108     }
1109
1110     $apputils->commit_db_session($session);
1111
1112     return scalar(@$maps);
1113 }
1114
1115
1116 __PACKAGE__->register_method(
1117     method  => "user_retrieve_by_barcode",
1118     authoritative => 1,
1119     api_name    => "open-ils.actor.user.fleshed.retrieve_by_barcode",);
1120
1121 sub user_retrieve_by_barcode {
1122     my($self, $client, $auth, $barcode, $flesh_home_ou) = @_;
1123
1124     my $e = new_editor(authtoken => $auth);
1125     return $e->event unless $e->checkauth;
1126
1127     my $card = $e->search_actor_card({barcode => $barcode})->[0]
1128         or return $e->event;
1129
1130     my $user = flesh_user($card->usr, $e, $flesh_home_ou);
1131     return $e->event unless $e->allowed(
1132         "VIEW_USER", $flesh_home_ou ? $user->home_ou->id : $user->home_ou
1133     );
1134     return $user;
1135 }
1136
1137
1138
1139 __PACKAGE__->register_method(
1140     method        => "get_user_by_id",
1141     authoritative => 1,
1142     api_name      => "open-ils.actor.user.retrieve",
1143 );
1144
1145 sub get_user_by_id {
1146     my ($self, $client, $auth, $id) = @_;
1147     my $e = new_editor(authtoken=>$auth);
1148     return $e->event unless $e->checkauth;
1149     my $user = $e->retrieve_actor_user($id) or return $e->event;
1150     return $e->event unless $e->allowed('VIEW_USER', $user->home_ou);
1151     return $user;
1152 }
1153
1154
1155 __PACKAGE__->register_method(
1156     method   => "get_org_types",
1157     api_name => "open-ils.actor.org_types.retrieve",
1158 );
1159 sub get_org_types {
1160     return $U->get_org_types();
1161 }
1162
1163
1164 __PACKAGE__->register_method(
1165     method   => "get_user_ident_types",
1166     api_name => "open-ils.actor.user.ident_types.retrieve",
1167 );
1168 my $ident_types;
1169 sub get_user_ident_types {
1170     return $ident_types if $ident_types;
1171     return $ident_types =
1172         new_editor()->retrieve_all_config_identification_type();
1173 }
1174
1175
1176 __PACKAGE__->register_method(
1177     method   => "get_org_unit",
1178     api_name => "open-ils.actor.org_unit.retrieve",
1179 );
1180
1181 sub get_org_unit {
1182     my( $self, $client, $user_session, $org_id ) = @_;
1183     my $e = new_editor(authtoken => $user_session);
1184     if(!$org_id) {
1185         return $e->event unless $e->checkauth;
1186         $org_id = $e->requestor->ws_ou;
1187     }
1188     my $o = $e->retrieve_actor_org_unit($org_id)
1189         or return $e->event;
1190     return $o;
1191 }
1192
1193 __PACKAGE__->register_method(
1194     method   => "search_org_unit",
1195     api_name => "open-ils.actor.org_unit_list.search",
1196 );
1197
1198 sub search_org_unit {
1199
1200     my( $self, $client, $field, $value ) = @_;
1201
1202     my $list = OpenILS::Application::AppUtils->simple_scalar_request(
1203         "open-ils.cstore",
1204         "open-ils.cstore.direct.actor.org_unit.search.atomic",
1205         { $field => $value } );
1206
1207     return $list;
1208 }
1209
1210
1211 # build the org tree
1212
1213 __PACKAGE__->register_method(
1214     method  => "get_org_tree",
1215     api_name    => "open-ils.actor.org_tree.retrieve",
1216     argc        => 0,
1217     note        => "Returns the entire org tree structure",
1218 );
1219
1220 sub get_org_tree {
1221     my $self = shift;
1222     my $client = shift;
1223     return $U->get_org_tree($client->session->session_locale);
1224 }
1225
1226
1227 __PACKAGE__->register_method(
1228     method  => "get_org_descendants",
1229     api_name    => "open-ils.actor.org_tree.descendants.retrieve"
1230 );
1231
1232 # depth is optional.  org_unit is the id
1233 sub get_org_descendants {
1234     my( $self, $client, $org_unit, $depth ) = @_;
1235
1236     if(ref $org_unit eq 'ARRAY') {
1237         $depth ||= [];
1238         my @trees;
1239         for my $i (0..scalar(@$org_unit)-1) {
1240             my $list = $U->simple_scalar_request(
1241                 "open-ils.storage",
1242                 "open-ils.storage.actor.org_unit.descendants.atomic",
1243                 $org_unit->[$i], $depth->[$i] );
1244             push(@trees, $U->build_org_tree($list));
1245         }
1246         return \@trees;
1247
1248     } else {
1249         my $orglist = $apputils->simple_scalar_request(
1250                 "open-ils.storage",
1251                 "open-ils.storage.actor.org_unit.descendants.atomic",
1252                 $org_unit, $depth );
1253         return $U->build_org_tree($orglist);
1254     }
1255 }
1256
1257
1258 __PACKAGE__->register_method(
1259     method  => "get_org_ancestors",
1260     api_name    => "open-ils.actor.org_tree.ancestors.retrieve"
1261 );
1262
1263 # depth is optional.  org_unit is the id
1264 sub get_org_ancestors {
1265     my( $self, $client, $org_unit, $depth ) = @_;
1266     my $orglist = $apputils->simple_scalar_request(
1267             "open-ils.storage",
1268             "open-ils.storage.actor.org_unit.ancestors.atomic",
1269             $org_unit, $depth );
1270     return $U->build_org_tree($orglist);
1271 }
1272
1273
1274 __PACKAGE__->register_method(
1275     method  => "get_standings",
1276     api_name    => "open-ils.actor.standings.retrieve"
1277 );
1278
1279 my $user_standings;
1280 sub get_standings {
1281     return $user_standings if $user_standings;
1282     return $user_standings =
1283         $apputils->simple_scalar_request(
1284             "open-ils.cstore",
1285             "open-ils.cstore.direct.config.standing.search.atomic",
1286             { id => { "!=" => undef } }
1287         );
1288 }
1289
1290
1291 __PACKAGE__->register_method(
1292     method   => "get_my_org_path",
1293     api_name => "open-ils.actor.org_unit.full_path.retrieve"
1294 );
1295
1296 sub get_my_org_path {
1297     my( $self, $client, $auth, $org_id ) = @_;
1298     my $e = new_editor(authtoken=>$auth);
1299     return $e->event unless $e->checkauth;
1300     $org_id = $e->requestor->ws_ou unless defined $org_id;
1301
1302     return $apputils->simple_scalar_request(
1303         "open-ils.storage",
1304         "open-ils.storage.actor.org_unit.full_path.atomic",
1305         $org_id );
1306 }
1307
1308
1309 __PACKAGE__->register_method(
1310     method   => "patron_adv_search",
1311     api_name => "open-ils.actor.patron.search.advanced"
1312 );
1313
1314 __PACKAGE__->register_method(
1315     method   => "patron_adv_search",
1316     api_name => "open-ils.actor.patron.search.advanced.fleshed",
1317     stream => 1,
1318     # TODO: change when opensrf 'bundling' is merged.
1319     # set a relatively small bundle size so the caller can start
1320     # seeing results fairly quickly
1321     max_chunk_size => 4096, # bundling
1322
1323     # api_level => 2,
1324     # pending opensrf work -- also, not sure if needed since we're not
1325     # actaully creating an alternate vesrion, only offering to return a
1326     # different format.
1327     #
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         "addresses",
3006         "billing_address",
3007         "mailing_address",
3008         "stat_cat_entries",
3009         "usr_activity" ];
3010     return new_flesh_user($user_id, $fields, $e);
3011 }
3012
3013
3014 sub new_flesh_user {
3015
3016     my $id = shift;
3017     my $fields = shift || [];
3018     my $e = shift;
3019
3020     my $fetch_penalties = 0;
3021     if(grep {$_ eq 'standing_penalties'} @$fields) {
3022         $fields = [grep {$_ ne 'standing_penalties'} @$fields];
3023         $fetch_penalties = 1;
3024     }
3025
3026     my $fetch_usr_act = 0;
3027     if(grep {$_ eq 'usr_activity'} @$fields) {
3028         $fields = [grep {$_ ne 'usr_activity'} @$fields];
3029         $fetch_usr_act = 1;
3030     }
3031
3032     my $user = $e->retrieve_actor_user(
3033     [
3034         $id,
3035         {
3036             "flesh"             => 1,
3037             "flesh_fields" =>  { "au" => $fields }
3038         }
3039     ]
3040     ) or return $e->die_event;
3041
3042
3043     if( grep { $_ eq 'addresses' } @$fields ) {
3044
3045         $user->addresses([]) unless @{$user->addresses};
3046         # don't expose "replaced" addresses by default
3047         $user->addresses([grep {$_->id >= 0} @{$user->addresses}]);
3048
3049         if( ref $user->billing_address ) {
3050             unless( grep { $user->billing_address->id == $_->id } @{$user->addresses} ) {
3051                 push( @{$user->addresses}, $user->billing_address );
3052             }
3053         }
3054
3055         if( ref $user->mailing_address ) {
3056             unless( grep { $user->mailing_address->id == $_->id } @{$user->addresses} ) {
3057                 push( @{$user->addresses}, $user->mailing_address );
3058             }
3059         }
3060     }
3061
3062     if($fetch_penalties) {
3063         # grab the user penalties ranged for this location
3064         $user->standing_penalties(
3065             $e->search_actor_user_standing_penalty([
3066                 {   usr => $id,
3067                     '-or' => [
3068                         {stop_date => undef},
3069                         {stop_date => {'>' => 'now'}}
3070                     ],
3071                     org_unit => $U->get_org_full_path($e->requestor->ws_ou)
3072                 },
3073                 {   flesh => 1,
3074                     flesh_fields => {ausp => ['standing_penalty']}
3075                 }
3076             ])
3077         );
3078     }
3079
3080     # retrieve the most recent usr_activity entry
3081     if ($fetch_usr_act) {
3082
3083         # max number to return for simple patron fleshing
3084         my $limit = $U->ou_ancestor_setting_value(
3085             $e->requestor->ws_ou,
3086             'circ.patron.usr_activity_retrieve.max');
3087
3088         my $opts = {
3089             flesh => 1,
3090             flesh_fields => {auact => ['etype']},
3091             order_by => {auact => 'event_time DESC'},
3092         };
3093
3094         # 0 == none, <0 == return all
3095         $limit = 1 unless defined $limit;
3096         $opts->{limit} = $limit if $limit > 0;
3097
3098         $user->usr_activity(
3099             ($limit == 0) ?
3100                 [] : # skip the DB call
3101                 $e->search_actor_usr_activity([{usr => $user->id}, $opts])
3102         );
3103     }
3104
3105     $e->rollback;
3106     $user->clear_passwd();
3107     return $user;
3108 }
3109
3110
3111
3112
3113 __PACKAGE__->register_method(
3114     method   => "user_retrieve_parts",
3115     api_name => "open-ils.actor.user.retrieve.parts",
3116 );
3117
3118 sub user_retrieve_parts {
3119     my( $self, $client, $auth, $user_id, $fields ) = @_;
3120     my $e = new_editor(authtoken => $auth);
3121     return $e->event unless $e->checkauth;
3122     $user_id ||= $e->requestor->id;
3123     if( $e->requestor->id != $user_id ) {
3124         return $e->event unless $e->allowed('VIEW_USER');
3125     }
3126     my @resp;
3127     my $user = $e->retrieve_actor_user($user_id) or return $e->event;
3128     push(@resp, $user->$_()) for(@$fields);
3129     return \@resp;
3130 }
3131
3132
3133
3134 __PACKAGE__->register_method(
3135     method    => 'user_opt_in_enabled',
3136     api_name  => 'open-ils.actor.user.org_unit_opt_in.enabled',
3137     signature => '@return 1 if user opt-in is globally enabled, 0 otherwise.'
3138 );
3139
3140 sub user_opt_in_enabled {
3141     my($self, $conn) = @_;
3142     my $sc = OpenSRF::Utils::SettingsClient->new;
3143     return 1 if lc($sc->config_value(share => user => 'opt_in')) eq 'true';
3144     return 0;
3145 }
3146
3147
3148 __PACKAGE__->register_method(
3149     method    => 'user_opt_in_at_org',
3150     api_name  => 'open-ils.actor.user.org_unit_opt_in.check',
3151     signature => q/
3152         @param $auth The auth token
3153         @param user_id The ID of the user to test
3154         @return 1 if the user has opted in at the specified org,
3155             2 if opt-in is disallowed for the user's home org,
3156             event on error, and 0 otherwise. /
3157 );
3158 sub user_opt_in_at_org {
3159     my($self, $conn, $auth, $user_id) = @_;
3160
3161     # see if we even need to enforce the opt-in value
3162     return 1 unless user_opt_in_enabled($self);
3163
3164     my $e = new_editor(authtoken => $auth);
3165     return $e->event unless $e->checkauth;
3166
3167     my $user = $e->retrieve_actor_user($user_id) or return $e->event;
3168     return $e->event unless $e->allowed('VIEW_USER', $user->home_ou);
3169
3170     my $ws_org = $e->requestor->ws_ou;
3171     # user is automatically opted-in if they are from the local org
3172     return 1 if $user->home_ou eq $ws_org;
3173
3174     # get the boundary setting
3175     my $opt_boundary = $U->ou_ancestor_setting_value($e->requestor->ws_ou,'org.patron_opt_boundary');
3176
3177     # auto opt in if user falls within the opt boundary
3178     my $opt_orgs = $U->get_org_descendants($ws_org, $opt_boundary);
3179
3180     return 1 if grep $_ eq $user->home_ou, @$opt_orgs;
3181
3182     # check whether opt-in is restricted at the user's home library
3183     my $opt_restrict_depth = $U->ou_ancestor_setting_value($user->home_ou, 'org.restrict_opt_to_depth');
3184     if ($opt_restrict_depth) {
3185         my $restrict_ancestor = $U->org_unit_ancestor_at_depth($user->home_ou, $opt_restrict_depth);
3186         my $unrestricted_orgs = $U->get_org_descendants($restrict_ancestor);
3187
3188         # opt-in is disallowed unless the workstation org is within the home
3189         # library's opt-in scope
3190         return 2 unless grep $_ eq $e->requestor->ws_ou, @$unrestricted_orgs;
3191     }
3192
3193     my $vals = $e->search_actor_usr_org_unit_opt_in(
3194         {org_unit=>$opt_orgs, usr=>$user_id},{idlist=>1});
3195
3196     return 1 if @$vals;
3197     return 0;
3198 }
3199
3200 __PACKAGE__->register_method(
3201     method    => 'create_user_opt_in_at_org',
3202     api_name  => 'open-ils.actor.user.org_unit_opt_in.create',
3203     signature => q/
3204         @param $auth The auth token
3205         @param user_id The ID of the user to test
3206         @return The ID of the newly created object, event on error./
3207 );
3208
3209 sub create_user_opt_in_at_org {
3210     my($self, $conn, $auth, $user_id, $org_id) = @_;
3211
3212     my $e = new_editor(authtoken => $auth, xact=>1);
3213     return $e->die_event unless $e->checkauth;
3214
3215     # if a specific org unit wasn't passed in, get one based on the defaults;
3216     if(!$org_id){
3217         my $wsou = $e->requestor->ws_ou;
3218         # get the default opt depth
3219         my $opt_depth = $U->ou_ancestor_setting_value($wsou,'org.patron_opt_default');
3220         # get the org unit at that depth
3221         my $org = $e->json_query({
3222             from => [ 'actor.org_unit_ancestor_at_depth', $wsou, $opt_depth ]})->[0];
3223         $org_id = $org->{id};
3224     }
3225     if (!$org_id) {
3226         # fall back to the workstation OU, the pre-opt-in-boundary way
3227         $org_id = $e->requestor->ws_ou;
3228     }
3229
3230     my $user = $e->retrieve_actor_user($user_id) or return $e->die_event;
3231     return $e->die_event unless $e->allowed('UPDATE_USER', $user->home_ou);
3232
3233     my $opt_in = Fieldmapper::actor::usr_org_unit_opt_in->new;
3234
3235     $opt_in->org_unit($org_id);
3236     $opt_in->usr($user_id);
3237     $opt_in->staff($e->requestor->id);
3238     $opt_in->opt_in_ts('now');
3239     $opt_in->opt_in_ws($e->requestor->wsid);
3240
3241     $opt_in = $e->create_actor_usr_org_unit_opt_in($opt_in)
3242         or return $e->die_event;
3243
3244     $e->commit;
3245
3246     return $opt_in->id;
3247 }
3248
3249
3250 __PACKAGE__->register_method (
3251     method      => 'retrieve_org_hours',
3252     api_name    => 'open-ils.actor.org_unit.hours_of_operation.retrieve',
3253     signature   => q/
3254         Returns the hours of operation for a specified org unit
3255         @param authtoken The login session key
3256         @param org_id The org_unit ID
3257     /
3258 );
3259
3260 sub retrieve_org_hours {
3261     my($self, $conn, $auth, $org_id) = @_;
3262     my $e = new_editor(authtoken => $auth);
3263     return $e->die_event unless $e->checkauth;
3264     $org_id ||= $e->requestor->ws_ou;
3265     return $e->retrieve_actor_org_unit_hours_of_operation($org_id);
3266 }
3267
3268
3269 __PACKAGE__->register_method (
3270     method      => 'verify_user_password',
3271     api_name    => 'open-ils.actor.verify_user_password',
3272     signature   => q/
3273         Given a barcode or username and the MD5 encoded password,
3274         returns 1 if the password is correct.  Returns 0 otherwise.
3275     /
3276 );
3277
3278 sub verify_user_password {
3279     my($self, $conn, $auth, $barcode, $username, $password) = @_;
3280     my $e = new_editor(authtoken => $auth);
3281     return $e->die_event unless $e->checkauth;
3282     my $user;
3283     my $user_by_barcode;
3284     my $user_by_username;
3285     if($barcode) {
3286         my $card = $e->search_actor_card([
3287             {barcode => $barcode},
3288             {flesh => 1, flesh_fields => {ac => ['usr']}}])->[0] or return 0;
3289         $user_by_barcode = $card->usr;
3290         $user = $user_by_barcode;
3291     }
3292     if ($username) {
3293         $user_by_username = $e->search_actor_user({usrname => $username})->[0] or return 0;
3294         $user = $user_by_username;
3295     }
3296     return 0 if (!$user || $U->is_true($user->deleted));
3297     return 0 if ($user_by_username && $user_by_barcode && $user_by_username->id != $user_by_barcode->id);
3298     return $e->event unless $e->allowed('VIEW_USER', $user->home_ou);
3299     return $U->verify_migrated_user_password($e, $user->id, $password, 1);
3300 }
3301
3302 __PACKAGE__->register_method (
3303     method      => 'retrieve_usr_id_via_barcode_or_usrname',
3304     api_name    => "open-ils.actor.user.retrieve_id_by_barcode_or_username",
3305     signature   => q/
3306         Given a barcode or username returns the id for the user or
3307         a failure event.
3308     /
3309 );
3310
3311 sub retrieve_usr_id_via_barcode_or_usrname {
3312     my($self, $conn, $auth, $barcode, $username) = @_;
3313     my $e = new_editor(authtoken => $auth);
3314     return $e->die_event unless $e->checkauth;
3315     my $id_as_barcode= OpenSRF::Utils::SettingsClient->new->config_value(apps => 'open-ils.actor' => app_settings => 'id_as_barcode');
3316     my $user;
3317     my $user_by_barcode;
3318     my $user_by_username;
3319     $logger->info("$id_as_barcode is the ID as BARCODE");
3320     if($barcode) {
3321         my $card = $e->search_actor_card([
3322             {barcode => $barcode},
3323             {flesh => 1, flesh_fields => {ac => ['usr']}}])->[0];