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