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