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