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