LP1913811 Items out notice summary API batching
[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 OpenILS::Utils::DateTime 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::Carousel;
30 use OpenILS::Application::Actor::Container;
31 use OpenILS::Application::Actor::ClosedDates;
32 use OpenILS::Application::Actor::UserGroups;
33 use OpenILS::Application::Actor::Friends;
34 use OpenILS::Application::Actor::Stage;
35 use OpenILS::Application::Actor::Settings;
36
37 use OpenILS::Utils::CStoreEditor qw/:funcs/;
38 use OpenILS::Utils::Penalty;
39 use OpenILS::Utils::BadContact;
40 use List::Util qw/max reduce/;
41
42 use UUID::Tiny qw/:std/;
43
44 sub initialize {
45     OpenILS::Application::Actor::Container->initialize();
46     OpenILS::Application::Actor::UserGroups->initialize();
47     OpenILS::Application::Actor::ClosedDates->initialize();
48 }
49
50 my $apputils = "OpenILS::Application::AppUtils";
51 my $U = $apputils;
52
53 sub _d { warn "Patron:\n" . Dumper(shift()); }
54
55 my $cache;
56 my $set_user_settings;
57 my $set_ou_settings;
58
59
60 #__PACKAGE__->register_method(
61 #   method  => "allowed_test",
62 #   api_name    => "open-ils.actor.allowed_test",
63 #);
64 #sub allowed_test {
65 #    my($self, $conn, $auth, $orgid, $permcode) = @_;
66 #    my $e = new_editor(authtoken => $auth);
67 #    return $e->die_event unless $e->checkauth;
68 #
69 #    return {
70 #        orgid => $orgid,
71 #        permcode => $permcode,
72 #        result => $e->allowed($permcode, $orgid)
73 #    };
74 #}
75
76 __PACKAGE__->register_method(
77     method  => "update_user_setting",
78     api_name    => "open-ils.actor.patron.settings.update",
79 );
80 sub update_user_setting {
81     my($self, $conn, $auth, $user_id, $settings) = @_;
82     my $e = new_editor(xact => 1, authtoken => $auth);
83     return $e->die_event unless $e->checkauth;
84
85     $user_id = $e->requestor->id unless defined $user_id;
86
87     unless($e->requestor->id == $user_id) {
88         my $user = $e->retrieve_actor_user($user_id) or return $e->die_event;
89         return $e->die_event unless $e->allowed('UPDATE_USER', $user->home_ou);
90     }
91
92     for my $name (keys %$settings) {
93         my $val = $$settings{$name};
94         my $set = $e->search_actor_user_setting({usr => $user_id, name => $name})->[0];
95
96         if(defined $val) {
97             $val = OpenSRF::Utils::JSON->perl2JSON($val);
98             if($set) {
99                 $set->value($val);
100                 $e->update_actor_user_setting($set) or return $e->die_event;
101             } else {
102                 $set = Fieldmapper::actor::user_setting->new;
103                 $set->usr($user_id);
104                 $set->name($name);
105                 $set->value($val);
106                 $e->create_actor_user_setting($set) or return $e->die_event;
107             }
108         } elsif($set) {
109             $e->delete_actor_user_setting($set) or return $e->die_event;
110         }
111     }
112
113     $e->commit;
114     return 1;
115 }
116
117
118 __PACKAGE__->register_method(
119     method    => "update_privacy_waiver",
120     api_name  => "open-ils.actor.patron.privacy_waiver.update",
121     signature => {
122         desc => "Replaces any existing privacy waiver entries for the patron with the supplied values.",
123         params => [
124             {desc => 'Authentication token', type => 'string'},
125             {desc => 'User ID', type => 'number'},
126             {desc => 'Arrayref of privacy waiver entries', type => 'object'}
127         ],
128         return => {desc => '1 on success, Event on error'}
129     }
130 );
131 sub update_privacy_waiver {
132     my($self, $conn, $auth, $user_id, $waiver) = @_;
133     my $e = new_editor(xact => 1, authtoken => $auth);
134     return $e->die_event unless $e->checkauth;
135
136     $user_id = $e->requestor->id unless defined $user_id;
137
138     unless($e->requestor->id == $user_id) {
139         my $user = $e->retrieve_actor_user($user_id) or return $e->die_event;
140         return $e->die_event unless $e->allowed('UPDATE_USER', $user->home_ou);
141     }
142
143     foreach my $w (@$waiver) {
144         $w->{usr} = $user_id unless $w->{usr};
145         if ($w->{id} && $w->{id} ne 'new') {
146             my $existing_rows = $e->search_actor_usr_privacy_waiver({usr => $user_id, id => $w->{id}});
147             if ($existing_rows) {
148                 my $existing = $existing_rows->[0];
149                 # delete existing if name is empty
150                 if (!$w->{name} or $w->{name} =~ /^\s*$/) {
151                     $e->delete_actor_usr_privacy_waiver($existing) or return $e->die_event;
152
153                 # delete existing if none of the boxes were checked
154                 } elsif (!$w->{place_holds} && !$w->{pickup_holds} && !$w->{checkout_items} && !$w->{view_history}) {
155                     $e->delete_actor_usr_privacy_waiver($existing) or return $e->die_event;
156
157                 # otherwise, update existing waiver entry
158                 } else {
159                     $existing->name($w->{name});
160                     $existing->place_holds($w->{place_holds});
161                     $existing->pickup_holds($w->{pickup_holds});
162                     $existing->checkout_items($w->{checkout_items});
163                     $existing->view_history($w->{view_history});
164                     $e->update_actor_usr_privacy_waiver($existing) or return $e->die_event;
165                 }
166             } else {
167                 $logger->warn("No privacy waiver entry found for user $user_id with ID " . $w->{id});
168             }
169
170         } else {
171             # ignore new entries with empty name or with no boxes checked
172             next if (!$w->{name} or $w->{name} =~ /^\s*$/);
173             next if (!$w->{place_holds} && !$w->{pickup_holds} && !$w->{checkout_items} && !$w->{view_history});
174             my $new = Fieldmapper::actor::usr_privacy_waiver->new;
175             $new->usr($w->{usr});
176             $new->name($w->{name});
177             $new->place_holds($w->{place_holds});
178             $new->pickup_holds($w->{pickup_holds});
179             $new->checkout_items($w->{checkout_items});
180             $new->view_history($w->{view_history});
181             $e->create_actor_usr_privacy_waiver($new) or return $e->die_event;
182         }
183     }
184
185     $e->commit;
186     return 1;
187 }
188
189
190 __PACKAGE__->register_method(
191     method    => "set_ou_settings",
192     api_name  => "open-ils.actor.org_unit.settings.update",
193     signature => {
194         desc => "Updates the value for a given org unit setting.  The permission to update "          .
195                 "an org unit setting is either the UPDATE_ORG_UNIT_SETTING_ALL, or a specific "       .
196                 "permission specified in the update_perm column of the config.org_unit_setting_type " .
197                 "table's row corresponding to the setting being changed." ,
198         params => [
199             {desc => 'Authentication token',             type => 'string'},
200             {desc => 'Org unit ID',                      type => 'number'},
201             {desc => 'Hash of setting name-value pairs', type => 'object'}
202         ],
203         return => {desc => '1 on success, Event on error'}
204     }
205 );
206
207 sub set_ou_settings {
208     my( $self, $client, $auth, $org_id, $settings ) = @_;
209
210     my $e = new_editor(authtoken => $auth, xact => 1);
211     return $e->die_event unless $e->checkauth;
212
213     my $all_allowed = $e->allowed("UPDATE_ORG_UNIT_SETTING_ALL", $org_id);
214
215     for my $name (keys %$settings) {
216         my $val = $$settings{$name};
217
218         my $type = $e->retrieve_config_org_unit_setting_type([
219             $name,
220             {flesh => 1, flesh_fields => {'coust' => ['update_perm']}}
221         ]) or return $e->die_event;
222         my $set = $e->search_actor_org_unit_setting({org_unit => $org_id, name => $name})->[0];
223
224         # If there is no relevant permission, the default assumption will
225         # be, "no, the caller cannot change that value."
226         return $e->die_event unless ($all_allowed ||
227             ($type->update_perm && $e->allowed($type->update_perm->code, $org_id)));
228
229         if(defined $val) {
230             $val = OpenSRF::Utils::JSON->perl2JSON($val);
231             if($set) {
232                 $set->value($val);
233                 $e->update_actor_org_unit_setting($set) or return $e->die_event;
234             } else {
235                 $set = Fieldmapper::actor::org_unit_setting->new;
236                 $set->org_unit($org_id);
237                 $set->name($name);
238                 $set->value($val);
239                 $e->create_actor_org_unit_setting($set) or return $e->die_event;
240             }
241         } elsif($set) {
242             $e->delete_actor_org_unit_setting($set) or return $e->die_event;
243         }
244     }
245
246     $e->commit;
247     return 1;
248 }
249
250 __PACKAGE__->register_method(
251     method   => "user_settings",
252     authoritative => 1,
253     api_name => "open-ils.actor.patron.settings.retrieve",
254 );
255 sub user_settings {
256     my( $self, $client, $auth, $user_id, $setting ) = @_;
257
258     my $e = new_editor(authtoken => $auth);
259     return $e->event unless $e->checkauth;
260     $user_id = $e->requestor->id unless defined $user_id;
261
262     my $patron = $e->retrieve_actor_user($user_id) or return $e->event;
263     if($e->requestor->id != $user_id) {
264         return $e->event unless $e->allowed('VIEW_USER', $patron->home_ou);
265     }
266
267     sub get_setting {
268         my($e, $user_id, $setting) = @_;
269         my $val = $e->search_actor_user_setting({usr => $user_id, name => $setting})->[0];
270         return undef unless $val; # XXX this should really return undef, but needs testing
271         return OpenSRF::Utils::JSON->JSON2perl($val->value);
272     }
273
274     if($setting) {
275         if(ref $setting eq 'ARRAY') {
276             my %settings;
277             $settings{$_} = get_setting($e, $user_id, $_) for @$setting;
278             return \%settings;
279         } else {
280             return get_setting($e, $user_id, $setting);
281         }
282     } else {
283         my $s = $e->search_actor_user_setting({usr => $user_id});
284         return { map { ( $_->name => OpenSRF::Utils::JSON->JSON2perl($_->value) ) } @$s };
285     }
286 }
287
288
289 __PACKAGE__->register_method(
290     method    => "ranged_ou_settings",
291     api_name  => "open-ils.actor.org_unit_setting.values.ranged.retrieve",
292     signature => {
293         desc   => "Retrieves all org unit settings for the given org_id, up to whatever limit " .
294                 "is implied for retrieving OU settings by the authenticated users' permissions.",
295         params => [
296             {desc => 'Authentication token',   type => 'string'},
297             {desc => 'Org unit ID',            type => 'number'},
298         ],
299         return => {desc => 'A hashref of "ranged" settings, event on error'}
300     }
301 );
302 sub ranged_ou_settings {
303     my( $self, $client, $auth, $org_id ) = @_;
304
305     my $e = new_editor(authtoken => $auth);
306     return $e->event unless $e->checkauth;
307
308     my %ranged_settings;
309     my $org_list = $U->get_org_ancestors($org_id);
310     my $settings = $e->search_actor_org_unit_setting({org_unit => $org_list});
311     $org_list = [ reverse @$org_list ];
312
313     # start at the context org and capture the setting value
314     # without clobbering settings we've already captured
315     for my $this_org_id (@$org_list) {
316
317         my @sets = grep { $_->org_unit == $this_org_id } @$settings;
318
319         for my $set (@sets) {
320             my $type = $e->retrieve_config_org_unit_setting_type([
321                 $set->name,
322                 {flesh => 1, flesh_fields => {coust => ['view_perm']}}
323             ]);
324
325             # If there is no relevant permission, the default assumption will
326             # be, "yes, the caller can have that value."
327             if ($type && $type->view_perm) {
328                 next if not $e->allowed($type->view_perm->code, $org_id);
329             }
330
331             $ranged_settings{$set->name} = OpenSRF::Utils::JSON->JSON2perl($set->value)
332                 unless defined $ranged_settings{$set->name};
333         }
334     }
335
336     return \%ranged_settings;
337 }
338
339
340
341 __PACKAGE__->register_method(
342     api_name  => 'open-ils.actor.ou_setting.ancestor_default',
343     method    => 'ou_ancestor_setting',
344     signature => {
345         desc => 'Get the org unit setting value associated with the setting name as seen from the specified org unit.  ' .
346                 'This method will make sure that the given user has permission to view that setting, if there is a '     .
347                 'permission associated with the setting.  If a permission is required and no authtoken is given, or '     .
348                 'the user lacks the permisssion, undef will be returned.'       ,
349         params => [
350             { desc => 'Org unit ID',          type => 'number' },
351             { desc => 'setting name',         type => 'string' },
352             { desc => 'authtoken (optional)', type => 'string' }
353         ],
354         return => {desc => 'A value for the org unit setting, or undef'}
355     }
356 );
357
358 # ------------------------------------------------------------------
359 # Attempts to find the org setting value for a given org.  if not
360 # found at the requested org, searches up the org tree until it
361 # finds a parent that has the requested setting.
362 # when found, returns { org => $id, value => $value }
363 # otherwise, returns NULL
364 # ------------------------------------------------------------------
365 sub ou_ancestor_setting {
366     my( $self, $client, $orgid, $name, $auth ) = @_;
367     # Make sure $auth is set to something if not given.
368     $auth ||= -1;
369     return $U->ou_ancestor_setting($orgid, $name, undef, $auth);
370 }
371
372 __PACKAGE__->register_method(
373     api_name  => 'open-ils.actor.ou_setting.ancestor_default.batch',
374     method    => 'ou_ancestor_setting_batch',
375     signature => {
376         desc => 'Get org unit setting name => value pairs for a list of names, as seen from the specified org unit.  ' .
377                 'This method will make sure that the given user has permission to view that setting, if there is a '     .
378                 'permission associated with the setting.  If a permission is required and no authtoken is given, or '     .
379                 'the user lacks the permisssion, undef will be returned.'       ,
380         params => [
381             { desc => 'Org unit ID',          type => 'number' },
382             { desc => 'setting name list',    type => 'array'  },
383             { desc => 'authtoken (optional)', type => 'string' }
384         ],
385         return => {desc => 'A hash with name => value pairs for the org unit settings'}
386     }
387 );
388 sub ou_ancestor_setting_batch {
389     my( $self, $client, $orgid, $name_list, $auth ) = @_;
390
391     # splitting the list of settings to fetch values
392     # so that ones that *don't* require view_perm checks
393     # can be fetched in one fell swoop, which is
394     # significantly faster in cases where a large
395     # number of settings need to be fetched.
396     my %perm_check_required = ();
397     my @perm_check_not_required = ();
398
399     # Note that ->ou_ancestor_setting also can check
400     # to see if the setting has a view_perm, but testing
401     # suggests that the redundant checks do not significantly
402     # increase the time it takes to fetch the values of
403     # permission-controlled settings.
404     my $e = new_editor();
405     my $res = $e->search_config_org_unit_setting_type({
406         name      => $name_list,
407         view_perm => { "!=" => undef },
408     });
409     %perm_check_required = map { $_->name() => 1 } @$res;
410     foreach my $setting (@$name_list) {
411         push @perm_check_not_required, $setting
412             unless exists($perm_check_required{$setting});
413     }
414
415     my %values;
416     if (@perm_check_not_required) {
417         %values = $U->ou_ancestor_setting_batch_insecure($orgid, \@perm_check_not_required);
418     }
419     $values{$_} = $U->ou_ancestor_setting(
420         $orgid, $_, undef,
421         ($auth ? $auth : -1)
422     ) for keys(%perm_check_required);
423     return \%values;
424 }
425
426
427
428 __PACKAGE__->register_method(
429     method   => "update_patron",
430     api_name => "open-ils.actor.patron.update",
431     signature => {
432         desc   => q/
433             Update an existing user, or create a new one.  Related objects,
434             like cards, addresses, survey responses, and stat cats,
435             can be updated by attaching them to the user object in their
436             respective fields.  For examples, the billing address object
437             may be inserted into the 'billing_address' field, etc.  For each
438             attached object, indicate if the object should be created,
439             updated, or deleted using the built-in 'isnew', 'ischanged',
440             and 'isdeleted' fields on the object.
441         /,
442         params => [
443             { desc => 'Authentication token', type => 'string' },
444             { desc => 'Patron data object',   type => 'object' }
445         ],
446         return => {desc => 'A fleshed user object, event on error'}
447     }
448 );
449
450 sub update_patron {
451     my( $self, $client, $auth, $patron ) = @_;
452
453     my $e = new_editor(xact => 1, authtoken => $auth);
454     return $e->event unless $e->checkauth;
455
456     $logger->info($patron->isnew ? "Creating new patron..." :
457         "Updating Patron: " . $patron->id);
458
459     my $evt = check_group_perm($e, $e->requestor, $patron);
460     return $evt if $evt;
461
462     # $new_patron is the patron in progress.  $patron is the original patron
463     # passed in with the method.  new_patron will change as the components
464     # of patron are added/updated.
465
466     my $new_patron;
467
468     # unflesh the real items on the patron
469     $patron->card( $patron->card->id ) if(ref($patron->card));
470     $patron->billing_address( $patron->billing_address->id )
471         if(ref($patron->billing_address));
472     $patron->mailing_address( $patron->mailing_address->id )
473         if(ref($patron->mailing_address));
474
475     # create/update the patron first so we can use his id
476
477     # $patron is the obj from the client (new data) and $new_patron is the
478     # patron object properly built for db insertion, so we need a third variable
479     # if we want to represent the old patron.
480
481     my $old_patron;
482     my $barred_hook = '';
483     my $renew_hook = '';
484
485     if($patron->isnew()) {
486         ( $new_patron, $evt ) = _add_patron($e, _clone_patron($patron));
487         return $evt if $evt;
488         if($U->is_true($patron->barred)) {
489             return $e->die_event unless
490                 $e->allowed('BAR_PATRON', $patron->home_ou);
491         }
492     } else {
493         $new_patron = $patron;
494
495         # Did auth checking above already.
496         $old_patron = $e->retrieve_actor_user($patron->id) or
497             return $e->die_event;
498
499         $renew_hook = 'au.renewed' if ($old_patron->expire_date ne $new_patron->expire_date);
500
501         if($U->is_true($old_patron->barred) != $U->is_true($new_patron->barred)) {
502             my $perm = $U->is_true($old_patron->barred) ? 'UNBAR_PATRON' : 'BAR_PATRON';
503             return $e->die_event unless $e->allowed($perm, $patron->home_ou);
504
505             $barred_hook = $U->is_true($new_patron->barred) ?
506                 'au.barred' : 'au.unbarred';
507         }
508
509         # update the password by itself to avoid the password protection magic
510         if ($patron->passwd && $patron->passwd ne $old_patron->passwd) {
511             modify_migrated_user_password($e, $patron->id, $patron->passwd);
512             $new_patron->passwd(''); # subsequent update will set
513                                      # actor.usr.passwd to MD5('')
514         }
515     }
516
517     ( $new_patron, $evt ) = _add_update_addresses($e, $patron, $new_patron);
518     return $evt if $evt;
519
520     ( $new_patron, $evt ) = _add_update_cards($e, $patron, $new_patron);
521     return $evt if $evt;
522
523     ( $new_patron, $evt ) = _add_update_waiver_entries($e, $patron, $new_patron);
524     return $evt if $evt;
525
526     ( $new_patron, $evt ) = _add_survey_responses($e, $patron, $new_patron);
527     return $evt if $evt;
528
529     # re-update the patron if anything has happened to him during this process
530     if($new_patron->ischanged()) {
531         ( $new_patron, $evt ) = _update_patron($e, $new_patron);
532         return $evt if $evt;
533     }
534
535     ( $new_patron, $evt ) = _clear_badcontact_penalties($e, $old_patron, $new_patron);
536     return $evt if $evt;
537
538     ($new_patron, $evt) = _create_stat_maps($e, $patron, $new_patron);
539     return $evt if $evt;
540
541     ($new_patron, $evt) = _create_perm_maps($e, $patron, $new_patron);
542     return $evt if $evt;
543
544     $evt = apply_invalid_addr_penalty($e, $patron);
545     return $evt if $evt;
546
547     $e->commit;
548
549     my $tses = OpenSRF::AppSession->create('open-ils.trigger');
550     if($patron->isnew) {
551         $tses->request('open-ils.trigger.event.autocreate',
552             'au.created', $new_patron, $new_patron->home_ou);
553     } else {
554         $tses->request('open-ils.trigger.event.autocreate',
555             'au.updated', $new_patron, $new_patron->home_ou);
556
557         $tses->request('open-ils.trigger.event.autocreate', $renew_hook,
558             $new_patron, $new_patron->home_ou) if $renew_hook;
559
560         $tses->request('open-ils.trigger.event.autocreate', $barred_hook,
561             $new_patron, $new_patron->home_ou) if $barred_hook;
562     }
563
564     $e->xact_begin; # $e->rollback is called in new_flesh_user
565     return flesh_user($new_patron->id(), $e);
566 }
567
568 sub apply_invalid_addr_penalty {
569     my $e = shift;
570     my $patron = shift;
571
572     # grab the invalid address penalty if set
573     my $penalties = OpenILS::Utils::Penalty->retrieve_usr_penalties($e, $patron->id, $patron->home_ou);
574
575     my ($addr_penalty) = grep
576         { $_->standing_penalty->name eq 'INVALID_PATRON_ADDRESS' } @$penalties;
577
578     # do we enforce invalid address penalty
579     my $enforce = $U->ou_ancestor_setting_value(
580         $patron->home_ou, 'circ.patron_invalid_address_apply_penalty') || 0;
581
582     my $addrs = $e->search_actor_user_address(
583         {usr => $patron->id, valid => 'f', id => {'>' => 0}}, {idlist => 1});
584     my $addr_count = scalar(@$addrs);
585
586     if($addr_count == 0 and $addr_penalty) {
587
588         # regardless of any settings, remove the penalty when the user has no invalid addresses
589         $e->delete_actor_user_standing_penalty($addr_penalty) or return $e->die_event;
590         $e->commit;
591
592     } elsif($enforce and $addr_count > 0 and !$addr_penalty) {
593
594         my $ptype = $e->retrieve_config_standing_penalty(29) or return $e->die_event;
595         my $depth = $ptype->org_depth;
596         my $ctx_org = $U->org_unit_ancestor_at_depth($patron->home_ou, $depth) if defined $depth;
597         $ctx_org = $patron->home_ou unless defined $ctx_org;
598
599         my $penalty = Fieldmapper::actor::user_standing_penalty->new;
600         $penalty->usr($patron->id);
601         $penalty->org_unit($ctx_org);
602         $penalty->standing_penalty(OILS_PENALTY_INVALID_PATRON_ADDRESS);
603
604         $e->create_actor_user_standing_penalty($penalty) or return $e->die_event;
605     }
606
607     return undef;
608 }
609
610
611 sub flesh_user {
612     my $id = shift;
613     my $e = shift;
614     my $home_ou = shift;
615
616     my $fields = [
617         "cards",
618         "card",
619         "standing_penalties",
620         "settings",
621         "addresses",
622         "billing_address",
623         "mailing_address",
624         "stat_cat_entries",
625         "waiver_entries",
626         "settings",
627         "usr_activity"
628     ];
629     push @$fields, "home_ou" if $home_ou;
630     return new_flesh_user($id, $fields, $e );
631 }
632
633
634
635
636
637
638 # clone and clear stuff that would break the database
639 sub _clone_patron {
640     my $patron = shift;
641
642     my $new_patron = $patron->clone;
643     # clear these
644     $new_patron->clear_billing_address();
645     $new_patron->clear_mailing_address();
646     $new_patron->clear_addresses();
647     $new_patron->clear_card();
648     $new_patron->clear_cards();
649     $new_patron->clear_id();
650     $new_patron->clear_isnew();
651     $new_patron->clear_ischanged();
652     $new_patron->clear_isdeleted();
653     $new_patron->clear_stat_cat_entries();
654     $new_patron->clear_waiver_entries();
655     $new_patron->clear_permissions();
656     $new_patron->clear_standing_penalties();
657
658     return $new_patron;
659 }
660
661
662 sub _add_patron {
663
664     my $e          = shift;
665     my $patron      = shift;
666
667     return (undef, $e->die_event) unless
668         $e->allowed('CREATE_USER', $patron->home_ou);
669
670     my $ex = $e->search_actor_user(
671         {usrname => $patron->usrname}, {idlist => 1});
672     return (undef, OpenILS::Event->new('USERNAME_EXISTS')) if @$ex;
673
674     $logger->info("Creating new user in the DB with username: ".$patron->usrname());
675
676     # do a dance to get the password hashed securely
677     my $saved_password = $patron->passwd;
678     $patron->passwd('');
679     $e->create_actor_user($patron) or return (undef, $e->die_event);
680     modify_migrated_user_password($e, $patron->id, $saved_password);
681
682     my $id = $patron->id; # added by CStoreEditor
683
684     $logger->info("Successfully created new user [$id] in DB");
685     return ($e->retrieve_actor_user($id), undef);
686 }
687
688
689 sub check_group_perm {
690     my( $e, $requestor, $patron ) = @_;
691     my $evt;
692
693     # first let's see if the requestor has
694     # priveleges to update this user in any way
695     if( ! $patron->isnew ) {
696         my $p = $e->retrieve_actor_user($patron->id);
697
698         # If we are the requestor (trying to update our own account)
699         # and we are not trying to change our profile, we're good
700         if( $p->id == $requestor->id and
701                 $p->profile == $patron->profile ) {
702             return undef;
703         }
704
705
706         $evt = group_perm_failed($e, $requestor, $p);
707         return $evt if $evt;
708     }
709
710     # They are allowed to edit this patron.. can they put the
711     # patron into the group requested?
712     $evt = group_perm_failed($e, $requestor, $patron);
713     return $evt if $evt;
714     return undef;
715 }
716
717
718 sub group_perm_failed {
719     my( $e, $requestor, $patron ) = @_;
720
721     my $perm;
722     my $grp;
723     my $grpid = $patron->profile;
724
725     do {
726
727         $logger->debug("user update looking for group perm for group $grpid");
728         $grp = $e->retrieve_permission_grp_tree($grpid);
729
730     } while( !($perm = $grp->application_perm) and ($grpid = $grp->parent) );
731
732     $logger->info("user update checking perm $perm on user ".
733         $requestor->id." for update/create on user username=".$patron->usrname);
734
735     return $e->allowed($perm, $patron->home_ou) ? undef : $e->die_event;
736 }
737
738
739
740 sub _update_patron {
741     my( $e, $patron, $noperm) = @_;
742
743     $logger->info("Updating patron ".$patron->id." in DB");
744
745     my $evt;
746
747     if(!$noperm) {
748         return (undef, $e->die_event)
749             unless $e->allowed('UPDATE_USER', $patron->home_ou);
750     }
751
752     if(!$patron->ident_type) {
753         $patron->clear_ident_type;
754         $patron->clear_ident_value;
755     }
756
757     $evt = verify_last_xact($e, $patron);
758     return (undef, $evt) if $evt;
759
760     $e->update_actor_user($patron) or return (undef, $e->die_event);
761
762     # re-fetch the user to pick up the latest last_xact_id value
763     # to avoid collisions.
764     $patron = $e->retrieve_actor_user($patron->id);
765
766     return ($patron);
767 }
768
769 sub verify_last_xact {
770     my( $e, $patron ) = @_;
771     return undef unless $patron->id and $patron->id > 0;
772     my $p = $e->retrieve_actor_user($patron->id);
773     my $xact = $p->last_xact_id;
774     return undef unless $xact;
775     $logger->info("user xact = $xact, saving with xact " . $patron->last_xact_id);
776     return OpenILS::Event->new('XACT_COLLISION')
777         if $xact ne $patron->last_xact_id;
778     return undef;
779 }
780
781
782 sub _check_dup_ident {
783     my( $session, $patron ) = @_;
784
785     return undef unless $patron->ident_value;
786
787     my $search = {
788         ident_type  => $patron->ident_type,
789         ident_value => $patron->ident_value,
790     };
791
792     $logger->debug("patron update searching for dup ident values: " .
793         $patron->ident_type . ':' . $patron->ident_value);
794
795     $search->{id} = {'!=' => $patron->id} if $patron->id and $patron->id > 0;
796
797     my $dups = $session->request(
798         'open-ils.storage.direct.actor.user.search_where.atomic', $search )->gather(1);
799
800
801     return OpenILS::Event->new('PATRON_DUP_IDENT1', payload => $patron )
802         if $dups and @$dups;
803
804     return undef;
805 }
806
807
808 sub _add_update_addresses {
809
810     my $e = shift;
811     my $patron = shift;
812     my $new_patron = shift;
813
814     my $evt;
815
816     my $current_id; # id of the address before creation
817
818     my $addresses = $patron->addresses();
819
820     for my $address (@$addresses) {
821
822         next unless ref $address;
823         $current_id = $address->id();
824
825         if( $patron->billing_address() and
826             $patron->billing_address() == $current_id ) {
827             $logger->info("setting billing addr to $current_id");
828             $new_patron->billing_address($address->id());
829             $new_patron->ischanged(1);
830         }
831
832         if( $patron->mailing_address() and
833             $patron->mailing_address() == $current_id ) {
834             $new_patron->mailing_address($address->id());
835             $logger->info("setting mailing addr to $current_id");
836             $new_patron->ischanged(1);
837         }
838
839
840         if($address->isnew()) {
841
842             $address->usr($new_patron->id());
843
844             ($address, $evt) = _add_address($e,$address);
845             return (undef, $evt) if $evt;
846
847             # we need to get the new id
848             if( $patron->billing_address() and
849                     $patron->billing_address() == $current_id ) {
850                 $new_patron->billing_address($address->id());
851                 $logger->info("setting billing addr to $current_id");
852                 $new_patron->ischanged(1);
853             }
854
855             if( $patron->mailing_address() and
856                     $patron->mailing_address() == $current_id ) {
857                 $new_patron->mailing_address($address->id());
858                 $logger->info("setting mailing addr to $current_id");
859                 $new_patron->ischanged(1);
860             }
861
862         } elsif($address->ischanged() ) {
863
864             ($address, $evt) = _update_address($e, $address);
865             return (undef, $evt) if $evt;
866
867         } elsif($address->isdeleted() ) {
868
869             if( $address->id() == $new_patron->mailing_address() ) {
870                 $new_patron->clear_mailing_address();
871                 ($new_patron, $evt) = _update_patron($e, $new_patron);
872                 return (undef, $evt) if $evt;
873             }
874
875             if( $address->id() == $new_patron->billing_address() ) {
876                 $new_patron->clear_billing_address();
877                 ($new_patron, $evt) = _update_patron($e, $new_patron);
878                 return (undef, $evt) if $evt;
879             }
880
881             $evt = _delete_address($e, $address);
882             return (undef, $evt) if $evt;
883         }
884     }
885
886     return ( $new_patron, undef );
887 }
888
889
890 # adds an address to the db and returns the address with new id
891 sub _add_address {
892     my($e, $address) = @_;
893     $address->clear_id();
894
895     $logger->info("Creating new address at street ".$address->street1);
896
897     # put the address into the database
898     $e->create_actor_user_address($address) or return (undef, $e->die_event);
899     return ($address, undef);
900 }
901
902
903 sub _update_address {
904     my( $e, $address ) = @_;
905
906     $logger->info("Updating address ".$address->id." in the DB");
907
908     $e->update_actor_user_address($address) or return (undef, $e->die_event);
909
910     return ($address, undef);
911 }
912
913
914
915 sub _add_update_cards {
916
917     my $e = shift;
918     my $patron = shift;
919     my $new_patron = shift;
920
921     my $evt;
922
923     my $virtual_id; #id of the card before creation
924
925     my $card_changed = 0;
926     my $cards = $patron->cards();
927     for my $card (@$cards) {
928
929         $card->usr($new_patron->id());
930
931         if(ref($card) and $card->isnew()) {
932
933             $virtual_id = $card->id();
934             ( $card, $evt ) = _add_card($e, $card);
935             return (undef, $evt) if $evt;
936
937             #if(ref($patron->card)) { $patron->card($patron->card->id); }
938             if($patron->card() == $virtual_id) {
939                 $new_patron->card($card->id());
940                 $new_patron->ischanged(1);
941             }
942             $card_changed++;
943
944         } elsif( ref($card) and $card->ischanged() ) {
945             $evt = _update_card($e, $card);
946             return (undef, $evt) if $evt;
947             $card_changed++;
948         }
949     }
950
951     $U->create_events_for_hook('au.barcode_changed', $new_patron, $e->requestor->ws_ou)
952         if $card_changed;
953
954     return ( $new_patron, undef );
955 }
956
957
958 # adds an card to the db and returns the card with new id
959 sub _add_card {
960     my( $e, $card ) = @_;
961     $card->clear_id();
962
963     $logger->info("Adding new patron card ".$card->barcode);
964
965     $e->create_actor_card($card) or return (undef, $e->die_event);
966
967     return ( $card, undef );
968 }
969
970
971 # returns event on error.  returns undef otherwise
972 sub _update_card {
973     my( $e, $card ) = @_;
974     $logger->info("Updating patron card ".$card->id);
975
976     $e->update_actor_card($card) or return $e->die_event;
977     return undef;
978 }
979
980
981 sub _add_update_waiver_entries {
982     my $e = shift;
983     my $patron = shift;
984     my $new_patron = shift;
985     my $evt;
986
987     my $waiver_entries = $patron->waiver_entries();
988     for my $waiver (@$waiver_entries) {
989         next unless ref $waiver;
990         $waiver->usr($new_patron->id());
991         if ($waiver->isnew()) {
992             next if (!$waiver->name() or $waiver->name() =~ /^\s*$/);
993             next if (!$waiver->place_holds() && !$waiver->pickup_holds() && !$waiver->checkout_items() && !$waiver->view_history());
994             $logger->info("Adding new patron waiver entry");
995             $waiver->clear_id();
996             $e->create_actor_usr_privacy_waiver($waiver) or return (undef, $e->die_event);
997         } elsif ($waiver->ischanged()) {
998             $logger->info("Updating patron waiver entry " . $waiver->id);
999             $e->update_actor_usr_privacy_waiver($waiver) or return (undef, $e->die_event);
1000         } elsif ($waiver->isdeleted()) {
1001             $logger->info("Deleting patron waiver entry " . $waiver->id);
1002             $e->delete_actor_usr_privacy_waiver($waiver) or return (undef, $e->die_event);
1003         }
1004     }
1005     return ($new_patron, undef);
1006 }
1007
1008
1009 # returns event on error.  returns undef otherwise
1010 sub _delete_address {
1011     my( $e, $address ) = @_;
1012
1013     $logger->info("Deleting address ".$address->id." from DB");
1014
1015     $e->delete_actor_user_address($address) or return $e->die_event;
1016     return undef;
1017 }
1018
1019
1020
1021 sub _add_survey_responses {
1022     my ($e, $patron, $new_patron) = @_;
1023
1024     $logger->info( "Updating survey responses for patron ".$new_patron->id );
1025
1026     my $responses = $patron->survey_responses;
1027
1028     if($responses) {
1029
1030         $_->usr($new_patron->id) for (@$responses);
1031
1032         my $evt = $U->simplereq( "open-ils.circ",
1033             "open-ils.circ.survey.submit.user_id", $responses );
1034
1035         return (undef, $evt) if defined($U->event_code($evt));
1036
1037     }
1038
1039     return ( $new_patron, undef );
1040 }
1041
1042 sub _clear_badcontact_penalties {
1043     my ($e, $old_patron, $new_patron) = @_;
1044
1045     return ($new_patron, undef) unless $old_patron;
1046
1047     my $PNM = $OpenILS::Utils::BadContact::PENALTY_NAME_MAP;
1048
1049     # This ignores whether the caller of update_patron has any permission
1050     # to remove penalties, but these penalties no longer make sense
1051     # if an email address field (for example) is changed (and the caller must
1052     # have perms to do *that*) so there's no reason not to clear the penalties.
1053
1054     my $bad_contact_penalties = $e->search_actor_user_standing_penalty([
1055         {
1056             "+csp" => {"name" => [values(%$PNM)]},
1057             "+ausp" => {"stop_date" => undef, "usr" => $new_patron->id}
1058         }, {
1059             "join" => {"csp" => {}},
1060             "flesh" => 1,
1061             "flesh_fields" => {"ausp" => ["standing_penalty"]}
1062         }
1063     ]) or return (undef, $e->die_event);
1064
1065     return ($new_patron, undef) unless @$bad_contact_penalties;
1066
1067     my @penalties_to_clear;
1068     my ($field, $penalty_name);
1069
1070     # For each field that might have an associated bad contact penalty,
1071     # check for such penalties and add them to the to-clear list if that
1072     # field has changed.
1073     while (($field, $penalty_name) = each(%$PNM)) {
1074         if ($old_patron->$field ne $new_patron->$field) {
1075             push @penalties_to_clear, grep {
1076                 $_->standing_penalty->name eq $penalty_name
1077             } @$bad_contact_penalties;
1078         }
1079     }
1080
1081     foreach (@penalties_to_clear) {
1082         # Note that this "archives" penalties, in the terminology of the staff
1083         # client, instead of just deleting them.  This may assist reporting,
1084         # or preserving old contact information when it is still potentially
1085         # of interest.
1086         $_->standing_penalty($_->standing_penalty->id); # deflesh
1087         $_->stop_date('now');
1088         $e->update_actor_user_standing_penalty($_) or return (undef, $e->die_event);
1089     }
1090
1091     return ($new_patron, undef);
1092 }
1093
1094
1095 sub _create_stat_maps {
1096
1097     my($e, $patron, $new_patron) = @_;
1098
1099     my $maps = $patron->stat_cat_entries();
1100
1101     for my $map (@$maps) {
1102
1103         my $method = "update_actor_stat_cat_entry_user_map";
1104
1105         if ($map->isdeleted()) {
1106             $method = "delete_actor_stat_cat_entry_user_map";
1107
1108         } elsif ($map->isnew()) {
1109             $method = "create_actor_stat_cat_entry_user_map";
1110             $map->clear_id;
1111         }
1112
1113
1114         $map->target_usr($new_patron->id);
1115
1116         $logger->info("Updating stat entry with method $method and map $map");
1117
1118         $e->$method($map) or return (undef, $e->die_event);
1119     }
1120
1121     return ($new_patron, undef);
1122 }
1123
1124 sub _create_perm_maps {
1125
1126     my($e, $patron, $new_patron) = @_;
1127
1128     my $maps = $patron->permissions;
1129
1130     for my $map (@$maps) {
1131
1132         my $method = "update_permission_usr_perm_map";
1133         if ($map->isdeleted()) {
1134             $method = "delete_permission_usr_perm_map";
1135         } elsif ($map->isnew()) {
1136             $method = "create_permission_usr_perm_map";
1137             $map->clear_id;
1138         }
1139
1140         $map->usr($new_patron->id);
1141
1142         $logger->info( "Updating permissions with method $method and map $map" );
1143
1144         $e->$method($map) or return (undef, $e->die_event);
1145     }
1146
1147     return ($new_patron, undef);
1148 }
1149
1150
1151 __PACKAGE__->register_method(
1152     method   => "set_user_work_ous",
1153     api_name => "open-ils.actor.user.work_ous.update",
1154 );
1155
1156 sub set_user_work_ous {
1157     my $self   = shift;
1158     my $client = shift;
1159     my $ses    = shift;
1160     my $maps   = shift;
1161
1162     my( $requestor, $evt ) = $apputils->checksesperm( $ses, 'ASSIGN_WORK_ORG_UNIT' );
1163     return $evt if $evt;
1164
1165     my $session = $apputils->start_db_session();
1166     $apputils->set_audit_info($session, $ses, $requestor->id, $requestor->wsid);
1167
1168     for my $map (@$maps) {
1169
1170         my $method = "open-ils.storage.direct.permission.usr_work_ou_map.update";
1171         if ($map->isdeleted()) {
1172             $method = "open-ils.storage.direct.permission.usr_work_ou_map.delete";
1173         } elsif ($map->isnew()) {
1174             $method = "open-ils.storage.direct.permission.usr_work_ou_map.create";
1175             $map->clear_id;
1176         }
1177
1178         #warn( "Updating permissions with method $method and session $ses and map $map" );
1179         $logger->info( "Updating work_ou map with method $method and map $map" );
1180
1181         my $stat = $session->request($method, $map)->gather(1);
1182         $logger->warn( "update failed: ".$U->DB_UPDATE_FAILED($map) ) unless defined($stat);
1183
1184     }
1185
1186     $apputils->commit_db_session($session);
1187
1188     return scalar(@$maps);
1189 }
1190
1191
1192 __PACKAGE__->register_method(
1193     method   => "set_user_perms",
1194     api_name => "open-ils.actor.user.permissions.update",
1195 );
1196
1197 sub set_user_perms {
1198     my $self = shift;
1199     my $client = shift;
1200     my $ses = shift;
1201     my $maps = shift;
1202
1203     my $session = $apputils->start_db_session();
1204
1205     my( $user_obj, $evt ) = $U->checkses($ses);
1206     return $evt if $evt;
1207     $apputils->set_audit_info($session, $ses, $user_obj->id, $user_obj->wsid);
1208
1209     my $perms = $session->request('open-ils.storage.permission.user_perms.atomic', $user_obj->id)->gather(1);
1210
1211     my $all = undef;
1212     $all = 1 if ($U->is_true($user_obj->super_user()));
1213     $all = 1 unless ($U->check_perms($user_obj->id, $user_obj->home_ou, 'EVERYTHING'));
1214
1215     for my $map (@$maps) {
1216
1217         my $method = "open-ils.storage.direct.permission.usr_perm_map.update";
1218         if ($map->isdeleted()) {
1219             $method = "open-ils.storage.direct.permission.usr_perm_map.delete";
1220         } elsif ($map->isnew()) {
1221             $method = "open-ils.storage.direct.permission.usr_perm_map.create";
1222             $map->clear_id;
1223         }
1224
1225         next if (!$all and !grep { $_->perm eq $map->perm and $U->is_true($_->grantable) and $_->depth <= $map->depth } @$perms);
1226         #warn( "Updating permissions with method $method and session $ses and map $map" );
1227         $logger->info( "Updating permissions with method $method and map $map" );
1228
1229         my $stat = $session->request($method, $map)->gather(1);
1230         $logger->warn( "update failed: ".$U->DB_UPDATE_FAILED($map) ) unless defined($stat);
1231
1232     }
1233
1234     $apputils->commit_db_session($session);
1235
1236     return scalar(@$maps);
1237 }
1238
1239
1240 __PACKAGE__->register_method(
1241     method  => "user_retrieve_by_barcode",
1242     authoritative => 1,
1243     api_name    => "open-ils.actor.user.fleshed.retrieve_by_barcode",);
1244
1245 sub user_retrieve_by_barcode {
1246     my($self, $client, $auth, $barcode, $flesh_home_ou) = @_;
1247
1248     my $e = new_editor(authtoken => $auth);
1249     return $e->event unless $e->checkauth;
1250
1251     my $card = $e->search_actor_card({barcode => $barcode})->[0]
1252         or return $e->event;
1253
1254     my $user = flesh_user($card->usr, $e, $flesh_home_ou);
1255     return $e->event unless $e->allowed(
1256         "VIEW_USER", $flesh_home_ou ? $user->home_ou->id : $user->home_ou
1257     );
1258     return $user;
1259 }
1260
1261
1262
1263 __PACKAGE__->register_method(
1264     method        => "get_user_by_id",
1265     authoritative => 1,
1266     api_name      => "open-ils.actor.user.retrieve",
1267 );
1268
1269 sub get_user_by_id {
1270     my ($self, $client, $auth, $id) = @_;
1271     my $e = new_editor(authtoken=>$auth);
1272     return $e->event unless $e->checkauth;
1273     my $user = $e->retrieve_actor_user($id) or return $e->event;
1274     return $e->event unless $e->allowed('VIEW_USER', $user->home_ou);
1275     return $user;
1276 }
1277
1278
1279 __PACKAGE__->register_method(
1280     method   => "get_org_types",
1281     api_name => "open-ils.actor.org_types.retrieve",
1282 );
1283 sub get_org_types {
1284     return $U->get_org_types();
1285 }
1286
1287
1288 __PACKAGE__->register_method(
1289     method   => "get_user_ident_types",
1290     api_name => "open-ils.actor.user.ident_types.retrieve",
1291 );
1292 my $ident_types;
1293 sub get_user_ident_types {
1294     return $ident_types if $ident_types;
1295     return $ident_types =
1296         new_editor()->retrieve_all_config_identification_type();
1297 }
1298
1299
1300 __PACKAGE__->register_method(
1301     method   => "get_org_unit",
1302     api_name => "open-ils.actor.org_unit.retrieve",
1303 );
1304
1305 sub get_org_unit {
1306     my( $self, $client, $user_session, $org_id ) = @_;
1307     my $e = new_editor(authtoken => $user_session);
1308     if(!$org_id) {
1309         return $e->event unless $e->checkauth;
1310         $org_id = $e->requestor->ws_ou;
1311     }
1312     my $o = $e->retrieve_actor_org_unit($org_id)
1313         or return $e->event;
1314     return $o;
1315 }
1316
1317 __PACKAGE__->register_method(
1318     method   => "search_org_unit",
1319     api_name => "open-ils.actor.org_unit_list.search",
1320 );
1321
1322 sub search_org_unit {
1323
1324     my( $self, $client, $field, $value ) = @_;
1325
1326     my $list = OpenILS::Application::AppUtils->simple_scalar_request(
1327         "open-ils.cstore",
1328         "open-ils.cstore.direct.actor.org_unit.search.atomic",
1329         { $field => $value } );
1330
1331     return $list;
1332 }
1333
1334
1335 # build the org tree
1336
1337 __PACKAGE__->register_method(
1338     method  => "get_org_tree",
1339     api_name    => "open-ils.actor.org_tree.retrieve",
1340     argc        => 0,
1341     note        => "Returns the entire org tree structure",
1342 );
1343
1344 sub get_org_tree {
1345     my $self = shift;
1346     my $client = shift;
1347     return $U->get_org_tree($client->session->session_locale);
1348 }
1349
1350
1351 __PACKAGE__->register_method(
1352     method  => "get_org_descendants",
1353     api_name    => "open-ils.actor.org_tree.descendants.retrieve"
1354 );
1355
1356 # depth is optional.  org_unit is the id
1357 sub get_org_descendants {
1358     my( $self, $client, $org_unit, $depth ) = @_;
1359
1360     if(ref $org_unit eq 'ARRAY') {
1361         $depth ||= [];
1362         my @trees;
1363         for my $i (0..scalar(@$org_unit)-1) {
1364             my $list = $U->simple_scalar_request(
1365                 "open-ils.storage",
1366                 "open-ils.storage.actor.org_unit.descendants.atomic",
1367                 $org_unit->[$i], $depth->[$i] );
1368             push(@trees, $U->build_org_tree($list));
1369         }
1370         return \@trees;
1371
1372     } else {
1373         my $orglist = $apputils->simple_scalar_request(
1374                 "open-ils.storage",
1375                 "open-ils.storage.actor.org_unit.descendants.atomic",
1376                 $org_unit, $depth );
1377         return $U->build_org_tree($orglist);
1378     }
1379 }
1380
1381
1382 __PACKAGE__->register_method(
1383     method  => "get_org_ancestors",
1384     api_name    => "open-ils.actor.org_tree.ancestors.retrieve"
1385 );
1386
1387 # depth is optional.  org_unit is the id
1388 sub get_org_ancestors {
1389     my( $self, $client, $org_unit, $depth ) = @_;
1390     my $orglist = $apputils->simple_scalar_request(
1391             "open-ils.storage",
1392             "open-ils.storage.actor.org_unit.ancestors.atomic",
1393             $org_unit, $depth );
1394     return $U->build_org_tree($orglist);
1395 }
1396
1397
1398 __PACKAGE__->register_method(
1399     method  => "get_standings",
1400     api_name    => "open-ils.actor.standings.retrieve"
1401 );
1402
1403 my $user_standings;
1404 sub get_standings {
1405     return $user_standings if $user_standings;
1406     return $user_standings =
1407         $apputils->simple_scalar_request(
1408             "open-ils.cstore",
1409             "open-ils.cstore.direct.config.standing.search.atomic",
1410             { id => { "!=" => undef } }
1411         );
1412 }
1413
1414
1415 __PACKAGE__->register_method(
1416     method   => "get_my_org_path",
1417     api_name => "open-ils.actor.org_unit.full_path.retrieve"
1418 );
1419
1420 sub get_my_org_path {
1421     my( $self, $client, $auth, $org_id ) = @_;
1422     my $e = new_editor(authtoken=>$auth);
1423     return $e->event unless $e->checkauth;
1424     $org_id = $e->requestor->ws_ou unless defined $org_id;
1425
1426     return $apputils->simple_scalar_request(
1427         "open-ils.storage",
1428         "open-ils.storage.actor.org_unit.full_path.atomic",
1429         $org_id );
1430 }
1431
1432
1433 __PACKAGE__->register_method(
1434     method   => "patron_adv_search",
1435     api_name => "open-ils.actor.patron.search.advanced"
1436 );
1437
1438 __PACKAGE__->register_method(
1439     method   => "patron_adv_search",
1440     api_name => "open-ils.actor.patron.search.advanced.fleshed",
1441     stream => 1,
1442     # Flush the response stream at most 5 patrons in for UI responsiveness.
1443     max_bundle_count => 5,
1444     signature => {
1445         desc => q/Returns a stream of fleshed user objects instead of
1446             a pile of identifiers/
1447     }
1448 );
1449
1450 sub patron_adv_search {
1451     my( $self, $client, $auth, $search_hash, $search_limit,
1452         $search_sort, $include_inactive, $search_ou, $flesh_fields, $offset) = @_;
1453
1454     # API params sanity checks.
1455     # Exit early with empty result if no filter exists.
1456     # .fleshed call is streaming.  Non-fleshed is effectively atomic.
1457     my $fleshed = ($self->api_name =~ /fleshed/);
1458     return ($fleshed ? undef : []) unless (ref $search_hash ||'') eq 'HASH';
1459     my $search_ok = 0;
1460     for my $key (keys %$search_hash) {
1461         next if $search_hash->{$key}{value} =~ /^\s*$/; # empty filter
1462         $search_ok = 1;
1463         last;
1464     }
1465     return ($fleshed ? undef : []) unless $search_ok;
1466
1467     my $e = new_editor(authtoken=>$auth);
1468     return $e->event unless $e->checkauth;
1469     return $e->event unless $e->allowed('VIEW_USER');
1470
1471     # depth boundary outside of which patrons must opt-in, default to 0
1472     my $opt_boundary = 0;
1473     $opt_boundary = $U->ou_ancestor_setting_value($e->requestor->ws_ou,'org.patron_opt_boundary') if user_opt_in_enabled($self);
1474
1475     if (not defined $search_ou) {
1476         my $depth = $U->ou_ancestor_setting_value(
1477             $e->requestor->ws_ou,
1478             'circ.patron_edit.duplicate_patron_check_depth'
1479         );
1480
1481         if (defined $depth) {
1482             $search_ou = $U->org_unit_ancestor_at_depth(
1483                 $e->requestor->ws_ou, $depth
1484             );
1485         }
1486     }
1487
1488     my $ids = $U->storagereq(
1489         "open-ils.storage.actor.user.crazy_search", $search_hash,
1490         $search_limit, $search_sort, $include_inactive,
1491         $e->requestor->ws_ou, $search_ou, $opt_boundary, $offset);
1492
1493     return $ids unless $self->api_name =~ /fleshed/;
1494
1495     $client->respond(new_flesh_user($_, $flesh_fields, $e)) for @$ids;
1496
1497     return;
1498 }
1499
1500
1501 # A migrated (main) password has the form:
1502 # CRYPT( MD5( pw_salt || MD5(real_password) ), pw_salt )
1503 sub modify_migrated_user_password {
1504     my ($e, $user_id, $passwd) = @_;
1505
1506     # new password gets a new salt
1507     my $new_salt = $e->json_query({
1508         from => ['actor.create_salt', 'main']})->[0];
1509     $new_salt = $new_salt->{'actor.create_salt'};
1510
1511     $e->json_query({
1512         from => [
1513             'actor.set_passwd',
1514             $user_id,
1515             'main',
1516             md5_hex($new_salt . md5_hex($passwd)),
1517             $new_salt
1518         ]
1519     });
1520 }
1521
1522
1523
1524 __PACKAGE__->register_method(
1525     method    => "update_passwd",
1526     api_name  => "open-ils.actor.user.password.update",
1527     signature => {
1528         desc   => "Update the operator's password",
1529         params => [
1530             { desc => 'Authentication token', type => 'string' },
1531             { desc => 'New password',         type => 'string' },
1532             { desc => 'Current password',     type => 'string' }
1533         ],
1534         return => {desc => '1 on success, Event on error or incorrect current password'}
1535     }
1536 );
1537
1538 __PACKAGE__->register_method(
1539     method    => "update_passwd",
1540     api_name  => "open-ils.actor.user.username.update",
1541     signature => {
1542         desc   => "Update the operator's username",
1543         params => [
1544             { desc => 'Authentication token', type => 'string' },
1545             { desc => 'New username',         type => 'string' },
1546             { desc => 'Current password',     type => 'string' }
1547         ],
1548         return => {desc => '1 on success, Event on error or incorrect current password'}
1549     }
1550 );
1551
1552 __PACKAGE__->register_method(
1553     method    => "update_passwd",
1554     api_name  => "open-ils.actor.user.email.update",
1555     signature => {
1556         desc   => "Update the operator's email address",
1557         params => [
1558             { desc => 'Authentication token', type => 'string' },
1559             { desc => 'New email address',    type => 'string' },
1560             { desc => 'Current password',     type => 'string' }
1561         ],
1562         return => {desc => '1 on success, Event on error or incorrect current password'}
1563     }
1564 );
1565
1566 sub update_passwd {
1567     my( $self, $conn, $auth, $new_val, $orig_pw ) = @_;
1568     my $e = new_editor(xact=>1, authtoken=>$auth);
1569     return $e->die_event unless $e->checkauth;
1570
1571     my $db_user = $e->retrieve_actor_user($e->requestor->id)
1572         or return $e->die_event;
1573     my $api = $self->api_name;
1574
1575     if (!$U->verify_migrated_user_password($e, $db_user->id, $orig_pw)) {
1576         $e->rollback;
1577         return new OpenILS::Event('INCORRECT_PASSWORD');
1578     }
1579
1580     my $at_event = 0;
1581     if( $api =~ /password/o ) {
1582         # NOTE: with access to the plain text password we could crypt
1583         # the password without the extra MD5 pre-hashing.  Other changes
1584         # would be required.  Noting here for future reference.
1585         modify_migrated_user_password($e, $db_user->id, $new_val);
1586         $db_user->passwd('');
1587
1588     } else {
1589
1590         # if we don't clear the password, the user will be updated with
1591         # a hashed version of the hashed version of their password
1592         $db_user->clear_passwd;
1593
1594         if( $api =~ /username/o ) {
1595
1596             # make sure no one else has this username
1597             my $exist = $e->search_actor_user({usrname=>$new_val},{idlist=>1});
1598             if (@$exist) {
1599                 $e->rollback;
1600                 return new OpenILS::Event('USERNAME_EXISTS');
1601             }
1602             $db_user->usrname($new_val);
1603             $at_event++;
1604
1605         } elsif( $api =~ /email/o ) {
1606             $db_user->email($new_val);
1607             $at_event++;
1608         }
1609     }
1610
1611     $e->update_actor_user($db_user) or return $e->die_event;
1612     $e->commit;
1613
1614     $U->create_events_for_hook('au.updated', $db_user, $e->requestor->ws_ou)
1615         if $at_event;
1616
1617     # update the cached user to pick up these changes
1618     $U->simplereq('open-ils.auth', 'open-ils.auth.session.reset_timeout', $auth, 1);
1619     return 1;
1620 }
1621
1622
1623
1624 __PACKAGE__->register_method(
1625     method   => "check_user_perms",
1626     api_name => "open-ils.actor.user.perm.check",
1627     notes    => <<"    NOTES");
1628     Takes a login session, user id, an org id, and an array of perm type strings.  For each
1629     perm type, if the user does *not* have the given permission it is added
1630     to a list which is returned from the method.  If all permissions
1631     are allowed, an empty list is returned
1632     if the logged in user does not match 'user_id', then the logged in user must
1633     have VIEW_PERMISSION priveleges.
1634     NOTES
1635
1636 sub check_user_perms {
1637     my( $self, $client, $login_session, $user_id, $org_id, $perm_types ) = @_;
1638
1639     my( $staff, $evt ) = $apputils->checkses($login_session);
1640     return $evt if $evt;
1641
1642     if($staff->id ne $user_id) {
1643         if( $evt = $apputils->check_perms(
1644             $staff->id, $org_id, 'VIEW_PERMISSION') ) {
1645             return $evt;
1646         }
1647     }
1648
1649     my @not_allowed;
1650     for my $perm (@$perm_types) {
1651         if($apputils->check_perms($user_id, $org_id, $perm)) {
1652             push @not_allowed, $perm;
1653         }
1654     }
1655
1656     return \@not_allowed
1657 }
1658
1659 __PACKAGE__->register_method(
1660     method  => "check_user_perms2",
1661     api_name    => "open-ils.actor.user.perm.check.multi_org",
1662     notes       => q/
1663         Checks the permissions on a list of perms and orgs for a user
1664         @param authtoken The login session key
1665         @param user_id The id of the user to check
1666         @param orgs The array of org ids
1667         @param perms The array of permission names
1668         @return An array of  [ orgId, permissionName ] arrays that FAILED the check
1669         if the logged in user does not match 'user_id', then the logged in user must
1670         have VIEW_PERMISSION priveleges.
1671     /);
1672
1673 sub check_user_perms2 {
1674     my( $self, $client, $authtoken, $user_id, $orgs, $perms ) = @_;
1675
1676     my( $staff, $target, $evt ) = $apputils->checkses_requestor(
1677         $authtoken, $user_id, 'VIEW_PERMISSION' );
1678     return $evt if $evt;
1679
1680     my @not_allowed;
1681     for my $org (@$orgs) {
1682         for my $perm (@$perms) {
1683             if($apputils->check_perms($user_id, $org, $perm)) {
1684                 push @not_allowed, [ $org, $perm ];
1685             }
1686         }
1687     }
1688
1689     return \@not_allowed
1690 }
1691
1692
1693 __PACKAGE__->register_method(
1694     method => 'check_user_perms3',
1695     api_name    => 'open-ils.actor.user.perm.highest_org',
1696     notes       => q/
1697         Returns the highest org unit id at which a user has a given permission
1698         If the requestor does not match the target user, the requestor must have
1699         'VIEW_PERMISSION' rights at the home org unit of the target user
1700         @param authtoken The login session key
1701         @param userid The id of the user in question
1702         @param perm The permission to check
1703         @return The org unit highest in the org tree within which the user has
1704         the requested permission
1705     /);
1706
1707 sub check_user_perms3 {
1708     my($self, $client, $authtoken, $user_id, $perm) = @_;
1709     my $e = new_editor(authtoken=>$authtoken);
1710     return $e->event unless $e->checkauth;
1711
1712     my $tree = $U->get_org_tree();
1713
1714     unless($e->requestor->id == $user_id) {
1715         my $user = $e->retrieve_actor_user($user_id)
1716             or return $e->event;
1717         return $e->event unless $e->allowed('VIEW_PERMISSION', $user->home_ou);
1718         return $U->find_highest_perm_org($perm, $user_id, $user->home_ou, $tree );
1719     }
1720
1721     return $U->find_highest_perm_org($perm, $user_id, $e->requestor->ws_ou, $tree);
1722 }
1723
1724 __PACKAGE__->register_method(
1725     method => 'user_has_work_perm_at',
1726     api_name    => 'open-ils.actor.user.has_work_perm_at',
1727     authoritative => 1,
1728     signature => {
1729         desc => q/
1730             Returns a set of org unit IDs which represent the highest orgs in
1731             the org tree where the user has the requested permission.  The
1732             purpose of this method is to return the smallest set of org units
1733             which represent the full expanse of the user's ability to perform
1734             the requested action.  The user whose perms this method should
1735             check is implied by the authtoken. /,
1736         params => [
1737             {desc => 'authtoken', type => 'string'},
1738             {desc => 'permission name', type => 'string'},
1739             {desc => q/user id, optional.  If present, check perms for
1740                 this user instead of the logged in user/, type => 'number'},
1741         ],
1742         return => {desc => 'An array of org IDs'}
1743     }
1744 );
1745
1746 sub user_has_work_perm_at {
1747     my($self, $conn, $auth, $perm, $user_id) = @_;
1748     my $e = new_editor(authtoken=>$auth);
1749     return $e->event unless $e->checkauth;
1750     if(defined $user_id) {
1751         my $user = $e->retrieve_actor_user($user_id) or return $e->event;
1752         return $e->event unless $e->allowed('VIEW_PERMISSION', $user->home_ou);
1753     }
1754     return $U->user_has_work_perm_at($e, $perm, undef, $user_id);
1755 }
1756
1757 __PACKAGE__->register_method(
1758     method => 'user_has_work_perm_at_batch',
1759     api_name    => 'open-ils.actor.user.has_work_perm_at.batch',
1760     authoritative => 1,
1761 );
1762
1763 sub user_has_work_perm_at_batch {
1764     my($self, $conn, $auth, $perms, $user_id) = @_;
1765     my $e = new_editor(authtoken=>$auth);
1766     return $e->event unless $e->checkauth;
1767     if(defined $user_id) {
1768         my $user = $e->retrieve_actor_user($user_id) or return $e->event;
1769         return $e->event unless $e->allowed('VIEW_PERMISSION', $user->home_ou);
1770     }
1771     my $map = {};
1772     $map->{$_} = $U->user_has_work_perm_at($e, $_) for @$perms;
1773     return $map;
1774 }
1775
1776
1777
1778 __PACKAGE__->register_method(
1779     method => 'check_user_perms4',
1780     api_name    => 'open-ils.actor.user.perm.highest_org.batch',
1781     notes       => q/
1782         Returns the highest org unit id at which a user has a given permission
1783         If the requestor does not match the target user, the requestor must have
1784         'VIEW_PERMISSION' rights at the home org unit of the target user
1785         @param authtoken The login session key
1786         @param userid The id of the user in question
1787         @param perms An array of perm names to check
1788         @return An array of orgId's  representing the org unit
1789         highest in the org tree within which the user has the requested permission
1790         The arrah of orgId's has matches the order of the perms array
1791     /);
1792
1793 sub check_user_perms4 {
1794     my( $self, $client, $authtoken, $userid, $perms ) = @_;
1795
1796     my( $staff, $target, $org, $evt );
1797
1798     ( $staff, $target, $evt ) = $apputils->checkses_requestor(
1799         $authtoken, $userid, 'VIEW_PERMISSION' );
1800     return $evt if $evt;
1801
1802     my @arr;
1803     return [] unless ref($perms);
1804     my $tree = $U->get_org_tree();
1805
1806     for my $p (@$perms) {
1807         push( @arr, $U->find_highest_perm_org( $p, $userid, $target->home_ou, $tree ) );
1808     }
1809     return \@arr;
1810 }
1811
1812
1813 __PACKAGE__->register_method(
1814     method        => "user_fines_summary",
1815     api_name      => "open-ils.actor.user.fines.summary",
1816     authoritative => 1,
1817     signature     => {
1818         desc   => 'Returns a short summary of the users total open fines, '  .
1819                 'excluding voided fines Params are login_session, user_id' ,
1820         params => [
1821             {desc => 'Authentication token', type => 'string'},
1822             {desc => 'User ID',              type => 'string'}  # number?
1823         ],
1824         return => {
1825             desc => "a 'mous' object, event on error",
1826         }
1827     }
1828 );
1829
1830 sub user_fines_summary {
1831     my( $self, $client, $auth, $user_id ) = @_;
1832
1833     my $e = new_editor(authtoken=>$auth);
1834     return $e->event unless $e->checkauth;
1835
1836     if( $user_id ne $e->requestor->id ) {
1837         my $user = $e->retrieve_actor_user($user_id) or return $e->event;
1838         return $e->event unless
1839             $e->allowed('VIEW_USER_FINES_SUMMARY', $user->home_ou);
1840     }
1841
1842     return $e->search_money_open_user_summary({usr => $user_id})->[0];
1843 }
1844
1845
1846 __PACKAGE__->register_method(
1847     method        => "user_opac_vitals",
1848     api_name      => "open-ils.actor.user.opac.vital_stats",
1849     argc          => 1,
1850     authoritative => 1,
1851     signature     => {
1852         desc   => 'Returns a short summary of the users vital stats, including '  .
1853                 'identification information, accumulated balance, number of holds, ' .
1854                 'and current open circulation stats' ,
1855         params => [
1856             {desc => 'Authentication token',                          type => 'string'},
1857             {desc => 'Optional User ID, for use in the staff client', type => 'number'}  # number?
1858         ],
1859         return => {
1860             desc => "An object with four properties: user, fines, checkouts and holds."
1861         }
1862     }
1863 );
1864
1865 sub user_opac_vitals {
1866     my( $self, $client, $auth, $user_id ) = @_;
1867
1868     my $e = new_editor(authtoken=>$auth);
1869     return $e->event unless $e->checkauth;
1870
1871     $user_id ||= $e->requestor->id;
1872
1873     my $user = $e->retrieve_actor_user( $user_id );
1874
1875     my ($fines) = $self
1876         ->method_lookup('open-ils.actor.user.fines.summary')
1877         ->run($auth => $user_id);
1878     return $fines if (defined($U->event_code($fines)));
1879
1880     if (!$fines) {
1881         $fines = new Fieldmapper::money::open_user_summary ();
1882         $fines->balance_owed(0.00);
1883         $fines->total_owed(0.00);
1884         $fines->total_paid(0.00);
1885         $fines->usr($user_id);
1886     }
1887
1888     my ($holds) = $self
1889         ->method_lookup('open-ils.actor.user.hold_requests.count')
1890         ->run($auth => $user_id);
1891     return $holds if (defined($U->event_code($holds)));
1892
1893     my ($out) = $self
1894         ->method_lookup('open-ils.actor.user.checked_out.count')
1895         ->run($auth => $user_id);
1896     return $out if (defined($U->event_code($out)));
1897
1898     $out->{"total_out"} = reduce { $a + $out->{$b} } 0, qw/out overdue/;
1899
1900     my $unread_msgs = $e->search_actor_usr_message([
1901         {usr => $user_id, read_date => undef, deleted => 'f'},
1902         {idlist => 1}
1903     ]);
1904
1905     return {
1906         user => {
1907             first_given_name  => $user->first_given_name,
1908             second_given_name => $user->second_given_name,
1909             family_name       => $user->family_name,
1910             alias             => $user->alias,
1911             usrname           => $user->usrname
1912         },
1913         fines => $fines->to_bare_hash,
1914         checkouts => $out,
1915         holds => $holds,
1916         messages => { unread => scalar(@$unread_msgs) }
1917     };
1918 }
1919
1920
1921 ##### a small consolidation of related method registrations
1922 my $common_params = [
1923     { desc => 'Authentication token', type => 'string' },
1924     { desc => 'User ID',              type => 'string' },
1925     { desc => 'Transactions type (optional, defaults to all)', type => 'string' },
1926     { desc => 'Options hash.  May contain limit and offset for paged results.', type => 'object' },
1927 ];
1928 my %methods = (
1929     'open-ils.actor.user.transactions'                      => '',
1930     'open-ils.actor.user.transactions.fleshed'              => '',
1931     'open-ils.actor.user.transactions.have_charge'          => ' that have an initial charge',
1932     'open-ils.actor.user.transactions.have_charge.fleshed'  => ' that have an initial charge',
1933     'open-ils.actor.user.transactions.have_balance'         => ' that have an outstanding balance',
1934     'open-ils.actor.user.transactions.have_balance.fleshed' => ' that have an outstanding balance',
1935 );
1936
1937 foreach (keys %methods) {
1938     my %args = (
1939         method    => "user_transactions",
1940         api_name  => $_,
1941         signature => {
1942             desc   => 'For a given user, retrieve a list of '
1943                     . (/\.fleshed/ ? 'fleshed ' : '')
1944                     . 'transactions' . $methods{$_}
1945                     . ' optionally limited to transactions of a given type.',
1946             params => $common_params,
1947             return => {
1948                 desc => "List of objects, or event on error.  Each object is a hash containing: transaction, circ, record. "
1949                     . 'These represent the relevant (mbts) transaction, attached circulation and title pointed to in the circ, respectively.',
1950             }
1951         }
1952     );
1953     $args{authoritative} = 1;
1954     __PACKAGE__->register_method(%args);
1955 }
1956
1957 # Now for the counts
1958 %methods = (
1959     'open-ils.actor.user.transactions.count'              => '',
1960     'open-ils.actor.user.transactions.have_charge.count'  => ' that have an initial charge',
1961     'open-ils.actor.user.transactions.have_balance.count' => ' that have an outstanding balance',
1962 );
1963
1964 foreach (keys %methods) {
1965     my %args = (
1966         method    => "user_transactions",
1967         api_name  => $_,
1968         signature => {
1969             desc   => 'For a given user, retrieve a count of open '
1970                     . 'transactions' . $methods{$_}
1971                     . ' optionally limited to transactions of a given type.',
1972             params => $common_params,
1973             return => { desc => "Integer count of transactions, or event on error" }
1974         }
1975     );
1976     /\.have_balance/ and $args{authoritative} = 1;     # FIXME: I don't know why have_charge isn't authoritative
1977     __PACKAGE__->register_method(%args);
1978 }
1979
1980 __PACKAGE__->register_method(
1981     method        => "user_transactions",
1982     api_name      => "open-ils.actor.user.transactions.have_balance.total",
1983     authoritative => 1,
1984     signature     => {
1985         desc   => 'For a given user, retrieve the total balance owed for open transactions,'
1986                 . ' optionally limited to transactions of a given type.',
1987         params => $common_params,
1988         return => { desc => "Decimal balance value, or event on error" }
1989     }
1990 );
1991
1992
1993 sub user_transactions {
1994     my( $self, $client, $auth, $user_id, $type, $options ) = @_;
1995     $options ||= {};
1996
1997     my $e = new_editor(authtoken => $auth);
1998     return $e->event unless $e->checkauth;
1999
2000     my $user = $e->retrieve_actor_user($user_id) or return $e->event;
2001
2002     return $e->event unless
2003         $e->requestor->id == $user_id or
2004         $e->allowed('VIEW_USER_TRANSACTIONS', $user->home_ou);
2005
2006     my $api = $self->api_name();
2007
2008     my $filter = ($api =~ /have_balance/o) ?
2009         { 'balance_owed' => { '<>' => 0 } }:
2010         { 'total_owed' => { '>' => 0 } };
2011
2012     my $method = 'open-ils.actor.user.transactions.history.still_open';
2013     $method = "$method.authoritative" if $api =~ /authoritative/;
2014     my ($trans) = $self->method_lookup($method)->run($auth, $user_id, $type, $filter, $options);
2015
2016     if($api =~ /total/o) {
2017         my $total = 0.0;
2018         $total += $_->balance_owed for @$trans;
2019         return $total;
2020     }
2021
2022     ($api =~ /count/o  ) and return scalar @$trans;
2023     ($api !~ /fleshed/o) and return $trans;
2024
2025     my @resp;
2026     for my $t (@$trans) {
2027
2028         if( $t->xact_type ne 'circulation' ) {
2029             push @resp, {transaction => $t};
2030             next;
2031         }
2032
2033         my $circ_data = flesh_circ($e, $t->id);
2034         push @resp, {transaction => $t, %$circ_data};
2035     }
2036
2037     return \@resp;
2038 }
2039
2040
2041 __PACKAGE__->register_method(
2042     method   => "user_transaction_retrieve",
2043     api_name => "open-ils.actor.user.transaction.fleshed.retrieve",
2044     argc     => 1,
2045     authoritative => 1,
2046     notes    => "Returns a fleshed transaction record"
2047 );
2048
2049 __PACKAGE__->register_method(
2050     method   => "user_transaction_retrieve",
2051     api_name => "open-ils.actor.user.transaction.retrieve",
2052     argc     => 1,
2053     authoritative => 1,
2054     notes    => "Returns a transaction record"
2055 );
2056
2057 sub user_transaction_retrieve {
2058     my($self, $client, $auth, $bill_id) = @_;
2059
2060     my $e = new_editor(authtoken => $auth);
2061     return $e->event unless $e->checkauth;
2062
2063     my $trans = $e->retrieve_money_billable_transaction_summary(
2064         [$bill_id, {flesh => 1, flesh_fields => {mbts => ['usr']}}]) or return $e->event;
2065
2066     return $e->event unless $e->allowed('VIEW_USER_TRANSACTIONS', $trans->usr->home_ou);
2067
2068     $trans->usr($trans->usr->id); # de-flesh for backwards compat
2069
2070     return $trans unless $self->api_name =~ /flesh/;
2071     return {transaction => $trans} if $trans->xact_type ne 'circulation';
2072
2073     my $circ_data = flesh_circ($e, $trans->id, 1);
2074
2075     return {transaction => $trans, %$circ_data};
2076 }
2077
2078 sub flesh_circ {
2079     my $e = shift;
2080     my $circ_id = shift;
2081     my $flesh_copy = shift;
2082
2083     my $circ = $e->retrieve_action_circulation([
2084         $circ_id, {
2085             flesh => 3,
2086             flesh_fields => {
2087                 circ => ['target_copy'],
2088                 acp => ['call_number'],
2089                 acn => ['record']
2090             }
2091         }
2092     ]);
2093
2094     my $mods;
2095     my $copy = $circ->target_copy;
2096
2097     if($circ->target_copy->call_number->id == OILS_PRECAT_CALL_NUMBER) {
2098         $mods = new Fieldmapper::metabib::virtual_record;
2099         $mods->doc_id(OILS_PRECAT_RECORD);
2100         $mods->title($copy->dummy_title);
2101         $mods->author($copy->dummy_author);
2102
2103     } else {
2104         $mods = $U->record_to_mvr($circ->target_copy->call_number->record);
2105     }
2106
2107     # more de-fleshiing
2108     $circ->target_copy($circ->target_copy->id);
2109     $copy->call_number($copy->call_number->id);
2110
2111     return {circ => $circ, record => $mods, copy => ($flesh_copy) ? $copy : undef };
2112 }
2113
2114
2115 __PACKAGE__->register_method(
2116     method        => "hold_request_count",
2117     api_name      => "open-ils.actor.user.hold_requests.count",
2118     authoritative => 1,
2119     argc          => 1,
2120     notes         => q/
2121         Returns hold ready vs. total counts.
2122         If a context org unit is provided, a third value
2123         is returned with key 'behind_desk', which reports
2124         how many holds are ready at the pickup library
2125         with the behind_desk flag set to true.
2126     /
2127 );
2128
2129 sub hold_request_count {
2130     my( $self, $client, $authtoken, $user_id, $ctx_org ) = @_;
2131     my $e = new_editor(authtoken => $authtoken);
2132     return $e->event unless $e->checkauth;
2133
2134     $user_id = $e->requestor->id unless defined $user_id;
2135
2136     if($e->requestor->id ne $user_id) {
2137         my $user = $e->retrieve_actor_user($user_id);
2138         return $e->event unless $e->allowed('VIEW_HOLD', $user->home_ou);
2139     }
2140
2141     my $holds = $e->json_query({
2142         select => {ahr => ['pickup_lib', 'current_shelf_lib', 'behind_desk']},
2143         from => 'ahr',
2144         where => {
2145             usr => $user_id,
2146             fulfillment_time => {"=" => undef },
2147             cancel_time => undef,
2148         }
2149     });
2150
2151     my @ready = grep {
2152         $_->{current_shelf_lib} and # avoid undef warnings
2153         $_->{pickup_lib} eq $_->{current_shelf_lib}
2154     } @$holds;
2155
2156     my $resp = {
2157         total => scalar(@$holds),
2158         ready => scalar(@ready)
2159     };
2160
2161     if ($ctx_org) {
2162         # count of holds ready at pickup lib with behind_desk true.
2163         $resp->{behind_desk} = scalar(
2164             grep {
2165                 $_->{pickup_lib} == $ctx_org and
2166                 $U->is_true($_->{behind_desk})
2167             } @ready
2168         );
2169     }
2170
2171     return $resp;
2172 }
2173
2174 __PACKAGE__->register_method(
2175     method        => "checked_out",
2176     api_name      => "open-ils.actor.user.checked_out",
2177     authoritative => 1,
2178     argc          => 2,
2179     signature     => {
2180         desc => "For a given user, returns a structure of circulations objects sorted by out, overdue, lost, claims_returned, long_overdue. "
2181             . "A list of IDs are returned of each type.  Circs marked lost, long_overdue, and claims_returned will not be 'finished' "
2182             . "(i.e., outstanding balance or some other pending action on the circ). "
2183             . "The .count method also includes a 'total' field which sums all open circs.",
2184         params => [
2185             { desc => 'Authentication Token', type => 'string'},
2186             { desc => 'User ID',              type => 'string'},
2187         ],
2188         return => {
2189             desc => 'Returns event on error, or an object with ID lists, like: '
2190                 . '{"out":[12552,451232], "claims_returned":[], "long_overdue":[23421] "overdue":[], "lost":[]}'
2191         },
2192     }
2193 );
2194
2195 __PACKAGE__->register_method(
2196     method        => "checked_out",
2197     api_name      => "open-ils.actor.user.checked_out.count",
2198     authoritative => 1,
2199     argc          => 2,
2200     signature     => q/@see open-ils.actor.user.checked_out/
2201 );
2202
2203 sub checked_out {
2204     my( $self, $conn, $auth, $userid ) = @_;
2205
2206     my $e = new_editor(authtoken=>$auth);
2207     return $e->event unless $e->checkauth;
2208
2209     if( $userid ne $e->requestor->id ) {
2210         my $user = $e->retrieve_actor_user($userid) or return $e->event;
2211         unless($e->allowed('VIEW_CIRCULATIONS', $user->home_ou)) {
2212
2213             # see if there is a friend link allowing circ.view perms
2214             my $allowed = OpenILS::Application::Actor::Friends->friend_perm_allowed(
2215                 $e, $userid, $e->requestor->id, 'circ.view');
2216             return $e->event unless $allowed;
2217         }
2218     }
2219
2220     my $count = $self->api_name =~ /count/;
2221     return _checked_out( $count, $e, $userid );
2222 }
2223
2224 sub _checked_out {
2225     my( $iscount, $e, $userid ) = @_;
2226
2227     my %result = (
2228         out => [],
2229         overdue => [],
2230         lost => [],
2231         claims_returned => [],
2232         long_overdue => []
2233     );
2234     my $meth = 'retrieve_action_open_circ_';
2235
2236     if ($iscount) {
2237         $meth .= 'count';
2238         %result = (
2239             out => 0,
2240             overdue => 0,
2241             lost => 0,
2242             claims_returned => 0,
2243             long_overdue => 0
2244         );
2245     } else {
2246         $meth .= 'list';
2247     }
2248
2249     my $data = $e->$meth($userid);
2250
2251     if ($data) {
2252         if ($iscount) {
2253             $result{$_} += $data->$_() for (keys %result);
2254             $result{total} += $data->$_() for (keys %result);
2255         } else {
2256             for my $k (keys %result) {
2257                 $result{$k} = [ grep { $_ > 0 } split( ',', $data->$k()) ];
2258             }
2259         }
2260     }
2261
2262     return \%result;
2263 }
2264
2265
2266
2267 __PACKAGE__->register_method(
2268     method        => "checked_in_with_fines",
2269     api_name      => "open-ils.actor.user.checked_in_with_fines",
2270     authoritative => 1,
2271     argc          => 2,
2272     signature     => q/@see open-ils.actor.user.checked_out/
2273 );
2274
2275 sub checked_in_with_fines {
2276     my( $self, $conn, $auth, $userid ) = @_;
2277
2278     my $e = new_editor(authtoken=>$auth);
2279     return $e->event unless $e->checkauth;
2280
2281     if( $userid ne $e->requestor->id ) {
2282         return $e->event unless $e->allowed('VIEW_CIRCULATIONS');
2283     }
2284
2285     # money is owed on these items and they are checked in
2286     my $open = $e->search_action_circulation(
2287         {
2288             usr             => $userid,
2289             xact_finish     => undef,
2290             checkin_time    => { "!=" => undef },
2291         }
2292     );
2293
2294
2295     my( @lost, @cr, @lo );
2296     for my $c (@$open) {
2297         push( @lost, $c->id ) if ($c->stop_fines eq 'LOST');
2298         push( @cr, $c->id ) if $c->stop_fines eq 'CLAIMSRETURNED';
2299         push( @lo, $c->id ) if $c->stop_fines eq 'LONGOVERDUE';
2300     }
2301
2302     return {
2303         lost        => \@lost,
2304         claims_returned => \@cr,
2305         long_overdue        => \@lo
2306     };
2307 }
2308
2309
2310 sub _sigmaker {
2311     my ($api, $desc, $auth) = @_;
2312     $desc = $desc ? (" " . $desc) : '';
2313     my $ids = ($api =~ /ids$/) ? 1 : 0;
2314     my @sig = (
2315         argc      => 1,
2316         method    => "user_transaction_history",
2317         api_name  => "open-ils.actor.user.transactions.$api",
2318         signature => {
2319             desc   => "For a given User ID, returns a list of billable transaction" .
2320                     ($ids ? " id" : '') .
2321                     "s$desc, optionally filtered by type and/or fields in money.billable_xact_summary.  " .
2322                     "The VIEW_USER_TRANSACTIONS permission is required to view another user's transactions",
2323             params => [
2324                 {desc => 'Authentication token',        type => 'string'},
2325                 {desc => 'User ID',                     type => 'number'},
2326                 {desc => 'Transaction type (optional)', type => 'number'},
2327                 {desc => 'Hash of Billable Transaction Summary filters (optional)', type => 'object'}
2328             ],
2329             return => {
2330                 desc => 'List of transaction' . ($ids ? " id" : '') . 's, Event on error'
2331             },
2332         }
2333     );
2334     $auth and push @sig, (authoritative => 1);
2335     return @sig;
2336 }
2337
2338 my %auth_hist_methods = (
2339     'history'             => '',
2340     'history.have_charge' => 'that have an initial charge',
2341     'history.still_open'  => 'that are not finished',
2342     'history.have_balance'         => 'that have a balance',
2343     'history.have_bill'            => 'that have billings',
2344     'history.have_bill_or_payment' => 'that have non-zero-sum billings or at least 1 payment',
2345     'history.have_payment' => 'that have at least 1 payment',
2346 );
2347
2348 foreach (keys %auth_hist_methods) {
2349     __PACKAGE__->register_method(_sigmaker($_,       $auth_hist_methods{$_}, 1));
2350     __PACKAGE__->register_method(_sigmaker("$_.ids", $auth_hist_methods{$_}, 1));
2351     __PACKAGE__->register_method(_sigmaker("$_.fleshed", $auth_hist_methods{$_}, 1));
2352 }
2353
2354 sub user_transaction_history {
2355     my( $self, $conn, $auth, $userid, $type, $filter, $options ) = @_;
2356     $filter ||= {};
2357     $options ||= {};
2358
2359     my $e = new_editor(authtoken=>$auth);
2360     return $e->die_event unless $e->checkauth;
2361
2362     if ($e->requestor->id ne $userid) {
2363         return $e->die_event unless $e->allowed('VIEW_USER_TRANSACTIONS');
2364     }
2365
2366     my $api = $self->api_name;
2367     my @xact_finish  = (xact_finish => undef ) if ($api =~ /history\.still_open$/);     # What about history.still_open.ids?
2368
2369     if(defined($type)) {
2370         $filter->{'xact_type'} = $type;
2371     }
2372
2373     if($api =~ /have_bill_or_payment/o) {
2374
2375         # transactions that have a non-zero sum across all billings or at least 1 payment
2376         $filter->{'-or'} = {
2377             'balance_owed' => { '<>' => 0 },
2378             'last_payment_ts' => { '<>' => undef }
2379         };
2380
2381     } elsif($api =~ /have_payment/) {
2382
2383         $filter->{last_payment_ts} ||= {'<>' => undef};
2384
2385     } elsif( $api =~ /have_balance/o) {
2386
2387         # transactions that have a non-zero overall balance
2388         $filter->{'balance_owed'} = { '<>' => 0 };
2389
2390     } elsif( $api =~ /have_charge/o) {
2391
2392         # transactions that have at least 1 billing, regardless of whether it was voided
2393         $filter->{'last_billing_ts'} = { '<>' => undef };
2394
2395     } elsif( $api =~ /have_bill/o) {    # needs to be an elsif, or we double-match have_bill_or_payment!
2396
2397         # transactions that have non-zero sum across all billings.  This will exclude
2398         # xacts where all billings have been voided
2399         $filter->{'total_owed'} = { '<>' => 0 };
2400     }
2401
2402     my $options_clause = { order_by => { mbt => 'xact_start DESC' } };
2403     $options_clause->{'limit'} = $options->{'limit'} if $options->{'limit'};
2404     $options_clause->{'offset'} = $options->{'offset'} if $options->{'offset'};
2405
2406     my $mbts = $e->search_money_billable_transaction_summary(
2407         [   { usr => $userid, @xact_finish, %$filter },
2408             $options_clause
2409         ]
2410     );
2411
2412     return [map {$_->id} @$mbts] if $api =~ /\.ids/;
2413     return $mbts unless $api =~ /fleshed/;
2414
2415     my @resp;
2416     for my $t (@$mbts) {
2417
2418         if( $t->xact_type ne 'circulation' ) {
2419             push @resp, {transaction => $t};
2420             next;
2421         }
2422
2423         my $circ_data = flesh_circ($e, $t->id);
2424         push @resp, {transaction => $t, %$circ_data};
2425     }
2426
2427     return \@resp;
2428 }
2429
2430
2431
2432 __PACKAGE__->register_method(
2433     method   => "user_perms",
2434     api_name => "open-ils.actor.permissions.user_perms.retrieve",
2435     argc     => 1,
2436     notes    => "Returns a list of permissions"
2437 );
2438
2439 sub user_perms {
2440     my( $self, $client, $authtoken, $user ) = @_;
2441
2442     my( $staff, $evt ) = $apputils->checkses($authtoken);
2443     return $evt if $evt;
2444
2445     $user ||= $staff->id;
2446
2447     if( $user != $staff->id and $evt = $apputils->check_perms( $staff->id, $staff->home_ou, 'VIEW_PERMISSION') ) {
2448         return $evt;
2449     }
2450
2451     return $apputils->simple_scalar_request(
2452         "open-ils.storage",
2453         "open-ils.storage.permission.user_perms.atomic",
2454         $user);
2455 }
2456
2457 __PACKAGE__->register_method(
2458     method   => "retrieve_perms",
2459     api_name => "open-ils.actor.permissions.retrieve",
2460     notes    => "Returns a list of permissions"
2461 );
2462 sub retrieve_perms {
2463     my( $self, $client ) = @_;
2464     return $apputils->simple_scalar_request(
2465         "open-ils.cstore",
2466         "open-ils.cstore.direct.permission.perm_list.search.atomic",
2467         { id => { '!=' => undef } }
2468     );
2469 }
2470
2471 __PACKAGE__->register_method(
2472     method   => "retrieve_groups",
2473     api_name => "open-ils.actor.groups.retrieve",
2474     notes    => "Returns a list of user groups"
2475 );
2476 sub retrieve_groups {
2477     my( $self, $client ) = @_;
2478     return new_editor()->retrieve_all_permission_grp_tree();
2479 }
2480
2481 __PACKAGE__->register_method(
2482     method  => "retrieve_org_address",
2483     api_name    => "open-ils.actor.org_unit.address.retrieve",
2484     notes        => <<'    NOTES');
2485     Returns an org_unit address by ID
2486     @param An org_address ID
2487     NOTES
2488 sub retrieve_org_address {
2489     my( $self, $client, $id ) = @_;
2490     return $apputils->simple_scalar_request(
2491         "open-ils.cstore",
2492         "open-ils.cstore.direct.actor.org_address.retrieve",
2493         $id
2494     );
2495 }
2496
2497 __PACKAGE__->register_method(
2498     method   => "retrieve_groups_tree",
2499     api_name => "open-ils.actor.groups.tree.retrieve",
2500     notes    => "Returns a list of user groups"
2501 );
2502
2503 sub retrieve_groups_tree {
2504     my( $self, $client ) = @_;
2505     return new_editor()->search_permission_grp_tree(
2506         [
2507             { parent => undef},
2508             {
2509                 flesh               => -1,
2510                 flesh_fields    => { pgt => ["children"] },
2511                 order_by            => { pgt => 'name'}
2512             }
2513         ]
2514     )->[0];
2515 }
2516
2517
2518 __PACKAGE__->register_method(
2519     method   => "add_user_to_groups",
2520     api_name => "open-ils.actor.user.set_groups",
2521     notes    => "Adds a user to one or more permission groups"
2522 );
2523
2524 sub add_user_to_groups {
2525     my( $self, $client, $authtoken, $userid, $groups ) = @_;
2526
2527     my( $requestor, $target, $evt ) = $apputils->checkses_requestor(
2528         $authtoken, $userid, 'CREATE_USER_GROUP_LINK' );
2529     return $evt if $evt;
2530
2531     ( $requestor, $target, $evt ) = $apputils->checkses_requestor(
2532         $authtoken, $userid, 'REMOVE_USER_GROUP_LINK' );
2533     return $evt if $evt;
2534
2535     $apputils->simplereq(
2536         'open-ils.storage',
2537         'open-ils.storage.direct.permission.usr_grp_map.mass_delete', { usr => $userid } );
2538
2539     for my $group (@$groups) {
2540         my $link = Fieldmapper::permission::usr_grp_map->new;
2541         $link->grp($group);
2542         $link->usr($userid);
2543
2544         my $id = $apputils->simplereq(
2545             'open-ils.storage',
2546             'open-ils.storage.direct.permission.usr_grp_map.create', $link );
2547     }
2548
2549     return 1;
2550 }
2551
2552 __PACKAGE__->register_method(
2553     method   => "get_user_perm_groups",
2554     api_name => "open-ils.actor.user.get_groups",
2555     notes    => "Retrieve a user's permission groups."
2556 );
2557
2558
2559 sub get_user_perm_groups {
2560     my( $self, $client, $authtoken, $userid ) = @_;
2561
2562     my( $requestor, $target, $evt ) = $apputils->checkses_requestor(
2563         $authtoken, $userid, 'VIEW_PERM_GROUPS' );
2564     return $evt if $evt;
2565
2566     return $apputils->simplereq(
2567         'open-ils.cstore',
2568         'open-ils.cstore.direct.permission.usr_grp_map.search.atomic', { usr => $userid } );
2569 }
2570
2571
2572 __PACKAGE__->register_method(
2573     method   => "get_user_work_ous",
2574     api_name => "open-ils.actor.user.get_work_ous",
2575     notes    => "Retrieve a user's work org units."
2576 );
2577
2578 __PACKAGE__->register_method(
2579     method   => "get_user_work_ous",
2580     api_name => "open-ils.actor.user.get_work_ous.ids",
2581     notes    => "Retrieve a user's work org units."
2582 );
2583
2584 sub get_user_work_ous {
2585     my( $self, $client, $auth, $userid ) = @_;
2586     my $e = new_editor(authtoken=>$auth);
2587     return $e->event unless $e->checkauth;
2588     $userid ||= $e->requestor->id;
2589
2590     if($e->requestor->id != $userid) {
2591         my $user = $e->retrieve_actor_user($userid)
2592             or return $e->event;
2593         return $e->event unless $e->allowed('ASSIGN_WORK_ORG_UNIT', $user->home_ou);
2594     }
2595
2596     return $e->search_permission_usr_work_ou_map({usr => $userid})
2597         unless $self->api_name =~ /.ids$/;
2598
2599     # client just wants a list of org IDs
2600     return $U->get_user_work_ou_ids($e, $userid);
2601 }
2602
2603
2604
2605 __PACKAGE__->register_method(
2606     method    => 'register_workstation',
2607     api_name  => 'open-ils.actor.workstation.register.override',
2608     signature => q/@see open-ils.actor.workstation.register/
2609 );
2610
2611 __PACKAGE__->register_method(
2612     method    => 'register_workstation',
2613     api_name  => 'open-ils.actor.workstation.register',
2614     signature => q/
2615         Registers a new workstion in the system
2616         @param authtoken The login session key
2617         @param name The name of the workstation id
2618         @param owner The org unit that owns this workstation
2619         @return The workstation id on success, WORKSTATION_NAME_EXISTS
2620         if the name is already in use.
2621     /
2622 );
2623
2624 sub register_workstation {
2625     my( $self, $conn, $authtoken, $name, $owner, $oargs ) = @_;
2626
2627     my $e = new_editor(authtoken=>$authtoken, xact=>1);
2628     return $e->die_event unless $e->checkauth;
2629     return $e->die_event unless $e->allowed('REGISTER_WORKSTATION', $owner);
2630     my $existing = $e->search_actor_workstation({name => $name})->[0];
2631     $oargs = { all => 1 } unless defined $oargs;
2632
2633     if( $existing ) {
2634
2635         if( $self->api_name =~ /override/o && ($oargs->{all} || grep { $_ eq 'WORKSTATION_NAME_EXISTS' } @{$oargs->{events}}) ) {
2636             # workstation with the given name exists.
2637
2638             if($owner ne $existing->owning_lib) {
2639                 # if necessary, update the owning_lib of the workstation
2640
2641                 $logger->info("changing owning lib of workstation ".$existing->id.
2642                     " from ".$existing->owning_lib." to $owner");
2643                 return $e->die_event unless
2644                     $e->allowed('UPDATE_WORKSTATION', $existing->owning_lib);
2645
2646                 return $e->die_event unless $e->allowed('UPDATE_WORKSTATION', $owner);
2647
2648                 $existing->owning_lib($owner);
2649                 return $e->die_event unless $e->update_actor_workstation($existing);
2650
2651                 $e->commit;
2652
2653             } else {
2654                 $logger->info(
2655                     "attempt to register an existing workstation.  returning existing ID");
2656             }
2657
2658             return $existing->id;
2659
2660         } else {
2661             return OpenILS::Event->new('WORKSTATION_NAME_EXISTS')
2662         }
2663     }
2664
2665     my $ws = Fieldmapper::actor::workstation->new;
2666     $ws->owning_lib($owner);
2667     $ws->name($name);
2668     $e->create_actor_workstation($ws) or return $e->die_event;
2669     $e->commit;
2670     return $ws->id; # note: editor sets the id on the new object for us
2671 }
2672
2673 __PACKAGE__->register_method(
2674     method    => 'workstation_list',
2675     api_name  => 'open-ils.actor.workstation.list',
2676     signature => q/
2677         Returns a list of workstations registered at the given location
2678         @param authtoken The login session key
2679         @param ids A list of org_unit.id's for the workstation owners
2680     /
2681 );
2682
2683 sub workstation_list {
2684     my( $self, $conn, $authtoken, @orgs ) = @_;
2685
2686     my $e = new_editor(authtoken=>$authtoken);
2687     return $e->event unless $e->checkauth;
2688     my %results;
2689
2690     for my $o (@orgs) {
2691         return $e->event
2692             unless $e->allowed('REGISTER_WORKSTATION', $o);
2693         $results{$o} = $e->search_actor_workstation({owning_lib=>$o});
2694     }
2695     return \%results;
2696 }
2697
2698
2699 __PACKAGE__->register_method(
2700     method        => 'fetch_patron_note',
2701     api_name      => 'open-ils.actor.note.retrieve.all',
2702     authoritative => 1,
2703     signature     => q/
2704         Returns a list of notes for a given user
2705         Requestor must have VIEW_USER permission if pub==false and
2706         @param authtoken The login session key
2707         @param args Hash of params including
2708             patronid : the patron's id
2709             pub : true if retrieving only public notes
2710     /
2711 );
2712
2713 sub fetch_patron_note {
2714     my( $self, $conn, $authtoken, $args ) = @_;
2715     my $patronid = $$args{patronid};
2716
2717     my($reqr, $evt) = $U->checkses($authtoken);
2718     return $evt if $evt;
2719
2720     my $patron;
2721     ($patron, $evt) = $U->fetch_user($patronid);
2722     return $evt if $evt;
2723
2724     if($$args{pub}) {
2725         if( $patronid ne $reqr->id ) {
2726             $evt = $U->check_perms($reqr->id, $patron->home_ou, 'VIEW_USER');
2727             return $evt if $evt;
2728         }
2729         return $U->cstorereq(
2730             'open-ils.cstore.direct.actor.usr_note.search.atomic',
2731             { usr => $patronid, pub => 't' } );
2732     }
2733
2734     $evt = $U->check_perms($reqr->id, $patron->home_ou, 'VIEW_USER');
2735     return $evt if $evt;
2736
2737     return $U->cstorereq(
2738         'open-ils.cstore.direct.actor.usr_note.search.atomic', { usr => $patronid } );
2739 }
2740
2741 __PACKAGE__->register_method(
2742     method    => 'create_user_note',
2743     api_name  => 'open-ils.actor.note.create',
2744     signature => q/
2745         Creates a new note for the given user
2746         @param authtoken The login session key
2747         @param note The note object
2748     /
2749 );
2750 sub create_user_note {
2751     my( $self, $conn, $authtoken, $note ) = @_;
2752     my $e = new_editor(xact=>1, authtoken=>$authtoken);
2753     return $e->die_event unless $e->checkauth;
2754
2755     my $user = $e->retrieve_actor_user($note->usr)
2756         or return $e->die_event;
2757
2758     return $e->die_event unless
2759         $e->allowed('UPDATE_USER',$user->home_ou);
2760
2761     $note->creator($e->requestor->id);
2762     $e->create_actor_usr_note($note) or return $e->die_event;
2763     $e->commit;
2764     return $note->id;
2765 }
2766
2767
2768 __PACKAGE__->register_method(
2769     method    => 'delete_user_note',
2770     api_name  => 'open-ils.actor.note.delete',
2771     signature => q/
2772         Deletes a note for the given user
2773         @param authtoken The login session key
2774         @param noteid The note id
2775     /
2776 );
2777 sub delete_user_note {
2778     my( $self, $conn, $authtoken, $noteid ) = @_;
2779
2780     my $e = new_editor(xact=>1, authtoken=>$authtoken);
2781     return $e->die_event unless $e->checkauth;
2782     my $note = $e->retrieve_actor_usr_note($noteid)
2783         or return $e->die_event;
2784     my $user = $e->retrieve_actor_user($note->usr)
2785         or return $e->die_event;
2786     return $e->die_event unless
2787         $e->allowed('UPDATE_USER', $user->home_ou);
2788
2789     $e->delete_actor_usr_note($note) or return $e->die_event;
2790     $e->commit;
2791     return 1;
2792 }
2793
2794
2795 __PACKAGE__->register_method(
2796     method    => 'update_user_note',
2797     api_name  => 'open-ils.actor.note.update',
2798     signature => q/
2799         @param authtoken The login session key
2800         @param note The note
2801     /
2802 );
2803
2804 sub update_user_note {
2805     my( $self, $conn, $auth, $note ) = @_;
2806     my $e = new_editor(authtoken=>$auth, xact=>1);
2807     return $e->die_event unless $e->checkauth;
2808     my $patron = $e->retrieve_actor_user($note->usr)
2809         or return $e->die_event;
2810     return $e->die_event unless
2811         $e->allowed('UPDATE_USER', $patron->home_ou);
2812     $e->update_actor_user_note($note)
2813         or return $e->die_event;
2814     $e->commit;
2815     return 1;
2816 }
2817
2818 __PACKAGE__->register_method(
2819     method        => 'fetch_patron_messages',
2820     api_name      => 'open-ils.actor.message.retrieve',
2821     authoritative => 1,
2822     signature     => q/
2823         Returns a list of notes for a given user, not
2824         including ones marked deleted
2825         @param authtoken The login session key
2826         @param patronid patron ID
2827         @param options hash containing optional limit and offset
2828     /
2829 );
2830
2831 sub fetch_patron_messages {
2832     my( $self, $conn, $auth, $patronid, $options ) = @_;
2833
2834     $options ||= {};
2835
2836     my $e = new_editor(authtoken => $auth);
2837     return $e->die_event unless $e->checkauth;
2838
2839     if ($e->requestor->id ne $patronid) {
2840         return $e->die_event unless $e->allowed('VIEW_USER');
2841     }
2842
2843     my $select_clause = { usr => $patronid };
2844     my $options_clause = { order_by => { aum => 'create_date DESC' } };
2845     $options_clause->{'limit'} = $options->{'limit'} if $options->{'limit'};
2846     $options_clause->{'offset'} = $options->{'offset'} if $options->{'offset'};
2847
2848     my $aum = $e->search_actor_usr_message([ $select_clause, $options_clause ]);
2849     return $aum;
2850 }
2851
2852
2853 __PACKAGE__->register_method(
2854     method    => 'usrname_exists',
2855     api_name  => 'open-ils.actor.username.exists',
2856     signature => {
2857         desc  => 'Check if a username is already taken (by an undeleted patron)',
2858         param => [
2859             {desc => 'Authentication token', type => 'string'},
2860             {desc => 'Username',             type => 'string'}
2861         ],
2862         return => {
2863             desc => 'id of existing user if username exists, undef otherwise.  Event on error'
2864         },
2865     }
2866 );
2867
2868 sub usrname_exists {
2869     my( $self, $conn, $auth, $usrname ) = @_;
2870     my $e = new_editor(authtoken=>$auth);
2871     return $e->event unless $e->checkauth;
2872     my $a = $e->search_actor_user({usrname => $usrname}, {idlist=>1});
2873     return $$a[0] if $a and @$a;
2874     return undef;
2875 }
2876
2877 __PACKAGE__->register_method(
2878     method        => 'barcode_exists',
2879     api_name      => 'open-ils.actor.barcode.exists',
2880     authoritative => 1,
2881     signature     => 'Returns 1 if the requested barcode exists, returns 0 otherwise'
2882 );
2883
2884 sub barcode_exists {
2885     my( $self, $conn, $auth, $barcode ) = @_;
2886     my $e = new_editor(authtoken=>$auth);
2887     return $e->event unless $e->checkauth;
2888     my $card = $e->search_actor_card({barcode => $barcode});
2889     if (@$card) {
2890         return 1;
2891     } else {
2892         return 0;
2893     }
2894     #return undef unless @$card;
2895     #return $card->[0]->usr;
2896 }
2897
2898
2899 __PACKAGE__->register_method(
2900     method   => 'retrieve_net_levels',
2901     api_name => 'open-ils.actor.net_access_level.retrieve.all',
2902 );
2903
2904 sub retrieve_net_levels {
2905     my( $self, $conn, $auth ) = @_;
2906     my $e = new_editor(authtoken=>$auth);
2907     return $e->event unless $e->checkauth;
2908     return $e->retrieve_all_config_net_access_level();
2909 }
2910
2911 # Retain the old typo API name just in case
2912 __PACKAGE__->register_method(
2913     method   => 'fetch_org_by_shortname',
2914     api_name => 'open-ils.actor.org_unit.retrieve_by_shorname',
2915 );
2916 __PACKAGE__->register_method(
2917     method   => 'fetch_org_by_shortname',
2918     api_name => 'open-ils.actor.org_unit.retrieve_by_shortname',
2919 );
2920 sub fetch_org_by_shortname {
2921     my( $self, $conn, $sname ) = @_;
2922     my $e = new_editor();
2923     my $org = $e->search_actor_org_unit({ shortname => uc($sname)})->[0];
2924     return $e->event unless $org;
2925     return $org;
2926 }
2927
2928
2929 __PACKAGE__->register_method(
2930     method   => 'session_home_lib',
2931     api_name => 'open-ils.actor.session.home_lib',
2932 );
2933
2934 sub session_home_lib {
2935     my( $self, $conn, $auth ) = @_;
2936     my $e = new_editor(authtoken=>$auth);
2937     return undef unless $e->checkauth;
2938     my $org = $e->retrieve_actor_org_unit($e->requestor->home_ou);
2939     return $org->shortname;
2940 }
2941
2942 __PACKAGE__->register_method(
2943     method    => 'session_safe_token',
2944     api_name  => 'open-ils.actor.session.safe_token',
2945     signature => q/
2946         Returns a hashed session ID that is safe for export to the world.
2947         This safe token will expire after 1 hour of non-use.
2948         @param auth Active authentication token
2949     /
2950 );
2951
2952 sub session_safe_token {
2953     my( $self, $conn, $auth ) = @_;
2954     my $e = new_editor(authtoken=>$auth);
2955     return undef unless $e->checkauth;
2956
2957     my $safe_token = md5_hex($auth);
2958
2959     $cache ||= OpenSRF::Utils::Cache->new("global", 0);
2960
2961     # add more user fields as needed
2962     $cache->put_cache(
2963         "safe-token-user-$safe_token", {
2964             id => $e->requestor->id,
2965             home_ou_shortname => $e->retrieve_actor_org_unit(
2966                 $e->requestor->home_ou)->shortname,
2967         },
2968         60 * 60
2969     );
2970
2971     return $safe_token;
2972 }
2973
2974
2975 __PACKAGE__->register_method(
2976     method    => 'safe_token_home_lib',
2977     api_name  => 'open-ils.actor.safe_token.home_lib.shortname',
2978     signature => q/
2979         Returns the home library shortname from the session
2980         asscociated with a safe token from generated by
2981         open-ils.actor.session.safe_token.
2982         @param safe_token Active safe token
2983         @param who Optional user activity "ewho" value
2984     /
2985 );
2986
2987 sub safe_token_home_lib {
2988     my( $self, $conn, $safe_token, $who ) = @_;
2989     $cache ||= OpenSRF::Utils::Cache->new("global", 0);
2990
2991     my $blob = $cache->get_cache("safe-token-user-$safe_token");
2992     return unless $blob;
2993
2994     $U->log_user_activity($blob->{id}, $who, 'verify');
2995     return $blob->{home_ou_shortname};
2996 }
2997
2998
2999 __PACKAGE__->register_method(
3000     method   => "update_penalties",
3001     api_name => "open-ils.actor.user.penalties.update"
3002 );
3003
3004 sub update_penalties {
3005     my($self, $conn, $auth, $user_id) = @_;
3006     my $e = new_editor(authtoken=>$auth, xact => 1);
3007     return $e->die_event unless $e->checkauth;
3008     my $user = $e->retrieve_actor_user($user_id) or return $e->die_event;
3009     return $e->die_event unless $e->allowed('UPDATE_USER', $user->home_ou);
3010     my $evt = OpenILS::Utils::Penalty->calculate_penalties($e, $user_id, $e->requestor->ws_ou);
3011     return $evt if $evt;
3012     $e->commit;
3013     return 1;
3014 }
3015
3016
3017 __PACKAGE__->register_method(
3018     method   => "apply_penalty",
3019     api_name => "open-ils.actor.user.penalty.apply"
3020 );
3021
3022 sub apply_penalty {
3023     my($self, $conn, $auth, $penalty) = @_;
3024
3025     my $e = new_editor(authtoken=>$auth, xact => 1);
3026     return $e->die_event unless $e->checkauth;
3027
3028     my $user = $e->retrieve_actor_user($penalty->usr) or return $e->die_event;
3029     return $e->die_event unless $e->allowed('UPDATE_USER', $user->home_ou);
3030
3031     my $ptype = $e->retrieve_config_standing_penalty($penalty->standing_penalty) or return $e->die_event;
3032
3033     my $ctx_org =
3034         (defined $ptype->org_depth) ?
3035         $U->org_unit_ancestor_at_depth($penalty->org_unit, $ptype->org_depth) :
3036         $penalty->org_unit;
3037
3038     $penalty->org_unit($ctx_org);
3039     $penalty->staff($e->requestor->id);
3040     $e->create_actor_user_standing_penalty($penalty) or return $e->die_event;
3041
3042     $e->commit;
3043     return $penalty->id;
3044 }
3045
3046 __PACKAGE__->register_method(
3047     method   => "remove_penalty",
3048     api_name => "open-ils.actor.user.penalty.remove"
3049 );
3050
3051 sub remove_penalty {
3052     my($self, $conn, $auth, $penalty) = @_;
3053     my $e = new_editor(authtoken=>$auth, xact => 1);
3054     return $e->die_event unless $e->checkauth;
3055     my $user = $e->retrieve_actor_user($penalty->usr) or return $e->die_event;
3056     return $e->die_event unless $e->allowed('UPDATE_USER', $user->home_ou);
3057
3058     $e->delete_actor_user_standing_penalty($penalty) or return $e->die_event;
3059     $e->commit;
3060     return 1;
3061 }
3062
3063 __PACKAGE__->register_method(
3064     method   => "update_penalty_note",
3065     api_name => "open-ils.actor.user.penalty.note.update"
3066 );
3067
3068 sub update_penalty_note {
3069     my($self, $conn, $auth, $penalty_ids, $note) = @_;
3070     my $e = new_editor(authtoken=>$auth, xact => 1);
3071     return $e->die_event unless $e->checkauth;
3072     for my $penalty_id (@$penalty_ids) {
3073         my $penalty = $e->search_actor_user_standing_penalty( { id => $penalty_id } )->[0];
3074         if (! $penalty ) { return $e->die_event; }
3075         my $user = $e->retrieve_actor_user($penalty->usr) or return $e->die_event;
3076         return $e->die_event unless $e->allowed('UPDATE_USER', $user->home_ou);
3077
3078         $penalty->note( $note ); $penalty->ischanged( 1 );
3079
3080         $e->update_actor_user_standing_penalty($penalty) or return $e->die_event;
3081     }
3082     $e->commit;
3083     return 1;
3084 }
3085
3086 __PACKAGE__->register_method(
3087     method   => "ranged_penalty_thresholds",
3088     api_name => "open-ils.actor.grp_penalty_threshold.ranged.retrieve",
3089     stream   => 1
3090 );
3091
3092 sub ranged_penalty_thresholds {
3093     my($self, $conn, $auth, $context_org) = @_;
3094     my $e = new_editor(authtoken=>$auth);
3095     return $e->event unless $e->checkauth;
3096     return $e->event unless $e->allowed('VIEW_GROUP_PENALTY_THRESHOLD', $context_org);
3097     my $list = $e->search_permission_grp_penalty_threshold([
3098         {org_unit => $U->get_org_ancestors($context_org)},
3099         {order_by => {pgpt => 'id'}}
3100     ]);
3101     $conn->respond($_) for @$list;
3102     return undef;
3103 }
3104
3105
3106
3107 __PACKAGE__->register_method(
3108     method        => "user_retrieve_fleshed_by_id",
3109     authoritative => 1,
3110     api_name      => "open-ils.actor.user.fleshed.retrieve",
3111 );
3112
3113 sub user_retrieve_fleshed_by_id {
3114     my( $self, $client, $auth, $user_id, $fields ) = @_;
3115     my $e = new_editor(authtoken => $auth);
3116     return $e->event unless $e->checkauth;
3117
3118     if( $e->requestor->id != $user_id ) {
3119         return $e->event unless $e->allowed('VIEW_USER');
3120     }
3121
3122     $fields ||= [
3123         "cards",
3124         "card",
3125         "groups",
3126         "standing_penalties",
3127         "settings",
3128         "addresses",
3129         "billing_address",
3130         "mailing_address",
3131         "stat_cat_entries",
3132         "waiver_entries",
3133         "usr_activity" ];
3134     return new_flesh_user($user_id, $fields, $e);
3135 }
3136
3137
3138 sub new_flesh_user {
3139
3140     my $id = shift;
3141     my $fields = shift || [];
3142     my $e = shift;
3143
3144     my $fetch_penalties = 0;
3145     if(grep {$_ eq 'standing_penalties'} @$fields) {
3146         $fields = [grep {$_ ne 'standing_penalties'} @$fields];
3147         $fetch_penalties = 1;
3148     }
3149
3150     my $fetch_usr_act = 0;
3151     if(grep {$_ eq 'usr_activity'} @$fields) {
3152         $fields = [grep {$_ ne 'usr_activity'} @$fields];
3153         $fetch_usr_act = 1;
3154     }
3155
3156     my $user = $e->retrieve_actor_user(
3157     [
3158         $id,
3159         {
3160             "flesh"             => 1,
3161             "flesh_fields" =>  { "au" => $fields }
3162         }
3163     ]
3164     ) or return $e->die_event;
3165
3166
3167     if( grep { $_ eq 'addresses' } @$fields ) {
3168
3169         $user->addresses([]) unless @{$user->addresses};
3170         # don't expose "replaced" addresses by default
3171         $user->addresses([grep {$_->id >= 0} @{$user->addresses}]);
3172
3173         if( ref $user->billing_address ) {
3174             unless( grep { $user->billing_address->id == $_->id } @{$user->addresses} ) {
3175                 push( @{$user->addresses}, $user->billing_address );
3176             }
3177         }
3178
3179         if( ref $user->mailing_address ) {
3180             unless( grep { $user->mailing_address->id == $_->id } @{$user->addresses} ) {
3181                 push( @{$user->addresses}, $user->mailing_address );
3182             }
3183         }
3184     }
3185
3186     if($fetch_penalties) {
3187         # grab the user penalties ranged for this location
3188         $user->standing_penalties(
3189             $e->search_actor_user_standing_penalty([
3190                 {   usr => $id,
3191                     '-or' => [
3192                         {stop_date => undef},
3193                         {stop_date => {'>' => 'now'}}
3194                     ],
3195                     org_unit => $U->get_org_full_path($e->requestor->ws_ou)
3196                 },
3197                 {   flesh => 1,
3198                     flesh_fields => {ausp => ['standing_penalty']}
3199                 }
3200             ])
3201         );
3202     }
3203
3204     # retrieve the most recent usr_activity entry
3205     if ($fetch_usr_act) {
3206
3207         # max number to return for simple patron fleshing
3208         my $limit = $U->ou_ancestor_setting_value(
3209             $e->requestor->ws_ou,
3210             'circ.patron.usr_activity_retrieve.max');
3211
3212         my $opts = {
3213             flesh => 1,
3214             flesh_fields => {auact => ['etype']},
3215             order_by => {auact => 'event_time DESC'},
3216         };
3217
3218         # 0 == none, <0 == return all
3219         $limit = 1 unless defined $limit;
3220         $opts->{limit} = $limit if $limit > 0;
3221
3222         $user->usr_activity(
3223             ($limit == 0) ?
3224                 [] : # skip the DB call
3225                 $e->search_actor_usr_activity([{usr => $user->id}, $opts])
3226         );
3227     }
3228
3229     $e->rollback;
3230     $user->clear_passwd();
3231     return $user;
3232 }
3233
3234
3235
3236
3237 __PACKAGE__->register_method(
3238     method   => "user_retrieve_parts",
3239     api_name => "open-ils.actor.user.retrieve.parts",
3240 );
3241
3242 sub user_retrieve_parts {
3243     my( $self, $client, $auth, $user_id, $fields ) = @_;
3244     my $e = new_editor(authtoken => $auth);
3245     return $e->event unless $e->checkauth;
3246     $user_id ||= $e->requestor->id;
3247     if( $e->requestor->id != $user_id ) {
3248         return $e->event unless $e->allowed('VIEW_USER');
3249     }
3250     my @resp;
3251     my $user = $e->retrieve_actor_user($user_id) or return $e->event;
3252     push(@resp, $user->$_()) for(@$fields);
3253     return \@resp;
3254 }
3255
3256
3257
3258 __PACKAGE__->register_method(
3259     method    => 'user_opt_in_enabled',
3260     api_name  => 'open-ils.actor.user.org_unit_opt_in.enabled',
3261     signature => '@return 1 if user opt-in is globally enabled, 0 otherwise.'
3262 );
3263
3264 sub user_opt_in_enabled {
3265     my($self, $conn) = @_;
3266     my $sc = OpenSRF::Utils::SettingsClient->new;
3267     return 1 if lc($sc->config_value(share => user => 'opt_in')) eq 'true';
3268     return 0;
3269 }
3270
3271
3272 __PACKAGE__->register_method(
3273     method    => 'user_opt_in_at_org',
3274     api_name  => 'open-ils.actor.user.org_unit_opt_in.check',
3275     signature => q/
3276         @param $auth The auth token
3277         @param user_id The ID of the user to test
3278         @return 1 if the user has opted in at the specified org,
3279             2 if opt-in is disallowed for the user's home org,
3280             event on error, and 0 otherwise. /
3281 );
3282 sub user_opt_in_at_org {
3283     my($self, $conn, $auth, $user_id) = @_;
3284
3285     # see if we even need to enforce the opt-in value
3286     return 1 unless user_opt_in_enabled($self);
3287
3288     my $e = new_editor(authtoken => $auth);
3289     return $e->event unless $e->checkauth;
3290
3291     my $user = $e->retrieve_actor_user($user_id) or return $e->event;
3292     return $e->event unless $e->allowed('VIEW_USER', $user->home_ou);
3293
3294     my $ws_org = $e->requestor->ws_ou;
3295     # user is automatically opted-in if they are from the local org
3296     return 1 if $user->home_ou eq $ws_org;
3297
3298     # get the boundary setting
3299     my $opt_boundary = $U->ou_ancestor_setting_value($e->requestor->ws_ou,'org.patron_opt_boundary');
3300
3301     # auto opt in if user falls within the opt boundary
3302     my $opt_orgs = $U->get_org_descendants($ws_org, $opt_boundary);
3303
3304     return 1 if grep $_ eq $user->home_ou, @$opt_orgs;
3305
3306     # check whether opt-in is restricted at the user's home library
3307     my $opt_restrict_depth = $U->ou_ancestor_setting_value($user->home_ou, 'org.restrict_opt_to_depth');
3308     if ($opt_restrict_depth) {
3309         my $restrict_ancestor = $U->org_unit_ancestor_at_depth($user->home_ou, $opt_restrict_depth);
3310         my $unrestricted_orgs = $U->get_org_descendants($restrict_ancestor);
3311