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