Open-ILS/src/perlmods/OpenILS/Application/Actor.pm

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