7580733de82f80893620fc14679acfae9f198087
[working/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         => q/
1933         Returns hold ready vs. total counts.
1934         If a context org unit is provided, a third value 
1935         is returned with key 'behind_desk', which reports
1936         how many holds are ready at the pickup library 
1937         with the behind_desk flag set to true.
1938     /
1939 );
1940     
1941 sub hold_request_count {
1942     my( $self, $client, $authtoken, $user_id, $ctx_org ) = @_;
1943     my $e = new_editor(authtoken => $authtoken);
1944     return $e->event unless $e->checkauth;
1945
1946     $user_id = $e->requestor->id unless defined $user_id;
1947
1948     if($e->requestor->id ne $user_id) {
1949         my $user = $e->retrieve_actor_user($user_id);
1950         return $e->event unless $e->allowed('VIEW_HOLD', $user->home_ou);
1951     }
1952
1953     my $holds = $e->json_query({
1954         select => {ahr => ['pickup_lib', 'current_shelf_lib', 'behind_desk']},
1955         from => 'ahr',
1956         where => {
1957             usr => $user_id,
1958             fulfillment_time => {"=" => undef },
1959             cancel_time => undef,
1960         }
1961     });
1962
1963     my @ready = grep { 
1964         $_->{current_shelf_lib} and # avoid undef warnings
1965         $_->{pickup_lib} eq $_->{current_shelf_lib} 
1966     } @$holds;
1967
1968         my $resp = { 
1969         total => scalar(@$holds), 
1970         ready => scalar(@ready)
1971     };
1972
1973     if ($ctx_org) {
1974         # count of holds ready at pickup lib with behind_desk true.
1975         $resp->{behind_desk} = scalar(
1976             grep {
1977                 $_->{pickup_lib} == $ctx_org and
1978                 $U->is_true($_->{behind_desk})
1979             } @ready
1980         );
1981     }
1982
1983     return $resp;
1984 }
1985
1986 __PACKAGE__->register_method(
1987     method        => "checked_out",
1988     api_name      => "open-ils.actor.user.checked_out",
1989     authoritative => 1,
1990     argc          => 2,
1991     signature     => {
1992         desc => "For a given user, returns a structure of circulations objects sorted by out, overdue, lost, claims_returned, long_overdue. "
1993               . "A list of IDs are returned of each type.  Circs marked lost, long_overdue, and claims_returned will not be 'finished' "
1994               . "(i.e., outstanding balance or some other pending action on the circ). "
1995               . "The .count method also includes a 'total' field which sums all open circs.",
1996         params => [
1997             { desc => 'Authentication Token', type => 'string'},
1998             { desc => 'User ID',              type => 'string'},
1999         ],
2000         return => {
2001             desc => 'Returns event on error, or an object with ID lists, like: '
2002                   . '{"out":[12552,451232], "claims_returned":[], "long_overdue":[23421] "overdue":[], "lost":[]}'
2003         },
2004     }
2005 );
2006
2007 __PACKAGE__->register_method(
2008     method        => "checked_out",
2009     api_name      => "open-ils.actor.user.checked_out.count",
2010     authoritative => 1,
2011     argc          => 2,
2012     signature     => q/@see open-ils.actor.user.checked_out/
2013 );
2014
2015 sub checked_out {
2016     my( $self, $conn, $auth, $userid ) = @_;
2017
2018     my $e = new_editor(authtoken=>$auth);
2019     return $e->event unless $e->checkauth;
2020
2021     if( $userid ne $e->requestor->id ) {
2022         my $user = $e->retrieve_actor_user($userid) or return $e->event;
2023         unless($e->allowed('VIEW_CIRCULATIONS', $user->home_ou)) {
2024
2025             # see if there is a friend link allowing circ.view perms
2026             my $allowed = OpenILS::Application::Actor::Friends->friend_perm_allowed(
2027                 $e, $userid, $e->requestor->id, 'circ.view');
2028             return $e->event unless $allowed;
2029         }
2030     }
2031
2032     my $count = $self->api_name =~ /count/;
2033     return _checked_out( $count, $e, $userid );
2034 }
2035
2036 sub _checked_out {
2037     my( $iscount, $e, $userid ) = @_;
2038
2039     my %result = (
2040         out => [],
2041         overdue => [],
2042         lost => [],
2043         claims_returned => [],
2044         long_overdue => []
2045     );
2046     my $meth = 'retrieve_action_open_circ_';
2047
2048     if ($iscount) {
2049         $meth .= 'count';
2050         %result = (
2051             out => 0,
2052             overdue => 0,
2053             lost => 0,
2054             claims_returned => 0,
2055             long_overdue => 0
2056         );
2057     } else {
2058         $meth .= 'list';
2059     }
2060
2061     my $data = $e->$meth($userid);
2062
2063     if ($data) {
2064         if ($iscount) {
2065             $result{$_} += $data->$_() for (keys %result);
2066             $result{total} += $data->$_() for (keys %result);
2067         } else {
2068             for my $k (keys %result) {
2069                 $result{$k} = [ grep { $_ > 0 } split( ',', $data->$k()) ];
2070             }
2071         }
2072     }
2073
2074     return \%result;
2075 }
2076
2077
2078
2079 __PACKAGE__->register_method(
2080     method        => "checked_in_with_fines",
2081     api_name      => "open-ils.actor.user.checked_in_with_fines",
2082     authoritative => 1,
2083     argc          => 2,
2084     signature     => q/@see open-ils.actor.user.checked_out/
2085 );
2086
2087 sub checked_in_with_fines {
2088     my( $self, $conn, $auth, $userid ) = @_;
2089
2090     my $e = new_editor(authtoken=>$auth);
2091     return $e->event unless $e->checkauth;
2092
2093     if( $userid ne $e->requestor->id ) {
2094         return $e->event unless $e->allowed('VIEW_CIRCULATIONS');
2095     }
2096
2097     # money is owed on these items and they are checked in
2098     my $open = $e->search_action_circulation(
2099         {
2100             usr             => $userid, 
2101             xact_finish     => undef,
2102             checkin_time    => { "!=" => undef },
2103         }
2104     );
2105
2106
2107     my( @lost, @cr, @lo );
2108     for my $c (@$open) {
2109         push( @lost, $c->id ) if ($c->stop_fines eq 'LOST');
2110         push( @cr, $c->id ) if $c->stop_fines eq 'CLAIMSRETURNED';
2111         push( @lo, $c->id ) if $c->stop_fines eq 'LONGOVERDUE';
2112     }
2113
2114     return {
2115         lost        => \@lost,
2116         claims_returned => \@cr,
2117         long_overdue        => \@lo
2118     };
2119 }
2120
2121
2122 sub _sigmaker {
2123     my ($api, $desc, $auth) = @_;
2124     $desc = $desc ? (" " . $desc) : '';
2125     my $ids = ($api =~ /ids$/) ? 1 : 0;
2126     my @sig = (
2127         argc      => 1,
2128         method    => "user_transaction_history",
2129         api_name  => "open-ils.actor.user.transactions.$api",
2130         signature => {
2131             desc   => "For a given User ID, returns a list of billable transaction" .
2132                       ($ids ? " id" : '') .
2133                       "s$desc, optionally filtered by type and/or fields in money.billable_xact_summary.  " .
2134                       "The VIEW_USER_TRANSACTIONS permission is required to view another user's transactions",
2135             params => [
2136                 {desc => 'Authentication token',        type => 'string'},
2137                 {desc => 'User ID',                     type => 'number'},
2138                 {desc => 'Transaction type (optional)', type => 'number'},
2139                 {desc => 'Hash of Billable Transaction Summary filters (optional)', type => 'object'}
2140             ],
2141             return => {
2142                 desc => 'List of transaction' . ($ids ? " id" : '') . 's, Event on error'
2143             },
2144         }
2145     );
2146     $auth and push @sig, (authoritative => 1);
2147     return @sig;
2148 }
2149
2150 my %auth_hist_methods = (
2151     'history'             => '',
2152     'history.have_charge' => 'that have an initial charge',
2153     'history.still_open'  => 'that are not finished',
2154     'history.have_balance'         => 'that have a balance',
2155     'history.have_bill'            => 'that have billings',
2156     'history.have_bill_or_payment' => 'that have non-zero-sum billings or at least 1 payment',
2157     'history.have_payment' => 'that have at least 1 payment',
2158 );
2159
2160 foreach (keys %auth_hist_methods) {
2161     __PACKAGE__->register_method(_sigmaker($_,       $auth_hist_methods{$_}, 1));
2162     __PACKAGE__->register_method(_sigmaker("$_.ids", $auth_hist_methods{$_}, 1));
2163     __PACKAGE__->register_method(_sigmaker("$_.fleshed", $auth_hist_methods{$_}, 1));
2164 }
2165
2166 sub user_transaction_history {
2167     my( $self, $conn, $auth, $userid, $type, $filter, $options ) = @_;
2168     $filter ||= {};
2169     $options ||= {};
2170
2171     my $e = new_editor(authtoken=>$auth);
2172     return $e->die_event unless $e->checkauth;
2173
2174     if ($e->requestor->id ne $userid) {
2175         return $e->die_event unless $e->allowed('VIEW_USER_TRANSACTIONS');
2176     }
2177
2178     my $api = $self->api_name;
2179     my @xact_finish  = (xact_finish => undef ) if ($api =~ /history\.still_open$/);     # What about history.still_open.ids?
2180
2181     if(defined($type)) {
2182         $filter->{'xact_type'} = $type;
2183     }
2184
2185     if($api =~ /have_bill_or_payment/o) {
2186
2187         # transactions that have a non-zero sum across all billings or at least 1 payment
2188         $filter->{'-or'} = {
2189             'balance_owed' => { '<>' => 0 },
2190             'last_payment_ts' => { '<>' => undef }
2191         };
2192
2193     } elsif($api =~ /have_payment/) {
2194
2195         $filter->{last_payment_ts} ||= {'<>' => undef};
2196
2197     } elsif( $api =~ /have_balance/o) {
2198
2199         # transactions that have a non-zero overall balance
2200         $filter->{'balance_owed'} = { '<>' => 0 };
2201
2202     } elsif( $api =~ /have_charge/o) {
2203
2204         # transactions that have at least 1 billing, regardless of whether it was voided
2205         $filter->{'last_billing_ts'} = { '<>' => undef };
2206
2207     } elsif( $api =~ /have_bill/o) {    # needs to be an elsif, or we double-match have_bill_or_payment!
2208
2209         # transactions that have non-zero sum across all billings.  This will exclude
2210         # xacts where all billings have been voided
2211         $filter->{'total_owed'} = { '<>' => 0 };
2212     }
2213
2214     my $options_clause = { order_by => { mbt => 'xact_start DESC' } };
2215     $options_clause->{'limit'} = $options->{'limit'} if $options->{'limit'}; 
2216     $options_clause->{'offset'} = $options->{'offset'} if $options->{'offset'}; 
2217
2218     my $mbts = $e->search_money_billable_transaction_summary(
2219         [   { usr => $userid, @xact_finish, %$filter },
2220             $options_clause
2221         ]
2222     );
2223
2224     return [map {$_->id} @$mbts] if $api =~ /\.ids/;
2225     return $mbts unless $api =~ /fleshed/;
2226
2227     my @resp;
2228     for my $t (@$mbts) {
2229             
2230         if( $t->xact_type ne 'circulation' ) {
2231             push @resp, {transaction => $t};
2232             next;
2233         }
2234
2235         my $circ_data = flesh_circ($e, $t->id);
2236         push @resp, {transaction => $t, %$circ_data};
2237     }
2238
2239     return \@resp; 
2240 }
2241
2242
2243
2244 __PACKAGE__->register_method(
2245     method   => "user_perms",
2246     api_name => "open-ils.actor.permissions.user_perms.retrieve",
2247     argc     => 1,
2248     notes    => "Returns a list of permissions"
2249 );
2250     
2251 sub user_perms {
2252     my( $self, $client, $authtoken, $user ) = @_;
2253
2254     my( $staff, $evt ) = $apputils->checkses($authtoken);
2255     return $evt if $evt;
2256
2257     $user ||= $staff->id;
2258
2259     if( $user != $staff->id and $evt = $apputils->check_perms( $staff->id, $staff->home_ou, 'VIEW_PERMISSION') ) {
2260         return $evt;
2261     }
2262
2263     return $apputils->simple_scalar_request(
2264         "open-ils.storage",
2265         "open-ils.storage.permission.user_perms.atomic",
2266         $user);
2267 }
2268
2269 __PACKAGE__->register_method(
2270     method   => "retrieve_perms",
2271     api_name => "open-ils.actor.permissions.retrieve",
2272     notes    => "Returns a list of permissions"
2273 );
2274 sub retrieve_perms {
2275     my( $self, $client ) = @_;
2276     return $apputils->simple_scalar_request(
2277         "open-ils.cstore",
2278         "open-ils.cstore.direct.permission.perm_list.search.atomic",
2279         { id => { '!=' => undef } }
2280     );
2281 }
2282
2283 __PACKAGE__->register_method(
2284     method   => "retrieve_groups",
2285     api_name => "open-ils.actor.groups.retrieve",
2286     notes    => "Returns a list of user groups"
2287 );
2288 sub retrieve_groups {
2289     my( $self, $client ) = @_;
2290     return new_editor()->retrieve_all_permission_grp_tree();
2291 }
2292
2293 __PACKAGE__->register_method(
2294     method  => "retrieve_org_address",
2295     api_name    => "open-ils.actor.org_unit.address.retrieve",
2296     notes        => <<'    NOTES');
2297     Returns an org_unit address by ID
2298     @param An org_address ID
2299     NOTES
2300 sub retrieve_org_address {
2301     my( $self, $client, $id ) = @_;
2302     return $apputils->simple_scalar_request(
2303         "open-ils.cstore",
2304         "open-ils.cstore.direct.actor.org_address.retrieve",
2305         $id
2306     );
2307 }
2308
2309 __PACKAGE__->register_method(
2310     method   => "retrieve_groups_tree",
2311     api_name => "open-ils.actor.groups.tree.retrieve",
2312     notes    => "Returns a list of user groups"
2313 );
2314     
2315 sub retrieve_groups_tree {
2316     my( $self, $client ) = @_;
2317     return new_editor()->search_permission_grp_tree(
2318         [
2319             { parent => undef},
2320             {   
2321                 flesh               => -1,
2322                 flesh_fields    => { pgt => ["children"] }, 
2323                 order_by            => { pgt => 'name'}
2324             }
2325         ]
2326     )->[0];
2327 }
2328
2329
2330 __PACKAGE__->register_method(
2331     method   => "add_user_to_groups",
2332     api_name => "open-ils.actor.user.set_groups",
2333     notes    => "Adds a user to one or more permission groups"
2334 );
2335     
2336 sub add_user_to_groups {
2337     my( $self, $client, $authtoken, $userid, $groups ) = @_;
2338
2339     my( $requestor, $target, $evt ) = $apputils->checkses_requestor(
2340         $authtoken, $userid, 'CREATE_USER_GROUP_LINK' );
2341     return $evt if $evt;
2342
2343     ( $requestor, $target, $evt ) = $apputils->checkses_requestor(
2344         $authtoken, $userid, 'REMOVE_USER_GROUP_LINK' );
2345     return $evt if $evt;
2346
2347     $apputils->simplereq(
2348         'open-ils.storage',
2349         'open-ils.storage.direct.permission.usr_grp_map.mass_delete', { usr => $userid } );
2350         
2351     for my $group (@$groups) {
2352         my $link = Fieldmapper::permission::usr_grp_map->new;
2353         $link->grp($group);
2354         $link->usr($userid);
2355
2356         my $id = $apputils->simplereq(
2357             'open-ils.storage',
2358             'open-ils.storage.direct.permission.usr_grp_map.create', $link );
2359     }
2360
2361     return 1;
2362 }
2363
2364 __PACKAGE__->register_method(
2365     method   => "get_user_perm_groups",
2366     api_name => "open-ils.actor.user.get_groups",
2367     notes    => "Retrieve a user's permission groups."
2368 );
2369
2370
2371 sub get_user_perm_groups {
2372     my( $self, $client, $authtoken, $userid ) = @_;
2373
2374     my( $requestor, $target, $evt ) = $apputils->checkses_requestor(
2375         $authtoken, $userid, 'VIEW_PERM_GROUPS' );
2376     return $evt if $evt;
2377
2378     return $apputils->simplereq(
2379         'open-ils.cstore',
2380         'open-ils.cstore.direct.permission.usr_grp_map.search.atomic', { usr => $userid } );
2381 }   
2382
2383
2384 __PACKAGE__->register_method(
2385     method   => "get_user_work_ous",
2386     api_name => "open-ils.actor.user.get_work_ous",
2387     notes    => "Retrieve a user's work org units."
2388 );
2389
2390 __PACKAGE__->register_method(
2391     method   => "get_user_work_ous",
2392     api_name => "open-ils.actor.user.get_work_ous.ids",
2393     notes    => "Retrieve a user's work org units."
2394 );
2395
2396 sub get_user_work_ous {
2397     my( $self, $client, $auth, $userid ) = @_;
2398     my $e = new_editor(authtoken=>$auth);
2399     return $e->event unless $e->checkauth;
2400     $userid ||= $e->requestor->id;
2401
2402     if($e->requestor->id != $userid) {
2403         my $user = $e->retrieve_actor_user($userid)
2404             or return $e->event;
2405         return $e->event unless $e->allowed('ASSIGN_WORK_ORG_UNIT', $user->home_ou);
2406     }
2407
2408     return $e->search_permission_usr_work_ou_map({usr => $userid})
2409         unless $self->api_name =~ /.ids$/;
2410
2411     # client just wants a list of org IDs
2412     return $U->get_user_work_ou_ids($e, $userid);
2413 }   
2414
2415
2416
2417 __PACKAGE__->register_method(
2418     method    => 'register_workstation',
2419     api_name  => 'open-ils.actor.workstation.register.override',
2420     signature => q/@see open-ils.actor.workstation.register/
2421 );
2422
2423 __PACKAGE__->register_method(
2424     method    => 'register_workstation',
2425     api_name  => 'open-ils.actor.workstation.register',
2426     signature => q/
2427         Registers a new workstion in the system
2428         @param authtoken The login session key
2429         @param name The name of the workstation id
2430         @param owner The org unit that owns this workstation
2431         @return The workstation id on success, WORKSTATION_NAME_EXISTS
2432         if the name is already in use.
2433     /
2434 );
2435
2436 sub register_workstation {
2437     my( $self, $conn, $authtoken, $name, $owner, $oargs ) = @_;
2438
2439     my $e = new_editor(authtoken=>$authtoken, xact=>1);
2440     return $e->die_event unless $e->checkauth;
2441     return $e->die_event unless $e->allowed('REGISTER_WORKSTATION', $owner);
2442     my $existing = $e->search_actor_workstation({name => $name})->[0];
2443     $oargs = { all => 1 } unless defined $oargs;
2444
2445     if( $existing ) {
2446
2447         if( $self->api_name =~ /override/o && ($oargs->{all} || grep { $_ eq 'WORKSTATION_NAME_EXISTS' } @{$oargs->{events}}) ) {
2448             # workstation with the given name exists.  
2449
2450             if($owner ne $existing->owning_lib) {
2451                 # if necessary, update the owning_lib of the workstation
2452
2453                 $logger->info("changing owning lib of workstation ".$existing->id.
2454                     " from ".$existing->owning_lib." to $owner");
2455                 return $e->die_event unless 
2456                     $e->allowed('UPDATE_WORKSTATION', $existing->owning_lib); 
2457
2458                 return $e->die_event unless $e->allowed('UPDATE_WORKSTATION', $owner); 
2459
2460                 $existing->owning_lib($owner);
2461                 return $e->die_event unless $e->update_actor_workstation($existing);
2462
2463                 $e->commit;
2464
2465             } else {
2466                 $logger->info(  
2467                     "attempt to register an existing workstation.  returning existing ID");
2468             }
2469
2470             return $existing->id;
2471
2472         } else {
2473             return OpenILS::Event->new('WORKSTATION_NAME_EXISTS')
2474         }
2475     }
2476
2477     my $ws = Fieldmapper::actor::workstation->new;
2478     $ws->owning_lib($owner);
2479     $ws->name($name);
2480     $e->create_actor_workstation($ws) or return $e->die_event;
2481     $e->commit;
2482     return $ws->id; # note: editor sets the id on the new object for us
2483 }
2484
2485 __PACKAGE__->register_method(
2486     method    => 'workstation_list',
2487     api_name  => 'open-ils.actor.workstation.list',
2488     signature => q/
2489         Returns a list of workstations registered at the given location
2490         @param authtoken The login session key
2491         @param ids A list of org_unit.id's for the workstation owners
2492     /
2493 );
2494
2495 sub workstation_list {
2496     my( $self, $conn, $authtoken, @orgs ) = @_;
2497
2498     my $e = new_editor(authtoken=>$authtoken);
2499     return $e->event unless $e->checkauth;
2500     my %results;
2501
2502     for my $o (@orgs) {
2503         return $e->event 
2504             unless $e->allowed('REGISTER_WORKSTATION', $o);
2505         $results{$o} = $e->search_actor_workstation({owning_lib=>$o});
2506     }
2507     return \%results;
2508 }
2509
2510
2511 __PACKAGE__->register_method(
2512     method        => 'fetch_patron_note',
2513     api_name      => 'open-ils.actor.note.retrieve.all',
2514     authoritative => 1,
2515     signature     => q/
2516         Returns a list of notes for a given user
2517         Requestor must have VIEW_USER permission if pub==false and
2518         @param authtoken The login session key
2519         @param args Hash of params including
2520             patronid : the patron's id
2521             pub : true if retrieving only public notes
2522     /
2523 );
2524
2525 sub fetch_patron_note {
2526     my( $self, $conn, $authtoken, $args ) = @_;
2527     my $patronid = $$args{patronid};
2528
2529     my($reqr, $evt) = $U->checkses($authtoken);
2530     return $evt if $evt;
2531
2532     my $patron;
2533     ($patron, $evt) = $U->fetch_user($patronid);
2534     return $evt if $evt;
2535
2536     if($$args{pub}) {
2537         if( $patronid ne $reqr->id ) {
2538             $evt = $U->check_perms($reqr->id, $patron->home_ou, 'VIEW_USER');
2539             return $evt if $evt;
2540         }
2541         return $U->cstorereq(
2542             'open-ils.cstore.direct.actor.usr_note.search.atomic', 
2543             { usr => $patronid, pub => 't' } );
2544     }
2545
2546     $evt = $U->check_perms($reqr->id, $patron->home_ou, 'VIEW_USER');
2547     return $evt if $evt;
2548
2549     return $U->cstorereq(
2550         'open-ils.cstore.direct.actor.usr_note.search.atomic', { usr => $patronid } );
2551 }
2552
2553 __PACKAGE__->register_method(
2554     method    => 'create_user_note',
2555     api_name  => 'open-ils.actor.note.create',
2556     signature => q/
2557         Creates a new note for the given user
2558         @param authtoken The login session key
2559         @param note The note object
2560     /
2561 );
2562 sub create_user_note {
2563     my( $self, $conn, $authtoken, $note ) = @_;
2564     my $e = new_editor(xact=>1, authtoken=>$authtoken);
2565     return $e->die_event unless $e->checkauth;
2566
2567     my $user = $e->retrieve_actor_user($note->usr)
2568         or return $e->die_event;
2569
2570     return $e->die_event unless 
2571         $e->allowed('UPDATE_USER',$user->home_ou);
2572
2573     $note->creator($e->requestor->id);
2574     $e->create_actor_usr_note($note) or return $e->die_event;
2575     $e->commit;
2576     return $note->id;
2577 }
2578
2579
2580 __PACKAGE__->register_method(
2581     method    => 'delete_user_note',
2582     api_name  => 'open-ils.actor.note.delete',
2583     signature => q/
2584         Deletes a note for the given user
2585         @param authtoken The login session key
2586         @param noteid The note id
2587     /
2588 );
2589 sub delete_user_note {
2590     my( $self, $conn, $authtoken, $noteid ) = @_;
2591
2592     my $e = new_editor(xact=>1, authtoken=>$authtoken);
2593     return $e->die_event unless $e->checkauth;
2594     my $note = $e->retrieve_actor_usr_note($noteid)
2595         or return $e->die_event;
2596     my $user = $e->retrieve_actor_user($note->usr)
2597         or return $e->die_event;
2598     return $e->die_event unless 
2599         $e->allowed('UPDATE_USER', $user->home_ou);
2600     
2601     $e->delete_actor_usr_note($note) or return $e->die_event;
2602     $e->commit;
2603     return 1;
2604 }
2605
2606
2607 __PACKAGE__->register_method(
2608     method    => 'update_user_note',
2609     api_name  => 'open-ils.actor.note.update',
2610     signature => q/
2611         @param authtoken The login session key
2612         @param note The note
2613     /
2614 );
2615
2616 sub update_user_note {
2617     my( $self, $conn, $auth, $note ) = @_;
2618     my $e = new_editor(authtoken=>$auth, xact=>1);
2619     return $e->die_event unless $e->checkauth;
2620     my $patron = $e->retrieve_actor_user($note->usr)
2621         or return $e->die_event;
2622     return $e->die_event unless 
2623         $e->allowed('UPDATE_USER', $patron->home_ou);
2624     $e->update_actor_user_note($note)
2625         or return $e->die_event;
2626     $e->commit;
2627     return 1;
2628 }
2629
2630
2631
2632 __PACKAGE__->register_method(
2633     method    => 'create_closed_date',
2634     api_name  => 'open-ils.actor.org_unit.closed_date.create',
2635     signature => q/
2636         Creates a new closing entry for the given org_unit
2637         @param authtoken The login session key
2638         @param note The closed_date object
2639     /
2640 );
2641 sub create_closed_date {
2642     my( $self, $conn, $authtoken, $cd ) = @_;
2643
2644     my( $user, $evt ) = $U->checkses($authtoken);
2645     return $evt if $evt;
2646
2647     $evt = $U->check_perms($user->id, $cd->org_unit, 'CREATE_CLOSEING');
2648     return $evt if $evt;
2649
2650     $logger->activity("user ".$user->id." creating library closing for ".$cd->org_unit);
2651
2652     my $id = $U->storagereq(
2653         'open-ils.storage.direct.actor.org_unit.closed_date.create', $cd );
2654     return $U->DB_UPDATE_FAILED($cd) unless $id;
2655     return $id;
2656 }
2657
2658
2659 __PACKAGE__->register_method(
2660     method    => 'delete_closed_date',
2661     api_name  => 'open-ils.actor.org_unit.closed_date.delete',
2662     signature => q/
2663         Deletes a closing entry for the given org_unit
2664         @param authtoken The login session key
2665         @param noteid The close_date id
2666     /
2667 );
2668 sub delete_closed_date {
2669     my( $self, $conn, $authtoken, $cd ) = @_;
2670
2671     my( $user, $evt ) = $U->checkses($authtoken);
2672     return $evt if $evt;
2673
2674     my $cd_obj;
2675     ($cd_obj, $evt) = fetch_closed_date($cd);
2676     return $evt if $evt;
2677
2678     $evt = $U->check_perms($user->id, $cd->org_unit, 'DELETE_CLOSEING');
2679     return $evt if $evt;
2680
2681     $logger->activity("user ".$user->id." deleting library closing for ".$cd->org_unit);
2682
2683     my $stat = $U->storagereq(
2684         'open-ils.storage.direct.actor.org_unit.closed_date.delete', $cd );
2685     return $U->DB_UPDATE_FAILED($cd) unless $stat;
2686     return $stat;
2687 }
2688
2689
2690 __PACKAGE__->register_method(
2691     method    => 'usrname_exists',
2692     api_name  => 'open-ils.actor.username.exists',
2693     signature => {
2694         desc  => 'Check if a username is already taken (by an undeleted patron)',
2695         param => [
2696             {desc => 'Authentication token', type => 'string'},
2697             {desc => 'Username',             type => 'string'}
2698         ],
2699         return => {
2700             desc => 'id of existing user if username exists, undef otherwise.  Event on error'
2701         },
2702     }
2703 );
2704
2705 sub usrname_exists {
2706     my( $self, $conn, $auth, $usrname ) = @_;
2707     my $e = new_editor(authtoken=>$auth);
2708     return $e->event unless $e->checkauth;
2709     my $a = $e->search_actor_user({usrname => $usrname}, {idlist=>1});
2710     return $$a[0] if $a and @$a;
2711     return undef;
2712 }
2713
2714 __PACKAGE__->register_method(
2715     method        => 'barcode_exists',
2716     api_name      => 'open-ils.actor.barcode.exists',
2717     authoritative => 1,
2718     signature     => 'Returns 1 if the requested barcode exists, returns 0 otherwise'
2719 );
2720
2721 sub barcode_exists {
2722     my( $self, $conn, $auth, $barcode ) = @_;
2723     my $e = new_editor(authtoken=>$auth);
2724     return $e->event unless $e->checkauth;
2725     my $card = $e->search_actor_card({barcode => $barcode});
2726     if (@$card) {
2727         return 1;
2728     } else {
2729         return 0;
2730     }
2731     #return undef unless @$card;
2732     #return $card->[0]->usr;
2733 }
2734
2735
2736 __PACKAGE__->register_method(
2737     method   => 'retrieve_net_levels',
2738     api_name => 'open-ils.actor.net_access_level.retrieve.all',
2739 );
2740
2741 sub retrieve_net_levels {
2742     my( $self, $conn, $auth ) = @_;
2743     my $e = new_editor(authtoken=>$auth);
2744     return $e->event unless $e->checkauth;
2745     return $e->retrieve_all_config_net_access_level();
2746 }
2747
2748 # Retain the old typo API name just in case
2749 __PACKAGE__->register_method(
2750     method   => 'fetch_org_by_shortname',
2751     api_name => 'open-ils.actor.org_unit.retrieve_by_shorname',
2752 );
2753 __PACKAGE__->register_method(
2754     method   => 'fetch_org_by_shortname',
2755     api_name => 'open-ils.actor.org_unit.retrieve_by_shortname',
2756 );
2757 sub fetch_org_by_shortname {
2758     my( $self, $conn, $sname ) = @_;
2759     my $e = new_editor();
2760     my $org = $e->search_actor_org_unit({ shortname => uc($sname)})->[0];
2761     return $e->event unless $org;
2762     return $org;
2763 }
2764
2765
2766 __PACKAGE__->register_method(
2767     method   => 'session_home_lib',
2768     api_name => 'open-ils.actor.session.home_lib',
2769 );
2770
2771 sub session_home_lib {
2772     my( $self, $conn, $auth ) = @_;
2773     my $e = new_editor(authtoken=>$auth);
2774     return undef unless $e->checkauth;
2775     my $org = $e->retrieve_actor_org_unit($e->requestor->home_ou);
2776     return $org->shortname;
2777 }
2778
2779 __PACKAGE__->register_method(
2780     method    => 'session_safe_token',
2781     api_name  => 'open-ils.actor.session.safe_token',
2782     signature => q/
2783         Returns a hashed session ID that is safe for export to the world.
2784         This safe token will expire after 1 hour of non-use.
2785         @param auth Active authentication token
2786     /
2787 );
2788
2789 sub session_safe_token {
2790     my( $self, $conn, $auth ) = @_;
2791     my $e = new_editor(authtoken=>$auth);
2792     return undef unless $e->checkauth;
2793
2794     my $safe_token = md5_hex($auth);
2795
2796     $cache ||= OpenSRF::Utils::Cache->new("global", 0);
2797
2798     # Add more like the following if needed...
2799     $cache->put_cache(
2800         "safe-token-home_lib-shortname-$safe_token",
2801         $e->retrieve_actor_org_unit(
2802             $e->requestor->home_ou
2803         )->shortname,
2804         60 * 60
2805     );
2806
2807     return $safe_token;
2808 }
2809
2810
2811 __PACKAGE__->register_method(
2812     method    => 'safe_token_home_lib',
2813     api_name  => 'open-ils.actor.safe_token.home_lib.shortname',
2814     signature => q/
2815         Returns the home library shortname from the session
2816         asscociated with a safe token from generated by
2817         open-ils.actor.session.safe_token.
2818         @param safe_token Active safe token
2819     /
2820 );
2821
2822 sub safe_token_home_lib {
2823     my( $self, $conn, $safe_token ) = @_;
2824
2825     $cache ||= OpenSRF::Utils::Cache->new("global", 0);
2826     return $cache->get_cache( 'safe-token-home_lib-shortname-'. $safe_token );
2827 }
2828
2829
2830 __PACKAGE__->register_method(
2831     method   => "update_penalties",
2832     api_name => "open-ils.actor.user.penalties.update"
2833 );
2834
2835 sub update_penalties {
2836     my($self, $conn, $auth, $user_id) = @_;
2837     my $e = new_editor(authtoken=>$auth, xact => 1);
2838     return $e->die_event unless $e->checkauth;
2839     my $user = $e->retrieve_actor_user($user_id) or return $e->die_event;
2840     return $e->die_event unless $e->allowed('UPDATE_USER', $user->home_ou);
2841     my $evt = OpenILS::Utils::Penalty->calculate_penalties($e, $user_id, $e->requestor->ws_ou);
2842     return $evt if $evt;
2843     $e->commit;
2844     return 1;
2845 }
2846
2847
2848 __PACKAGE__->register_method(
2849     method   => "apply_penalty",
2850     api_name => "open-ils.actor.user.penalty.apply"
2851 );
2852
2853 sub apply_penalty {
2854     my($self, $conn, $auth, $penalty) = @_;
2855
2856     my $e = new_editor(authtoken=>$auth, xact => 1);
2857     return $e->die_event unless $e->checkauth;
2858
2859     my $user = $e->retrieve_actor_user($penalty->usr) or return $e->die_event;
2860     return $e->die_event unless $e->allowed('UPDATE_USER', $user->home_ou);
2861
2862     my $ptype = $e->retrieve_config_standing_penalty($penalty->standing_penalty) or return $e->die_event;
2863     
2864     my $ctx_org = 
2865         (defined $ptype->org_depth) ?
2866         $U->org_unit_ancestor_at_depth($penalty->org_unit, $ptype->org_depth) :
2867         $penalty->org_unit;
2868
2869     $penalty->org_unit($ctx_org);
2870     $penalty->staff($e->requestor->id);
2871     $e->create_actor_user_standing_penalty($penalty) or return $e->die_event;
2872
2873     $e->commit;
2874     return $penalty->id;
2875 }
2876
2877 __PACKAGE__->register_method(
2878     method   => "remove_penalty",
2879     api_name => "open-ils.actor.user.penalty.remove"
2880 );
2881
2882 sub remove_penalty {
2883     my($self, $conn, $auth, $penalty) = @_;
2884     my $e = new_editor(authtoken=>$auth, xact => 1);
2885     return $e->die_event unless $e->checkauth;
2886     my $user = $e->retrieve_actor_user($penalty->usr) or return $e->die_event;
2887     return $e->die_event unless $e->allowed('UPDATE_USER', $user->home_ou);
2888
2889     $e->delete_actor_user_standing_penalty($penalty) or return $e->die_event;
2890     $e->commit;
2891     return 1;
2892 }
2893
2894 __PACKAGE__->register_method(
2895     method   => "update_penalty_note",
2896     api_name => "open-ils.actor.user.penalty.note.update"
2897 );
2898
2899 sub update_penalty_note {
2900     my($self, $conn, $auth, $penalty_ids, $note) = @_;
2901     my $e = new_editor(authtoken=>$auth, xact => 1);
2902     return $e->die_event unless $e->checkauth;
2903     for my $penalty_id (@$penalty_ids) {
2904         my $penalty = $e->search_actor_user_standing_penalty( { id => $penalty_id } )->[0];
2905         if (! $penalty ) { return $e->die_event; }
2906         my $user = $e->retrieve_actor_user($penalty->usr) or return $e->die_event;
2907         return $e->die_event unless $e->allowed('UPDATE_USER', $user->home_ou);
2908
2909         $penalty->note( $note ); $penalty->ischanged( 1 );
2910
2911         $e->update_actor_user_standing_penalty($penalty) or return $e->die_event;
2912     }
2913     $e->commit;
2914     return 1;
2915 }
2916
2917 __PACKAGE__->register_method(
2918     method   => "ranged_penalty_thresholds",
2919     api_name => "open-ils.actor.grp_penalty_threshold.ranged.retrieve",
2920     stream   => 1
2921 );
2922
2923 sub ranged_penalty_thresholds {
2924     my($self, $conn, $auth, $context_org) = @_;
2925     my $e = new_editor(authtoken=>$auth);
2926     return $e->event unless $e->checkauth;
2927     return $e->event unless $e->allowed('VIEW_GROUP_PENALTY_THRESHOLD', $context_org);
2928     my $list = $e->search_permission_grp_penalty_threshold([
2929         {org_unit => $U->get_org_ancestors($context_org)},
2930         {order_by => {pgpt => 'id'}}
2931     ]);
2932     $conn->respond($_) for @$list;
2933     return undef;
2934 }
2935
2936
2937
2938 __PACKAGE__->register_method(
2939     method        => "user_retrieve_fleshed_by_id",
2940     authoritative => 1,
2941     api_name      => "open-ils.actor.user.fleshed.retrieve",
2942 );
2943
2944 sub user_retrieve_fleshed_by_id {
2945     my( $self, $client, $auth, $user_id, $fields ) = @_;
2946     my $e = new_editor(authtoken => $auth);
2947     return $e->event unless $e->checkauth;
2948
2949     if( $e->requestor->id != $user_id ) {
2950         return $e->event unless $e->allowed('VIEW_USER');
2951     }
2952
2953     $fields ||= [
2954         "cards",
2955         "card",
2956         "standing_penalties",
2957         "addresses",
2958         "billing_address",
2959         "mailing_address",
2960         "stat_cat_entries",
2961         "usr_activity" ];
2962     return new_flesh_user($user_id, $fields, $e);
2963 }
2964
2965
2966 sub new_flesh_user {
2967
2968     my $id = shift;
2969     my $fields = shift || [];
2970     my $e = shift;
2971
2972     my $fetch_penalties = 0;
2973     if(grep {$_ eq 'standing_penalties'} @$fields) {
2974         $fields = [grep {$_ ne 'standing_penalties'} @$fields];
2975         $fetch_penalties = 1;
2976     }
2977
2978     my $fetch_usr_act = 0;
2979     if(grep {$_ eq 'usr_activity'} @$fields) {
2980         $fields = [grep {$_ ne 'usr_activity'} @$fields];
2981         $fetch_usr_act = 1;
2982     }
2983
2984     my $user = $e->retrieve_actor_user(
2985     [
2986         $id,
2987         {
2988             "flesh"             => 1,
2989             "flesh_fields" =>  { "au" => $fields }
2990         }
2991     ]
2992     ) or return $e->die_event;
2993
2994
2995     if( grep { $_ eq 'addresses' } @$fields ) {
2996
2997         $user->addresses([]) unless @{$user->addresses};
2998         # don't expose "replaced" addresses by default
2999         $user->addresses([grep {$_->id >= 0} @{$user->addresses}]);
3000     
3001         if( ref $user->billing_address ) {
3002             unless( grep { $user->billing_address->id == $_->id } @{$user->addresses} ) {
3003                 push( @{$user->addresses}, $user->billing_address );
3004             }
3005         }
3006     
3007         if( ref $user->mailing_address ) {
3008             unless( grep { $user->mailing_address->id == $_->id } @{$user->addresses} ) {
3009                 push( @{$user->addresses}, $user->mailing_address );
3010             }
3011         }
3012     }
3013
3014     if($fetch_penalties) {
3015         # grab the user penalties ranged for this location
3016         $user->standing_penalties(
3017             $e->search_actor_user_standing_penalty([
3018                 {   usr => $id, 
3019                     '-or' => [
3020                         {stop_date => undef},
3021                         {stop_date => {'>' => 'now'}}
3022                     ],
3023                     org_unit => $U->get_org_full_path($e->requestor->ws_ou)
3024                 },
3025                 {   flesh => 1,
3026                     flesh_fields => {ausp => ['standing_penalty']}
3027                 }
3028             ])
3029         );
3030     }
3031
3032     # retrieve the most recent usr_activity entry
3033     if ($fetch_usr_act) {
3034
3035         # max number to return for simple patron fleshing
3036         my $limit = $U->ou_ancestor_setting_value(
3037             $e->requestor->ws_ou, 
3038             'circ.patron.usr_activity_retrieve.max');
3039
3040         my $opts = {
3041             flesh => 1,
3042             flesh_fields => {auact => ['etype']},
3043             order_by => {auact => 'event_time DESC'}, 
3044         };
3045
3046         # 0 == none, <0 == return all
3047         $limit = 1 unless defined $limit;
3048         $opts->{limit} = $limit if $limit > 0;
3049
3050         $user->usr_activity( 
3051             ($limit == 0) ? 
3052                 [] : # skip the DB call
3053                 $e->search_actor_usr_activity([{usr => $user->id}, $opts])
3054         );
3055     }
3056
3057     $e->rollback;
3058     $user->clear_passwd();
3059     return $user;
3060 }
3061
3062
3063
3064
3065 __PACKAGE__->register_method(
3066     method   => "user_retrieve_parts",
3067     api_name => "open-ils.actor.user.retrieve.parts",
3068 );
3069
3070 sub user_retrieve_parts {
3071     my( $self, $client, $auth, $user_id, $fields ) = @_;
3072     my $e = new_editor(authtoken => $auth);
3073     return $e->event unless $e->checkauth;
3074     $user_id ||= $e->requestor->id;
3075     if( $e->requestor->id != $user_id ) {
3076         return $e->event unless $e->allowed('VIEW_USER');
3077     }
3078     my @resp;
3079     my $user = $e->retrieve_actor_user($user_id) or return $e->event;
3080     push(@resp, $user->$_()) for(@$fields);
3081     return \@resp;
3082 }
3083
3084
3085
3086 __PACKAGE__->register_method(
3087     method    => 'user_opt_in_enabled',
3088     api_name  => 'open-ils.actor.user.org_unit_opt_in.enabled',
3089     signature => '@return 1 if user opt-in is globally enabled, 0 otherwise.'
3090 );
3091
3092 sub user_opt_in_enabled {
3093     my($self, $conn) = @_;
3094     my $sc = OpenSRF::Utils::SettingsClient->new;
3095     return 1 if lc($sc->config_value(share => user => 'opt_in')) eq 'true'; 
3096     return 0;
3097 }
3098     
3099
3100 __PACKAGE__->register_method(
3101     method    => 'user_opt_in_at_org',
3102     api_name  => 'open-ils.actor.user.org_unit_opt_in.check',
3103     signature => q/
3104         @param $auth The auth token
3105         @param user_id The ID of the user to test
3106         @return 1 if the user has opted in at the specified org,
3107             event on error, and 0 otherwise. /
3108 );
3109 sub user_opt_in_at_org {
3110     my($self, $conn, $auth, $user_id) = @_;
3111
3112     # see if we even need to enforce the opt-in value
3113     return 1 unless user_opt_in_enabled($self);
3114
3115     my $e = new_editor(authtoken => $auth);
3116     return $e->event unless $e->checkauth;
3117
3118     my $user = $e->retrieve_actor_user($user_id) or return $e->event;
3119     return $e->event unless $e->allowed('VIEW_USER', $user->home_ou);
3120
3121     my $ws_org = $e->requestor->ws_ou;
3122     # user is automatically opted-in if they are from the local org
3123     return 1 if $user->home_ou eq $ws_org;
3124
3125     # get the boundary setting
3126     my $opt_boundary = $U->ou_ancestor_setting_value($e->requestor->ws_ou,'org.patron_opt_boundary');
3127  
3128     # auto opt in if user falls within the opt boundary
3129     my $opt_orgs = $U->get_org_descendants($ws_org, $opt_boundary);
3130
3131     return 1 if grep $_ eq $user->home_ou, @$opt_orgs;
3132
3133     my $vals = $e->search_actor_usr_org_unit_opt_in(
3134         {org_unit=>$opt_orgs, usr=>$user_id},{idlist=>1});
3135
3136     return 1 if @$vals;
3137     return 0;
3138 }
3139
3140 __PACKAGE__->register_method(
3141     method    => 'create_user_opt_in_at_org',
3142     api_name  => 'open-ils.actor.user.org_unit_opt_in.create',
3143     signature => q/
3144         @param $auth The auth token
3145         @param user_id The ID of the user to test
3146         @return The ID of the newly created object, event on error./
3147 );
3148
3149 sub create_user_opt_in_at_org {
3150     my($self, $conn, $auth, $user_id, $org_id) = @_;
3151
3152     my $e = new_editor(authtoken => $auth, xact=>1);
3153     return $e->die_event unless $e->checkauth;
3154    
3155     # if a specific org unit wasn't passed in, get one based on the defaults;
3156     if(!$org_id){
3157         my $wsou = $e->requestor->ws_ou;
3158         # get the default opt depth
3159         my $opt_depth = $U->ou_ancestor_setting_value($wsou,'org.patron_opt_default'); 
3160         # get the org unit at that depth
3161         my $org = $e->json_query({ 
3162             from => [ 'actor.org_unit_ancestor_at_depth', $wsou, $opt_depth ]})->[0];
3163         $org_id = $org->{id};
3164     } 
3165     if (!$org_id) {
3166         # fall back to the workstation OU, the pre-opt-in-boundary way
3167         $org_id = $e->requestor->ws_ou;
3168     }
3169
3170     my $user = $e->retrieve_actor_user($user_id) or return $e->die_event;
3171     return $e->die_event unless $e->allowed('UPDATE_USER', $user->home_ou);
3172
3173     my $opt_in = Fieldmapper::actor::usr_org_unit_opt_in->new;
3174
3175     $opt_in->org_unit($org_id);
3176     $opt_in->usr($user_id);
3177     $opt_in->staff($e->requestor->id);
3178     $opt_in->opt_in_ts('now');
3179     $opt_in->opt_in_ws($e->requestor->wsid);
3180
3181     $opt_in = $e->create_actor_usr_org_unit_opt_in($opt_in)
3182         or return $e->die_event;
3183
3184     $e->commit;
3185
3186     return $opt_in->id;
3187 }
3188
3189
3190 __PACKAGE__->register_method (
3191     method      => 'retrieve_org_hours',
3192     api_name    => 'open-ils.actor.org_unit.hours_of_operation.retrieve',
3193     signature   => q/
3194         Returns the hours of operation for a specified org unit
3195         @param authtoken The login session key
3196         @param org_id The org_unit ID
3197     /
3198 );
3199
3200 sub retrieve_org_hours {
3201     my($self, $conn, $auth, $org_id) = @_;
3202     my $e = new_editor(authtoken => $auth);
3203     return $e->die_event unless $e->checkauth;
3204     $org_id ||= $e->requestor->ws_ou;
3205     return $e->retrieve_actor_org_unit_hours_of_operation($org_id);
3206 }
3207
3208
3209 __PACKAGE__->register_method (
3210     method      => 'verify_user_password',
3211     api_name    => 'open-ils.actor.verify_user_password',
3212     signature   => q/
3213         Given a barcode or username and the MD5 encoded password, 
3214         returns 1 if the password is correct.  Returns 0 otherwise.
3215     /
3216 );
3217
3218 sub verify_user_password {
3219     my($self, $conn, $auth, $barcode, $username, $password) = @_;
3220     my $e = new_editor(authtoken => $auth);
3221     return $e->die_event unless $e->checkauth;
3222     my $user;
3223     my $user_by_barcode;
3224     my $user_by_username;
3225     if($barcode) {
3226         my $card = $e->search_actor_card([
3227             {barcode => $barcode},
3228             {flesh => 1, flesh_fields => {ac => ['usr']}}])->[0] or return 0;
3229         $user_by_barcode = $card->usr;
3230         $user = $user_by_barcode;
3231     }
3232     if ($username) {
3233         $user_by_username = $e->search_actor_user({usrname => $username})->[0] or return 0;
3234         $user = $user_by_username;
3235     }
3236     return 0 if (!$user);
3237     return 0 if ($user_by_username && $user_by_barcode && $user_by_username->id != $user_by_barcode->id); 
3238     return $e->event unless $e->allowed('VIEW_USER', $user->home_ou);
3239     return 1 if $user->passwd eq $password;
3240     return 0;
3241 }
3242
3243 __PACKAGE__->register_method (
3244     method      => 'retrieve_usr_id_via_barcode_or_usrname',
3245     api_name    => "open-ils.actor.user.retrieve_id_by_barcode_or_username",
3246     signature   => q/
3247         Given a barcode or username returns the id for the user or
3248         a failure event.
3249     /
3250 );
3251
3252 sub retrieve_usr_id_via_barcode_or_usrname {
3253     my($self, $conn, $auth, $barcode, $username) = @_;
3254     my $e = new_editor(authtoken => $auth);
3255     return $e->die_event unless $e->checkauth;
3256     my $id_as_barcode= OpenSRF::Utils::SettingsClient->new->config_value(apps => 'open-ils.actor' => app_settings => 'id_as_barcode');
3257     my $user;
3258     my $user_by_barcode;
3259     my $user_by_username;
3260     $logger->info("$id_as_barcode is the ID as BARCODE");
3261     if($barcode) {
3262         my $card = $e->search_actor_card([
3263             {barcode => $barcode},
3264             {flesh => 1, flesh_fields => {ac => ['usr']}}])->[0];
3265         if ($id_as_barcode =~ /^t/i) {
3266             if (!$card) {
3267                 $user = $e->retrieve_actor_user($barcode);
3268                 return OpenILS::Event->new( 'ACTOR_USER_NOT_FOUND' ) if(!$user);
3269             }else {
3270                 $user_by_barcode = $card->usr;
3271                 $user = $user_by_barcode;
3272             }
3273         }else {
3274             return OpenILS::Event->new( 'ACTOR_USER_NOT_FOUND' ) if(!$card);
3275             $user_by_barcode = $card->usr;
3276             $user = $user_by_barcode;
3277         }
3278     }
3279
3280     if ($username) {
3281         $user_by_username = $e->search_actor_user({usrname => $username})->[0] or return OpenILS::Event->new( 'ACTOR_USR_NOT_FOUND' );
3282
3283         $user = $user_by_username;
3284     }
3285     return OpenILS::Event->new( 'ACTOR_USER_NOT_FOUND' ) if (!$user);
3286     return OpenILS::Event->new( 'ACTOR_USER_NOT_FOUND' ) if ($user_by_username && $user_by_barcode && $user_by_username->id != $user_by_barcode->id); 
3287     return $e->event unless $e->allowed('VIEW_USER', $user->home_ou);
3288     return $user->id;
3289 }
3290
3291
3292 __PACKAGE__->register_method (
3293     method      => 'merge_users',
3294     api_name    => 'open-ils.actor.user.merge',
3295     signature   => {
3296         desc => q/
3297             Given a list of source users and destination user, transfer all data from the source
3298             to the dest user and delete the source user.  All user related data is 
3299             transferred, including circulations, holds, bookbags, etc.
3300         /
3301     }
3302 );
3303
3304 sub merge_users {
3305     my($self, $conn, $auth, $master_id, $user_ids, $options) = @_;
3306     my $e = new_editor(xact => 1, authtoken => $auth);
3307     return $e->die_event unless $e->checkauth;
3308
3309     # disallow the merge if any subordinate accounts are in collections
3310     my $colls = $e->search_money_collections_tracker({usr => $user_ids}, {idlist => 1});
3311     return OpenILS::Event->new('MERGED_USER_IN_COLLECTIONS', payload => $user_ids) if @$colls;
3312
3313     my $master_user = $e->retrieve_actor_user($master_id) or return $e->die_event;
3314     my $del_addrs = ($U->ou_ancestor_setting_value(
3315         $master_user->home_ou, 'circ.user_merge.delete_addresses', $e)) ? 't' : 'f';
3316     my $del_cards = ($U->ou_ancestor_setting_value(
3317         $master_user->home_ou, 'circ.user_merge.delete_cards', $e)) ? 't' : 'f';
3318     my $deactivate_cards = ($U->ou_ancestor_setting_value(
3319         $master_user->home_ou, 'circ.user_merge.deactivate_cards', $e)) ? 't' : 'f';
3320
3321     for my $src_id (@$user_ids) {
3322         my $src_user = $e->retrieve_actor_user($src_id) or return $e->die_event;
3323
3324         return $e->die_event unless $e->allowed('MERGE_USERS', $src_user->home_ou);
3325         if($src_user->home_ou ne $master_user->home_ou) {
3326             return $e->die_event unless $e->allowed('MERGE_USERS', $master_user->home_ou);
3327         }
3328
3329         return $e->die_event unless 
3330             $e->json_query({from => [
3331                 'actor.usr_merge', 
3332                 $src_id, 
3333                 $master_id,
3334                 $del_addrs,
3335                 $del_cards,
3336                 $deactivate_cards
3337             ]});
3338     }
3339
3340     $e->commit;
3341     return 1;
3342 }
3343
3344
3345 __PACKAGE__->register_method (
3346     method      => 'approve_user_address',
3347     api_name    => 'open-ils.actor.user.pending_address.approve',
3348     signature   => {
3349         desc => q/
3350         /
3351     }
3352 );
3353
3354 sub approve_user_address {
3355     my($self, $conn, $auth, $addr) = @_;
3356     my $e = new_editor(xact => 1, authtoken => $auth);
3357     return $e->die_event unless $e->checkauth;
3358     if(ref $addr) {
3359         # if the caller passes an address object, assume they want to 
3360         # update it first before approving it
3361         $e->update_actor_user_address($addr) or return $e->die_event;
3362     } else {
3363         $addr = $e->retrieve_actor_user_address($addr) or return $e->die_event;
3364     }
3365     my $user = $e->retrieve_actor_user($addr->usr);
3366     return $e->die_event unless $e->allowed('UPDATE_USER', $user->home_ou);
3367     my $result = $e->json_query({from => ['actor.approve_pending_address', $addr->id]})->[0]
3368         or return $e->die_event;
3369     $e->commit;
3370     return [values %$result]->[0]; 
3371 }
3372
3373
3374 __PACKAGE__->register_method (
3375     method      => 'retrieve_friends',
3376     api_name    => 'open-ils.actor.friends.retrieve',
3377     signature   => {
3378         desc => q/
3379             returns { confirmed: [], pending_out: [], pending_in: []}
3380             pending_out are users I'm requesting friendship with
3381             pending_in are users requesting friendship with me
3382         /
3383     }
3384 );
3385
3386 sub retrieve_friends {
3387     my($self, $conn, $auth, $user_id, $options) = @_;
3388     my $e = new_editor(authtoken => $auth);
3389     return $e->event unless $e->checkauth;
3390     $user_id ||= $e->requestor->id;
3391
3392     if($user_id != $e->requestor->id) {
3393         my $user = $e->retrieve_actor_user($user_id) or return $e->event;
3394         return $e->event unless $e->allowed('VIEW_USER', $user->home_ou);
3395     }
3396
3397     return OpenILS::Application::Actor::Friends->retrieve_friends(  
3398         $e, $user_id, $options);
3399 }
3400
3401
3402
3403 __PACKAGE__->register_method (
3404     method      => 'apply_friend_perms',
3405     api_name    => 'open-ils.actor.friends.perms.apply',
3406     signature   => {
3407         desc => q/
3408         /
3409     }
3410 );
3411 sub apply_friend_perms {
3412     my($self, $conn, $auth, $user_id, $delegate_id, @perms) = @_;
3413     my $e = new_editor(authtoken => $auth, xact => 1);
3414     return $e->die_event unless $e->checkauth;
3415
3416     if($user_id != $e->requestor->id) {
3417         my $user = $e->retrieve_actor_user($user_id) or return $e->die_event;
3418         return $e->die_event unless $e->allowed('VIEW_USER', $user->home_ou);
3419     }
3420
3421     for my $perm (@perms) {
3422         my $evt = 
3423             OpenILS::Application::Actor::Friends->apply_friend_perm(
3424                 $e, $user_id, $delegate_id, $perm);
3425         return $evt if $evt;
3426     }
3427
3428     $e->commit;
3429     return 1;
3430 }
3431
3432
3433 __PACKAGE__->register_method (
3434     method      => 'update_user_pending_address',
3435     api_name    => 'open-ils.actor.user.address.pending.cud'
3436 );
3437
3438 sub update_user_pending_address {
3439     my($self, $conn, $auth, $addr) = @_;
3440     my $e = new_editor(authtoken => $auth, xact => 1);
3441     return $e->die_event unless $e->checkauth;
3442
3443     if($addr->usr != $e->requestor->id) {
3444         my $user = $e->retrieve_actor_user($addr->usr) or return $e->die_event;
3445         return $e->die_event unless $e->allowed('UPDATE_USER', $user->home_ou);
3446     }
3447
3448     if($addr->isnew) {
3449         $e->create_actor_user_address($addr) or return $e->die_event;
3450     } elsif($addr->isdeleted) {
3451         $e->delete_actor_user_address($addr) or return $e->die_event;
3452     } else {
3453         $e->update_actor_user_address($addr) or return $e->die_event;
3454     }
3455
3456     $e->commit;
3457     return $addr->id;
3458 }
3459
3460
3461 __PACKAGE__->register_method (
3462     method      => 'user_events',
3463     api_name    => 'open-ils.actor.user.events.circ',
3464     stream      => 1,
3465 );
3466 __PACKAGE__->register_method (
3467     method      => 'user_events',
3468     api_name    => 'open-ils.actor.user.events.ahr',
3469     stream      => 1,
3470 );
3471
3472 sub user_events {
3473     my($self, $conn, $auth, $user_id, $filters) = @_;
3474     my $e = new_editor(authtoken => $auth);
3475     return $e->event unless $e->checkauth;
3476
3477     (my $obj_type = $self->api_name) =~ s/.*\.([a-z]+)$/$1/;
3478     my $user_field = 'usr';
3479
3480     $filters ||= {};
3481     $filters->{target} = { 
3482         select => { $obj_type => ['id'] },
3483         from => $obj_type,
3484         where => {usr => $user_id}
3485     };
3486
3487     my $user = $e->retrieve_actor_user($user_id) or return $e->event;
3488     if($e->requestor->id != $user_id) {
3489         return $e->event unless $e->allowed('VIEW_USER', $user->home_ou);
3490     }
3491
3492     my $ses = OpenSRF::AppSession->create('open-ils.trigger');
3493     my $req = $ses->request('open-ils.trigger.events_by_target', 
3494         $obj_type, $filters, {atevdef => ['reactor', 'validator']}, 2);
3495
3496     while(my $resp = $req->recv) {
3497         my $val = $resp->content;
3498         my $tgt = $val->target;
3499
3500         if($obj_type eq 'circ') {
3501             $tgt->target_copy($e->retrieve_asset_copy($tgt->target_copy));
3502
3503         } elsif($obj_type eq 'ahr') {
3504             $tgt->current_copy($e->retrieve_asset_copy($tgt->current_copy))
3505                 if $tgt->current_copy;
3506         }
3507
3508         $conn->respond($val) if $val;
3509     }
3510
3511     return undef;
3512 }
3513
3514 __PACKAGE__->register_method (
3515     method      => 'copy_events',
3516     api_name    => 'open-ils.actor.copy.events.circ',
3517     stream      => 1,
3518 );
3519 __PACKAGE__->register_method (
3520     method      => 'copy_events',
3521     api_name    => 'open-ils.actor.copy.events.ahr',
3522     stream      => 1,
3523 );
3524
3525 sub copy_events {
3526     my($self, $conn, $auth, $copy_id, $filters) = @_;
3527     my $e = new_editor(authtoken => $auth);
3528     return $e->event unless $e->checkauth;
3529
3530     (my $obj_type = $self->api_name) =~ s/.*\.([a-z]+)$/$1/;
3531
3532     my $copy = $e->retrieve_asset_copy($copy_id) or return $e->event;
3533
3534     my $copy_field = 'target_copy';
3535     $copy_field = 'current_copy' if $obj_type eq 'ahr';
3536
3537     $filters ||= {};
3538     $filters->{target} = { 
3539         select => { $obj_type => ['id'] },
3540         from => $obj_type,
3541         where => {$copy_field => $copy_id}
3542     };
3543
3544
3545     my $ses = OpenSRF::AppSession->create('open-ils.trigger');
3546     my $req = $ses->request('open-ils.trigger.events_by_target', 
3547         $obj_type, $filters, {atevdef => ['reactor', 'validator']}, 2);
3548
3549     while(my $resp = $req->recv) {
3550         my $val = $resp->content;
3551         my $tgt = $val->target;
3552         
3553         my $user = $e->retrieve_actor_user($tgt->usr);
3554         if($e->requestor->id != $user->id) {
3555             return $e->event unless $e->allowed('VIEW_USER', $user->home_ou);
3556         }
3557
3558         $tgt->$copy_field($copy);
3559
3560         $tgt->usr($user);
3561         $conn->respond($val) if $val;
3562     }
3563
3564     return undef;
3565 }
3566
3567
3568
3569
3570 __PACKAGE__->register_method (
3571     method      => 'update_events',
3572     api_name    => 'open-ils.actor.user.event.cancel.batch',
3573     stream      => 1,
3574 );
3575 __PACKAGE__->register_method (
3576     method      => 'update_events',
3577     api_name    => 'open-ils.actor.user.event.reset.batch',
3578     stream      => 1,
3579 );
3580
3581 sub update_events {
3582     my($self, $conn, $auth, $event_ids) = @_;
3583     my $e = new_editor(xact => 1, authtoken => $auth);
3584     return $e->die_event unless $e->checkauth;
3585
3586     my $x = 1;
3587     for my $id (@$event_ids) {
3588
3589         # do a little dance to determine what user we are ultimately affecting
3590         my $event = $e->retrieve_action_trigger_event([
3591             $id,
3592             {   flesh => 2,
3593                 flesh_fields => {atev => ['event_def'], atevdef => ['hook']}
3594             }
3595         ]) or return $e->die_event;
3596
3597         my $user_id;
3598         if($event->event_def->hook->core_type eq 'circ') {
3599             $user_id = $e->retrieve_action_circulation($event->target)->usr;
3600         } elsif($event->event_def->hook->core_type eq 'ahr') {
3601             $user_id = $e->retrieve_action_hold_request($event->target)->usr;
3602         } else {
3603             return 0;
3604         }
3605
3606         my $user = $e->retrieve_actor_user($user_id);
3607         return $e->die_event unless $e->allowed('UPDATE_USER', $user->home_ou);
3608
3609         if($self->api_name =~ /cancel/) {
3610             $event->state('invalid');
3611         } elsif($self->api_name =~ /reset/) {
3612             $event->clear_start_time;
3613             $event->clear_update_time;
3614             $event->state('pending');
3615         }
3616
3617         $e->update_action_trigger_event($event) or return $e->die_event;
3618         $conn->respond({maximum => scalar(@$event_ids), progress => $x++});
3619     }
3620
3621     $e->commit;
3622     return {complete => 1};
3623 }
3624
3625
3626 __PACKAGE__->register_method (
3627     method      => 'really_delete_user',
3628     api_name    => 'open-ils.actor.user.delete.override',
3629     signature   => q/@see open-ils.actor.user.delete/
3630 );
3631
3632 __PACKAGE__->register_method (
3633     method      => 'really_delete_user',
3634     api_name    => 'open-ils.actor.user.delete',
3635     signature   => q/
3636         It anonymizes all personally identifiable information in actor.usr. By calling actor.usr_purge_data() 
3637         it also purges related data from other tables, sometimes by transferring it to a designated destination user.
3638         The usrname field (along with first_given_name and family_name) is updated to id '-PURGED-' now().
3639         dest_usr_id is only required when deleting a user that performs staff functions.
3640     /
3641 );
3642
3643 sub really_delete_user {
3644     my($self, $conn, $auth, $user_id, $dest_user_id, $oargs) = @_;
3645     my $e = new_editor(authtoken => $auth, xact => 1);
3646     return $e->die_event unless $e->checkauth;
3647     $oargs = { all => 1 } unless defined $oargs;
3648
3649     # Find all unclosed billings for for user $user_id, thereby, also checking for open circs
3650     my $open_bills = $e->json_query({
3651         select => { mbts => ['id'] },
3652         from => 'mbts',
3653         where => {
3654             xact_finish => { '=' => undef },
3655             usr => { '=' => $user_id },
3656         }
3657     }) or return $e->die_event;
3658
3659     my $user = $e->retrieve_actor_user($user_id) or return $e->die_event;
3660
3661     # No deleting patrons with open billings or checked out copies, unless perm-enabled override
3662     if (@$open_bills) {
3663         return $e->die_event(OpenILS::Event->new('ACTOR_USER_DELETE_OPEN_XACTS'))
3664         unless $self->api_name =~ /override/o && ($oargs->{all} || grep { $_ eq 'ACTOR_USER_DELETE_OPEN_XACTS' } @{$oargs->{events}})
3665         && $e->allowed('ACTOR_USER_DELETE_OPEN_XACTS.override', $user->home_ou);
3666     }
3667     # No deleting yourself - UI is supposed to stop you first, though.
3668     return $e->die_event unless $e->requestor->id != $user->id;
3669     return $e->die_event unless $e->allowed('DELETE_USER', $user->home_ou);
3670     # Check if you are allowed to mess with this patron permission group at all
3671     my $session = OpenSRF::AppSession->create( "open-ils.storage" );
3672     my $evt = group_perm_failed($session, $e->requestor, $user);
3673     return $e->die_event($evt) if $evt;
3674     my $stat = $e->json_query(
3675         {from => ['actor.usr_delete', $user_id, $dest_user_id]})->[0]
3676         or return $e->die_event;
3677     $e->commit;
3678     return 1;
3679 }
3680
3681
3682 __PACKAGE__->register_method (
3683     method      => 'user_payments',
3684     api_name    => 'open-ils.actor.user.payments.retrieve',
3685     stream => 1,
3686     signature   => q/
3687         Returns all payments for a given user.  Default order is newest payments first.
3688         @param auth Authentication token
3689         @param user_id The user ID
3690         @param filters An optional hash of filters, including limit, offset, and order_by definitions
3691     /
3692 );
3693
3694 sub user_payments {
3695     my($self, $conn, $auth, $user_id, $filters) = @_;
3696     $filters ||= {};
3697
3698     my $e = new_editor(authtoken => $auth);
3699     return $e->die_event unless $e->checkauth;
3700
3701     my $user = $e->retrieve_actor_user($user_id) or return $e->event;
3702     return $e->event unless 
3703         $e->requestor->id == $user_id or
3704         $e->allowed('VIEW_USER_TRANSACTIONS', $user->home_ou);
3705
3706     # Find all payments for all transactions for user $user_id
3707     my $query = {
3708         select => {mp => ['id']}, 
3709         from => 'mp', 
3710         where => {
3711             xact => {
3712                 in => {
3713                     select => {mbt => ['id']}, 
3714                     from => 'mbt', 
3715                     where => {usr => $user_id}
3716                 }   
3717             }
3718         },
3719         order_by => [
3720             { # by default, order newest payments first
3721                 class => 'mp', 
3722                 field => 'payment_ts',
3723                 direction => 'desc'
3724             }, {
3725                 # secondary sort in ID as a tie-breaker, since payments created
3726                 # within the same transaction will have identical payment_ts's
3727                 class => 'mp',
3728                 field => 'id'
3729             }
3730         ]
3731     };
3732
3733     for (qw/order_by limit offset/) {
3734         $query->{$_} = $filters->{$_} if defined $filters->{$_};
3735     }
3736
3737     if(defined $filters->{where}) {
3738         foreach (keys %{$filters->{where}}) {
3739             # don't allow the caller to expand the result set to other users
3740             $query->{where}->{$_} = $filters->{where}->{$_} unless $_ eq 'xact'; 
3741         }
3742     }
3743
3744     my $payment_ids = $e->json_query($query);
3745     for my $pid (@$payment_ids) {
3746         my $pay = $e->retrieve_money_payment([
3747  &n