]> git.evergreen-ils.org Git - Evergreen.git/blob - Open-ILS/src/perlmods/lib/OpenILS/Application/Actor.pm
LP#1240119 Safe auth token activity logging
[Evergreen.git] / Open-ILS / src / perlmods / lib / OpenILS / Application / Actor.pm
1 package OpenILS::Application::Actor;
2 use OpenILS::Application;
3 use base qw/OpenILS::Application/;
4 use strict; use warnings;
5 use Data::Dumper;
6 $Data::Dumper::Indent = 0;
7 use OpenILS::Event;
8
9 use Digest::MD5 qw(md5_hex);
10
11 use OpenSRF::EX qw(:try);
12 use OpenILS::Perm;
13
14 use OpenILS::Application::AppUtils;
15
16 use OpenILS::Utils::Fieldmapper;
17 use OpenILS::Utils::ModsParser;
18 use OpenSRF::Utils::Logger qw/$logger/;
19 use OpenSRF::Utils qw/:datetime/;
20 use OpenSRF::Utils::SettingsClient;
21
22 use OpenSRF::Utils::Cache;
23
24 use OpenSRF::Utils::JSON;
25 use DateTime;
26 use DateTime::Format::ISO8601;
27 use OpenILS::Const qw/:const/;
28
29 use OpenILS::Application::Actor::Container;
30 use OpenILS::Application::Actor::ClosedDates;
31 use OpenILS::Application::Actor::UserGroups;
32 use OpenILS::Application::Actor::Friends;
33 use OpenILS::Application::Actor::Stage;
34
35 use OpenILS::Utils::CStoreEditor qw/:funcs/;
36 use OpenILS::Utils::Penalty;
37 use OpenILS::Utils::BadContact;
38 use List::Util qw/max reduce/;
39
40 use UUID::Tiny qw/:std/;
41
42 sub initialize {
43     OpenILS::Application::Actor::Container->initialize();
44     OpenILS::Application::Actor::UserGroups->initialize();
45     OpenILS::Application::Actor::ClosedDates->initialize();
46 }
47
48 my $apputils = "OpenILS::Application::AppUtils";
49 my $U = $apputils;
50
51 sub _d { warn "Patron:\n" . Dumper(shift()); }
52
53 my $cache;
54 my $set_user_settings;
55 my $set_ou_settings;
56
57
58 #__PACKAGE__->register_method(
59 #   method  => "allowed_test",
60 #   api_name    => "open-ils.actor.allowed_test",
61 #);
62 #sub allowed_test {
63 #    my($self, $conn, $auth, $orgid, $permcode) = @_;
64 #    my $e = new_editor(authtoken => $auth);
65 #    return $e->die_event unless $e->checkauth;
66 #
67 #    return {
68 #        orgid => $orgid,
69 #        permcode => $permcode,
70 #        result => $e->allowed($permcode, $orgid)
71 #    };
72 #}
73
74 __PACKAGE__->register_method(
75     method  => "update_user_setting",
76     api_name    => "open-ils.actor.patron.settings.update",
77 );
78 sub update_user_setting {
79     my($self, $conn, $auth, $user_id, $settings) = @_;
80     my $e = new_editor(xact => 1, authtoken => $auth);
81     return $e->die_event unless $e->checkauth;
82
83     $user_id = $e->requestor->id unless defined $user_id;
84
85     unless($e->requestor->id == $user_id) {
86         my $user = $e->retrieve_actor_user($user_id) or return $e->die_event;
87         return $e->die_event unless $e->allowed('UPDATE_USER', $user->home_ou);
88     }
89
90     for my $name (keys %$settings) {
91         my $val = $$settings{$name};
92         my $set = $e->search_actor_user_setting({usr => $user_id, name => $name})->[0];
93
94         if(defined $val) {
95             $val = OpenSRF::Utils::JSON->perl2JSON($val);
96             if($set) {
97                 $set->value($val);
98                 $e->update_actor_user_setting($set) or return $e->die_event;
99             } else {
100                 $set = Fieldmapper::actor::user_setting->new;
101                 $set->usr($user_id);
102                 $set->name($name);
103                 $set->value($val);
104                 $e->create_actor_user_setting($set) or return $e->die_event;
105             }
106         } elsif($set) {
107             $e->delete_actor_user_setting($set) or return $e->die_event;
108         }
109     }
110
111     $e->commit;
112     return 1;
113 }
114
115
116 __PACKAGE__->register_method(
117     method    => "set_ou_settings",
118     api_name  => "open-ils.actor.org_unit.settings.update",
119     signature => {
120         desc => "Updates the value for a given org unit setting.  The permission to update "          .
121                 "an org unit setting is either the UPDATE_ORG_UNIT_SETTING_ALL, or a specific "       .
122                 "permission specified in the update_perm column of the config.org_unit_setting_type " .
123                 "table's row corresponding to the setting being changed." ,
124         params => [
125             {desc => 'Authentication token',             type => 'string'},
126             {desc => 'Org unit ID',                      type => 'number'},
127             {desc => 'Hash of setting name-value pairs', type => 'object'}
128         ],
129         return => {desc => '1 on success, Event on error'}
130     }
131 );
132
133 sub set_ou_settings {
134     my( $self, $client, $auth, $org_id, $settings ) = @_;
135
136     my $e = new_editor(authtoken => $auth, xact => 1);
137     return $e->die_event unless $e->checkauth;
138
139     my $all_allowed = $e->allowed("UPDATE_ORG_UNIT_SETTING_ALL", $org_id);
140
141     for my $name (keys %$settings) {
142         my $val = $$settings{$name};
143
144         my $type = $e->retrieve_config_org_unit_setting_type([
145             $name,
146             {flesh => 1, flesh_fields => {'coust' => ['update_perm']}}
147         ]) or return $e->die_event;
148         my $set = $e->search_actor_org_unit_setting({org_unit => $org_id, name => $name})->[0];
149
150         # If there is no relevant permission, the default assumption will
151         # be, "no, the caller cannot change that value."
152         return $e->die_event unless ($all_allowed ||
153             ($type->update_perm && $e->allowed($type->update_perm->code, $org_id)));
154
155         if(defined $val) {
156             $val = OpenSRF::Utils::JSON->perl2JSON($val);
157             if($set) {
158                 $set->value($val);
159                 $e->update_actor_org_unit_setting($set) or return $e->die_event;
160             } else {
161                 $set = Fieldmapper::actor::org_unit_setting->new;
162                 $set->org_unit($org_id);
163                 $set->name($name);
164                 $set->value($val);
165                 $e->create_actor_org_unit_setting($set) or return $e->die_event;
166             }
167         } elsif($set) {
168             $e->delete_actor_org_unit_setting($set) or return $e->die_event;
169         }
170     }
171
172     $e->commit;
173     return 1;
174 }
175
176 __PACKAGE__->register_method(
177     method   => "user_settings",
178     authoritative => 1,
179     api_name => "open-ils.actor.patron.settings.retrieve",
180 );
181 sub user_settings {
182     my( $self, $client, $auth, $user_id, $setting ) = @_;
183
184     my $e = new_editor(authtoken => $auth);
185     return $e->event unless $e->checkauth;
186     $user_id = $e->requestor->id unless defined $user_id;
187
188     my $patron = $e->retrieve_actor_user($user_id) or return $e->event;
189     if($e->requestor->id != $user_id) {
190         return $e->event unless $e->allowed('VIEW_USER', $patron->home_ou);
191     }
192
193     sub get_setting {
194         my($e, $user_id, $setting) = @_;
195         my $val = $e->search_actor_user_setting({usr => $user_id, name => $setting})->[0];
196         return undef unless $val; # XXX this should really return undef, but needs testing
197         return OpenSRF::Utils::JSON->JSON2perl($val->value);
198     }
199
200     if($setting) {
201         if(ref $setting eq 'ARRAY') {
202             my %settings;
203             $settings{$_} = get_setting($e, $user_id, $_) for @$setting;
204             return \%settings;
205         } else {
206             return get_setting($e, $user_id, $setting);    
207         }
208     } else {
209         my $s = $e->search_actor_user_setting({usr => $user_id});
210         return { map { ( $_->name => OpenSRF::Utils::JSON->JSON2perl($_->value) ) } @$s };
211     }
212 }
213
214
215 __PACKAGE__->register_method(
216     method    => "ranged_ou_settings",
217     api_name  => "open-ils.actor.org_unit_setting.values.ranged.retrieve",
218     signature => {
219         desc   => "Retrieves all org unit settings for the given org_id, up to whatever limit " .
220                   "is implied for retrieving OU settings by the authenticated users' permissions.",
221         params => [
222             {desc => 'Authentication token',   type => 'string'},
223             {desc => 'Org unit ID',            type => 'number'},
224         ],
225         return => {desc => 'A hashref of "ranged" settings, event on error'}
226     }
227 );
228 sub ranged_ou_settings {
229     my( $self, $client, $auth, $org_id ) = @_;
230
231     my $e = new_editor(authtoken => $auth);
232     return $e->event unless $e->checkauth;
233
234     my %ranged_settings;
235     my $org_list = $U->get_org_ancestors($org_id);
236     my $settings = $e->search_actor_org_unit_setting({org_unit => $org_list});
237     $org_list = [ reverse @$org_list ];
238
239     # start at the context org and capture the setting value
240     # without clobbering settings we've already captured
241     for my $this_org_id (@$org_list) {
242         
243         my @sets = grep { $_->org_unit == $this_org_id } @$settings;
244
245         for my $set (@sets) {
246             my $type = $e->retrieve_config_org_unit_setting_type([
247                 $set->name,
248                 {flesh => 1, flesh_fields => {coust => ['view_perm']}}
249             ]);
250
251             # If there is no relevant permission, the default assumption will
252             # be, "yes, the caller can have that value."
253             if ($type && $type->view_perm) {
254                 next if not $e->allowed($type->view_perm->code, $org_id);
255             }
256
257             $ranged_settings{$set->name} = OpenSRF::Utils::JSON->JSON2perl($set->value)
258                 unless defined $ranged_settings{$set->name};
259         }
260     }
261
262     return \%ranged_settings;
263 }
264
265
266
267 __PACKAGE__->register_method(
268     api_name  => 'open-ils.actor.ou_setting.ancestor_default',
269     method    => 'ou_ancestor_setting',
270     signature => {
271         desc => 'Get the org unit setting value associated with the setting name as seen from the specified org unit.  ' .
272                 'This method will make sure that the given user has permission to view that setting, if there is a '     .
273                 'permission associated with the setting.  If a permission is required and no authtoken is given, or '     .
274                 'the user lacks the permisssion, undef will be returned.'       ,
275         params => [
276             { desc => 'Org unit ID',          type => 'number' },
277             { desc => 'setting name',         type => 'string' },
278             { desc => 'authtoken (optional)', type => 'string' }
279         ],
280         return => {desc => 'A value for the org unit setting, or undef'}
281     }
282 );
283
284 # ------------------------------------------------------------------
285 # Attempts to find the org setting value for a given org.  if not 
286 # found at the requested org, searches up the org tree until it 
287 # finds a parent that has the requested setting.
288 # when found, returns { org => $id, value => $value }
289 # otherwise, returns NULL
290 # ------------------------------------------------------------------
291 sub ou_ancestor_setting {
292     my( $self, $client, $orgid, $name, $auth ) = @_;
293     # Make sure $auth is set to something if not given.
294     $auth ||= -1;
295     return $U->ou_ancestor_setting($orgid, $name, undef, $auth);
296 }
297
298 __PACKAGE__->register_method(
299     api_name  => 'open-ils.actor.ou_setting.ancestor_default.batch',
300     method    => 'ou_ancestor_setting_batch',
301     signature => {
302         desc => 'Get org unit setting name => value pairs for a list of names, as seen from the specified org unit.  ' .
303                 'This method will make sure that the given user has permission to view that setting, if there is a '     .
304                 'permission associated with the setting.  If a permission is required and no authtoken is given, or '     .
305                 'the user lacks the permisssion, undef will be returned.'       ,
306         params => [
307             { desc => 'Org unit ID',          type => 'number' },
308             { desc => 'setting name list',    type => 'array'  },
309             { desc => 'authtoken (optional)', type => 'string' }
310         ],
311         return => {desc => 'A hash with name => value pairs for the org unit settings'}
312     }
313 );
314 sub ou_ancestor_setting_batch {
315     my( $self, $client, $orgid, $name_list, $auth ) = @_;
316     # Make sure $auth is set to something if not given.
317     $auth ||= -1;
318     my %values;
319     $values{$_} = $U->ou_ancestor_setting($orgid, $_, undef, $auth) for @$name_list;
320     return \%values;
321 }
322
323
324
325 __PACKAGE__->register_method(
326     method   => "update_patron",
327     api_name => "open-ils.actor.patron.update",
328     signature => {
329         desc   => q/
330             Update an existing user, or create a new one.  Related objects,
331             like cards, addresses, survey responses, and stat cats, 
332             can be updated by attaching them to the user object in their
333             respective fields.  For examples, the billing address object
334             may be inserted into the 'billing_address' field, etc.  For each 
335             attached object, indicate if the object should be created, 
336             updated, or deleted using the built-in 'isnew', 'ischanged', 
337             and 'isdeleted' fields on the object.
338         /,
339         params => [
340             { desc => 'Authentication token', type => 'string' },
341             { desc => 'Patron data object',   type => 'object' }
342         ],
343         return => {desc => 'A fleshed user object, event on error'}
344     }
345 );
346
347 sub update_patron {
348     my( $self, $client, $user_session, $patron ) = @_;
349
350     my $session = $apputils->start_db_session();
351
352     $logger->info($patron->isnew ? "Creating new patron..." : "Updating Patron: " . $patron->id);
353
354     my( $user_obj, $evt ) = $U->checkses($user_session);
355     return $evt if $evt;
356
357     $evt = check_group_perm($session, $user_obj, $patron);
358     return $evt if $evt;
359
360     $apputils->set_audit_info($session, $user_session, $user_obj->id, $user_obj->wsid);
361
362     # $new_patron is the patron in progress.  $patron is the original patron
363     # passed in with the method.  new_patron will change as the components
364     # of patron are added/updated.
365
366     my $new_patron;
367
368     # unflesh the real items on the patron
369     $patron->card( $patron->card->id ) if(ref($patron->card));
370     $patron->billing_address( $patron->billing_address->id ) 
371         if(ref($patron->billing_address));
372     $patron->mailing_address( $patron->mailing_address->id ) 
373         if(ref($patron->mailing_address));
374
375     # create/update the patron first so we can use his id
376
377     # $patron is the obj from the client (new data) and $new_patron is the
378     # patron object properly built for db insertion, so we need a third variable
379     # if we want to represent the old patron.
380
381     my $old_patron;
382     my $barred_hook = '';
383
384     if($patron->isnew()) {
385         ( $new_patron, $evt ) = _add_patron($session, _clone_patron($patron), $user_obj);
386         return $evt if $evt;
387         if($U->is_true($patron->barred)) {
388             $evt = $U->check_perms($user_obj->id, $patron->home_ou, 'BAR_PATRON');
389             return $evt if $evt;
390         }
391     } else {
392         $new_patron = $patron;
393
394         # Did auth checking above already.
395         my $e = new_editor;
396         $old_patron = $e->retrieve_actor_user($patron->id) or
397             return $e->die_event;
398         $e->disconnect;
399         if($U->is_true($old_patron->barred) != $U->is_true($new_patron->barred)) {
400             $evt = $U->check_perms($user_obj->id, $patron->home_ou, $U->is_true($old_patron->barred) ? 'UNBAR_PATRON' : 'BAR_PATRON');
401             return $evt if $evt;
402
403             $barred_hook = $U->is_true($new_patron->barred) ? 
404                 'au.barred' : 'au.unbarred';
405         }
406     }
407
408     ( $new_patron, $evt ) = _add_update_addresses($session, $patron, $new_patron, $user_obj);
409     return $evt if $evt;
410
411     ( $new_patron, $evt ) = _add_update_cards($session, $patron, $new_patron, $user_obj);
412     return $evt if $evt;
413
414     ( $new_patron, $evt ) = _add_survey_responses($session, $patron, $new_patron, $user_obj);
415     return $evt if $evt;
416
417     # re-update the patron if anything has happened to him during this process
418     if($new_patron->ischanged()) {
419         ( $new_patron, $evt ) = _update_patron($session, $new_patron, $user_obj);
420         return $evt if $evt;
421     }
422
423     ( $new_patron, $evt ) = _clear_badcontact_penalties($session, $old_patron, $new_patron, $user_obj);
424     return $evt if $evt;
425
426     ($new_patron, $evt) = _create_stat_maps($session, $user_session, $patron, $new_patron, $user_obj);
427     return $evt if $evt;
428
429     ($new_patron, $evt) = _create_perm_maps($session, $user_session, $patron, $new_patron, $user_obj);
430     return $evt if $evt;
431
432     $apputils->commit_db_session($session);
433
434     $evt = apply_invalid_addr_penalty($patron);
435     return $evt if $evt;
436
437     my $tses = OpenSRF::AppSession->create('open-ils.trigger');
438     if($patron->isnew) {
439         $tses->request('open-ils.trigger.event.autocreate', 'au.create', $new_patron, $new_patron->home_ou);
440     } else {
441         $tses->request('open-ils.trigger.event.autocreate', 'au.update', $new_patron, $new_patron->home_ou);
442
443         $tses->request('open-ils.trigger.event.autocreate', $barred_hook, 
444             $new_patron, $new_patron->home_ou) if $barred_hook;
445     }
446
447     return flesh_user($new_patron->id(), new_editor(requestor => $user_obj, xact => 1));
448 }
449
450 sub apply_invalid_addr_penalty {
451     my $patron = shift;
452     my $e = new_editor(xact => 1);
453
454     # grab the invalid address penalty if set
455     my $penalties = OpenILS::Utils::Penalty->retrieve_usr_penalties($e, $patron->id, $patron->home_ou);
456
457     my ($addr_penalty) = grep 
458         { $_->standing_penalty->name eq 'INVALID_PATRON_ADDRESS' } @$penalties;
459     
460     # do we enforce invalid address penalty
461     my $enforce = $U->ou_ancestor_setting_value(
462         $patron->home_ou, 'circ.patron_invalid_address_apply_penalty') || 0;
463
464     my $addrs = $e->search_actor_user_address(
465         {usr => $patron->id, valid => 'f', id => {'>' => 0}}, {idlist => 1});
466     my $addr_count = scalar(@$addrs);
467
468     if($addr_count == 0 and $addr_penalty) {
469
470         # regardless of any settings, remove the penalty when the user has no invalid addresses
471         $e->delete_actor_user_standing_penalty($addr_penalty) or return $e->die_event;
472         $e->commit;
473
474     } elsif($enforce and $addr_count > 0 and !$addr_penalty) {
475         
476         my $ptype = $e->retrieve_config_standing_penalty(29) or return $e->die_event;
477         my $depth = $ptype->org_depth;
478         my $ctx_org = $U->org_unit_ancestor_at_depth($patron->home_ou, $depth) if defined $depth;
479         $ctx_org = $patron->home_ou unless defined $ctx_org;
480         
481         my $penalty = Fieldmapper::actor::user_standing_penalty->new;
482         $penalty->usr($patron->id);
483         $penalty->org_unit($ctx_org);
484         $penalty->standing_penalty(OILS_PENALTY_INVALID_PATRON_ADDRESS);
485
486         $e->create_actor_user_standing_penalty($penalty) or return $e->die_event;
487         $e->commit;
488
489     } else {
490         $e->rollback;
491     }
492
493     return undef;
494 }
495
496
497 sub flesh_user {
498     my $id = shift;
499     my $e = shift;
500     my $home_ou = shift;
501
502     my $fields = [
503         "cards",
504         "card",
505         "standing_penalties",
506         "addresses",
507         "billing_address",
508         "mailing_address",
509         "stat_cat_entries",
510         "settings",
511         "usr_activity"
512     ];
513     push @$fields, "home_ou" if $home_ou;
514     return new_flesh_user($id, $fields, $e );
515 }
516
517
518
519
520
521
522 # clone and clear stuff that would break the database
523 sub _clone_patron {
524     my $patron = shift;
525
526     my $new_patron = $patron->clone;
527     # clear these
528     $new_patron->clear_billing_address();
529     $new_patron->clear_mailing_address();
530     $new_patron->clear_addresses();
531     $new_patron->clear_card();
532     $new_patron->clear_cards();
533     $new_patron->clear_id();
534     $new_patron->clear_isnew();
535     $new_patron->clear_ischanged();
536     $new_patron->clear_isdeleted();
537     $new_patron->clear_stat_cat_entries();
538     $new_patron->clear_permissions();
539     $new_patron->clear_standing_penalties();
540
541     return $new_patron;
542 }
543
544
545 sub _add_patron {
546
547     my $session     = shift;
548     my $patron      = shift;
549     my $user_obj    = shift;
550
551     my $evt = $U->check_perms($user_obj->id, $patron->home_ou, 'CREATE_USER');
552     return (undef, $evt) if $evt;
553
554     my $ex = $session->request(
555         'open-ils.storage.direct.actor.user.search.usrname', $patron->usrname())->gather(1);
556     if( $ex and @$ex ) {
557         return (undef, OpenILS::Event->new('USERNAME_EXISTS'));
558     }
559
560     $logger->info("Creating new user in the DB with username: ".$patron->usrname());
561
562     my $id = $session->request(
563         "open-ils.storage.direct.actor.user.create", $patron)->gather(1);
564     return (undef, $U->DB_UPDATE_FAILED($patron)) unless $id;
565
566     $logger->info("Successfully created new user [$id] in DB");
567
568     return ( $session->request( 
569         "open-ils.storage.direct.actor.user.retrieve", $id)->gather(1), undef );
570 }
571
572
573 sub check_group_perm {
574     my( $session, $requestor, $patron ) = @_;
575     my $evt;
576
577     # first let's see if the requestor has 
578     # priveleges to update this user in any way
579     if( ! $patron->isnew ) {
580         my $p = $session->request(
581             'open-ils.storage.direct.actor.user.retrieve', $patron->id )->gather(1);
582
583         # If we are the requestor (trying to update our own account)
584         # and we are not trying to change our profile, we're good
585         if( $p->id == $requestor->id and 
586                 $p->profile == $patron->profile ) {
587             return undef;
588         }
589
590
591         $evt = group_perm_failed($session, $requestor, $p);
592         return $evt if $evt;
593     }
594
595     # They are allowed to edit this patron.. can they put the 
596     # patron into the group requested?
597     $evt = group_perm_failed($session, $requestor, $patron);
598     return $evt if $evt;
599     return undef;
600 }
601
602
603 sub group_perm_failed {
604     my( $session, $requestor, $patron ) = @_;
605
606     my $perm;
607     my $grp;
608     my $grpid = $patron->profile;
609
610     do {
611
612         $logger->debug("user update looking for group perm for group $grpid");
613         $grp = $session->request(
614             'open-ils.storage.direct.permission.grp_tree.retrieve', $grpid )->gather(1);
615         return OpenILS::Event->new('PERMISSION_GRP_TREE_NOT_FOUND') unless $grp;
616
617     } while( !($perm = $grp->application_perm) and ($grpid = $grp->parent) );
618
619     $logger->info("user update checking perm $perm on user ".
620         $requestor->id." for update/create on user username=".$patron->usrname);
621
622     my $evt = $U->check_perms($requestor->id, $patron->home_ou, $perm);
623     return $evt if $evt;
624     return undef;
625 }
626
627
628
629 sub _update_patron {
630     my( $session, $patron, $user_obj, $noperm) = @_;
631
632     $logger->info("Updating patron ".$patron->id." in DB");
633
634     my $evt;
635
636     if(!$noperm) {
637         $evt = $U->check_perms($user_obj->id, $patron->home_ou, 'UPDATE_USER');
638         return (undef, $evt) if $evt;
639     }
640
641     # update the password by itself to avoid the password protection magic
642     if( $patron->passwd ) {
643         my $s = $session->request(
644             'open-ils.storage.direct.actor.user.remote_update',
645             {id => $patron->id}, {passwd => $patron->passwd})->gather(1);
646         return (undef, $U->DB_UPDATE_FAILED($patron)) unless defined($s);
647         $patron->clear_passwd;
648     }
649
650     if(!$patron->ident_type) {
651         $patron->clear_ident_type;
652         $patron->clear_ident_value;
653     }
654
655     $evt = verify_last_xact($session, $patron);
656     return (undef, $evt) if $evt;
657
658     my $stat = $session->request(
659         "open-ils.storage.direct.actor.user.update",$patron )->gather(1);
660     return (undef, $U->DB_UPDATE_FAILED($patron)) unless defined($stat);
661
662     return ($patron);
663 }
664
665 sub verify_last_xact {
666     my( $session, $patron ) = @_;
667     return undef unless $patron->id and $patron->id > 0;
668     my $p = $session->request(
669         'open-ils.storage.direct.actor.user.retrieve', $patron->id)->gather(1);
670     my $xact = $p->last_xact_id;
671     return undef unless $xact;
672     $logger->info("user xact = $xact, saving with xact " . $patron->last_xact_id);
673     return OpenILS::Event->new('XACT_COLLISION')
674         if $xact ne $patron->last_xact_id;
675     return undef;
676 }
677
678
679 sub _check_dup_ident {
680     my( $session, $patron ) = @_;
681
682     return undef unless $patron->ident_value;
683
684     my $search = {
685         ident_type  => $patron->ident_type, 
686         ident_value => $patron->ident_value,
687     };
688
689     $logger->debug("patron update searching for dup ident values: " . 
690         $patron->ident_type . ':' . $patron->ident_value);
691
692     $search->{id} = {'!=' => $patron->id} if $patron->id and $patron->id > 0;
693
694     my $dups = $session->request(
695         'open-ils.storage.direct.actor.user.search_where.atomic', $search )->gather(1);
696
697
698     return OpenILS::Event->new('PATRON_DUP_IDENT1', payload => $patron )
699         if $dups and @$dups;
700
701     return undef;
702 }
703
704
705 sub _add_update_addresses {
706
707     my $session = shift;
708     my $patron = shift;
709     my $new_patron = shift;
710
711     my $evt;
712
713     my $current_id; # id of the address before creation
714
715     my $addresses = $patron->addresses();
716
717     for my $address (@$addresses) {
718
719         next unless ref $address;
720         $current_id = $address->id();
721
722         if( $patron->billing_address() and
723             $patron->billing_address() == $current_id ) {
724             $logger->info("setting billing addr to $current_id");
725             $new_patron->billing_address($address->id());
726             $new_patron->ischanged(1);
727         }
728     
729         if( $patron->mailing_address() and
730             $patron->mailing_address() == $current_id ) {
731             $new_patron->mailing_address($address->id());
732             $logger->info("setting mailing addr to $current_id");
733             $new_patron->ischanged(1);
734         }
735
736
737         if($address->isnew()) {
738
739             $address->usr($new_patron->id());
740
741             ($address, $evt) = _add_address($session,$address);
742             return (undef, $evt) if $evt;
743
744             # we need to get the new id
745             if( $patron->billing_address() and 
746                     $patron->billing_address() == $current_id ) {
747                 $new_patron->billing_address($address->id());
748                 $logger->info("setting billing addr to $current_id");
749                 $new_patron->ischanged(1);
750             }
751
752             if( $patron->mailing_address() and
753                     $patron->mailing_address() == $current_id ) {
754                 $new_patron->mailing_address($address->id());
755                 $logger->info("setting mailing addr to $current_id");
756                 $new_patron->ischanged(1);
757             }
758
759         } elsif($address->ischanged() ) {
760
761             ($address, $evt) = _update_address($session, $address);
762             return (undef, $evt) if $evt;
763
764         } elsif($address->isdeleted() ) {
765
766             if( $address->id() == $new_patron->mailing_address() ) {
767                 $new_patron->clear_mailing_address();
768                 ($new_patron, $evt) = _update_patron($session, $new_patron);
769                 return (undef, $evt) if $evt;
770             }
771
772             if( $address->id() == $new_patron->billing_address() ) {
773                 $new_patron->clear_billing_address();
774                 ($new_patron, $evt) = _update_patron($session, $new_patron);
775                 return (undef, $evt) if $evt;
776             }
777
778             $evt = _delete_address($session, $address);
779             return (undef, $evt) if $evt;
780         } 
781     }
782
783     return ( $new_patron, undef );
784 }
785
786
787 # adds an address to the db and returns the address with new id
788 sub _add_address {
789     my($session, $address) = @_;
790     $address->clear_id();
791
792     $logger->info("Creating new address at street ".$address->street1);
793
794     # put the address into the database
795     my $id = $session->request(
796         "open-ils.storage.direct.actor.user_address.create", $address )->gather(1);
797     return (undef, $U->DB_UPDATE_FAILED($address)) unless $id;
798
799     $address->id( $id );
800     return ($address, undef);
801 }
802
803
804 sub _update_address {
805     my( $session, $address ) = @_;
806
807     $logger->info("Updating address ".$address->id." in the DB");
808
809     my $stat = $session->request(
810         "open-ils.storage.direct.actor.user_address.update", $address )->gather(1);
811
812     return (undef, $U->DB_UPDATE_FAILED($address)) unless defined($stat);
813     return ($address, undef);
814 }
815
816
817
818 sub _add_update_cards {
819
820     my $session = shift;
821     my $patron = shift;
822     my $new_patron = shift;
823
824     my $evt;
825
826     my $virtual_id; #id of the card before creation
827
828     my $cards = $patron->cards();
829     for my $card (@$cards) {
830
831         $card->usr($new_patron->id());
832
833         if(ref($card) and $card->isnew()) {
834
835             $virtual_id = $card->id();
836             ( $card, $evt ) = _add_card($session,$card);
837             return (undef, $evt) if $evt;
838
839             #if(ref($patron->card)) { $patron->card($patron->card->id); }
840             if($patron->card() == $virtual_id) {
841                 $new_patron->card($card->id());
842                 $new_patron->ischanged(1);
843             }
844
845         } elsif( ref($card) and $card->ischanged() ) {
846             $evt = _update_card($session, $card);
847             return (undef, $evt) if $evt;
848         }
849     }
850
851     return ( $new_patron, undef );
852 }
853
854
855 # adds an card to the db and returns the card with new id
856 sub _add_card {
857     my( $session, $card ) = @_;
858     $card->clear_id();
859
860     $logger->info("Adding new patron card ".$card->barcode);
861
862     my $id = $session->request(
863         "open-ils.storage.direct.actor.card.create", $card )->gather(1);
864     return (undef, $U->DB_UPDATE_FAILED($card)) unless $id;
865     $logger->info("Successfully created patron card $id");
866
867     $card->id($id);
868     return ( $card, undef );
869 }
870
871
872 # returns event on error.  returns undef otherwise
873 sub _update_card {
874     my( $session, $card ) = @_;
875     $logger->info("Updating patron card ".$card->id);
876
877     my $stat = $session->request(
878         "open-ils.storage.direct.actor.card.update", $card )->gather(1);
879     return $U->DB_UPDATE_FAILED($card) unless defined($stat);
880     return undef;
881 }
882
883
884
885
886 # returns event on error.  returns undef otherwise
887 sub _delete_address {
888     my( $session, $address ) = @_;
889
890     $logger->info("Deleting address ".$address->id." from DB");
891
892     my $stat = $session->request(
893         "open-ils.storage.direct.actor.user_address.delete", $address )->gather(1);
894
895     return $U->DB_UPDATE_FAILED($address) unless defined($stat);
896     return undef;
897 }
898
899
900
901 sub _add_survey_responses {
902     my ($session, $patron, $new_patron) = @_;
903
904     $logger->info( "Updating survey responses for patron ".$new_patron->id );
905
906     my $responses = $patron->survey_responses;
907
908     if($responses) {
909
910         $_->usr($new_patron->id) for (@$responses);
911
912         my $evt = $U->simplereq( "open-ils.circ", 
913             "open-ils.circ.survey.submit.user_id", $responses );
914
915         return (undef, $evt) if defined($U->event_code($evt));
916
917     }
918
919     return ( $new_patron, undef );
920 }
921
922 sub _clear_badcontact_penalties {
923     my ($session, $old_patron, $new_patron, $user_obj) = @_;
924
925     return ($new_patron, undef) unless $old_patron;
926
927     my $PNM = $OpenILS::Utils::BadContact::PENALTY_NAME_MAP;
928     my $e = new_editor(xact => 1);
929
930     # This ignores whether the caller of update_patron has any permission
931     # to remove penalties, but these penalties no longer make sense
932     # if an email address field (for example) is changed (and the caller must
933     # have perms to do *that*) so there's no reason not to clear the penalties.
934
935     my $bad_contact_penalties = $e->search_actor_user_standing_penalty([
936         {
937             "+csp" => {"name" => [values(%$PNM)]},
938             "+ausp" => {"stop_date" => undef, "usr" => $new_patron->id}
939         }, {
940             "join" => {"csp" => {}},
941             "flesh" => 1,
942             "flesh_fields" => {"ausp" => ["standing_penalty"]}
943         }
944     ]) or return (undef, $e->die_event);
945
946     return ($new_patron, undef) unless @$bad_contact_penalties;
947
948     my @penalties_to_clear;
949     my ($field, $penalty_name);
950
951     # For each field that might have an associated bad contact penalty, 
952     # check for such penalties and add them to the to-clear list if that
953     # field has changed.
954     while (($field, $penalty_name) = each(%$PNM)) {
955         if ($old_patron->$field ne $new_patron->$field) {
956             push @penalties_to_clear, grep {
957                 $_->standing_penalty->name eq $penalty_name
958             } @$bad_contact_penalties;
959         }
960     }
961
962     foreach (@penalties_to_clear) {
963         # Note that this "archives" penalties, in the terminology of the staff
964         # client, instead of just deleting them.  This may assist reporting,
965         # or preserving old contact information when it is still potentially
966         # of interest.
967         $_->standing_penalty($_->standing_penalty->id); # deflesh
968         $_->stop_date('now');
969         $e->update_actor_user_standing_penalty($_) or return (undef, $e->die_event);
970     }
971
972     $e->commit;
973     return ($new_patron, undef);
974 }
975
976
977 sub _create_stat_maps {
978
979     my($session, $user_session, $patron, $new_patron) = @_;
980
981     my $maps = $patron->stat_cat_entries();
982
983     for my $map (@$maps) {
984
985         my $method = "open-ils.storage.direct.actor.stat_cat_entry_user_map.update";
986
987         if ($map->isdeleted()) {
988             $method = "open-ils.storage.direct.actor.stat_cat_entry_user_map.delete";
989
990         } elsif ($map->isnew()) {
991             $method = "open-ils.storage.direct.actor.stat_cat_entry_user_map.create";
992             $map->clear_id;
993         }
994
995
996         $map->target_usr($new_patron->id);
997
998         #warn "
999         $logger->info("Updating stat entry with method $method and map $map");
1000
1001         my $stat = $session->request($method, $map)->gather(1);
1002         return (undef, $U->DB_UPDATE_FAILED($map)) unless defined($stat);
1003
1004     }
1005
1006     return ($new_patron, undef);
1007 }
1008
1009 sub _create_perm_maps {
1010
1011     my($session, $user_session, $patron, $new_patron) = @_;
1012
1013     my $maps = $patron->permissions;
1014
1015     for my $map (@$maps) {
1016
1017         my $method = "open-ils.storage.direct.permission.usr_perm_map.update";
1018         if ($map->isdeleted()) {
1019             $method = "open-ils.storage.direct.permission.usr_perm_map.delete";
1020         } elsif ($map->isnew()) {
1021             $method = "open-ils.storage.direct.permission.usr_perm_map.create";
1022             $map->clear_id;
1023         }
1024
1025
1026         $map->usr($new_patron->id);
1027
1028         #warn( "Updating permissions with method $method and session $user_session and map $map" );
1029         $logger->info( "Updating permissions with method $method and map $map" );
1030
1031         my $stat = $session->request($method, $map)->gather(1);
1032         return (undef, $U->DB_UPDATE_FAILED($map)) unless defined($stat);
1033
1034     }
1035
1036     return ($new_patron, undef);
1037 }
1038
1039
1040 __PACKAGE__->register_method(
1041     method   => "set_user_work_ous",
1042     api_name => "open-ils.actor.user.work_ous.update",
1043 );
1044
1045 sub set_user_work_ous {
1046     my $self   = shift;
1047     my $client = shift;
1048     my $ses    = shift;
1049     my $maps   = shift;
1050
1051     my( $requestor, $evt ) = $apputils->checksesperm( $ses, 'ASSIGN_WORK_ORG_UNIT' );
1052     return $evt if $evt;
1053
1054     my $session = $apputils->start_db_session();
1055     $apputils->set_audit_info($session, $ses, $requestor->id, $requestor->wsid);
1056
1057     for my $map (@$maps) {
1058
1059         my $method = "open-ils.storage.direct.permission.usr_work_ou_map.update";
1060         if ($map->isdeleted()) {
1061             $method = "open-ils.storage.direct.permission.usr_work_ou_map.delete";
1062         } elsif ($map->isnew()) {
1063             $method = "open-ils.storage.direct.permission.usr_work_ou_map.create";
1064             $map->clear_id;
1065         }
1066
1067         #warn( "Updating permissions with method $method and session $ses and map $map" );
1068         $logger->info( "Updating work_ou map with method $method and map $map" );
1069
1070         my $stat = $session->request($method, $map)->gather(1);
1071         $logger->warn( "update failed: ".$U->DB_UPDATE_FAILED($map) ) unless defined($stat);
1072
1073     }
1074
1075     $apputils->commit_db_session($session);
1076
1077     return scalar(@$maps);
1078 }
1079
1080
1081 __PACKAGE__->register_method(
1082     method   => "set_user_perms",
1083     api_name => "open-ils.actor.user.permissions.update",
1084 );
1085
1086 sub set_user_perms {
1087     my $self = shift;
1088     my $client = shift;
1089     my $ses = shift;
1090     my $maps = shift;
1091
1092     my $session = $apputils->start_db_session();
1093
1094     my( $user_obj, $evt ) = $U->checkses($ses);
1095     return $evt if $evt;
1096     $apputils->set_audit_info($session, $ses, $user_obj->id, $user_obj->wsid);
1097
1098     my $perms = $session->request('open-ils.storage.permission.user_perms.atomic', $user_obj->id)->gather(1);
1099
1100     my $all = undef;
1101     $all = 1 if ($U->is_true($user_obj->super_user()));
1102     $all = 1 unless ($U->check_perms($user_obj->id, $user_obj->home_ou, 'EVERYTHING'));
1103
1104     for my $map (@$maps) {
1105
1106         my $method = "open-ils.storage.direct.permission.usr_perm_map.update";
1107         if ($map->isdeleted()) {
1108             $method = "open-ils.storage.direct.permission.usr_perm_map.delete";
1109         } elsif ($map->isnew()) {
1110             $method = "open-ils.storage.direct.permission.usr_perm_map.create";
1111             $map->clear_id;
1112         }
1113
1114         next if (!$all and !grep { $_->perm eq $map->perm and $U->is_true($_->grantable) and $_->depth <= $map->depth } @$perms);
1115         #warn( "Updating permissions with method $method and session $ses and map $map" );
1116         $logger->info( "Updating permissions with method $method and map $map" );
1117
1118         my $stat = $session->request($method, $map)->gather(1);
1119         $logger->warn( "update failed: ".$U->DB_UPDATE_FAILED($map) ) unless defined($stat);
1120
1121     }
1122
1123     $apputils->commit_db_session($session);
1124
1125     return scalar(@$maps);
1126 }
1127
1128
1129 __PACKAGE__->register_method(
1130     method  => "user_retrieve_by_barcode",
1131     authoritative => 1,
1132     api_name    => "open-ils.actor.user.fleshed.retrieve_by_barcode",);
1133
1134 sub user_retrieve_by_barcode {
1135     my($self, $client, $auth, $barcode, $flesh_home_ou) = @_;
1136
1137     my $e = new_editor(authtoken => $auth);
1138     return $e->event unless $e->checkauth;
1139
1140     my $card = $e->search_actor_card({barcode => $barcode})->[0]
1141         or return $e->event;
1142
1143     my $user = flesh_user($card->usr, $e, $flesh_home_ou);
1144     return $e->event unless $e->allowed(
1145         "VIEW_USER", $flesh_home_ou ? $user->home_ou->id : $user->home_ou
1146     );
1147     return $user;
1148 }
1149
1150
1151
1152 __PACKAGE__->register_method(
1153     method        => "get_user_by_id",
1154     authoritative => 1,
1155     api_name      => "open-ils.actor.user.retrieve",
1156 );
1157
1158 sub get_user_by_id {
1159     my ($self, $client, $auth, $id) = @_;
1160     my $e = new_editor(authtoken=>$auth);
1161     return $e->event unless $e->checkauth;
1162     my $user = $e->retrieve_actor_user($id) or return $e->event;
1163     return $e->event unless $e->allowed('VIEW_USER', $user->home_ou);   
1164     return $user;
1165 }
1166
1167
1168 __PACKAGE__->register_method(
1169     method   => "get_org_types",
1170     api_name => "open-ils.actor.org_types.retrieve",
1171 );
1172 sub get_org_types {
1173     return $U->get_org_types();
1174 }
1175
1176
1177 __PACKAGE__->register_method(
1178     method   => "get_user_ident_types",
1179     api_name => "open-ils.actor.user.ident_types.retrieve",
1180 );
1181 my $ident_types;
1182 sub get_user_ident_types {
1183     return $ident_types if $ident_types;
1184     return $ident_types = 
1185         new_editor()->retrieve_all_config_identification_type();
1186 }
1187
1188
1189 __PACKAGE__->register_method(
1190     method   => "get_org_unit",
1191     api_name => "open-ils.actor.org_unit.retrieve",
1192 );
1193
1194 sub get_org_unit {
1195     my( $self, $client, $user_session, $org_id ) = @_;
1196     my $e = new_editor(authtoken => $user_session);
1197     if(!$org_id) {
1198         return $e->event unless $e->checkauth;
1199         $org_id = $e->requestor->ws_ou;
1200     }
1201     my $o = $e->retrieve_actor_org_unit($org_id)
1202         or return $e->event;
1203     return $o;
1204 }
1205
1206 __PACKAGE__->register_method(
1207     method   => "search_org_unit",
1208     api_name => "open-ils.actor.org_unit_list.search",
1209 );
1210
1211 sub search_org_unit {
1212
1213     my( $self, $client, $field, $value ) = @_;
1214
1215     my $list = OpenILS::Application::AppUtils->simple_scalar_request(
1216         "open-ils.cstore",
1217         "open-ils.cstore.direct.actor.org_unit.search.atomic", 
1218         { $field => $value } );
1219
1220     return $list;
1221 }
1222
1223
1224 # build the org tree
1225
1226 __PACKAGE__->register_method(
1227     method  => "get_org_tree",
1228     api_name    => "open-ils.actor.org_tree.retrieve",
1229     argc        => 0, 
1230     note        => "Returns the entire org tree structure",
1231 );
1232
1233 sub get_org_tree {
1234     my $self = shift;
1235     my $client = shift;
1236     return $U->get_org_tree($client->session->session_locale);
1237 }
1238
1239
1240 __PACKAGE__->register_method(
1241     method  => "get_org_descendants",
1242     api_name    => "open-ils.actor.org_tree.descendants.retrieve"
1243 );
1244
1245 # depth is optional.  org_unit is the id
1246 sub get_org_descendants {
1247     my( $self, $client, $org_unit, $depth ) = @_;
1248
1249     if(ref $org_unit eq 'ARRAY') {
1250         $depth ||= [];
1251         my @trees;
1252         for my $i (0..scalar(@$org_unit)-1) {
1253             my $list = $U->simple_scalar_request(
1254                 "open-ils.storage", 
1255                 "open-ils.storage.actor.org_unit.descendants.atomic",
1256                 $org_unit->[$i], $depth->[$i] );
1257             push(@trees, $U->build_org_tree($list));
1258         }
1259         return \@trees;
1260
1261     } else {
1262         my $orglist = $apputils->simple_scalar_request(
1263                 "open-ils.storage", 
1264                 "open-ils.storage.actor.org_unit.descendants.atomic",
1265                 $org_unit, $depth );
1266         return $U->build_org_tree($orglist);
1267     }
1268 }
1269
1270
1271 __PACKAGE__->register_method(
1272     method  => "get_org_ancestors",
1273     api_name    => "open-ils.actor.org_tree.ancestors.retrieve"
1274 );
1275
1276 # depth is optional.  org_unit is the id
1277 sub get_org_ancestors {
1278     my( $self, $client, $org_unit, $depth ) = @_;
1279     my $orglist = $apputils->simple_scalar_request(
1280             "open-ils.storage", 
1281             "open-ils.storage.actor.org_unit.ancestors.atomic",
1282             $org_unit, $depth );
1283     return $U->build_org_tree($orglist);
1284 }
1285
1286
1287 __PACKAGE__->register_method(
1288     method  => "get_standings",
1289     api_name    => "open-ils.actor.standings.retrieve"
1290 );
1291
1292 my $user_standings;
1293 sub get_standings {
1294     return $user_standings if $user_standings;
1295     return $user_standings = 
1296         $apputils->simple_scalar_request(
1297             "open-ils.cstore",
1298             "open-ils.cstore.direct.config.standing.search.atomic",
1299             { id => { "!=" => undef } }
1300         );
1301 }
1302
1303
1304 __PACKAGE__->register_method(
1305     method   => "get_my_org_path",
1306     api_name => "open-ils.actor.org_unit.full_path.retrieve"
1307 );
1308
1309 sub get_my_org_path {
1310     my( $self, $client, $auth, $org_id ) = @_;
1311     my $e = new_editor(authtoken=>$auth);
1312     return $e->event unless $e->checkauth;
1313     $org_id = $e->requestor->ws_ou unless defined $org_id;
1314
1315     return $apputils->simple_scalar_request(
1316         "open-ils.storage",
1317         "open-ils.storage.actor.org_unit.full_path.atomic",
1318         $org_id );
1319 }
1320
1321
1322 __PACKAGE__->register_method(
1323     method   => "patron_adv_search",
1324     api_name => "open-ils.actor.patron.search.advanced"
1325 );
1326
1327 __PACKAGE__->register_method(
1328     method   => "patron_adv_search",
1329     api_name => "open-ils.actor.patron.search.advanced.fleshed",
1330     stream => 1,
1331     # TODO: change when opensrf 'bundling' is merged.
1332     # set a relatively small bundle size so the caller can start
1333     # seeing results fairly quickly
1334     max_chunk_size => 4096, # bundling
1335
1336     # api_level => 2, 
1337     # pending opensrf work -- also, not sure if needed since we're not
1338     # actaully creating an alternate vesrion, only offering to return a
1339     # different format.
1340     #
1341     signature => {
1342         desc => q/Returns a stream of fleshed user objects instead of
1343             a pile of identifiers/
1344     }
1345 );
1346
1347 sub patron_adv_search {
1348     my( $self, $client, $auth, $search_hash, $search_limit, 
1349         $search_sort, $include_inactive, $search_ou, $flesh_fields, $offset) = @_;
1350
1351     my $e = new_editor(authtoken=>$auth);
1352     return $e->event unless $e->checkauth;
1353     return $e->event unless $e->allowed('VIEW_USER');
1354
1355     # depth boundary outside of which patrons must opt-in, default to 0
1356     my $opt_boundary = 0;
1357     $opt_boundary = $U->ou_ancestor_setting_value($e->requestor->ws_ou,'org.patron_opt_boundary') if user_opt_in_enabled($self);
1358
1359     if (not defined $search_ou) {
1360         my $depth = $U->ou_ancestor_setting_value(
1361             $e->requestor->ws_ou,
1362             'circ.patron_edit.duplicate_patron_check_depth'
1363         );
1364
1365         if (defined $depth) {
1366             $search_ou = $U->org_unit_ancestor_at_depth(
1367                 $e->requestor->ws_ou, $depth
1368             );
1369         }
1370     }
1371
1372     my $ids = $U->storagereq(
1373         "open-ils.storage.actor.user.crazy_search", $search_hash, 
1374         $search_limit, $search_sort, $include_inactive, 
1375         $e->requestor->ws_ou, $search_ou, $opt_boundary, $offset);
1376
1377     return $ids unless $self->api_name =~ /fleshed/;
1378
1379     $client->respond(new_flesh_user($_, $flesh_fields, $e)) for @$ids;
1380
1381     return;
1382 }
1383
1384
1385 __PACKAGE__->register_method(
1386     method    => "update_passwd",
1387     api_name  => "open-ils.actor.user.password.update",
1388     signature => {
1389         desc   => "Update the operator's password", 
1390         params => [
1391             { desc => 'Authentication token', type => 'string' },
1392             { desc => 'New password',         type => 'string' },
1393             { desc => 'Current password',     type => 'string' }
1394         ],
1395         return => {desc => '1 on success, Event on error or incorrect current password'}
1396     }
1397 );
1398
1399 __PACKAGE__->register_method(
1400     method    => "update_passwd",
1401     api_name  => "open-ils.actor.user.username.update",
1402     signature => {
1403         desc   => "Update the operator's username", 
1404         params => [
1405             { desc => 'Authentication token', type => 'string' },
1406             { desc => 'New username',         type => 'string' },
1407             { desc => 'Current password',     type => 'string' }
1408         ],
1409         return => {desc => '1 on success, Event on error or incorrect current password'}
1410     }
1411 );
1412
1413 __PACKAGE__->register_method(
1414     method    => "update_passwd",
1415     api_name  => "open-ils.actor.user.email.update",
1416     signature => {
1417         desc   => "Update the operator's email address", 
1418         params => [
1419             { desc => 'Authentication token', type => 'string' },
1420             { desc => 'New email address',    type => 'string' },
1421             { desc => 'Current password',     type => 'string' }
1422         ],
1423         return => {desc => '1 on success, Event on error or incorrect current password'}
1424     }
1425 );
1426
1427 sub update_passwd {
1428     my( $self, $conn, $auth, $new_val, $orig_pw ) = @_;
1429     my $e = new_editor(xact=>1, authtoken=>$auth);
1430     return $e->die_event unless $e->checkauth;
1431
1432     my $db_user = $e->retrieve_actor_user($e->requestor->id)
1433         or return $e->die_event;
1434     my $api = $self->api_name;
1435
1436     # make sure the original password matches the in-database password
1437     if (md5_hex($orig_pw) ne $db_user->passwd) {
1438         $e->rollback;
1439         return new OpenILS::Event('INCORRECT_PASSWORD');
1440     }
1441
1442     if( $api =~ /password/o ) {
1443
1444         $db_user->passwd($new_val);
1445
1446     } else {
1447
1448         # if we don't clear the password, the user will be updated with
1449         # a hashed version of the hashed version of their password
1450         $db_user->clear_passwd;
1451
1452         if( $api =~ /username/o ) {
1453
1454             # make sure no one else has this username
1455             my $exist = $e->search_actor_user({usrname=>$new_val},{idlist=>1}); 
1456             if (@$exist) {
1457                 $e->rollback;
1458                 return new OpenILS::Event('USERNAME_EXISTS');
1459             }
1460             $db_user->usrname($new_val);
1461
1462         } elsif( $api =~ /email/o ) {
1463             $db_user->email($new_val);
1464         }
1465     }
1466
1467     $e->update_actor_user($db_user) or return $e->die_event;
1468     $e->commit;
1469
1470     # update the cached user to pick up these changes
1471     $U->simplereq('open-ils.auth', 'open-ils.auth.session.reset_timeout', $auth, 1);
1472     return 1;
1473 }
1474
1475
1476
1477 __PACKAGE__->register_method(
1478     method   => "check_user_perms",
1479     api_name => "open-ils.actor.user.perm.check",
1480     notes    => <<"    NOTES");
1481     Takes a login session, user id, an org id, and an array of perm type strings.  For each
1482     perm type, if the user does *not* have the given permission it is added
1483     to a list which is returned from the method.  If all permissions
1484     are allowed, an empty list is returned
1485     if the logged in user does not match 'user_id', then the logged in user must
1486     have VIEW_PERMISSION priveleges.
1487     NOTES
1488
1489 sub check_user_perms {
1490     my( $self, $client, $login_session, $user_id, $org_id, $perm_types ) = @_;
1491
1492     my( $staff, $evt ) = $apputils->checkses($login_session);
1493     return $evt if $evt;
1494
1495     if($staff->id ne $user_id) {
1496         if( $evt = $apputils->check_perms(
1497             $staff->id, $org_id, 'VIEW_PERMISSION') ) {
1498             return $evt;
1499         }
1500     }
1501
1502     my @not_allowed;
1503     for my $perm (@$perm_types) {
1504         if($apputils->check_perms($user_id, $org_id, $perm)) {
1505             push @not_allowed, $perm;
1506         }
1507     }
1508
1509     return \@not_allowed
1510 }
1511
1512 __PACKAGE__->register_method(
1513     method  => "check_user_perms2",
1514     api_name    => "open-ils.actor.user.perm.check.multi_org",
1515     notes       => q/
1516         Checks the permissions on a list of perms and orgs for a user
1517         @param authtoken The login session key
1518         @param user_id The id of the user to check
1519         @param orgs The array of org ids
1520         @param perms The array of permission names
1521         @return An array of  [ orgId, permissionName ] arrays that FAILED the check
1522         if the logged in user does not match 'user_id', then the logged in user must
1523         have VIEW_PERMISSION priveleges.
1524     /);
1525
1526 sub check_user_perms2 {
1527     my( $self, $client, $authtoken, $user_id, $orgs, $perms ) = @_;
1528
1529     my( $staff, $target, $evt ) = $apputils->checkses_requestor(
1530         $authtoken, $user_id, 'VIEW_PERMISSION' );
1531     return $evt if $evt;
1532
1533     my @not_allowed;
1534     for my $org (@$orgs) {
1535         for my $perm (@$perms) {
1536             if($apputils->check_perms($user_id, $org, $perm)) {
1537                 push @not_allowed, [ $org, $perm ];
1538             }
1539         }
1540     }
1541
1542     return \@not_allowed
1543 }
1544
1545
1546 __PACKAGE__->register_method(
1547     method => 'check_user_perms3',
1548     api_name    => 'open-ils.actor.user.perm.highest_org',
1549     notes       => q/
1550         Returns the highest org unit id at which a user has a given permission
1551         If the requestor does not match the target user, the requestor must have
1552         'VIEW_PERMISSION' rights at the home org unit of the target user
1553         @param authtoken The login session key
1554         @param userid The id of the user in question
1555         @param perm The permission to check
1556         @return The org unit highest in the org tree within which the user has
1557         the requested permission
1558     /);
1559
1560 sub check_user_perms3 {
1561     my($self, $client, $authtoken, $user_id, $perm) = @_;
1562     my $e = new_editor(authtoken=>$authtoken);
1563     return $e->event unless $e->checkauth;
1564
1565     my $tree = $U->get_org_tree();
1566
1567     unless($e->requestor->id == $user_id) {
1568         my $user = $e->retrieve_actor_user($user_id)
1569             or return $e->event;
1570         return $e->event unless $e->allowed('VIEW_PERMISSION', $user->home_ou);
1571         return $U->find_highest_perm_org($perm, $user_id, $user->home_ou, $tree );
1572     }
1573
1574     return $U->find_highest_perm_org($perm, $user_id, $e->requestor->ws_ou, $tree);
1575 }
1576
1577 __PACKAGE__->register_method(
1578     method => 'user_has_work_perm_at',
1579     api_name    => 'open-ils.actor.user.has_work_perm_at',
1580     authoritative => 1,
1581     signature => {
1582         desc => q/
1583             Returns a set of org unit IDs which represent the highest orgs in 
1584             the org tree where the user has the requested permission.  The
1585             purpose of this method is to return the smallest set of org units
1586             which represent the full expanse of the user's ability to perform
1587             the requested action.  The user whose perms this method should
1588             check is implied by the authtoken. /,
1589         params => [
1590             {desc => 'authtoken', type => 'string'},
1591             {desc => 'permission name', type => 'string'},
1592             {desc => q/user id, optional.  If present, check perms for 
1593                 this user instead of the logged in user/, type => 'number'},
1594         ],
1595         return => {desc => 'An array of org IDs'}
1596     }
1597 );
1598
1599 sub user_has_work_perm_at {
1600     my($self, $conn, $auth, $perm, $user_id) = @_;
1601     my $e = new_editor(authtoken=>$auth);
1602     return $e->event unless $e->checkauth;
1603     if(defined $user_id) {
1604         my $user = $e->retrieve_actor_user($user_id) or return $e->event;
1605         return $e->event unless $e->allowed('VIEW_PERMISSION', $user->home_ou);
1606     }
1607     return $U->user_has_work_perm_at($e, $perm, undef, $user_id);
1608 }
1609
1610 __PACKAGE__->register_method(
1611     method => 'user_has_work_perm_at_batch',
1612     api_name    => 'open-ils.actor.user.has_work_perm_at.batch',
1613     authoritative => 1,
1614 );
1615
1616 sub user_has_work_perm_at_batch {
1617     my($self, $conn, $auth, $perms, $user_id) = @_;
1618     my $e = new_editor(authtoken=>$auth);
1619     return $e->event unless $e->checkauth;
1620     if(defined $user_id) {
1621         my $user = $e->retrieve_actor_user($user_id) or return $e->event;
1622         return $e->event unless $e->allowed('VIEW_PERMISSION', $user->home_ou);
1623     }
1624     my $map = {};
1625     $map->{$_} = $U->user_has_work_perm_at($e, $_) for @$perms;
1626     return $map;
1627 }
1628
1629
1630
1631 __PACKAGE__->register_method(
1632     method => 'check_user_perms4',
1633     api_name    => 'open-ils.actor.user.perm.highest_org.batch',
1634     notes       => q/
1635         Returns the highest org unit id at which a user has a given permission
1636         If the requestor does not match the target user, the requestor must have
1637         'VIEW_PERMISSION' rights at the home org unit of the target user
1638         @param authtoken The login session key
1639         @param userid The id of the user in question
1640         @param perms An array of perm names to check 
1641         @return An array of orgId's  representing the org unit 
1642         highest in the org tree within which the user has the requested permission
1643         The arrah of orgId's has matches the order of the perms array
1644     /);
1645
1646 sub check_user_perms4 {
1647     my( $self, $client, $authtoken, $userid, $perms ) = @_;
1648     
1649     my( $staff, $target, $org, $evt );
1650
1651     ( $staff, $target, $evt ) = $apputils->checkses_requestor(
1652         $authtoken, $userid, 'VIEW_PERMISSION' );
1653     return $evt if $evt;
1654
1655     my @arr;
1656     return [] unless ref($perms);
1657     my $tree = $U->get_org_tree();
1658
1659     for my $p (@$perms) {
1660         push( @arr, $U->find_highest_perm_org( $p, $userid, $target->home_ou, $tree ) );
1661     }
1662     return \@arr;
1663 }
1664
1665
1666 __PACKAGE__->register_method(
1667     method        => "user_fines_summary",
1668     api_name      => "open-ils.actor.user.fines.summary",
1669     authoritative => 1,
1670     signature     => {
1671         desc   => 'Returns a short summary of the users total open fines, '  .
1672                   'excluding voided fines Params are login_session, user_id' ,
1673         params => [
1674             {desc => 'Authentication token', type => 'string'},
1675             {desc => 'User ID',              type => 'string'}  # number?
1676         ],
1677         return => {
1678             desc => "a 'mous' object, event on error",
1679         }
1680     }
1681 );
1682
1683 sub user_fines_summary {
1684     my( $self, $client, $auth, $user_id ) = @_;
1685
1686     my $e = new_editor(authtoken=>$auth);
1687     return $e->event unless $e->checkauth;
1688
1689     if( $user_id ne $e->requestor->id ) {
1690         my $user = $e->retrieve_actor_user($user_id) or return $e->event;
1691         return $e->event unless 
1692             $e->allowed('VIEW_USER_FINES_SUMMARY', $user->home_ou);
1693     }
1694
1695     return $e->search_money_open_user_summary({usr => $user_id})->[0];
1696 }
1697
1698
1699 __PACKAGE__->register_method(
1700     method        => "user_opac_vitals",
1701     api_name      => "open-ils.actor.user.opac.vital_stats",
1702     argc          => 1,
1703     authoritative => 1,
1704     signature     => {
1705         desc   => 'Returns a short summary of the users vital stats, including '  .
1706                   'identification information, accumulated balance, number of holds, ' .
1707                   'and current open circulation stats' ,
1708         params => [
1709             {desc => 'Authentication token',                          type => 'string'},
1710             {desc => 'Optional User ID, for use in the staff client', type => 'number'}  # number?
1711         ],
1712         return => {
1713             desc => "An object with four properties: user, fines, checkouts and holds."
1714         }
1715     }
1716 );
1717
1718 sub user_opac_vitals {
1719     my( $self, $client, $auth, $user_id ) = @_;
1720
1721     my $e = new_editor(authtoken=>$auth);
1722     return $e->event unless $e->checkauth;
1723
1724     $user_id ||= $e->requestor->id;
1725
1726     my $user = $e->retrieve_actor_user( $user_id );
1727
1728     my ($fines) = $self
1729         ->method_lookup('open-ils.actor.user.fines.summary')
1730         ->run($auth => $user_id);
1731     return $fines if (defined($U->event_code($fines)));
1732
1733     if (!$fines) {
1734         $fines = new Fieldmapper::money::open_user_summary ();
1735         $fines->balance_owed(0.00);
1736         $fines->total_owed(0.00);
1737         $fines->total_paid(0.00);
1738         $fines->usr($user_id);
1739     }
1740
1741     my ($holds) = $self
1742         ->method_lookup('open-ils.actor.user.hold_requests.count')
1743         ->run($auth => $user_id);
1744     return $holds if (defined($U->event_code($holds)));
1745
1746     my ($out) = $self
1747         ->method_lookup('open-ils.actor.user.checked_out.count')
1748         ->run($auth => $user_id);
1749     return $out if (defined($U->event_code($out)));
1750
1751     $out->{"total_out"} = reduce { $a + $out->{$b} } 0, qw/out overdue/;
1752
1753     return {
1754         user => {
1755             first_given_name  => $user->first_given_name,
1756             second_given_name => $user->second_given_name,
1757             family_name       => $user->family_name,
1758             alias             => $user->alias,
1759             usrname           => $user->usrname
1760         },
1761         fines => $fines->to_bare_hash,
1762         checkouts => $out,
1763         holds => $holds
1764     };
1765 }
1766
1767
1768 ##### a small consolidation of related method registrations
1769 my $common_params = [
1770     { desc => 'Authentication token', type => 'string' },
1771     { desc => 'User ID',              type => 'string' },
1772     { desc => 'Transactions type (optional, defaults to all)', type => 'string' },
1773     { desc => 'Options hash.  May contain limit and offset for paged results.', type => 'object' },
1774 ];
1775 my %methods = (
1776     'open-ils.actor.user.transactions'                      => '',
1777     'open-ils.actor.user.transactions.fleshed'              => '',
1778     'open-ils.actor.user.transactions.have_charge'          => ' that have an initial charge',
1779     'open-ils.actor.user.transactions.have_charge.fleshed'  => ' that have an initial charge',
1780     'open-ils.actor.user.transactions.have_balance'         => ' that have an outstanding balance',
1781     'open-ils.actor.user.transactions.have_balance.fleshed' => ' that have an outstanding balance',
1782 );
1783
1784 foreach (keys %methods) {
1785     my %args = (
1786         method    => "user_transactions",
1787         api_name  => $_,
1788         signature => {
1789             desc   => 'For a given user, retrieve a list of '
1790                     . (/\.fleshed/ ? 'fleshed ' : '')
1791                     . 'transactions' . $methods{$_}
1792                     . ' optionally limited to transactions of a given type.',
1793             params => $common_params,
1794             return => {
1795                 desc => "List of objects, or event on error.  Each object is a hash containing: transaction, circ, record. "
1796                       . 'These represent the relevant (mbts) transaction, attached circulation and title pointed to in the circ, respectively.',
1797             }
1798         }
1799     );
1800     $args{authoritative} = 1;
1801     __PACKAGE__->register_method(%args);
1802 }
1803
1804 # Now for the counts
1805 %methods = (
1806     'open-ils.actor.user.transactions.count'              => '',
1807     'open-ils.actor.user.transactions.have_charge.count'  => ' that have an initial charge',
1808     'open-ils.actor.user.transactions.have_balance.count' => ' that have an outstanding balance',
1809 );
1810
1811 foreach (keys %methods) {
1812     my %args = (
1813         method    => "user_transactions",
1814         api_name  => $_,
1815         signature => {
1816             desc   => 'For a given user, retrieve a count of open '
1817                     . 'transactions' . $methods{$_}
1818                     . ' optionally limited to transactions of a given type.',
1819             params => $common_params,
1820             return => { desc => "Integer count of transactions, or event on error" }
1821         }
1822     );
1823     /\.have_balance/ and $args{authoritative} = 1;     # FIXME: I don't know why have_charge isn't authoritative
1824     __PACKAGE__->register_method(%args);
1825 }
1826
1827 __PACKAGE__->register_method(
1828     method        => "user_transactions",
1829     api_name      => "open-ils.actor.user.transactions.have_balance.total",
1830     authoritative => 1,
1831     signature     => {
1832         desc   => 'For a given user, retrieve the total balance owed for open transactions,'
1833                 . ' optionally limited to transactions of a given type.',
1834         params => $common_params,
1835         return => { desc => "Decimal balance value, or event on error" }
1836     }
1837 );
1838
1839
1840 sub user_transactions {
1841     my( $self, $client, $auth, $user_id, $type, $options ) = @_;
1842     $options ||= {};
1843
1844     my $e = new_editor(authtoken => $auth);
1845     return $e->event unless $e->checkauth;
1846
1847     my $user = $e->retrieve_actor_user($user_id) or return $e->event;
1848
1849     return $e->event unless 
1850         $e->requestor->id == $user_id or
1851         $e->allowed('VIEW_USER_TRANSACTIONS', $user->home_ou);
1852
1853     my $api = $self->api_name();
1854
1855     my $filter = ($api =~ /have_balance/o) ?
1856         { 'balance_owed' => { '<>' => 0 } }:
1857         { 'total_owed' => { '>' => 0 } };
1858
1859     my $method = 'open-ils.actor.user.transactions.history.still_open';
1860     $method = "$method.authoritative" if $api =~ /authoritative/;
1861     my ($trans) = $self->method_lookup($method)->run($auth, $user_id, $type, $filter, $options);
1862
1863     if($api =~ /total/o) { 
1864         my $total = 0.0;
1865         $total += $_->balance_owed for @$trans;
1866         return $total;
1867     }
1868
1869     ($api =~ /count/o  ) and return scalar @$trans;
1870     ($api !~ /fleshed/o) and return $trans;
1871
1872     my @resp;
1873     for my $t (@$trans) {
1874             
1875         if( $t->xact_type ne 'circulation' ) {
1876             push @resp, {transaction => $t};
1877             next;
1878         }
1879
1880         my $circ_data = flesh_circ($e, $t->id);
1881         push @resp, {transaction => $t, %$circ_data};
1882     }
1883
1884     return \@resp; 
1885
1886
1887
1888 __PACKAGE__->register_method(
1889     method   => "user_transaction_retrieve",
1890     api_name => "open-ils.actor.user.transaction.fleshed.retrieve",
1891     argc     => 1,
1892     authoritative => 1,
1893     notes    => "Returns a fleshed transaction record"
1894 );
1895
1896 __PACKAGE__->register_method(
1897     method   => "user_transaction_retrieve",
1898     api_name => "open-ils.actor.user.transaction.retrieve",
1899     argc     => 1,
1900     authoritative => 1,
1901     notes    => "Returns a transaction record"
1902 );
1903
1904 sub user_transaction_retrieve {
1905     my($self, $client, $auth, $bill_id) = @_;
1906
1907     my $e = new_editor(authtoken => $auth);
1908     return $e->event unless $e->checkauth;
1909
1910     my $trans = $e->retrieve_money_billable_transaction_summary(
1911         [$bill_id, {flesh => 1, flesh_fields => {mbts => ['usr']}}]) or return $e->event;
1912
1913     return $e->event unless $e->allowed('VIEW_USER_TRANSACTIONS', $trans->usr->home_ou);
1914
1915     $trans->usr($trans->usr->id); # de-flesh for backwards compat
1916
1917     return $trans unless $self->api_name =~ /flesh/;
1918     return {transaction => $trans} if $trans->xact_type ne 'circulation';
1919
1920     my $circ_data = flesh_circ($e, $trans->id, 1);
1921
1922     return {transaction => $trans, %$circ_data};
1923 }
1924
1925 sub flesh_circ {
1926     my $e = shift;
1927     my $circ_id = shift;
1928     my $flesh_copy = shift;
1929
1930     my $circ = $e->retrieve_action_circulation([
1931         $circ_id, {
1932             flesh => 3,
1933             flesh_fields => {
1934                 circ => ['target_copy'],
1935                 acp => ['call_number'],
1936                 acn => ['record']
1937             }
1938         }
1939     ]);
1940
1941     my $mods;
1942     my $copy = $circ->target_copy;
1943
1944     if($circ->target_copy->call_number->id == OILS_PRECAT_CALL_NUMBER) {
1945         $mods = new Fieldmapper::metabib::virtual_record;
1946         $mods->doc_id(OILS_PRECAT_RECORD);
1947         $mods->title($copy->dummy_title);
1948         $mods->author($copy->dummy_author);
1949
1950     } else {
1951         $mods = $U->record_to_mvr($circ->target_copy->call_number->record);
1952     }
1953
1954     # more de-fleshiing
1955     $circ->target_copy($circ->target_copy->id);
1956     $copy->call_number($copy->call_number->id);
1957
1958     return {circ => $circ, record => $mods, copy => ($flesh_copy) ? $copy : undef };
1959 }
1960
1961
1962 __PACKAGE__->register_method(
1963     method        => "hold_request_count",
1964     api_name      => "open-ils.actor.user.hold_requests.count",
1965     authoritative => 1,
1966     argc          => 1,
1967     notes         => q/
1968         Returns hold ready vs. total counts.
1969         If a context org unit is provided, a third value 
1970         is returned with key 'behind_desk', which reports
1971         how many holds are ready at the pickup library 
1972         with the behind_desk flag set to true.
1973     /
1974 );
1975     
1976 sub hold_request_count {
1977     my( $self, $client, $authtoken, $user_id, $ctx_org ) = @_;
1978     my $e = new_editor(authtoken => $authtoken);
1979     return $e->event unless $e->checkauth;
1980
1981     $user_id = $e->requestor->id unless defined $user_id;
1982
1983     if($e->requestor->id ne $user_id) {
1984         my $user = $e->retrieve_actor_user($user_id);
1985         return $e->event unless $e->allowed('VIEW_HOLD', $user->home_ou);
1986     }
1987
1988     my $holds = $e->json_query({
1989         select => {ahr => ['pickup_lib', 'current_shelf_lib', 'behind_desk']},
1990         from => 'ahr',
1991         where => {
1992             usr => $user_id,
1993             fulfillment_time => {"=" => undef },
1994             cancel_time => undef,
1995         }
1996     });
1997
1998     my @ready = grep { 
1999         $_->{current_shelf_lib} and # avoid undef warnings
2000         $_->{pickup_lib} eq $_->{current_shelf_lib} 
2001     } @$holds;
2002
2003         my $resp = { 
2004         total => scalar(@$holds), 
2005         ready => scalar(@ready)
2006     };
2007
2008     if ($ctx_org) {
2009         # count of holds ready at pickup lib with behind_desk true.
2010         $resp->{behind_desk} = scalar(
2011             grep {
2012                 $_->{pickup_lib} == $ctx_org and
2013                 $U->is_true($_->{behind_desk})
2014             } @ready
2015         );
2016     }
2017
2018     return $resp;
2019 }
2020
2021 __PACKAGE__->register_method(
2022     method        => "checked_out",
2023     api_name      => "open-ils.actor.user.checked_out",
2024     authoritative => 1,
2025     argc          => 2,
2026     signature     => {
2027         desc => "For a given user, returns a structure of circulations objects sorted by out, overdue, lost, claims_returned, long_overdue. "
2028               . "A list of IDs are returned of each type.  Circs marked lost, long_overdue, and claims_returned will not be 'finished' "
2029               . "(i.e., outstanding balance or some other pending action on the circ). "
2030               . "The .count method also includes a 'total' field which sums all open circs.",
2031         params => [
2032             { desc => 'Authentication Token', type => 'string'},
2033             { desc => 'User ID',              type => 'string'},
2034         ],
2035         return => {
2036             desc => 'Returns event on error, or an object with ID lists, like: '
2037                   . '{"out":[12552,451232], "claims_returned":[], "long_overdue":[23421] "overdue":[], "lost":[]}'
2038         },
2039     }
2040 );
2041
2042 __PACKAGE__->register_method(
2043     method        => "checked_out",
2044     api_name      => "open-ils.actor.user.checked_out.count",
2045     authoritative => 1,
2046     argc          => 2,
2047     signature     => q/@see open-ils.actor.user.checked_out/
2048 );
2049
2050 sub checked_out {
2051     my( $self, $conn, $auth, $userid ) = @_;
2052
2053     my $e = new_editor(authtoken=>$auth);
2054     return $e->event unless $e->checkauth;
2055
2056     if( $userid ne $e->requestor->id ) {
2057         my $user = $e->retrieve_actor_user($userid) or return $e->event;
2058         unless($e->allowed('VIEW_CIRCULATIONS', $user->home_ou)) {
2059
2060             # see if there is a friend link allowing circ.view perms
2061             my $allowed = OpenILS::Application::Actor::Friends->friend_perm_allowed(
2062                 $e, $userid, $e->requestor->id, 'circ.view');
2063             return $e->event unless $allowed;
2064         }
2065     }
2066
2067     my $count = $self->api_name =~ /count/;
2068     return _checked_out( $count, $e, $userid );
2069 }
2070
2071 sub _checked_out {
2072     my( $iscount, $e, $userid ) = @_;
2073
2074     my %result = (
2075         out => [],
2076         overdue => [],
2077         lost => [],
2078         claims_returned => [],
2079         long_overdue => []
2080     );
2081     my $meth = 'retrieve_action_open_circ_';
2082
2083     if ($iscount) {
2084         $meth .= 'count';
2085         %result = (
2086             out => 0,
2087             overdue => 0,
2088             lost => 0,
2089             claims_returned => 0,
2090             long_overdue => 0
2091         );
2092     } else {
2093         $meth .= 'list';
2094     }
2095
2096     my $data = $e->$meth($userid);
2097
2098     if ($data) {
2099         if ($iscount) {
2100             $result{$_} += $data->$_() for (keys %result);
2101             $result{total} += $data->$_() for (keys %result);
2102         } else {
2103             for my $k (keys %result) {
2104                 $result{$k} = [ grep { $_ > 0 } split( ',', $data->$k()) ];
2105             }
2106         }
2107     }
2108
2109     return \%result;
2110 }
2111
2112
2113
2114 __PACKAGE__->register_method(
2115     method        => "checked_in_with_fines",
2116     api_name      => "open-ils.actor.user.checked_in_with_fines",
2117     authoritative => 1,
2118     argc          => 2,
2119     signature     => q/@see open-ils.actor.user.checked_out/
2120 );
2121
2122 sub checked_in_with_fines {
2123     my( $self, $conn, $auth, $userid ) = @_;
2124
2125     my $e = new_editor(authtoken=>$auth);
2126     return $e->event unless $e->checkauth;
2127
2128     if( $userid ne $e->requestor->id ) {
2129         return $e->event unless $e->allowed('VIEW_CIRCULATIONS');
2130     }
2131
2132     # money is owed on these items and they are checked in
2133     my $open = $e->search_action_circulation(
2134         {
2135             usr             => $userid, 
2136             xact_finish     => undef,
2137             checkin_time    => { "!=" => undef },
2138         }
2139     );
2140
2141
2142     my( @lost, @cr, @lo );
2143     for my $c (@$open) {
2144         push( @lost, $c->id ) if ($c->stop_fines eq 'LOST');
2145         push( @cr, $c->id ) if $c->stop_fines eq 'CLAIMSRETURNED';
2146         push( @lo, $c->id ) if $c->stop_fines eq 'LONGOVERDUE';
2147     }
2148
2149     return {
2150         lost        => \@lost,
2151         claims_returned => \@cr,
2152         long_overdue        => \@lo
2153     };
2154 }
2155
2156
2157 sub _sigmaker {
2158     my ($api, $desc, $auth) = @_;
2159     $desc = $desc ? (" " . $desc) : '';
2160     my $ids = ($api =~ /ids$/) ? 1 : 0;
2161     my @sig = (
2162         argc      => 1,
2163         method    => "user_transaction_history",
2164         api_name  => "open-ils.actor.user.transactions.$api",
2165         signature => {
2166             desc   => "For a given User ID, returns a list of billable transaction" .
2167                       ($ids ? " id" : '') .
2168                       "s$desc, optionally filtered by type and/or fields in money.billable_xact_summary.  " .
2169                       "The VIEW_USER_TRANSACTIONS permission is required to view another user's transactions",
2170             params => [
2171                 {desc => 'Authentication token',        type => 'string'},
2172                 {desc => 'User ID',                     type => 'number'},
2173                 {desc => 'Transaction type (optional)', type => 'number'},
2174                 {desc => 'Hash of Billable Transaction Summary filters (optional)', type => 'object'}
2175             ],
2176             return => {
2177                 desc => 'List of transaction' . ($ids ? " id" : '') . 's, Event on error'
2178             },
2179         }
2180     );
2181     $auth and push @sig, (authoritative => 1);
2182     return @sig;
2183 }
2184
2185 my %auth_hist_methods = (
2186     'history'             => '',
2187     'history.have_charge' => 'that have an initial charge',
2188     'history.still_open'  => 'that are not finished',
2189     'history.have_balance'         => 'that have a balance',
2190     'history.have_bill'            => 'that have billings',
2191     'history.have_bill_or_payment' => 'that have non-zero-sum billings or at least 1 payment',
2192     'history.have_payment' => 'that have at least 1 payment',
2193 );
2194
2195 foreach (keys %auth_hist_methods) {
2196     __PACKAGE__->register_method(_sigmaker($_,       $auth_hist_methods{$_}, 1));
2197     __PACKAGE__->register_method(_sigmaker("$_.ids", $auth_hist_methods{$_}, 1));
2198     __PACKAGE__->register_method(_sigmaker("$_.fleshed", $auth_hist_methods{$_}, 1));
2199 }
2200
2201 sub user_transaction_history {
2202     my( $self, $conn, $auth, $userid, $type, $filter, $options ) = @_;
2203     $filter ||= {};
2204     $options ||= {};
2205
2206     my $e = new_editor(authtoken=>$auth);
2207     return $e->die_event unless $e->checkauth;
2208
2209     if ($e->requestor->id ne $userid) {
2210         return $e->die_event unless $e->allowed('VIEW_USER_TRANSACTIONS');
2211     }
2212
2213     my $api = $self->api_name;
2214     my @xact_finish  = (xact_finish => undef ) if ($api =~ /history\.still_open$/);     # What about history.still_open.ids?
2215
2216     if(defined($type)) {
2217         $filter->{'xact_type'} = $type;
2218     }
2219
2220     if($api =~ /have_bill_or_payment/o) {
2221
2222         # transactions that have a non-zero sum across all billings or at least 1 payment
2223         $filter->{'-or'} = {
2224             'balance_owed' => { '<>' => 0 },
2225             'last_payment_ts' => { '<>' => undef }
2226         };
2227
2228     } elsif($api =~ /have_payment/) {
2229
2230         $filter->{last_payment_ts} ||= {'<>' => undef};
2231
2232     } elsif( $api =~ /have_balance/o) {
2233
2234         # transactions that have a non-zero overall balance
2235         $filter->{'balance_owed'} = { '<>' => 0 };
2236
2237     } elsif( $api =~ /have_charge/o) {
2238
2239         # transactions that have at least 1 billing, regardless of whether it was voided
2240         $filter->{'last_billing_ts'} = { '<>' => undef };
2241
2242     } elsif( $api =~ /have_bill/o) {    # needs to be an elsif, or we double-match have_bill_or_payment!
2243
2244         # transactions that have non-zero sum across all billings.  This will exclude
2245         # xacts where all billings have been voided
2246         $filter->{'total_owed'} = { '<>' => 0 };
2247     }
2248
2249     my $options_clause = { order_by => { mbt => 'xact_start DESC' } };
2250     $options_clause->{'limit'} = $options->{'limit'} if $options->{'limit'}; 
2251     $options_clause->{'offset'} = $options->{'offset'} if $options->{'offset'}; 
2252
2253     my $mbts = $e->search_money_billable_transaction_summary(
2254         [   { usr => $userid, @xact_finish, %$filter },
2255             $options_clause
2256         ]
2257     );
2258
2259     return [map {$_->id} @$mbts] if $api =~ /\.ids/;
2260     return $mbts unless $api =~ /fleshed/;
2261
2262     my @resp;
2263     for my $t (@$mbts) {
2264             
2265         if( $t->xact_type ne 'circulation' ) {
2266             push @resp, {transaction => $t};
2267             next;
2268         }
2269
2270         my $circ_data = flesh_circ($e, $t->id);
2271         push @resp, {transaction => $t, %$circ_data};
2272     }
2273
2274     return \@resp; 
2275 }
2276
2277
2278
2279 __PACKAGE__->register_method(
2280     method   => "user_perms",
2281     api_name => "open-ils.actor.permissions.user_perms.retrieve",
2282     argc     => 1,
2283     notes    => "Returns a list of permissions"
2284 );
2285     
2286 sub user_perms {
2287     my( $self, $client, $authtoken, $user ) = @_;
2288
2289     my( $staff, $evt ) = $apputils->checkses($authtoken);
2290     return $evt if $evt;
2291
2292     $user ||= $staff->id;
2293
2294     if( $user != $staff->id and $evt = $apputils->check_perms( $staff->id, $staff->home_ou, 'VIEW_PERMISSION') ) {
2295         return $evt;
2296     }
2297
2298     return $apputils->simple_scalar_request(
2299         "open-ils.storage",
2300         "open-ils.storage.permission.user_perms.atomic",
2301         $user);
2302 }
2303
2304 __PACKAGE__->register_method(
2305     method   => "retrieve_perms",
2306     api_name => "open-ils.actor.permissions.retrieve",
2307     notes    => "Returns a list of permissions"
2308 );
2309 sub retrieve_perms {
2310     my( $self, $client ) = @_;
2311     return $apputils->simple_scalar_request(
2312         "open-ils.cstore",
2313         "open-ils.cstore.direct.permission.perm_list.search.atomic",
2314         { id => { '!=' => undef } }
2315     );
2316 }
2317
2318 __PACKAGE__->register_method(
2319     method   => "retrieve_groups",
2320     api_name => "open-ils.actor.groups.retrieve",
2321     notes    => "Returns a list of user groups"
2322 );
2323 sub retrieve_groups {
2324     my( $self, $client ) = @_;
2325     return new_editor()->retrieve_all_permission_grp_tree();
2326 }
2327
2328 __PACKAGE__->register_method(
2329     method  => "retrieve_org_address",
2330     api_name    => "open-ils.actor.org_unit.address.retrieve",
2331     notes        => <<'    NOTES');
2332     Returns an org_unit address by ID
2333     @param An org_address ID
2334     NOTES
2335 sub retrieve_org_address {
2336     my( $self, $client, $id ) = @_;
2337     return $apputils->simple_scalar_request(
2338         "open-ils.cstore",
2339         "open-ils.cstore.direct.actor.org_address.retrieve",
2340         $id
2341     );
2342 }
2343
2344 __PACKAGE__->register_method(
2345     method   => "retrieve_groups_tree",
2346     api_name => "open-ils.actor.groups.tree.retrieve",
2347     notes    => "Returns a list of user groups"
2348 );
2349     
2350 sub retrieve_groups_tree {
2351     my( $self, $client ) = @_;
2352     return new_editor()->search_permission_grp_tree(
2353         [
2354             { parent => undef},
2355             {   
2356                 flesh               => -1,
2357                 flesh_fields    => { pgt => ["children"] }, 
2358                 order_by            => { pgt => 'name'}
2359             }
2360         ]
2361     )->[0];
2362 }
2363
2364
2365 __PACKAGE__->register_method(
2366     method   => "add_user_to_groups",
2367     api_name => "open-ils.actor.user.set_groups",
2368     notes    => "Adds a user to one or more permission groups"
2369 );
2370     
2371 sub add_user_to_groups {
2372     my( $self, $client, $authtoken, $userid, $groups ) = @_;
2373
2374     my( $requestor, $target, $evt ) = $apputils->checkses_requestor(
2375         $authtoken, $userid, 'CREATE_USER_GROUP_LINK' );
2376     return $evt if $evt;
2377
2378     ( $requestor, $target, $evt ) = $apputils->checkses_requestor(
2379         $authtoken, $userid, 'REMOVE_USER_GROUP_LINK' );
2380     return $evt if $evt;
2381
2382     $apputils->simplereq(
2383         'open-ils.storage',
2384         'open-ils.storage.direct.permission.usr_grp_map.mass_delete', { usr => $userid } );
2385         
2386     for my $group (@$groups) {
2387         my $link = Fieldmapper::permission::usr_grp_map->new;
2388         $link->grp($group);
2389         $link->usr($userid);
2390
2391         my $id = $apputils->simplereq(
2392             'open-ils.storage',
2393             'open-ils.storage.direct.permission.usr_grp_map.create', $link );
2394     }
2395
2396     return 1;
2397 }
2398
2399 __PACKAGE__->register_method(
2400     method   => "get_user_perm_groups",
2401     api_name => "open-ils.actor.user.get_groups",
2402     notes    => "Retrieve a user's permission groups."
2403 );
2404
2405
2406 sub get_user_perm_groups {
2407     my( $self, $client, $authtoken, $userid ) = @_;
2408
2409     my( $requestor, $target, $evt ) = $apputils->checkses_requestor(
2410         $authtoken, $userid, 'VIEW_PERM_GROUPS' );
2411     return $evt if $evt;
2412
2413     return $apputils->simplereq(
2414         'open-ils.cstore',
2415         'open-ils.cstore.direct.permission.usr_grp_map.search.atomic', { usr => $userid } );
2416 }   
2417
2418
2419 __PACKAGE__->register_method(
2420     method   => "get_user_work_ous",
2421     api_name => "open-ils.actor.user.get_work_ous",
2422     notes    => "Retrieve a user's work org units."
2423 );
2424
2425 __PACKAGE__->register_method(
2426     method   => "get_user_work_ous",
2427     api_name => "open-ils.actor.user.get_work_ous.ids",
2428     notes    => "Retrieve a user's work org units."
2429 );
2430
2431 sub get_user_work_ous {
2432     my( $self, $client, $auth, $userid ) = @_;
2433     my $e = new_editor(authtoken=>$auth);
2434     return $e->event unless $e->checkauth;
2435     $userid ||= $e->requestor->id;
2436
2437     if($e->requestor->id != $userid) {
2438         my $user = $e->retrieve_actor_user($userid)
2439             or return $e->event;
2440         return $e->event unless $e->allowed('ASSIGN_WORK_ORG_UNIT', $user->home_ou);
2441     }
2442
2443     return $e->search_permission_usr_work_ou_map({usr => $userid})
2444         unless $self->api_name =~ /.ids$/;
2445
2446     # client just wants a list of org IDs
2447     return $U->get_user_work_ou_ids($e, $userid);
2448 }   
2449
2450
2451
2452 __PACKAGE__->register_method(
2453     method    => 'register_workstation',
2454     api_name  => 'open-ils.actor.workstation.register.override',
2455     signature => q/@see open-ils.actor.workstation.register/
2456 );
2457
2458 __PACKAGE__->register_method(
2459     method    => 'register_workstation',
2460     api_name  => 'open-ils.actor.workstation.register',
2461     signature => q/
2462         Registers a new workstion in the system
2463         @param authtoken The login session key
2464         @param name The name of the workstation id
2465         @param owner The org unit that owns this workstation
2466         @return The workstation id on success, WORKSTATION_NAME_EXISTS
2467         if the name is already in use.
2468     /
2469 );
2470
2471 sub register_workstation {
2472     my( $self, $conn, $authtoken, $name, $owner, $oargs ) = @_;
2473
2474     my $e = new_editor(authtoken=>$authtoken, xact=>1);
2475     return $e->die_event unless $e->checkauth;
2476     return $e->die_event unless $e->allowed('REGISTER_WORKSTATION', $owner);
2477     my $existing = $e->search_actor_workstation({name => $name})->[0];
2478     $oargs = { all => 1 } unless defined $oargs;
2479
2480     if( $existing ) {
2481
2482         if( $self->api_name =~ /override/o && ($oargs->{all} || grep { $_ eq 'WORKSTATION_NAME_EXISTS' } @{$oargs->{events}}) ) {
2483             # workstation with the given name exists.  
2484
2485             if($owner ne $existing->owning_lib) {
2486                 # if necessary, update the owning_lib of the workstation
2487
2488                 $logger->info("changing owning lib of workstation ".$existing->id.
2489                     " from ".$existing->owning_lib." to $owner");
2490                 return $e->die_event unless 
2491                     $e->allowed('UPDATE_WORKSTATION', $existing->owning_lib); 
2492
2493                 return $e->die_event unless $e->allowed('UPDATE_WORKSTATION', $owner); 
2494
2495                 $existing->owning_lib($owner);
2496                 return $e->die_event unless $e->update_actor_workstation($existing);
2497
2498                 $e->commit;
2499
2500             } else {
2501                 $logger->info(  
2502                     "attempt to register an existing workstation.  returning existing ID");
2503             }
2504
2505             return $existing->id;
2506
2507         } else {
2508             return OpenILS::Event->new('WORKSTATION_NAME_EXISTS')
2509         }
2510     }
2511
2512     my $ws = Fieldmapper::actor::workstation->new;
2513     $ws->owning_lib($owner);
2514     $ws->name($name);
2515     $e->create_actor_workstation($ws) or return $e->die_event;
2516     $e->commit;
2517     return $ws->id; # note: editor sets the id on the new object for us
2518 }
2519
2520 __PACKAGE__->register_method(
2521     method    => 'workstation_list',
2522     api_name  => 'open-ils.actor.workstation.list',
2523     signature => q/
2524         Returns a list of workstations registered at the given location
2525         @param authtoken The login session key
2526         @param ids A list of org_unit.id's for the workstation owners
2527     /
2528 );
2529
2530 sub workstation_list {
2531     my( $self, $conn, $authtoken, @orgs ) = @_;
2532
2533     my $e = new_editor(authtoken=>$authtoken);
2534     return $e->event unless $e->checkauth;
2535     my %results;
2536
2537     for my $o (@orgs) {
2538         return $e->event 
2539             unless $e->allowed('REGISTER_WORKSTATION', $o);
2540         $results{$o} = $e->search_actor_workstation({owning_lib=>$o});
2541     }
2542     return \%results;
2543 }
2544
2545
2546 __PACKAGE__->register_method(
2547     method        => 'fetch_patron_note',
2548     api_name      => 'open-ils.actor.note.retrieve.all',
2549     authoritative => 1,
2550     signature     => q/
2551         Returns a list of notes for a given user
2552         Requestor must have VIEW_USER permission if pub==false and
2553         @param authtoken The login session key
2554         @param args Hash of params including
2555             patronid : the patron's id
2556             pub : true if retrieving only public notes
2557     /
2558 );
2559
2560 sub fetch_patron_note {
2561     my( $self, $conn, $authtoken, $args ) = @_;
2562     my $patronid = $$args{patronid};
2563
2564     my($reqr, $evt) = $U->checkses($authtoken);
2565     return $evt if $evt;
2566
2567     my $patron;
2568     ($patron, $evt) = $U->fetch_user($patronid);
2569     return $evt if $evt;
2570
2571     if($$args{pub}) {
2572         if( $patronid ne $reqr->id ) {
2573             $evt = $U->check_perms($reqr->id, $patron->home_ou, 'VIEW_USER');
2574             return $evt if $evt;
2575         }
2576         return $U->cstorereq(
2577             'open-ils.cstore.direct.actor.usr_note.search.atomic', 
2578             { usr => $patronid, pub => 't' } );
2579     }
2580
2581     $evt = $U->check_perms($reqr->id, $patron->home_ou, 'VIEW_USER');
2582     return $evt if $evt;
2583
2584     return $U->cstorereq(
2585         'open-ils.cstore.direct.actor.usr_note.search.atomic', { usr => $patronid } );
2586 }
2587
2588 __PACKAGE__->register_method(
2589     method    => 'create_user_note',
2590     api_name  => 'open-ils.actor.note.create',
2591     signature => q/
2592         Creates a new note for the given user
2593         @param authtoken The login session key
2594         @param note The note object
2595     /
2596 );
2597 sub create_user_note {
2598     my( $self, $conn, $authtoken, $note ) = @_;
2599     my $e = new_editor(xact=>1, authtoken=>$authtoken);
2600     return $e->die_event unless $e->checkauth;
2601
2602     my $user = $e->retrieve_actor_user($note->usr)
2603         or return $e->die_event;
2604
2605     return $e->die_event unless 
2606         $e->allowed('UPDATE_USER',$user->home_ou);
2607
2608     $note->creator($e->requestor->id);
2609     $e->create_actor_usr_note($note) or return $e->die_event;
2610     $e->commit;
2611     return $note->id;
2612 }
2613
2614
2615 __PACKAGE__->register_method(
2616     method    => 'delete_user_note',
2617     api_name  => 'open-ils.actor.note.delete',
2618     signature => q/
2619         Deletes a note for the given user
2620         @param authtoken The login session key
2621         @param noteid The note id
2622     /
2623 );
2624 sub delete_user_note {
2625     my( $self, $conn, $authtoken, $noteid ) = @_;
2626
2627     my $e = new_editor(xact=>1, authtoken=>$authtoken);
2628     return $e->die_event unless $e->checkauth;
2629     my $note = $e->retrieve_actor_usr_note($noteid)
2630         or return $e->die_event;
2631     my $user = $e->retrieve_actor_user($note->usr)
2632         or return $e->die_event;
2633     return $e->die_event unless 
2634         $e->allowed('UPDATE_USER', $user->home_ou);
2635     
2636     $e->delete_actor_usr_note($note) or return $e->die_event;
2637     $e->commit;
2638     return 1;
2639 }
2640
2641
2642 __PACKAGE__->register_method(
2643     method    => 'update_user_note',
2644     api_name  => 'open-ils.actor.note.update',
2645     signature => q/
2646         @param authtoken The login session key
2647         @param note The note
2648     /
2649 );
2650
2651 sub update_user_note {
2652     my( $self, $conn, $auth, $note ) = @_;
2653     my $e = new_editor(authtoken=>$auth, xact=>1);
2654     return $e->die_event unless $e->checkauth;
2655     my $patron = $e->retrieve_actor_user($note->usr)
2656         or return $e->die_event;
2657     return $e->die_event unless 
2658         $e->allowed('UPDATE_USER', $patron->home_ou);
2659     $e->update_actor_user_note($note)
2660         or return $e->die_event;
2661     $e->commit;
2662     return 1;
2663 }
2664
2665
2666
2667 __PACKAGE__->register_method(
2668     method    => 'create_closed_date',
2669     api_name  => 'open-ils.actor.org_unit.closed_date.create',
2670     signature => q/
2671         Creates a new closing entry for the given org_unit
2672         @param authtoken The login session key
2673         @param note The closed_date object
2674     /
2675 );
2676 sub create_closed_date {
2677     my( $self, $conn, $authtoken, $cd ) = @_;
2678
2679     my( $user, $evt ) = $U->checkses($authtoken);
2680     return $evt if $evt;
2681
2682     $evt = $U->check_perms($user->id, $cd->org_unit, 'CREATE_CLOSEING');
2683     return $evt if $evt;
2684
2685     $logger->activity("user ".$user->id." creating library closing for ".$cd->org_unit);
2686
2687     my $id = $U->storagereq(
2688         'open-ils.storage.direct.actor.org_unit.closed_date.create', $cd );
2689     return $U->DB_UPDATE_FAILED($cd) unless $id;
2690     return $id;
2691 }
2692
2693
2694 __PACKAGE__->register_method(
2695     method    => 'delete_closed_date',
2696     api_name  => 'open-ils.actor.org_unit.closed_date.delete',
2697     signature => q/
2698         Deletes a closing entry for the given org_unit
2699         @param authtoken The login session key
2700         @param noteid The close_date id
2701     /
2702 );
2703 sub delete_closed_date {
2704     my( $self, $conn, $authtoken, $cd ) = @_;
2705
2706     my( $user, $evt ) = $U->checkses($authtoken);
2707     return $evt if $evt;
2708
2709     my $cd_obj;
2710     ($cd_obj, $evt) = fetch_closed_date($cd);
2711     return $evt if $evt;
2712
2713     $evt = $U->check_perms($user->id, $cd->org_unit, 'DELETE_CLOSEING');
2714     return $evt if $evt;
2715
2716     $logger->activity("user ".$user->id." deleting library closing for ".$cd->org_unit);
2717
2718     my $stat = $U->storagereq(
2719         'open-ils.storage.direct.actor.org_unit.closed_date.delete', $cd );
2720     return $U->DB_UPDATE_FAILED($cd) unless $stat;
2721     return $stat;
2722 }
2723
2724
2725 __PACKAGE__->register_method(
2726     method    => 'usrname_exists',
2727     api_name  => 'open-ils.actor.username.exists',
2728     signature => {
2729         desc  => 'Check if a username is already taken (by an undeleted patron)',
2730         param => [
2731             {desc => 'Authentication token', type => 'string'},
2732             {desc => 'Username',             type => 'string'}
2733         ],
2734         return => {
2735             desc => 'id of existing user if username exists, undef otherwise.  Event on error'
2736         },
2737     }
2738 );
2739
2740 sub usrname_exists {
2741     my( $self, $conn, $auth, $usrname ) = @_;
2742     my $e = new_editor(authtoken=>$auth);
2743     return $e->event unless $e->checkauth;
2744     my $a = $e->search_actor_user({usrname => $usrname}, {idlist=>1});
2745     return $$a[0] if $a and @$a;
2746     return undef;
2747 }
2748
2749 __PACKAGE__->register_method(
2750     method        => 'barcode_exists',
2751     api_name      => 'open-ils.actor.barcode.exists',
2752     authoritative => 1,
2753     signature     => 'Returns 1 if the requested barcode exists, returns 0 otherwise'
2754 );
2755
2756 sub barcode_exists {
2757     my( $self, $conn, $auth, $barcode ) = @_;
2758     my $e = new_editor(authtoken=>$auth);
2759     return $e->event unless $e->checkauth;
2760     my $card = $e->search_actor_card({barcode => $barcode});
2761     if (@$card) {
2762         return 1;
2763     } else {
2764         return 0;
2765     }
2766     #return undef unless @$card;
2767     #return $card->[0]->usr;
2768 }
2769
2770
2771 __PACKAGE__->register_method(
2772     method   => 'retrieve_net_levels',
2773     api_name => 'open-ils.actor.net_access_level.retrieve.all',
2774 );
2775
2776 sub retrieve_net_levels {
2777     my( $self, $conn, $auth ) = @_;
2778     my $e = new_editor(authtoken=>$auth);
2779     return $e->event unless $e->checkauth;
2780     return $e->retrieve_all_config_net_access_level();
2781 }
2782
2783 # Retain the old typo API name just in case
2784 __PACKAGE__->register_method(
2785     method   => 'fetch_org_by_shortname',
2786     api_name => 'open-ils.actor.org_unit.retrieve_by_shorname',
2787 );
2788 __PACKAGE__->register_method(
2789     method   => 'fetch_org_by_shortname',
2790     api_name => 'open-ils.actor.org_unit.retrieve_by_shortname',
2791 );
2792 sub fetch_org_by_shortname {
2793     my( $self, $conn, $sname ) = @_;
2794     my $e = new_editor();
2795     my $org = $e->search_actor_org_unit({ shortname => uc($sname)})->[0];
2796     return $e->event unless $org;
2797     return $org;
2798 }
2799
2800
2801 __PACKAGE__->register_method(
2802     method   => 'session_home_lib',
2803     api_name => 'open-ils.actor.session.home_lib',
2804 );
2805
2806 sub session_home_lib {
2807     my( $self, $conn, $auth ) = @_;
2808     my $e = new_editor(authtoken=>$auth);
2809     return undef unless $e->checkauth;
2810     my $org = $e->retrieve_actor_org_unit($e->requestor->home_ou);
2811     return $org->shortname;
2812 }
2813
2814 __PACKAGE__->register_method(
2815     method    => 'session_safe_token',
2816     api_name  => 'open-ils.actor.session.safe_token',
2817     signature => q/
2818         Returns a hashed session ID that is safe for export to the world.
2819         This safe token will expire after 1 hour of non-use.
2820         @param auth Active authentication token
2821     /
2822 );
2823
2824 sub session_safe_token {
2825     my( $self, $conn, $auth ) = @_;
2826     my $e = new_editor(authtoken=>$auth);
2827     return undef unless $e->checkauth;
2828
2829     my $safe_token = md5_hex($auth);
2830
2831     $cache ||= OpenSRF::Utils::Cache->new("global", 0);
2832
2833     # add more user fields as needed
2834     $cache->put_cache(
2835         "safe-token-user-$safe_token", {   
2836             id => $e->requestor->id, 
2837             home_ou_shortname => $e->retrieve_actor_org_unit(
2838                 $e->requestor->home_ou)->shortname,
2839         },
2840         60 * 60
2841     );
2842
2843     return $safe_token;
2844 }
2845
2846
2847 __PACKAGE__->register_method(
2848     method    => 'safe_token_home_lib',
2849     api_name  => 'open-ils.actor.safe_token.home_lib.shortname',
2850     signature => q/
2851         Returns the home library shortname from the session
2852         asscociated with a safe token from generated by
2853         open-ils.actor.session.safe_token.
2854         @param safe_token Active safe token
2855         @param who Optional user activity "ewho" value
2856     /
2857 );
2858
2859 sub safe_token_home_lib {
2860     my( $self, $conn, $safe_token, $who ) = @_;
2861     $cache ||= OpenSRF::Utils::Cache->new("global", 0);
2862
2863     my $blob = $cache->get_cache("safe-token-user-$safe_token");
2864     return unless $blob;
2865
2866     $U->log_user_activity($blob->{id}, $who, 'verify');
2867     return $blob->{home_ou_shortname};
2868 }
2869
2870
2871 __PACKAGE__->register_method(
2872     method   => "update_penalties",
2873     api_name => "open-ils.actor.user.penalties.update"
2874 );
2875
2876 sub update_penalties {
2877     my($self, $conn, $auth, $user_id) = @_;
2878     my $e = new_editor(authtoken=>$auth, xact => 1);
2879     return $e->die_event unless $e->checkauth;
2880     my $user = $e->retrieve_actor_user($user_id) or return $e->die_event;
2881     return $e->die_event unless $e->allowed('UPDATE_USER', $user->home_ou);
2882     my $evt = OpenILS::Utils::Penalty->calculate_penalties($e, $user_id, $e->requestor->ws_ou);
2883     return $evt if $evt;
2884     $e->commit;
2885     return 1;
2886 }
2887
2888
2889 __PACKAGE__->register_method(
2890     method   => "apply_penalty",
2891     api_name => "open-ils.actor.user.penalty.apply"
2892 );
2893
2894 sub apply_penalty {
2895     my($self, $conn, $auth, $penalty) = @_;
2896
2897     my $e = new_editor(authtoken=>$auth, xact => 1);
2898     return $e->die_event unless $e->checkauth;
2899
2900     my $user = $e->retrieve_actor_user($penalty->usr) or return $e->die_event;
2901     return $e->die_event unless $e->allowed('UPDATE_USER', $user->home_ou);
2902
2903     my $ptype = $e->retrieve_config_standing_penalty($penalty->standing_penalty) or return $e->die_event;
2904     
2905     my $ctx_org = 
2906         (defined $ptype->org_depth) ?
2907         $U->org_unit_ancestor_at_depth($penalty->org_unit, $ptype->org_depth) :
2908         $penalty->org_unit;
2909
2910     $penalty->org_unit($ctx_org);
2911     $penalty->staff($e->requestor->id);
2912     $e->create_actor_user_standing_penalty($penalty) or return $e->die_event;
2913
2914     $e->commit;
2915     return $penalty->id;
2916 }
2917
2918 __PACKAGE__->register_method(
2919     method   => "remove_penalty",
2920     api_name => "open-ils.actor.user.penalty.remove"
2921 );
2922
2923 sub remove_penalty {
2924     my($self, $conn, $auth, $penalty) = @_;
2925     my $e = new_editor(authtoken=>$auth, xact => 1);
2926     return $e->die_event unless $e->checkauth;
2927     my $user = $e->retrieve_actor_user($penalty->usr) or return $e->die_event;
2928     return $e->die_event unless $e->allowed('UPDATE_USER', $user->home_ou);
2929
2930     $e->delete_actor_user_standing_penalty($penalty) or return $e->die_event;
2931     $e->commit;
2932     return 1;
2933 }
2934
2935 __PACKAGE__->register_method(
2936     method   => "update_penalty_note",
2937     api_name => "open-ils.actor.user.penalty.note.update"
2938 );
2939
2940 sub update_penalty_note {
2941     my($self, $conn, $auth, $penalty_ids, $note) = @_;
2942     my $e = new_editor(authtoken=>$auth, xact => 1);
2943     return $e->die_event unless $e->checkauth;
2944     for my $penalty_id (@$penalty_ids) {
2945         my $penalty = $e->search_actor_user_standing_penalty( { id => $penalty_id } )->[0];
2946         if (! $penalty ) { return $e->die_event; }
2947         my $user = $e->retrieve_actor_user($penalty->usr) or return $e->die_event;
2948         return $e->die_event unless $e->allowed('UPDATE_USER', $user->home_ou);
2949
2950         $penalty->note( $note ); $penalty->ischanged( 1 );
2951
2952         $e->update_actor_user_standing_penalty($penalty) or return $e->die_event;
2953     }
2954     $e->commit;
2955     return 1;
2956 }
2957
2958 __PACKAGE__->register_method(
2959     method   => "ranged_penalty_thresholds",
2960     api_name => "open-ils.actor.grp_penalty_threshold.ranged.retrieve",
2961     stream   => 1
2962 );
2963
2964 sub ranged_penalty_thresholds {
2965     my($self, $conn, $auth, $context_org) = @_;
2966     my $e = new_editor(authtoken=>$auth);
2967     return $e->event unless $e->checkauth;
2968     return $e->event unless $e->allowed('VIEW_GROUP_PENALTY_THRESHOLD', $context_org);
2969     my $list = $e->search_permission_grp_penalty_threshold([
2970         {org_unit => $U->get_org_ancestors($context_org)},
2971         {order_by => {pgpt => 'id'}}
2972     ]);
2973     $conn->respond($_) for @$list;
2974     return undef;
2975 }
2976
2977
2978
2979 __PACKAGE__->register_method(
2980     method        => "user_retrieve_fleshed_by_id",
2981     authoritative => 1,
2982     api_name      => "open-ils.actor.user.fleshed.retrieve",
2983 );
2984
2985 sub user_retrieve_fleshed_by_id {
2986     my( $self, $client, $auth, $user_id, $fields ) = @_;
2987     my $e = new_editor(authtoken => $auth);
2988     return $e->event unless $e->checkauth;
2989
2990     if( $e->requestor->id != $user_id ) {
2991         return $e->event unless $e->allowed('VIEW_USER');
2992     }
2993
2994     $fields ||= [
2995         "cards",
2996         "card",
2997         "groups",
2998         "standing_penalties",
2999         "addresses",
3000         "billing_address",
3001         "mailing_address",
3002         "stat_cat_entries",
3003         "usr_activity" ];
3004     return new_flesh_user($user_id, $fields, $e);
3005 }
3006
3007
3008 sub new_flesh_user {
3009
3010     my $id = shift;
3011     my $fields = shift || [];
3012     my $e = shift;
3013
3014     my $fetch_penalties = 0;
3015     if(grep {$_ eq 'standing_penalties'} @$fields) {
3016         $fields = [grep {$_ ne 'standing_penalties'} @$fields];
3017         $fetch_penalties = 1;
3018     }
3019
3020     my $fetch_usr_act = 0;
3021     if(grep {$_ eq 'usr_activity'} @$fields) {
3022         $fields = [grep {$_ ne 'usr_activity'} @$fields];
3023         $fetch_usr_act = 1;
3024     }
3025
3026     my $user = $e->retrieve_actor_user(
3027     [
3028         $id,
3029         {
3030             "flesh"             => 1,
3031             "flesh_fields" =>  { "au" => $fields }
3032         }
3033     ]
3034     ) or return $e->die_event;
3035
3036
3037     if( grep { $_ eq 'addresses' } @$fields ) {
3038
3039         $user->addresses([]) unless @{$user->addresses};
3040         # don't expose "replaced" addresses by default
3041         $user->addresses([grep {$_->id >= 0} @{$user->addresses}]);
3042     
3043         if( ref $user->billing_address ) {
3044             unless( grep { $user->billing_address->id == $_->id } @{$user->addresses} ) {
3045                 push( @{$user->addresses}, $user->billing_address );
3046             }
3047         }
3048     
3049         if( ref $user->mailing_address ) {
3050             unless( grep { $user->mailing_address->id == $_->id } @{$user->addresses} ) {
3051                 push( @{$user->addresses}, $user->mailing_address );
3052             }
3053         }
3054     }
3055
3056     if($fetch_penalties) {
3057         # grab the user penalties ranged for this location
3058         $user->standing_penalties(
3059             $e->search_actor_user_standing_penalty([
3060                 {   usr => $id, 
3061                     '-or' => [
3062                         {stop_date => undef},
3063                         {stop_date => {'>' => 'now'}}
3064                     ],
3065                     org_unit => $U->get_org_full_path($e->requestor->ws_ou)
3066                 },
3067                 {   flesh => 1,
3068                     flesh_fields => {ausp => ['standing_penalty']}
3069                 }
3070             ])
3071         );
3072     }
3073
3074     # retrieve the most recent usr_activity entry
3075     if ($fetch_usr_act) {
3076
3077         # max number to return for simple patron fleshing
3078         my $limit = $U->ou_ancestor_setting_value(
3079             $e->requestor->ws_ou, 
3080             'circ.patron.usr_activity_retrieve.max');
3081
3082         my $opts = {
3083             flesh => 1,
3084             flesh_fields => {auact => ['etype']},
3085             order_by => {auact => 'event_time DESC'}, 
3086         };
3087
3088         # 0 == none, <0 == return all
3089         $limit = 1 unless defined $limit;
3090         $opts->{limit} = $limit if $limit > 0;
3091
3092         $user->usr_activity( 
3093             ($limit == 0) ? 
3094                 [] : # skip the DB call
3095                 $e->search_actor_usr_activity([{usr => $user->id}, $opts])
3096         );
3097     }
3098
3099     $e->rollback;
3100     $user->clear_passwd();
3101     return $user;
3102 }
3103
3104
3105
3106
3107 __PACKAGE__->register_method(
3108     method   => "user_retrieve_parts",
3109     api_name => "open-ils.actor.user.retrieve.parts",
3110 );
3111
3112 sub user_retrieve_parts {
3113     my( $self, $client, $auth, $user_id, $fields ) = @_;
3114     my $e = new_editor(authtoken => $auth);
3115     return $e->event unless $e->checkauth;
3116     $user_id ||= $e->requestor->id;
3117     if( $e->requestor->id != $user_id ) {
3118         return $e->event unless $e->allowed('VIEW_USER');
3119     }
3120     my @resp;
3121     my $user = $e->retrieve_actor_user($user_id) or return $e->event;
3122     push(@resp, $user->$_()) for(@$fields);
3123     return \@resp;
3124 }
3125
3126
3127
3128 __PACKAGE__->register_method(
3129     method    => 'user_opt_in_enabled',
3130     api_name  => 'open-ils.actor.user.org_unit_opt_in.enabled',
3131     signature => '@return 1 if user opt-in is globally enabled, 0 otherwise.'
3132 );
3133
3134 sub user_opt_in_enabled {
3135     my($self, $conn) = @_;
3136     my $sc = OpenSRF::Utils::SettingsClient->new;
3137     return 1 if lc($sc->config_value(share => user => 'opt_in')) eq 'true'; 
3138     return 0;
3139 }
3140     
3141
3142 __PACKAGE__->register_method(
3143     method    => 'user_opt_in_at_org',
3144     api_name  => 'open-ils.actor.user.org_unit_opt_in.check',
3145     signature => q/
3146         @param $auth The auth token
3147         @param user_id The ID of the user to test
3148         @return 1 if the user has opted in at the specified org,
3149             event on error, and 0 otherwise. /
3150 );
3151 sub user_opt_in_at_org {
3152     my($self, $conn, $auth, $user_id) = @_;
3153
3154     # see if we even need to enforce the opt-in value
3155     return 1 unless user_opt_in_enabled($self);
3156
3157     my $e = new_editor(authtoken => $auth);
3158     return $e->event unless $e->checkauth;
3159
3160     my $user = $e->retrieve_actor_user($user_id) or return $e->event;
3161     return $e->event unless $e->allowed('VIEW_USER', $user->home_ou);
3162
3163     my $ws_org = $e->requestor->ws_ou;
3164     # user is automatically opted-in if they are from the local org
3165     return 1 if $user->home_ou eq $ws_org;
3166
3167     # get the boundary setting
3168     my $opt_boundary = $U->ou_ancestor_setting_value($e->requestor->ws_ou,'org.patron_opt_boundary');
3169  
3170     # auto opt in if user falls within the opt boundary
3171     my $opt_orgs = $U->get_org_descendants($ws_org, $opt_boundary);
3172
3173     return 1 if grep $_ eq $user->home_ou, @$opt_orgs;
3174
3175     my $vals = $e->search_actor_usr_org_unit_opt_in(
3176         {org_unit=>$opt_orgs, usr=>$user_id},{idlist=>1});
3177
3178     return 1 if @$vals;
3179     return 0;
3180 }
3181
3182 __PACKAGE__->register_method(
3183     method    => 'create_user_opt_in_at_org',
3184     api_name  => 'open-ils.actor.user.org_unit_opt_in.create',
3185     signature => q/
3186         @param $auth The auth token
3187         @param user_id The ID of the user to test
3188         @return The ID of the newly created object, event on error./
3189 );
3190
3191 sub create_user_opt_in_at_org {
3192     my($self, $conn, $auth, $user_id, $org_id) = @_;
3193
3194     my $e = new_editor(authtoken => $auth, xact=>1);
3195     return $e->die_event unless $e->checkauth;
3196    
3197     # if a specific org unit wasn't passed in, get one based on the defaults;
3198     if(!$org_id){
3199         my $wsou = $e->requestor->ws_ou;
3200         # get the default opt depth
3201         my $opt_depth = $U->ou_ancestor_setting_value($wsou,'org.patron_opt_default'); 
3202         # get the org unit at that depth
3203         my $org = $e->json_query({ 
3204             from => [ 'actor.org_unit_ancestor_at_depth', $wsou, $opt_depth ]})->[0];
3205         $org_id = $org->{id};
3206     } 
3207     if (!$org_id) {
3208         # fall back to the workstation OU, the pre-opt-in-boundary way
3209         $org_id = $e->requestor->ws_ou;
3210     }
3211
3212     my $user = $e->retrieve_actor_user($user_id) or return $e->die_event;
3213     return $e->die_event unless $e->allowed('UPDATE_USER', $user->home_ou);
3214
3215     my $opt_in = Fieldmapper::actor::usr_org_unit_opt_in->new;
3216
3217     $opt_in->org_unit($org_id);
3218     $opt_in->usr($user_id);
3219     $opt_in->staff($e->requestor->id);
3220     $opt_in->opt_in_ts('now');
3221     $opt_in->opt_in_ws($e->requestor->wsid);
3222
3223     $opt_in = $e->create_actor_usr_org_unit_opt_in($opt_in)
3224         or return $e->die_event;
3225
3226     $e->commit;
3227
3228     return $opt_in->id;
3229 }
3230
3231
3232 __PACKAGE__->register_method (
3233     method      => 'retrieve_org_hours',
3234     api_name    => 'open-ils.actor.org_unit.hours_of_operation.retrieve',
3235     signature   => q/
3236         Returns the hours of operation for a specified org unit
3237         @param authtoken The login session key
3238         @param org_id The org_unit ID
3239     /
3240 );
3241
3242 sub retrieve_org_hours {
3243     my($self, $conn, $auth, $org_id) = @_;
3244     my $e = new_editor(authtoken => $auth);
3245     return $e->die_event unless $e->checkauth;
3246     $org_id ||= $e->requestor->ws_ou;
3247     return $e->retrieve_actor_org_unit_hours_of_operation($org_id);
3248 }
3249
3250
3251 __PACKAGE__->register_method (
3252     method      => 'verify_user_password',
3253     api_name    => 'open-ils.actor.verify_user_password',
3254     signature   => q/
3255         Given a barcode or username and the MD5 encoded password, 
3256         returns 1 if the password is correct.  Returns 0 otherwise.
3257     /
3258 );
3259
3260 sub verify_user_password {
3261     my($self, $conn, $auth, $barcode, $username, $password) = @_;
3262     my $e = new_editor(authtoken => $auth);
3263     return $e->die_event unless $e->checkauth;
3264     my $user;
3265     my $user_by_barcode;
3266     my $user_by_username;
3267     if($barcode) {
3268         my $card = $e->search_actor_card([
3269             {barcode => $barcode},
3270             {flesh => 1, flesh_fields => {ac => ['usr']}}])->[0] or return 0;
3271         $user_by_barcode = $card->usr;
3272         $user = $user_by_barcode;
3273     }
3274     if ($username) {
3275         $user_by_username = $e->search_actor_user({usrname => $username})->[0] or return 0;
3276         $user = $user_by_username;
3277     }
3278     return 0 if (!$user);
3279     return 0 if ($user_by_username && $user_by_barcode && $user_by_username->id != $user_by_barcode->id); 
3280     return $e->event unless $e->allowed('VIEW_USER', $user->home_ou);
3281     return 1 if $user->passwd eq $password;
3282     return 0;
3283 }
3284
3285 __PACKAGE__->register_method (
3286     method      => 'retrieve_usr_id_via_barcode_or_usrname',
3287     api_name    => "open-ils.actor.user.retrieve_id_by_barcode_or_username",
3288     signature   => q/
3289         Given a barcode or username returns the id for the user or
3290         a failure event.
3291     /
3292 );
3293
3294 sub retrieve_usr_id_via_barcode_or_usrname {
3295     my($self, $conn, $auth, $barcode, $username) = @_;
3296     my $e = new_editor(authtoken => $auth);
3297     return $e->die_event unless $e->checkauth;
3298     my $id_as_barcode= OpenSRF::Utils::SettingsClient->new->config_value(apps => 'open-ils.actor' => app_settings => 'id_as_barcode');
3299     my $user;
3300     my $user_by_barcode;
3301     my $user_by_username;
3302     $logger->info("$id_as_barcode is the ID as BARCODE");
3303     if($barcode) {
3304         my $card = $e->search_actor_card([
3305             {barcode => $barcode},
3306             {flesh => 1, flesh_fields => {ac => ['usr']}}])->[0];
3307         if ($id_as_barcode =~ /^t/i) {
3308             if (!$card) {
3309                 $user = $e->retrieve_actor_user($barcode);
3310                 return OpenILS::Event->new( 'ACTOR_USER_NOT_FOUND' ) if(!$user);
3311             }else {
3312                 $user_by_barcode = $card->usr;
3313                 $user = $user_by_barcode;
3314             }
3315         }else {
3316             return OpenILS::Event->new( 'ACTOR_USER_NOT_FOUND' ) if(!$card);
3317             $user_by_barcode = $card->usr;
3318             $user = $user_by_barcode;
3319         }
3320     }
3321
3322     if ($username) {
3323         $user_by_username = $e->search_actor_user({usrname => $username})->[0] or return OpenILS::Event->new( 'ACTOR_USR_NOT_FOUND' );
3324
3325         $user = $user_by_username;
3326     }
3327     return OpenILS::Event->new( 'ACTOR_USER_NOT_FOUND' ) if (!$user);
3328     return OpenILS::Event->new( 'ACTOR_USER_NOT_FOUND' ) if ($user_by_username && $user_by_barcode && $user_by_username->id != $user_by_barcode->id); 
3329     return $e->event unless $e->allowed('VIEW_USER', $user->home_ou);
3330     return $user->id;
3331 }
3332
3333
3334 __PACKAGE__->register_method (
3335     method      => 'merge_users',
3336     api_name    => 'open-ils.actor.user.merge',
3337     signature   => {
3338         desc => q/
3339             Given a list of source users and destination user, transfer all data from the source
3340             to the dest user and delete the source user.  All user related data is 
3341             transferred, including circulations, holds, bookbags, etc.
3342         /
3343     }
3344 );
3345
3346 sub merge_users {
3347     my($self, $conn, $auth, $master_id, $user_ids, $options) = @_;
3348     my $e = new_editor(xact => 1, authtoken => $auth);
3349     return $e->die_event unless $e->checkauth;
3350
3351     # disallow the merge if any subordinate accounts are in collections
3352     my $colls = $e->search_money_collections_tracker({usr => $user_ids}, {idlist => 1});
3353     return OpenILS::Event->new('MERGED_USER_IN_COLLECTIONS', payload => $user_ids) if @$colls;
3354
3355     my $master_user = $e->retrieve_actor_user($master_id) or return $e->die_event;
3356     my $del_addrs = ($U->ou_ancestor_setting_value(
3357         $master_user->home_ou, 'circ.user_merge.delete_addresses', $e)) ? 't' : 'f';
3358     my $del_cards = ($U->ou_ancestor_setting_value(
3359         $master_user->home_ou, 'circ.user_merge.delete_cards', $e)) ? 't' : 'f';
3360     my $deactivate_cards = ($U->ou_ancestor_setting_value(
3361         $master_user->home_ou, 'circ.user_merge.deactivate_cards', $e)) ? 't' : 'f';
3362
3363     for my $src_id (@$user_ids) {
3364         my $src_user = $e->retrieve_actor_user($src_id) or return $e->die_event;
3365
3366         return $e->die_event unless $e->allowed('MERGE_USERS', $src_user->home_ou);
3367         if($src_user->home_ou ne $master_user->home_ou) {
3368             return $e->die_event unless $e->allowed('MERGE_USERS', $master_user->home_ou);
3369         }
3370
3371         return $e->die_event unless 
3372             $e->json_query({from => [
3373                 'actor.usr_merge', 
3374                 $src_id, 
3375                 $master_id,
3376                 $del_addrs,
3377                 $del_cards,
3378                 $deactivate_cards
3379             ]});
3380     }
3381
3382     $e->commit;
3383     return 1;
3384 }
3385
3386
3387 __PACKAGE__->register_method (
3388     method      => 'approve_user_address',
3389     api_name    => 'open-ils.actor.user.pending_address.approve',
3390     signature   => {
3391         desc => q/
3392         /
3393     }
3394 );
3395
3396 sub approve_user_address {
3397     my($self, $conn, $auth, $addr) = @_;
3398     my $e = new_editor(xact => 1, authtoken => $auth);
3399     return $e->die_event unless $e->checkauth;
3400     if(ref $addr) {
3401         # if the caller passes an address object, assume they want to 
3402         # update it first before approving it
3403         $e->update_actor_user_address($addr) or return $e->die_event;
3404     } else {
3405         $addr = $e->retrieve_actor_user_address($addr) or return $e->die_event;
3406     }
3407     my $user = $e->retrieve_actor_user($addr->usr);
3408     return $e->die_event unless $e->allowed('UPDATE_USER', $user->home_ou);
3409     my $result = $e->json_query({from => ['actor.approve_pending_address', $addr->id]})->[0]
3410         or return $e->die_event;
3411     $e->commit;
3412     return [values %$result]->[0]; 
3413 }
3414
3415
3416 __PACKAGE__->register_method (
3417     method      => 'retrieve_friends',
3418     api_name    => 'open-ils.actor.friends.retrieve',
3419     signature   => {
3420         desc => q/
3421             returns { confirmed: [], pending_out: [], pending_in: []}
3422             pending_out are users I'm requesting friendship with
3423             pending_in are users requesting friendship with me
3424         /
3425     }
3426 );
3427
3428 sub retrieve_friends {
3429     my($self, $conn, $auth, $user_id, $options) = @_;
3430     my $e = new_editor(authtoken => $auth);
3431     return $e->event unless $e->checkauth;
3432     $user_id ||= $e->requestor->id;
3433
3434     if($user_id != $e->requestor->id) {
3435         my $user = $e->retrieve_actor_user($user_id) or return $e->event;
3436         return $e->event unless $e->allowed('VIEW_USER', $user->home_ou);
3437     }
3438
3439     return OpenILS::Application::Actor::Friends->retrieve_friends(  
3440         $e, $user_id, $options);
3441 }
3442
3443
3444
3445 __PACKAGE__->register_method (
3446     method      => 'apply_friend_perms',
3447     api_name    => 'open-ils.actor.friends.perms.apply',
3448     signature   => {
3449         desc => q/
3450         /
3451     }
3452 );
3453 sub apply_friend_perms {
3454     my($self, $conn, $auth, $user_id, $delegate_id, @perms) = @_;
3455     my $e = new_editor(authtoken => $auth, xact => 1);
3456     return $e->die_event unless $e->checkauth;
3457
3458     if($user_id != $e->requestor->id) {
3459         my $user = $e->retrieve_actor_user($user_id) or return $e->die_event;
3460         return $e->die_event unless $e->allowed('VIEW_USER', $user->home_ou);
3461     }
3462
3463     for my $perm (@perms) {
3464         my $evt = 
3465             OpenILS::Application::Actor::Friends->apply_friend_perm(
3466                 $e, $user_id, $delegate_id, $perm);
3467         return $evt if $evt;
3468     }
3469
3470     $e->commit;
3471     return 1;
3472 }
3473
3474
3475 __PACKAGE__->register_method (
3476     method      => 'update_user_pending_address',
3477     api_name    => 'open-ils.actor.user.address.pending.cud'
3478 );
3479
3480 sub update_user_pending_address {
3481     my($self, $conn, $auth, $addr) = @_;
3482     my $e = new_editor(authtoken => $auth, xact => 1);
3483     return $e->die_event unless $e->checkauth;
3484
3485     if($addr->usr != $e->requestor->id) {
3486         my $user = $e->retrieve_actor_user($addr->usr) or return $e->die_event;
3487         return $e->die_event unless $e->allowed('UPDATE_USER', $user->home_ou);
3488     }
3489
3490     if($addr->isnew) {
3491         $e->create_actor_user_address($addr) or return $e->die_event;
3492     } elsif($addr->isdeleted) {
3493         $e->delete_actor_user_address($addr) or return $e->die_event;
3494     } else {
3495         $e->update_actor_user_address($addr) or return $e->die_event;
3496     }
3497
3498     $e->commit;
3499     return $addr->id;
3500 }
3501
3502
3503 __PACKAGE__->register_method (
3504     method      => 'user_events',
3505     api_name    => 'open-ils.actor.user.events.circ',
3506     stream      => 1,
3507 );
3508 __PACKAGE__->register_method (
3509     method      => 'user_events',
3510     api_name    => 'open-ils.actor.user.events.ahr',
3511     stream      => 1,
3512 );
3513
3514 sub user_events {
3515     my($self, $conn, $auth, $user_id, $filters) = @_;
3516     my $e = new_editor(authtoken => $auth);
3517     return $e->event unless $e->checkauth;
3518
3519     (my $obj_type = $self->api_name) =~ s/.*\.([a-z]+)$/$1/;
3520     my $user_field = 'usr';
3521
3522     $filters ||= {};
3523     $filters->{target} = { 
3524         select => { $obj_type => ['id'] },
3525         from => $obj_type,
3526         where => {usr => $user_id}
3527     };
3528
3529     my $user = $e->retrieve_actor_user($user_id) or return $e->event;
3530     if($e->requestor->id != $user_id) {
3531         return $e->event unless $e->allowed('VIEW_USER', $user->home_ou);
3532     }
3533
3534     my $ses = OpenSRF::AppSession->create('open-ils.trigger');
3535     my $req = $ses->request('open-ils.trigger.events_by_target', 
3536         $obj_type, $filters, {atevdef => ['reactor', 'validator']}, 2);
3537
3538     while(my $resp = $req->recv) {
3539         my $val = $resp->content;
3540         my $tgt = $val->target;
3541
3542         if($obj_type eq 'circ') {
3543             $tgt->target_copy($e->retrieve_asset_copy($tgt->target_copy));
3544
3545         } elsif($obj_type eq 'ahr') {
3546             $tgt->current_copy($e->retrieve_asset_copy($tgt->current_copy))
3547                 if $tgt->current_copy;
3548         }
3549
3550         $conn->respond($val) if $val;
3551     }
3552
3553     return undef;
3554 }
3555
3556 __PACKAGE__->register_method (
3557     method      => 'copy_events',
3558     api_name    => 'open-ils.actor.copy.events.circ',
3559     stream      => 1,
3560 );
3561 __PACKAGE__->register_method (
3562     method      => 'copy_events',
3563     api_name    => 'open-ils.actor.copy.events.ahr',
3564     stream      => 1,
3565 );
3566
3567 sub copy_events {
3568     my($self, $conn, $auth, $copy_id, $filters) = @_;
3569     my $e = new_editor(authtoken => $auth);
3570     return $e->event unless $e->checkauth;
3571
3572     (my $obj_type = $self->api_name) =~ s/.*\.([a-z]+)$/$1/;
3573
3574     my $copy = $e->retrieve_asset_copy($copy_id) or return $e->event;
3575
3576     my $copy_field = 'target_copy';
3577     $copy_field = 'current_copy' if $obj_type eq 'ahr';
3578
3579     $filters ||= {};
3580     $filters->{target} = { 
3581         select => { $obj_type => ['id'] },
3582         from => $obj_type,
3583         where => {$copy_field => $copy_id}
3584     };
3585
3586
3587     my $ses = OpenSRF::AppSession->create('open-ils.trigger');
3588     my $req = $ses->request('open-ils.trigger.events_by_target', 
3589         $obj_type, $filters, {atevdef => ['reactor', 'validator']}, 2);
3590
3591     while(my $resp = $req->recv) {
3592         my $val = $resp->content;
3593         my $tgt = $val->target;
3594         
3595         my $user = $e->retrieve_actor_user($tgt->usr);
3596         if($e->requestor->id != $user->id) {
3597             return $e->event unless $e->allowed('VIEW_USER', $user->home_ou);
3598         }
3599
3600         $tgt->$copy_field($copy);
3601
3602         $tgt->usr($user);
3603         $conn->respond($val) if $val;
3604     }
3605
3606     return undef;
3607 }
3608
3609
3610
3611
3612 __PACKAGE__->register_method (
3613     method      => 'update_events',
3614     api_name    => 'open-ils.actor.user.event.cancel.batch',
3615     stream      => 1,
3616 );
3617 __PACKAGE__->register_method (
3618     method      => 'update_events',
3619     api_name    => 'open-ils.actor.user.event.reset.batch',
3620     stream      => 1,
3621 );
3622
3623 sub update_events {
3624     my($self, $conn, $auth, $event_ids) = @_;
3625     my $e = new_editor(xact => 1, authtoken => $auth);
3626     return $e->die_event unless $e->checkauth;
3627
3628     my $x = 1;
3629     for my $id (@$event_ids) {
3630
3631         # do a little dance to determine what user we are ultimately affecting
3632         my $event = $e->retrieve_action_trigger_event([
3633             $id,
3634             {   flesh => 2,
3635                 flesh_fields => {atev => ['event_def'], atevdef => ['hook']}
3636             }
3637         ]) or return $e->die_event;
3638
3639         my $user_id;
3640         if($event->event_def->hook->core_type eq 'circ') {
3641             $user_id = $e->retrieve_action_circulation($event->target)->usr;
3642         } elsif($event->event_def->hook->core_type eq 'ahr') {
3643             $user_id = $e->retrieve_action_hold_request($event->target)->usr;
3644         } else {
3645             return 0;
3646         }
3647
3648         my $user = $e->retrieve_actor_user($user_id);
3649         return $e->die_event unless $e->allowed('UPDATE_USER', $user->home_ou);
3650
3651         if($self->api_name =~ /cancel/) {
3652             $event->state('invalid');
3653         } elsif($self->api_name =~ /reset/) {
3654             $event->clear_start_time;
3655             $event->clear_update_time;
3656             $event->state('pending');
3657         }
3658
3659         $e->update_action_trigger_event($event) or return $e->die_event;
3660         $conn->respond({maximum => scalar(@$event_ids), progress => $x++});
3661     }
3662
3663     $e->commit;
3664     return {complete => 1};
3665 }
3666
3667
3668 __PACKAGE__->register_method (
3669     method      => 'really_delete_user',
3670     api_name    => 'open-ils.actor.user.delete.override',
3671     signature   => q/@see open-ils.actor.user.delete/
3672 );
3673
3674 __PACKAGE__->register_method (
3675     method      => 'really_delete_user',
3676     api_name    => 'open-ils.actor.user.delete',
3677     signature   => q/
3678         It anonymizes all personally identifiable information in actor.usr. By calling actor.usr_purge_data() 
3679         it also purges related data from other tables, sometimes by transferring it to a designated destination user.
3680         The usrname field (along with first_given_name and family_name) is updated to id '-PURGED-' now().
3681         dest_usr_id is only required when deleting a user that performs staff functions.
3682     /
3683 );
3684
3685 sub really_delete_user {
3686     my($self, $conn, $auth, $user_id, $dest_user_id, $oargs) = @_;
3687     my $e = new_editor(authtoken => $auth, xact => 1);
3688     return $e->die_event unless $e->checkauth;
3689     $oargs = { all => 1 } unless defined $oargs;
3690
3691     # Find all unclosed billings for for user $user_id, thereby, also checking for open circs
3692     my $open_bills = $e->json_query({
3693         select => { mbts => ['id'] },
3694         from => 'mbts',
3695         where => {
3696             xact_finish => { '=' => undef },
3697             usr => { '=' => $user_id },
3698         }
3699     }) or return $e->die_event;
3700
3701     my $user = $e->retrieve_actor_user($user_id) or return $e->die_event;
3702
3703     # No deleting patrons with open billings or checked out copies, unless perm-enabled override
3704     if (@$open_bills) {
3705         return $e->die_event(OpenILS::Event->new('ACTOR_USER_DELETE_OPEN_XACTS'))
3706         unless $self->api_name =~ /override/o && ($oargs->{all} || grep { $_ eq 'ACTOR_USER_DELETE_OPEN_XACTS' } @{$oargs->{events}})
3707         && $e->allowed('ACTOR_USER_DELETE_OPEN_XACTS.override', $user->home_ou);
3708     }
3709     # No deleting yourself - UI is supposed to stop you first, though.
3710     return $e->die_event unless $e->requestor->id != $user->id;
3711     return $e->die_event unless $e->allowed('DELETE_USER', $user->home_ou);
3712     # Check if you are allowed to mess with this patron permission group at all
3713     my $session = OpenSRF::AppSession->create( "open-ils.storage" );
3714     my $evt = group_perm_failed($session, $e->requestor, $user);
3715     return $e->die_event($evt) if $evt;
3716     my $stat = $e->json_query(
3717         {from => ['actor.usr_delete', $user_id, $dest_user_id]})->[0]
3718         or return $e->die_event;
3719     $e->commit;
3720     return 1;
3721 }
3722
3723
3724 __PACKAGE__->register_method (
3725     method      => 'user_payments',
3726     api_name    => 'open-ils.actor.user.payments.retrieve',
3727     stream => 1,
3728     signature   => q/
3729         Returns all payments for a given user.  Default order is newest payments first.
3730         @param auth Authentication token
3731         @param user_id The user ID
3732         @param filters An optional hash of filters, including limit, offset, and order_by definitions
3733     /
3734 );
3735
3736 sub user_payments {
3737     my($self, $conn, $auth, $user_id, $filters) = @_;
3738     $filters ||= {};
3739
3740     my $e = new_editor(authtoken => $auth);
3741     return $e->die_event unless $e->checkauth;
3742
3743     my $user = $e->retrieve_actor_user($user_id) or return $e->event;
3744     return $e->event unless 
3745         $e->requestor->id == $user_id or
3746         $e->allowed('VIEW_USER_TRANSACTIONS', $user->home_ou);
3747
3748     # Find all payments for all transactions for user $user_id
3749     my $query = {
3750         select => {mp => ['id']}, 
3751         from => 'mp', 
3752         where => {
3753             xact => {
3754                 in => {
3755                     select => {mbt => ['id']}, 
3756                     from => 'mbt', 
3757                     where => {usr => $user_id}
3758                 }   
3759             }
3760         },
3761         order_by => [
3762             { # by default, order newest payments first
3763                 class => 'mp', 
3764                 field => 'payment_ts',
3765                 direction => 'desc'
3766             }, {
3767                 # secondary sort in ID as a tie-breaker, since payments created
3768                 # within the same transaction will have identical payment_ts's
3769                 class => 'mp',
3770                 field => 'id'
3771             }
3772         ]
3773     };
3774
3775     for (qw/order_by limit offset/) {
3776         $query->{$_} = $filters->{$_} if defined $filters->{$_};
3777     }
3778
3779     if(defined $filters->{where}) {
3780         foreach (keys %{$filters->{where}}) {
3781             # don't allow the caller to expand the result set to other users
3782             $query->{where}->{$_} = $filters->{where}->{$_} unless $_ eq 'xact'; 
3783         }
3784     }
3785
3786     my $payment_ids = $e->json_query($query);
3787     for my $pid (@$payment_ids) {
3788         my $pay = $e->retrieve_money_payment([
3789             $pid->{id},
3790             {   flesh => 6,
3791                 flesh_fields => {
3792                     mp => ['xact'],
3793                     mbt => ['summary', 'circulation', 'grocery'],
3794                     circ => ['target_copy'],
3795                     acp => ['call_number'],
3796                     acn => ['record']
3797                 }
3798             }
3799         ]);
3800
3801         my $resp = {
3802             mp => $pay,
3803             xact_type => $pay->xact->summary->xact_type,
3804             last_billing_type => $pay->xact->summary->last_billing_type,
3805         };
3806
3807         if($pay->xact->summary->xact_type eq 'circulation') {
3808             $resp->{barcode} = $pay->xact->circulation->target_copy->barcode;
3809             $resp->{title} = $U->record_to_mvr($pay->xact->circulation->target_copy->call_number->record)->title;
3810         }
3811
3812         $pay->xact($pay->xact->id); # de-flesh
3813         $conn->respond($resp);
3814     }
3815
3816     return undef;
3817 }
3818
3819
3820
3821 __PACKAGE__->register_method (
3822     method      => 'negative_balance_users',
3823     api_name    => 'open-ils.actor.users.negative_balance',
3824     stream => 1,
3825     signature   => q/
3826         Returns all users that have an overall negative balance
3827         @param auth Authentication token
3828         @param org_id The context org unit as an ID or list of IDs.  This will be the home 
3829         library of the user.  If no org_unit is specified, no org unit filter is applied
3830     /
3831 );
3832
3833 sub negative_balance_users {
3834     my($self, $conn, $auth, $org_id) = @_;
3835
3836     my $e = new_editor(authtoken => $auth);
3837     return $e->die_event unless $e->checkauth;
3838     return $e->die_event unless $e->allowed('VIEW_USER', $org_id);
3839
3840     my $query = {
3841         select => { 
3842             mous => ['usr', 'balance_owed'], 
3843             au => ['home_ou'], 
3844             mbts => [
3845                 {column => 'last_billing_ts', transform => 'max', aggregate => 1},
3846                 {column => 'last_payment_ts', transform => 'max', aggregate => 1},
3847             ]
3848         }, 
3849         from => { 
3850             mous => { 
3851                 au => { 
3852                     fkey => 'usr', 
3853                     field => 'id', 
3854                     join => { 
3855                         mbts => { 
3856                             key => 'id', 
3857                             field => 'usr' 
3858                         } 
3859                     } 
3860                 } 
3861             } 
3862         }, 
3863         where => {'+mous' => {balance_owed => {'<' => 0}}} 
3864     };
3865
3866     $query->{from}->{mous}->{au}->{filter}->{home_ou} = $org_id if $org_id;
3867
3868     my $list = $e->json_query($query, {timeout => 600});
3869
3870     for my $data (@$list) {
3871         $conn->respond({
3872             usr => $e->retrieve_actor_user([$data->{usr}, {flesh => 1, flesh_fields => {au => ['card']}}]),
3873             balance_owed => $data->{balance_owed},
3874             last_billing_activity => max($data->{last_billing_ts}, $data->{last_payment_ts})
3875         });
3876     }
3877
3878     return undef;
3879 }
3880
3881 __PACKAGE__->register_method(
3882     method  => "request_password_reset",
3883     api_name    => "open-ils.actor.patron.password_reset.request",
3884     signature   => {
3885         desc => "Generates a UUID token usable with the open-ils.actor.patron.password_reset.commit " .
3886                 "method for changing a user's password.  The UUID token is distributed via A/T "      .
3887                 "templates (i.e. email to the user).",
3888         params => [
3889             { desc => 'user_id_type', type => 'string' },
3890             { desc => 'user_id', type => 'string' },
3891             { desc => 'optional (based on library setting) matching email address for authorizing request', type => 'string' },
3892         ],
3893         return => {desc => '1 on success, Event on error'}
3894     }
3895 );
3896 sub request_password_reset {
3897     my($self, $conn, $user_id_type, $user_id, $email) = @_;
3898
3899     # Check to see if password reset requests are already being throttled:
3900     # 0. Check cache to see if we're in throttle mode (avoid hitting database)
3901
3902     my $e = new_editor(xact => 1);
3903     my $user;
3904
3905     # Get the user, if any, depending on the input value
3906     if ($user_id_type eq 'username') {
3907         $user = $e->search_actor_user({usrname => $user_id})->[0];
3908         if (!$user) {
3909             $e->die_event;
3910             return OpenILS::Event->new( 'ACTOR_USER_NOT_FOUND' );
3911         }
3912     } elsif ($user_id_type eq 'barcode') {
3913         my $card = $e->search_actor_card([
3914             {barcode => $user_id},
3915             {flesh => 1, flesh_fields => {ac => ['usr']}}])->[0];
3916         if (!$card) { 
3917             $e->die_event;
3918             return OpenILS::Event->new('ACTOR_USER_NOT_FOUND');
3919         }
3920         $user = $card->usr;
3921     }
3922     
3923     # If the user doesn't have an email address, we can't help them
3924     if (!$user->email) {
3925         $e->die_event;
3926         return OpenILS::Event->new('PATRON_NO_EMAIL_ADDRESS');
3927     }
3928     
3929     my $email_must_match = $U->ou_ancestor_setting_value($user->home_ou, 'circ.password_reset_request_requires_matching_email');
3930     if ($email_must_match) {
3931         if ($user->email ne $email) {
3932             return OpenILS::Event->new('EMAIL_VERIFICATION_FAILED');
3933         }
3934     }
3935
3936     _reset_password_request($conn, $e, $user);
3937 }
3938
3939 # Once we have the user, we can issue the password reset request
3940 # XXX Add a wrapper method that accepts barcode + email input
3941 sub _reset_password_request {
3942     my ($conn, $e, $user) = @_;
3943
3944     # 1. Get throttle threshold and time-to-live from OU_settings
3945     my $aupr_throttle = $U->ou_ancestor_setting_value($user->home_ou, 'circ.password_reset_request_throttle') || 1000;
3946     my $aupr_ttl = $U->ou_ancestor_setting_value($user->home_ou, 'circ.password_reset_request_time_to_live') || 24*60*60;
3947
3948     my $threshold_time = DateTime->now(time_zone => 'local')->subtract(seconds => $aupr_ttl)->iso8601();
3949
3950     # 2. Get time of last request and number of active requests (num_active)
3951     my $active_requests = $e->json_query({
3952         from => 'aupr',
3953         select => {
3954             aupr => [
3955                 {
3956                     column => 'uuid',
3957                     transform => 'COUNT'
3958                 },
3959                 {
3960                     column => 'request_time',
3961                     transform => 'MAX'
3962                 }
3963             ]
3964         },
3965         where => {
3966             has_been_reset => { '=' => 'f' },
3967             request_time => { '>' => $threshold_time }
3968         }
3969     });
3970
3971     # Guard against no active requests
3972     if ($active_requests->[0]->{'request_time'}) {
3973         my $last_request = DateTime::Format::ISO8601->parse_datetime(clense_ISO8601($active_requests->[0]->{'request_time'}));
3974         my $now = DateTime::Format::ISO8601->new();
3975
3976         # 3. if (num_active > throttle_threshold) and (now - last_request < 1 minute)
3977         if (($active_requests->[0]->{'usr'} > $aupr_throttle) &&
3978             ($last_request->add_duration('1 minute') > $now)) {
3979             $cache->put_cache('open-ils.actor.password.throttle', DateTime::Format::ISO8601->new(), 60);
3980             $e->die_event;
3981             return OpenILS::Event->new('PATRON_TOO_MANY_ACTIVE_PASSWORD_RESET_REQUESTS');
3982         }
3983     }
3984
3985     # TODO Check to see if the user is in a password-reset-restricted group
3986
3987     # Otherwise, go ahead and try to get the user.
3988  
3989     # Check the number of active requests for this user
3990     $active_requests = $e->json_query({
3991         from => 'aupr',
3992         select => {
3993             aupr => [
3994                 {
3995                     column => 'usr',
3996                     transform => 'COUNT'
3997                 }
3998             ]
3999         },
4000         where => {
4001             usr => { '=' => $user->id },
4002             has_been_reset => { '=' => 'f' },
4003             request_time => { '>' => $threshold_time }
4004         }
4005     });
4006
4007     $logger->info("User " . $user->id . " has " . $active_requests->[0]->{'usr'} . " active password reset requests.");
4008
4009     # if less than or equal to per-user threshold, proceed; otherwise, return event
4010     my $aupr_per_user_limit = $U->ou_ancestor_setting_value($user->home_ou, 'circ.password_reset_request_per_user_limit') || 3;
4011     if ($active_requests->[0]->{'usr'} > $aupr_per_user_limit) {
4012         $e->die_event;
4013         return OpenILS::Event->new('PATRON_TOO_MANY_ACTIVE_PASSWORD_RESET_REQUESTS');
4014     }
4015
4016     # Create the aupr object and insert into the database
4017     my $reset_request = Fieldmapper::actor::usr_password_reset->new;
4018     my $uuid = create_uuid_as_string(UUID_V4);
4019     $reset_request->uuid($uuid);
4020     $reset_request->usr($user->id);
4021
4022     my $aupr = $e->create_actor_usr_password_reset($reset_request) or return $e->die_event;
4023     $e->commit;
4024
4025     # Create an event to notify user of the URL to reset their password
4026
4027     # Can we stuff this in the user_data param for trigger autocreate?
4028     my $hostname = $U->ou_ancestor_setting_value($user->home_ou, 'lib.hostname') || 'localhost';
4029
4030     my $ses = OpenSRF::AppSession->create('open-ils.trigger');
4031     $ses->request('open-ils.trigger.event.autocreate', 'password.reset_request', $aupr, $user->home_ou);
4032
4033     # Trunk only
4034     # $U->create_trigger_event('password.reset_request', $aupr, $user->home_ou);
4035
4036     return 1;
4037 }
4038
4039 __PACKAGE__->register_method(
4040     method  => "commit_password_reset",
4041     api_name    => "open-ils.actor.patron.password_reset.commit",
4042     signature   => {
4043         desc => "Checks a UUID token generated by the open-ils.actor.patron.password_reset.request method for " .
4044                 "validity, and if valid, uses it as authorization for changing the associated user's password " .
4045                 "with the supplied password.",
4046         params => [
4047             { desc => 'uuid', type => 'string' },
4048             { desc => 'password', type => 'string' },
4049         ],
4050         return => {desc => '1 on success, Event on error'}
4051     }
4052 );
4053 sub commit_password_reset {
4054     my($self, $conn, $uuid, $password) = @_;
4055
4056     # Check to see if password reset requests are already being throttled:
4057     # 0. Check cache to see if we're in throttle mode (avoid hitting database)
4058     $cache ||= OpenSRF::Utils::Cache->new("global", 0);
4059     my $throttle = $cache->get_cache('open-ils.actor.password.throttle') || undef;
4060     if ($throttle) {
4061         return OpenILS::Event->new('PATRON_NOT_AN_ACTIVE_PASSWORD_RESET_REQUEST');
4062     }
4063
4064     my $e = new_editor(xact => 1);
4065
4066     my $aupr = $e->search_actor_usr_password_reset({
4067         uuid => $uuid,
4068         has_been_reset => 0
4069     });
4070
4071     if (!$aupr->[0]) {
4072         $e->die_event;
4073         return OpenILS::Event->new('PATRON_NOT_AN_ACTIVE_PASSWORD_RESET_REQUEST');
4074     }
4075     my $user_id = $aupr->[0]->usr;
4076     my $user = $e->retrieve_actor_user($user_id);
4077
4078     # Ensure we're still within the TTL for the request
4079     my $aupr_ttl = $U->ou_ancestor_setting_value($user->home_ou, 'circ.password_reset_request_time_to_live') || 24*60*60;
4080     my $threshold = DateTime::Format::ISO8601->parse_datetime(clense_ISO8601($aupr->[0]->request_time))->add(seconds => $aupr_ttl);
4081     if ($threshold < DateTime->now(time_zone => 'local')) {
4082         $e->die_event;
4083         $logger->info("Password reset request needed to be submitted before $threshold");
4084         return OpenILS::Event->new('PATRON_NOT_AN_ACTIVE_PASSWORD_RESET_REQUEST');
4085     }
4086
4087     # Check complexity of password against OU-defined regex
4088     my $pw_regex = $U->ou_ancestor_setting_value($user->home_ou, 'global.password_regex');
4089
4090     my $is_strong = 0;
4091     if ($pw_regex) {
4092         # Calling JSON2perl on the $pw_regex causes failure, even before the fancy Unicode regex
4093         # ($pw_regex = OpenSRF::Utils::JSON->JSON2perl($pw_regex)) =~ s/\\u([0-9a-fA-F]{4})/\\x{$1}/gs;
4094         $is_strong = check_password_strength_custom($password, $pw_regex);
4095     } else {
4096         $is_strong = check_password_strength_default($password);
4097     }
4098
4099     if (!$is_strong) {
4100         $e->die_event;
4101         return OpenILS::Event->new('PATRON_PASSWORD_WAS_NOT_STRONG');
4102     }
4103
4104     # All is well; update the password
4105     $user->passwd($password);
4106     $e->update_actor_user($user);
4107
4108     # And flag that this password reset request has been honoured
4109     $aupr->[0]->has_been_reset('t');
4110     $e->update_actor_usr_password_reset($aupr->[0]);
4111     $e->commit;
4112
4113     return 1;
4114 }
4115
4116 sub check_password_strength_default {
4117     my $password = shift;
4118     # Use the default set of checks
4119     if ( (length($password) < 7) or 
4120             ($password !~ m/.*\d+.*/) or 
4121             ($password !~ m/.*[A-Za-z]+.*/)
4122        ) {
4123         return 0;
4124     }
4125     return 1;
4126 }
4127
4128 sub check_password_strength_custom {
4129     my ($password, $pw_regex) = @_;
4130
4131     $pw_regex = qr/$pw_regex/;
4132     if ($password !~  /$pw_regex/) {
4133         return 0;
4134     }
4135     return 1;
4136 }
4137
4138
4139
4140 __PACKAGE__->register_method(
4141     method    => "event_def_opt_in_settings",
4142     api_name  => "open-ils.actor.event_def.opt_in.settings",
4143     stream => 1,
4144     signature => {
4145         desc   => 'Streams the set of "cust" objects that are used as opt-in settings for event definitions',
4146         params => [
4147             { desc => 'Authentication token',  type => 'string'},
4148             { 
4149                 desc => 'Org Unit ID.  (optional).  If no org ID is present, the home_ou of the requesting user is used', 
4150                 type => 'number'
4151             },
4152         ],
4153         return => {
4154             desc => q/set of "cust" objects that are used as opt-in settings for event definitions at the specified org unit/,
4155             type => 'object',
4156             class => 'cust'
4157         }
4158     }
4159 );
4160
4161 sub event_def_opt_in_settings {
4162     my($self, $conn, $auth, $org_id) = @_;
4163     my $e = new_editor(authtoken => $auth);
4164     return $e->event unless $e->checkauth;
4165
4166     if(defined $org_id and $org_id != $e->requestor->home_ou) {
4167         return $e->event unless 
4168             $e->allowed(['VIEW_USER_SETTING_TYPE', 'ADMIN_USER_SETTING_TYPE'], $org_id);
4169     } else {
4170         $org_id = $e->requestor->home_ou;
4171     }
4172
4173     # find all config.user_setting_type's related to event_defs for the requested org unit
4174     my $types = $e->json_query({
4175         select => {cust => ['name']}, 
4176         from => {atevdef => 'cust'}, 
4177         where => {
4178             '+atevdef' => {
4179                 owner => $U->get_org_ancestors($org_id), # context org plus parents
4180                 active => 't'
4181             }
4182         }
4183     });
4184
4185     if(@$types) {
4186         $conn->respond($_) for 
4187             @{$e->search_config_usr_setting_type({name => [map {$_->{name}} @$types]})};
4188     }
4189
4190     return undef;
4191 }
4192
4193
4194 __PACKAGE__->register_method(
4195     method    => "user_visible_circs",
4196     api_name  => "open-ils.actor.history.circ.visible",
4197     stream => 1,
4198     signature => {
4199         desc   => 'Returns the set of opt-in visible circulations accompanied by circulation chain summaries',
4200         params => [
4201             { desc => 'Authentication token',  type => 'string'},
4202             { desc => 'User ID.  If no user id is present, the authenticated user is assumed', type => 'number' },
4203             { desc => 'Options hash.  Supported fields are "limit" and "offset"', type => 'object' },
4204         ],
4205         return => {
4206             desc => q/An object with 2 fields: circulation and summary.  
4207                 circulation is the "circ" object.   summary is the related "accs" object/,
4208             type => 'object',
4209         }
4210     }
4211 );
4212
4213 __PACKAGE__->register_method(
4214     method    => "user_visible_circs",
4215     api_name  => "open-ils.actor.history.circ.visible.print",
4216     stream => 1,
4217     signature => {
4218         desc   => 'Returns printable output for the set of opt-in visible circulations',
4219         params => [
4220             { desc => 'Authentication token',  type => 'string'},
4221             { desc => 'User ID.  If no user id is present, the authenticated user is assumed', type => 'number' },
4222             { desc => 'Options hash.  Supported fields are "limit" and "offset"', type => 'object' },
4223         ],
4224         return => {
4225             desc => q/An action_trigger.event object or error event./,
4226             type => 'object',
4227         }
4228     }
4229 );
4230
4231 __PACKAGE__->register_method(
4232     method    => "user_visible_circs",
4233     api_name  => "open-ils.actor.history.circ.visible.email",
4234     stream => 1,
4235     signature => {
4236         desc   => 'Emails the set of opt-in visible circulations to the requestor',
4237         params => [
4238             { desc => 'Authentication token',  type => 'string'},
4239             { desc => 'User ID.  If no user id is present, the authenticated user is assumed', type => 'number' },
4240             { desc => 'Options hash.  Supported fields are "limit" and "offset"', type => 'object' },
4241         ],
4242         return => {
4243             desc => q/undef, or event on error/
4244         }
4245     }
4246 );
4247
4248 __PACKAGE__->register_method(
4249     method    => "user_visible_circs",
4250     api_name  => "open-ils.actor.history.hold.visible",
4251     stream => 1,
4252     signature => {
4253         desc   => 'Returns the set of opt-in visible holds',
4254         params => [
4255             { desc => 'Authentication token',  type => 'string'},
4256             { desc => 'User ID.  If no user id is present, the authenticated user is assumed', type => 'number' },
4257             { desc => 'Options hash.  Supported fields are "limit" and "offset"', type => 'object' },
4258         ],
4259         return => {
4260             desc => q/An object with 1 field: "hold"/,
4261             type => 'object',
4262         }
4263     }
4264 );
4265
4266 __PACKAGE__->register_method(
4267     method    => "user_visible_circs",
4268     api_name  => "open-ils.actor.history.hold.visible.print",
4269     stream => 1,
4270     signature => {
4271         desc   => 'Returns printable output for the set of opt-in visible holds',
4272         params => [
4273             { desc => 'Authentication token',  type => 'string'},
4274             { desc => 'User ID.  If no user id is present, the authenticated user is assumed', type => 'number' },
4275             { desc => 'Options hash.  Supported fields are "limit" and "offset"', type => 'object' },
4276         ],
4277         return => {
4278             desc => q/An action_trigger.event object or error event./,
4279             type => 'object',
4280         }
4281     }
4282 );
4283
4284 __PACKAGE__->register_method(
4285     method    => "user_visible_circs",
4286     api_name  => "open-ils.actor.history.hold.visible.email",
4287     stream => 1,
4288     signature => {
4289         desc   => 'Emails the set of opt-in visible holds to the requestor',
4290         params => [
4291             { desc => 'Authentication token',  type => 'string'},
4292             { desc => 'User ID.  If no user id is present, the authenticated user is assumed', type => 'number' },
4293             { desc => 'Options hash.  Supported fields are "limit" and "offset"', type => 'object' },
4294         ],
4295         return => {
4296             desc => q/undef, or event on error/
4297         }
4298     }
4299 );
4300
4301 sub user_visible_circs {
4302     my($self, $conn, $auth, $user_id, $options) = @_;
4303
4304     my $is_hold = ($self->api_name =~ /hold/);
4305     my $for_print = ($self->api_name =~ /print/);
4306     my $for_email = ($self->api_name =~ /email/);
4307     my $e = new_editor(authtoken => $auth);
4308     return $e->event unless $e->checkauth;
4309
4310     $user_id ||= $e->requestor->id;
4311     $options ||= {};
4312     $options->{limit} ||= 50;
4313     $options->{offset} ||= 0;
4314
4315     if($user_id != $e->requestor->id) {
4316         my $perm = ($is_hold) ? 'VIEW_HOLD' : 'VIEW_CIRCULATIONS';
4317         my $user = $e->retrieve_actor_user($user_id) or return $e->event;
4318         return $e->event unless $e->allowed($perm, $user->home_ou);
4319     }
4320
4321     my $db_func = ($is_hold) ? 'action.usr_visible_holds' : 'action.usr_visible_circs';
4322
4323     my $data = $e->json_query({
4324         from => [$db_func, $user_id],
4325         limit => $$options{limit},
4326         offset => $$options{offset}
4327
4328         # TODO: I only want IDs. code below didn't get me there
4329         # {"select":{"au":[{"column":"id", "result_field":"id", 
4330         # "transform":"action.usr_visible_circs"}]}, "where":{"id":10}, "from":"au"}
4331     },{
4332         substream => 1
4333     });
4334
4335     return undef unless @$data;
4336
4337     if ($for_print) {
4338
4339         # collect the batch of objects
4340
4341         if($is_hold) {
4342
4343             my $hold_list = $e->search_action_hold_request({id => [map { $_->{id} } @$data]});
4344             return $U->fire_object_event(undef, 'ahr.format.history.print', $hold_list, $$hold_list[0]->request_lib);
4345
4346         } else {
4347
4348             my $circ_list = $e->search_action_circulation({id => [map { $_->{id} } @$data]});
4349             return $U->fire_object_event(undef, 'circ.format.history.print', $circ_list, $$circ_list[0]->circ_lib);
4350         }
4351
4352     } elsif ($for_email) {
4353
4354         $conn->respond_complete(1) if $for_email;  # no sense in waiting
4355
4356         foreach (@$data) {
4357
4358             my $id = $_->{id};
4359
4360             if($is_hold) {
4361
4362                 my $hold = $e->retrieve_action_hold_request($id);
4363                 $U->create_events_for_hook('ahr.format.history.email', $hold, $hold->request_lib, undef, undef, 1);
4364                 # events will be fired from action_trigger_runner
4365
4366             } else {
4367
4368                 my $circ = $e->retrieve_action_circulation($id);
4369                 $U->create_events_for_hook('circ.format.history.email', $circ, $circ->circ_lib, undef, undef, 1);
4370                 # events will be fired from action_trigger_runner
4371             }
4372         }
4373
4374     } else { # just give me the data please
4375
4376         foreach (@$data) {
4377
4378             my $id = $_->{id};
4379
4380             if($is_hold) {
4381
4382                 my $hold = $e->retrieve_action_hold_request($id);
4383                 $conn->respond({hold => $hold});
4384
4385             } else {
4386
4387                 my $circ = $e->retrieve_action_circulation($id);
4388                 $conn->respond({
4389                     circ => $circ,
4390                     summary => $U->create_circ_chain_summary($e, $id)
4391                 });
4392             }
4393         }
4394     }
4395
4396     return undef;
4397 }
4398
4399 __PACKAGE__->register_method(
4400     method     => "user_saved_search_cud",
4401     api_name   => "open-ils.actor.user.saved_search.cud",
4402     stream     => 1,
4403     signature  => {
4404         desc   => 'Create/Update/Delete Access to user saved searches',
4405         params => [
4406             { desc => 'Authentication token', type => 'string' },
4407             { desc => 'Saved Search Object', type => 'object', class => 'auss' }
4408         ],
4409         return => {
4410             desc   => q/The retrieved or updated saved search object, or id of a deleted object; Event on error/,
4411             class  => 'auss'
4412         }   
4413     }
4414 );
4415
4416 __PACKAGE__->register_method(
4417     method     => "user_saved_search_cud",
4418     api_name   => "open-ils.actor.user.saved_search.retrieve",
4419     stream     => 1,
4420     signature  => {
4421         desc   => 'Retrieve a saved search object',
4422         params => [
4423             { desc => 'Authentication token', type => 'string' },
4424             { desc => 'Saved Search ID', type => 'number' }
4425         ],
4426         return => {
4427             desc   => q/The saved search object, Event on error/,
4428             class  => 'auss'
4429         }   
4430     }
4431 );
4432
4433 sub user_saved_search_cud {
4434     my( $self, $client, $auth, $search ) = @_;
4435     my $e = new_editor( authtoken=>$auth );
4436     return $e->die_event unless $e->checkauth;
4437
4438     my $o_search;      # prior version of the object, if any
4439     my $res;           # to be returned
4440
4441     # branch on the operation type
4442
4443     if( $self->api_name =~ /retrieve/ ) {                    # Retrieve
4444
4445         # Get the old version, to check ownership
4446         $o_search = $e->retrieve_actor_usr_saved_search( $search )
4447             or return $e->die_event;
4448
4449         # You can't read somebody else's search
4450         return OpenILS::Event->new('BAD_PARAMS')
4451             unless $o_search->owner == $e->requestor->id;
4452
4453         $res = $o_search;
4454
4455     } else {
4456
4457         $e->xact_begin;               # start an editor transaction
4458
4459         if( $search->isnew ) {                               # Create
4460
4461             # You can't create a search for somebody else
4462             return OpenILS::Event->new('BAD_PARAMS')
4463                 unless $search->owner == $e->requestor->id;
4464
4465             $e->create_actor_usr_saved_search( $search )
4466                 or return $e->die_event;
4467
4468             $res = $search->id;
4469
4470         } elsif( $search->ischanged ) {                      # Update
4471
4472             # You can't change ownership of a search
4473             return OpenILS::Event->new('BAD_PARAMS')
4474                 unless $search->owner == $e->requestor->id;
4475
4476             # Get the old version, to check ownership
4477             $o_search = $e->retrieve_actor_usr_saved_search( $search->id )
4478                 or return $e->die_event;
4479
4480             # You can't update somebody else's search
4481             return OpenILS::Event->new('BAD_PARAMS')
4482                 unless $o_search->owner == $e->requestor->id;
4483
4484             # Do the update
4485             $e->update_actor_usr_saved_search( $search )
4486                 or return $e->die_event;
4487
4488             $res = $search;
4489
4490         } elsif( $search->isdeleted ) {                      # Delete
4491
4492             # Get the old version, to check ownership
4493             $o_search = $e->retrieve_actor_usr_saved_search( $search->id )
4494                 or return $e->die_event;
4495
4496             # You can't delete somebody else's search
4497             return OpenILS::Event->new('BAD_PARAMS')
4498                 unless $o_search->owner == $e->requestor->id;
4499
4500             # Do the delete
4501             $e->delete_actor_usr_saved_search( $o_search )
4502                 or return $e->die_event;
4503
4504             $res = $search->id;
4505         }
4506
4507         $e->commit;
4508     }
4509
4510     return $res;
4511 }
4512
4513 __PACKAGE__->register_method(
4514     method   => "get_barcodes",
4515     api_name => "open-ils.actor.get_barcodes"
4516 );
4517
4518 sub get_barcodes {
4519     my( $self, $client, $auth, $org_id, $context, $barcode ) = @_;
4520     my $e = new_editor(authtoken => $auth);
4521     return $e->event unless $e->checkauth;
4522     return $e->event unless $e->allowed('STAFF_LOGIN', $org_id);
4523
4524     my $db_result = $e->json_query(
4525         {   from => [
4526                 'evergreen.get_barcodes',
4527                 $org_id, $context, $barcode,
4528             ]
4529         }
4530     );
4531     if($context =~ /actor/) {
4532         my $filter_result = ();
4533         my $patron;
4534         foreach my $result (@$db_result) {
4535             if($result->{type} eq 'actor') {
4536                 if($e->requestor->id != $result->{id}) {
4537                     $patron = $e->retrieve_actor_user($result->{id});
4538                     if(!$patron) {
4539                         push(@$filter_result, $e->event);
4540                         next;
4541                     }
4542                     if($e->allowed('VIEW_USER', $patron->home_ou)) {
4543                         push(@$filter_result, $result);
4544                     }
4545                     else {
4546                         push(@$filter_result, $e->event);
4547                     }
4548                 }
4549                 else {
4550                     push(@$filter_result, $result);
4551                 }
4552             }
4553             else {
4554                 push(@$filter_result, $result);
4555             }
4556         }
4557         return $filter_result;
4558     }
4559     else {
4560         return $db_result;
4561     }
4562 }
4563 __PACKAGE__->register_method(
4564     method   => 'address_alert_test',
4565     api_name => 'open-ils.actor.address_alert.test',
4566     signature => {
4567         desc => "Tests a set of address fields to determine if they match with an address_alert",
4568         params => [
4569             {desc => 'Authentication token', type => 'string'},
4570             {desc => 'Org Unit',             type => 'number'},
4571             {desc => 'Fields',               type => 'hash'},
4572         ],
4573         return => {desc => 'List of matching address_alerts'}
4574     }
4575 );
4576
4577 sub address_alert_test {
4578     my ($self, $client, $auth, $org_unit, $fields) = @_;
4579     return [] unless $fields and grep {$_} values %$fields;
4580
4581     my $e = new_editor(authtoken => $auth);
4582     return $e->event unless $e->checkauth;
4583     return $e->event unless $e->allowed('CREATE_USER', $org_unit);
4584     $org_unit ||= $e->requestor->ws_ou;
4585
4586     my $alerts = $e->json_query({
4587         from => [
4588             'actor.address_alert_matches',
4589             $org_unit,
4590             $$fields{street1},
4591             $$fields{street2},
4592             $$fields{city},
4593             $$fields{county},
4594             $$fields{state},
4595             $$fields{country},
4596             $$fields{post_code},
4597             $$fields{mailing_address},
4598             $$fields{billing_address}
4599         ]
4600     });
4601
4602     # map the json_query hashes to real objects
4603     return [
4604         map {$e->retrieve_actor_address_alert($_)} 
4605             (map {$_->{id}} @$alerts)
4606     ];
4607 }
4608
4609 __PACKAGE__->register_method(
4610     method   => "mark_users_contact_invalid",
4611     api_name => "open-ils.actor.invalidate.email",
4612     signature => {
4613         desc => "Given a patron, clear the email field and put the old email address into a note and/or create a standing penalty, depending on OU settings",
4614         params => [
4615             {desc => "Authentication token", type => "string"},
4616             {desc => "Patron ID", type => "number"},
4617             {desc => "Additional note text (optional)", type => "string"},
4618             {desc => "penalty org unit ID (optional)", type => "number"}
4619         ],
4620         return => {desc => "Event describing success or failure", type => "object"}
4621     }
4622 );
4623
4624 __PACKAGE__->register_method(
4625     method   => "mark_users_contact_invalid",
4626     api_name => "open-ils.actor.invalidate.day_phone",
4627     signature => {
4628         desc => "Given a patron, clear the day_phone field and put the old day_phone into a note and/or create a standing penalty, depending on OU settings",
4629         params => [
4630             {desc => "Authentication token", type => "string"},
4631             {desc => "Patron ID", type => "number"},
4632             {desc => "Additional note text (optional)", type => "string"},
4633             {desc => "penalty org unit ID (optional)", type => "number"}
4634         ],
4635         return => {desc => "Event describing success or failure", type => "object"}
4636     }
4637 );
4638
4639 __PACKAGE__->register_method(
4640     method   => "mark_users_contact_invalid",
4641     api_name => "open-ils.actor.invalidate.evening_phone",
4642     signature => {
4643         desc => "Given a patron, clear the evening_phone field and put the old evening_phone into a note and/or create a standing penalty, depending on OU settings",
4644         params => [
4645             {desc => "Authentication token", type => "string"},
4646             {desc => "Patron ID", type => "number"},
4647             {desc => "Additional note text (optional)", type => "string"},
4648             {desc => "penalty org unit ID (optional)", type => "number"}
4649         ],
4650         return => {desc => "Event describing success or failure", type => "object"}
4651     }
4652 );
4653
4654 __PACKAGE__->register_method(
4655     method   => "mark_users_contact_invalid",
4656     api_name => "open-ils.actor.invalidate.other_phone",
4657     signature => {
4658         desc => "Given a patron, clear the other_phone field and put the old other_phone into a note and/or create a standing penalty, depending on OU settings",
4659         params => [
4660             {desc => "Authentication token", type => "string"},
4661             {desc => "Patron ID", type => "number"},
4662             {desc => "Additional note text (optional)", type => "string"},
4663             {desc => "penalty org unit ID (optional, default to top of org tree)",
4664                 type => "number"}
4665         ],
4666         return => {desc => "Event describing success or failure", type => "object"}
4667     }
4668 );
4669
4670 sub mark_users_contact_invalid {
4671     my ($self, $conn, $auth, $patron_id, $addl_note, $penalty_ou) = @_;
4672
4673     # This method invalidates an email address or a phone_number which
4674     # removes the bad email address or phone number, copying its contents
4675     # to a patron note, and institutes a standing penalty for "bad email"
4676     # or "bad phone number" which is cleared when the user is saved or
4677     # optionally only when the user is saved with an email address or
4678     # phone number (or staff manually delete the penalty).
4679
4680     my $contact_type = ($self->api_name =~ /invalidate.(\w+)(\.|$)/)[0];
4681
4682     my $e = new_editor(authtoken => $auth, xact => 1);
4683     return $e->die_event unless $e->checkauth;
4684
4685     return OpenILS::Utils::BadContact->mark_users_contact_invalid(
4686         $e, $contact_type, {usr => $patron_id},
4687         $addl_note, $penalty_ou, $e->requestor->id
4688     );
4689 }
4690
4691 # Putting the following method in open-ils.actor is a bad fit, except in that
4692 # it serves an interface that lives under 'actor' in the templates directory,
4693 # and in that there's nowhere else obvious to put it (open-ils.trigger is
4694 # private).
4695 __PACKAGE__->register_method(
4696     api_name => "open-ils.actor.action_trigger.reactors.all_in_use",
4697     method   => "get_all_at_reactors_in_use",
4698     api_level=> 1,
4699     argc     => 1,
4700     signature=> {
4701         params => [
4702             { name => 'authtoken', type => 'string' }
4703         ],
4704         return => {
4705             desc => 'list of reactor names', type => 'array'
4706         }
4707     }
4708 );
4709
4710 sub get_all_at_reactors_in_use {
4711     my ($self, $conn, $auth) = @_;
4712
4713     my $e = new_editor(authtoken => $auth);
4714     $e->checkauth or return $e->die_event;
4715     return $e->die_event unless $e->allowed('VIEW_TRIGGER_EVENT_DEF');
4716
4717     my $reactors = $e->json_query({
4718         select => {
4719             atevdef => [{column => "reactor", transform => "distinct"}]
4720         },
4721         from => {atevdef => {}}
4722     });
4723
4724     return $e->die_event unless ref $reactors eq "ARRAY";
4725     $e->disconnect;
4726
4727     return [ map { $_->{reactor} } @$reactors ];
4728 }
4729
4730 __PACKAGE__->register_method(
4731     method   => "filter_group_entry_crud",
4732     api_name => "open-ils.actor.filter_group_entry.crud",
4733     signature => {
4734         desc => q/
4735             Provides CRUD access to filter group entry objects.  These are not full accessible
4736             via PCRUD, since they requre "asq" objects for storing the query, and "asq" objects
4737             are not accessible via PCRUD (because they have no fields against which to link perms)
4738             /,
4739         params => [
4740             {desc => "Authentication token", type => "string"},
4741             {desc => "Entry ID / Entry Object", type => "number"},
4742             {desc => "Additional note text (optional)", type => "string"},
4743             {desc => "penalty org unit ID (optional, default to top of org tree)",
4744                 type => "number"}
4745         ],
4746         return => {
4747             desc => "Entry fleshed with query on Create, Retrieve, and Uupdate.  1 on Delete", 
4748             type => "object"
4749         }
4750     }
4751 );
4752
4753 sub filter_group_entry_crud {
4754     my ($self, $conn, $auth, $arg) = @_;
4755
4756     return OpenILS::Event->new('BAD_PARAMS') unless $arg;
4757     my $e = new_editor(authtoken => $auth, xact => 1);
4758     return $e->die_event unless $e->checkauth;
4759
4760     if (ref $arg) {
4761
4762         if ($arg->isnew) {
4763             
4764             my $grp = $e->retrieve_actor_search_filter_group($arg->grp)
4765                 or return $e->die_event;
4766
4767             return $e->die_event unless $e->allowed(
4768                 'ADMIN_SEARCH_FILTER_GROUP', $grp->owner);
4769
4770             my $query = $arg->query;
4771             $query = $e->create_actor_search_query($query) or return $e->die_event;
4772             $arg->query($query->id);
4773             my $entry = $e->create_actor_search_filter_group_entry($arg) or return $e->die_event;
4774             $entry->query($query);
4775
4776             $e->commit;
4777             return $entry;
4778
4779         } elsif ($arg->ischanged) {
4780
4781             my $entry = $e->retrieve_actor_search_filter_group_entry([
4782                 $arg->id, {
4783                     flesh => 1,
4784                     flesh_fields => {asfge => ['grp']}
4785                 }
4786             ]) or return $e->die_event;
4787
4788             return $e->die_event unless $e->allowed(
4789                 'ADMIN_SEARCH_FILTER_GROUP', $entry->grp->owner);
4790
4791             my $query = $e->update_actor_search_query($arg->query) or return $e->die_event;
4792             $arg->query($arg->query->id);
4793             $e->update_actor_search_filter_group_entry($arg) or return $e->die_event;
4794             $arg->query($query);
4795
4796             $e->commit;
4797             return $arg;
4798
4799         } elsif ($arg->isdeleted) {
4800
4801             my $entry = $e->retrieve_actor_search_filter_group_entry([
4802                 $arg->id, {
4803                     flesh => 1,
4804                     flesh_fields => {asfge => ['grp', 'query']}
4805                 }
4806             ]) or return $e->die_event;
4807
4808             return $e->die_event unless $e->allowed(
4809                 'ADMIN_SEARCH_FILTER_GROUP', $entry->grp->owner);
4810
4811             $e->delete_actor_search_filter_group_entry($entry) or return $e->die_event;
4812             $e->delete_actor_search_query($entry->query) or return $e->die_event;
4813
4814             $e->commit;
4815             return 1;
4816
4817         } else {
4818
4819             $e->rollback;
4820             return undef;
4821         }
4822
4823     } else {
4824
4825         my $entry = $e->retrieve_actor_search_filter_group_entry([
4826             $arg, {
4827                 flesh => 1,
4828                 flesh_fields => {asfge => ['grp', 'query']}
4829             }
4830         ]) or return $e->die_event;
4831
4832         return $e->die_event unless $e->allowed(
4833             ['ADMIN_SEARCH_FILTER_GROUP', 'VIEW_SEARCH_FILTER_GROUP'], 
4834             $entry->grp->owner);
4835
4836         $e->rollback;
4837         $entry->grp($entry->grp->id); # for consistency
4838         return $entry;
4839     }
4840 }
4841
4842 1;