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