1 package OpenILS::Application::Actor;
2 use base qw/OpenSRF::Application/;
3 use strict; use warnings;
6 use Digest::MD5 qw(md5_hex);
8 use OpenSRF::EX qw(:try);
11 use OpenILS::Application::AppUtils;
12 use OpenILS::Utils::Fieldmapper;
13 use OpenILS::Application::Search::Actor;
14 use OpenILS::Utils::ModsParser;
16 my $apputils = "OpenILS::Application::AppUtils";
17 sub _d { warn "Patron:\n" . Dumper(shift()); }
18 my $cache_client = OpenSRF::Utils::Cache->new("global", 0);
21 __PACKAGE__->register_method(
22 method => "update_patron",
23 api_name => "open-ils.actor.patron.update",);
26 my( $self, $client, $user_session, $patron ) = @_;
28 my $session = $apputils->start_db_session();
31 warn $user_session . " " . $patron . "\n";
35 OpenILS::Application::AppUtils->check_user_session(
36 $user_session ); #throws EX on error
38 # XXX does this user have permission to add/create users. Granularity?
40 # $new_patron is the patron in progress. $patron is the original patron
41 # passed in with the method. new_patron will change as the components
42 # of patron are added/updated.
47 # create/update the patron first so we can use his id
48 if($patron->isnew()) {
49 $new_patron = _add_patron(
50 $session, _clone_patron($patron));
51 if(UNIVERSAL::isa($new_patron, "OpenILS::EX")) {
52 $client->respond_complete($new_patron->ex);
57 $new_patron = $patron;
60 $new_patron = _add_update_addresses($session, $patron, $new_patron);
61 $new_patron = _add_update_cards($session, $patron, $new_patron);
63 if(UNIVERSAL::isa($new_patron,"OpenILS::EX")) {
64 $client->respond_complete($new_patron->ex);
68 $new_patron = _add_survey_responses($session, $patron, $new_patron);
69 $new_patron = _create_stat_maps($session, $user_session, $patron, $new_patron);
71 # re-update the patron if anything has happened to him during this process
72 if($new_patron->ischanged()) {
73 $new_patron = _update_patron($session, $new_patron);
75 $apputils->commit_db_session($session);
80 $err = "-*- Failure adding user: $e";
81 $apputils->rollback_db_session($session);
85 if($err) { throw OpenSRF::EX::ERROR ($err); }
88 warn "Patron Update/Create complete\n";
89 return flesh_user($new_patron->id());
95 __PACKAGE__->register_method(
96 method => "user_retrieve_fleshed_by_id",
97 api_name => "open-ils.actor.user.fleshed.retrieve",);
99 sub user_retrieve_fleshed_by_id {
100 my( $self, $client, $user_session, $user_id ) = @_;
101 my $user_obj = $apputils->check_user_session( $user_session );
102 return flesh_user($user_id);
113 $session = OpenSRF::AppSession->create("open-ils.storage");
117 # grab the user with the given id
118 my $ureq = $session->request(
119 "open-ils.storage.direct.actor.user.retrieve", $id);
120 my $user = $ureq->gather(1);
122 if(!$user) { return undef; }
125 my $cards_req = $session->request(
126 "open-ils.storage.direct.actor.card.search.usr.atomic",
128 $user->cards( $cards_req->gather(1) );
130 for my $c(@{$user->cards}) {
131 if($c->id == $user->card || $c->id eq $user->card ) {
132 warn "Setting my card to " . $c->id . "\n";
137 my $add_req = $session->request(
138 "open-ils.storage.direct.actor.user_address.search.usr.atomic",
140 $user->addresses( $add_req->gather(1) );
142 for my $c(@{$user->addresses}) {
143 if($c->id == $user->billing_address || $c->id eq $user->billing_address ) {
144 warn "Setting my address to " . $c->id . "\n";
145 $user->billing_address($c);
149 for my $c(@{$user->addresses}) {
150 if($c->id == $user->mailing_address || $c->id eq $user->mailing_address ) {
151 warn "Setting my address to " . $c->id . "\n";
152 $user->mailing_address($c);
156 my $stat_req = $session->request(
157 "open-ils.storage.direct.actor.stat_cat_entry_user_map.search.target_usr.atomic",
159 $user->stat_cat_entries($stat_req->gather(1));
161 if($kill) { $session->disconnect(); }
162 $user->clear_passwd();
170 # clone and clear stuff that would break the database
174 my $new_patron = Fieldmapper::actor::user->new();
176 my $fmap = $Fieldmapper::fieldmap;
177 no strict; # shallow clone, may be useful in the fieldmapper
179 (keys %{$fmap->{"Fieldmapper::actor::user"}->{'fields'}}) {
180 $new_patron->$field( $patron->$field() );
185 $new_patron->clear_billing_address();
186 $new_patron->clear_mailing_address();
187 $new_patron->clear_addresses();
188 $new_patron->clear_card();
189 $new_patron->clear_cards();
190 $new_patron->clear_id();
191 $new_patron->clear_isnew();
192 $new_patron->clear_changed();
193 $new_patron->clear_deleted();
194 $new_patron->clear_stat_cat_entries();
204 warn "Creating new patron\n";
207 my $req = $session->request(
208 "open-ils.storage.direct.actor.user.create",$patron);
209 my $id = $req->gather(1);
211 return OpenILS::EX->new("DUPLICATE_USER_USERNAME");
214 # retrieve the patron from the db to collect defaults
215 my $ureq = $session->request(
216 "open-ils.storage.direct.actor.user.retrieve",
219 warn "Created new patron with id $id\n";
221 return $ureq->gather(1);
226 my( $session, $patron) = @_;
228 warn "updating patron " . Dumper($patron) . "\n";
230 my $req = $session->request(
231 "open-ils.storage.direct.actor.user.update",$patron );
232 my $status = $req->gather(1);
233 if(!defined($status)) {
234 throw OpenSRF::EX::ERROR
235 ("Unknown error updating patron");
241 sub _add_update_addresses {
244 my $new_patron = shift;
246 my $current_id; # id of the address before creation
248 for my $address (@{$patron->addresses()}) {
250 $address->usr($new_patron->id());
252 if(ref($address) and $address->isnew()) {
253 warn "Adding new address at street " . $address->street1() . "\n";
255 $current_id = $address->id();
256 $address = _add_address($session,$address);
258 if( $patron->billing_address() and
259 $patron->billing_address() == $current_id ) {
260 $new_patron->billing_address($address->id());
261 $new_patron->ischanged(1);
264 if( $patron->mailing_address() and
265 $patron->mailing_address() == $current_id ) {
266 $new_patron->mailing_address($address->id());
267 $new_patron->ischanged(1);
270 } elsif( ref($address) and $address->ischanged() ) {
271 warn "Updating address at street " . $address->street1();
272 $address->usr($new_patron->id());
273 _update_address($session,$address);
275 } elsif( ref($address) and $address->isdeleted() ) {
276 warn "Deleting address at street " . $address->street1();
278 if( $address->id() == $new_patron->mailing_address() ) {
279 $new_patron->clear_mailing_address();
280 _update_patron($session, $new_patron);
283 if( $address->id() == $new_patron->billing_address() ) {
284 $new_patron->clear_billing_address();
285 _update_patron($session, $new_patron);
288 _delete_address($session,$address);
296 # adds an address to the db and returns the address with new id
298 my($session, $address) = @_;
299 $address->clear_id();
301 # put the address into the database
302 my $req = $session->request(
303 "open-ils.storage.direct.actor.user_address.create",
307 my $id = $req->gather(1);
309 throw OpenSRF::EX::ERROR
310 ("Unable to create new user address");
313 warn "Created address with id $id\n";
315 # update all the necessary id's
321 sub _update_address {
322 my( $session, $address ) = @_;
323 my $req = $session->request(
324 "open-ils.storage.direct.actor.user_address.update",
326 my $status = $req->gather(1);
327 if(!defined($status)) {
328 throw OpenSRF::EX::ERROR
329 ("Unknown error updating address");
336 sub _add_update_cards {
340 my $new_patron = shift;
342 my $virtual_id; #id of the card before creation
343 for my $card (@{$patron->cards()}) {
345 $card->usr($new_patron->id());
347 if(ref($card) and $card->isnew()) {
349 $virtual_id = $card->id();
350 $card = _add_card($session,$card);
351 if(UNIVERSAL::isa($card,"OpenILS::EX")) {
355 if($patron->card() == $virtual_id) {
356 $new_patron->card($card->id());
357 $new_patron->ischanged(1);
360 } elsif( ref($card) and $card->ischanged() ) {
361 $card->usr($new_patron->id());
362 _update_card($session, $card);
369 # adds an card to the db and returns the card with new id
371 my( $session, $card ) = @_;
374 warn "Adding card with barcode " . $card->barcode() . "\n";
375 my $req = $session->request(
376 "open-ils.storage.direct.actor.card.create",
379 my $id = $req->gather(1);
381 return OpenILS::EX->new("DUPLICATE_INVALID_USER_BARCODE");
385 warn "Created patron card with id $id\n";
391 my( $session, $card ) = @_;
394 my $req = $session->request(
395 "open-ils.storage.direct.actor.card.update",
397 my $status = $req->gather(1);
398 if(!defined($status)) {
399 throw OpenSRF::EX::ERROR
400 ("Unknown error updating card");
408 sub _delete_address {
409 my( $session, $address ) = @_;
411 warn "Deleting address " . $address->street1() . "\n";
413 my $req = $session->request(
414 "open-ils.storage.direct.actor.user_address.delete",
416 my $status = $req->gather(1);
417 if(!defined($status)) {
418 throw OpenSRF::EX::ERROR
419 ("Unknown error updating address");
421 warn "Delete address status is $status\n";
426 sub _add_survey_responses {
427 my ($session, $patron, $new_patron) = @_;
429 warn "updating responses for user " . $new_patron->id . "\n";
431 my $responses = $patron->survey_responses;
432 for my $resp( @$responses ) {
433 $resp->usr($new_patron->id);
436 my $status = $apputils->simple_scalar_request(
438 "open-ils.circ.survey.submit.user_id",
445 sub _create_stat_maps {
447 my($session, $user_session, $patron, $new_patron) = @_;
449 my $maps = $patron->stat_cat_entries();
451 for my $map (@$maps) {
453 next unless($map->isnew() || $map->ischanged());
455 my $method = "open-ils.storage.direct.actor.stat_cat_entry_user_map.update";
457 $method = "open-ils.storage.direct.actor.stat_cat_entry_user_map.create";
460 $map->target_usr($new_patron->id);
462 warn "Updating stat entry with method $method and session $user_session and map $map\n";
464 my $req = $session->request($method, $map);
465 my $status = $req->gather(1);
470 throw OpenSRF::EX::ERROR
471 ("Error updating stat map with method $method");
480 __PACKAGE__->register_method(
481 method => "search_username",
482 api_name => "open-ils.actor.user.search.username",
485 sub search_username {
486 my($self, $client, $username) = @_;
487 my $users = OpenILS::Application::AppUtils->simple_scalar_request(
489 "open-ils.storage.direct.actor.user.search.usrname.atomic",
497 __PACKAGE__->register_method(
498 method => "user_retrieve_by_barcode",
499 api_name => "open-ils.actor.user.fleshed.retrieve_by_barcode",);
501 sub user_retrieve_by_barcode {
502 my($self, $client, $user_session, $barcode) = @_;
503 warn "Searching for user with barcode $barcode\n";
504 my $user_obj = $apputils->check_user_session( $user_session );
506 my $session = OpenSRF::AppSession->create("open-ils.storage");
508 # find the card with the given barcode
509 my $creq = $session->request(
510 "open-ils.storage.direct.actor.card.search.barcode.atomic",
512 my $card = $creq->gather(1);
514 if(!$card || !$card->[0]) {
515 $session->disconnect();
520 my $user = flesh_user($card->usr(), $session);
521 $session->disconnect();
528 __PACKAGE__->register_method(
529 method => "get_user_by_id",
530 api_name => "open-ils.actor.user.retrieve",);
533 my ($self, $client, $user_session, $id) = @_;
535 my $user_obj = $apputils->check_user_session( $user_session );
537 return $apputils->simple_scalar_request(
539 "open-ils.storage.direct.actor.user.retrieve",
545 __PACKAGE__->register_method(
546 method => "get_org_types",
547 api_name => "open-ils.actor.org_types.retrieve",);
551 my($self, $client) = @_;
553 return $org_types if $org_types;
555 $apputils->simple_scalar_request(
557 "open-ils.storage.direct.actor.org_unit_type.retrieve.all.atomic" );
562 __PACKAGE__->register_method(
563 method => "get_user_profiles",
564 api_name => "open-ils.actor.user.profiles.retrieve",
568 sub get_user_profiles {
569 return $user_profiles if $user_profiles;
571 return $user_profiles =
572 $apputils->simple_scalar_request(
574 "open-ils.storage.direct.actor.profile.retrieve.all.atomic");
579 __PACKAGE__->register_method(
580 method => "get_user_ident_types",
581 api_name => "open-ils.actor.user.ident_types.retrieve",
584 sub get_user_ident_types {
585 return $ident_types if $ident_types;
586 return $ident_types =
587 $apputils->simple_scalar_request(
589 "open-ils.storage.direct.config.identification_type.retrieve.all.atomic" );
595 __PACKAGE__->register_method(
596 method => "get_org_unit",
597 api_name => "open-ils.actor.org_unit.retrieve",
602 my( $self, $client, $user_session, $org_id ) = @_;
604 if(defined($user_session) && !defined($org_id)) {
606 OpenILS::Application::AppUtils->check_user_session( $user_session ); #throws EX on error
607 if(!defined($org_id)) {
608 $org_id = $user_obj->home_ou;
613 my $home_ou = OpenILS::Application::AppUtils->simple_scalar_request(
615 "open-ils.storage.direct.actor.org_unit.retrieve",
624 __PACKAGE__->register_method(
625 method => "get_org_tree",
626 api_name => "open-ils.actor.org_tree.retrieve",
628 note => "Returns the entire org tree structure",
632 my( $self, $client) = @_;
634 # see if it's in the cache
635 warn "Getting ORG Tree\n";
636 my $tree = $cache_client->get_cache('orgtree');
638 warn "Found orgtree in cache. returning...\n";
642 my $orglist = $apputils->simple_scalar_request(
644 "open-ils.storage.direct.actor.org_unit.retrieve.all.atomic" );
647 warn "found org list\n";
650 $tree = $self->build_org_tree($orglist);
651 $cache_client->put_cache('orgtree', $tree);
657 # turns an org list into an org tree
660 my( $self, $orglist) = @_;
662 return $orglist unless (
663 ref($orglist) and @$orglist > 1 );
666 $a->ou_type <=> $b->ou_type ||
667 $a->name cmp $b->name } @$orglist;
669 for my $org (@list) {
671 next unless ($org and defined($org->parent_ou));
672 my ($parent) = grep { $_->id == $org->parent_ou } @list;
675 $parent->children([]) unless defined($parent->children);
676 push( @{$parent->children}, $org );
684 __PACKAGE__->register_method(
685 method => "get_org_descendants",
686 api_name => "open-ils.actor.org_tree.descendants.retrieve"
689 # depth is optional. org_unit is the id
690 sub get_org_descendants {
691 my( $self, $client, $org_unit, $depth ) = @_;
692 my $orglist = $apputils->simple_scalar_request(
694 "open-ils.storage.actor.org_unit.descendants.atomic",
696 return $self->build_org_tree($orglist);
700 __PACKAGE__->register_method(
701 method => "get_org_ancestors",
702 api_name => "open-ils.actor.org_tree.ancestors.retrieve"
705 # depth is optional. org_unit is the id
706 sub get_org_ancestors {
707 my( $self, $client, $org_unit, $depth ) = @_;
708 my $orglist = $apputils->simple_scalar_request(
710 "open-ils.storage.actor.org_unit.ancestors.atomic",
712 return $self->build_org_tree($orglist);
716 __PACKAGE__->register_method(
717 method => "get_standings",
718 api_name => "open-ils.actor.standings.retrieve"
723 return $user_standings if $user_standings;
724 return $user_standings =
725 $apputils->simple_scalar_request(
727 "open-ils.storage.direct.config.standing.retrieve.all.atomic" );
732 __PACKAGE__->register_method(
733 method => "get_my_org_path",
734 api_name => "open-ils.actor.org_unit.full_path.retrieve"
737 sub get_my_org_path {
738 my( $self, $client, $user_session, $org_id ) = @_;
739 my $user_obj = $apputils->check_user_session($user_session);
740 if(!defined($org_id)) { $org_id = $user_obj->home_ou; }
742 return $apputils->simple_scalar_request(
744 "open-ils.storage.actor.org_unit.full_path.atomic",
749 __PACKAGE__->register_method(
750 method => "patron_adv_search",
751 api_name => "open-ils.actor.patron.search.advanced" );
753 sub patron_adv_search {
754 my( $self, $client, $staff_login, $search_hash ) = @_;
757 warn "patron adv with $staff_login and search " .
758 Dumper($search_hash) . "\n";
760 my $session = OpenSRF::AppSession->create("open-ils.storage");
761 my $req = $session->request(
762 "open-ils.storage.actor.user.crazy_search", $search_hash);
764 my $ans = $req->gather(1);
766 my %hash = map { ($_ =>1) } @$ans;
767 $ans = [ keys %hash ];
769 warn "Returning @$ans\n";
771 $session->disconnect();
778 sub _verify_password {
779 my($user_session, $password) = @_;
780 my $user_obj = $apputils->check_user_session($user_session);
782 #grab the user with password
783 $user_obj = $apputils->simple_scalar_request(
785 "open-ils.storage.direct.actor.user.retrieve",
788 if($user_obj->passwd eq $password) {
796 __PACKAGE__->register_method(
797 method => "update_password",
798 api_name => "open-ils.actor.user.password.update");
800 __PACKAGE__->register_method(
801 method => "update_password",
802 api_name => "open-ils.actor.user.username.update");
804 __PACKAGE__->register_method(
805 method => "update_password",
806 api_name => "open-ils.actor.user.email.update");
808 sub update_password {
809 my( $self, $client, $user_session, $new_value, $current_password ) = @_;
811 warn "Updating user with method " .$self->api_name . "\n";
812 my $user_obj = $apputils->check_user_session($user_session);
814 if($self->api_name =~ /password/) {
816 #make sure they know the current password
817 if(!_verify_password($user_session, md5_hex($current_password))) {
818 return OpenILS::EX->new("USER_WRONG_PASSWORD")->ex;
821 $user_obj->passwd($new_value);
823 elsif($self->api_name =~ /username/) {
824 $user_obj->usrname($new_value);
827 elsif($self->api_name =~ /email/) {
828 warn "Updating email to $new_value\n";
829 $user_obj->email($new_value);
832 my $session = $apputils->start_db_session();
833 $user_obj = _update_patron($session, $user_obj);
834 $apputils->commit_db_session($session);
836 if($user_obj) { return 1; }
841 __PACKAGE__->register_method(
842 method => "check_user_perms",
843 api_name => "open-ils.actor.user.perm.check",
845 Takes a user id, an org id, and an array of perm type strings. For each
846 perm type, if the user does *not* have the given permission it is added
847 to a list which is returned from the method. If all permissions
848 are allowed, an empty list is returned
852 sub check_user_perms {
853 my( $self, $client, $user_id, $org_id, $perm_types ) = @_;
856 for my $perm (@$perm_types) {
857 if($apputils->check_user_perms($user_id, $org_id, $perm)) {
858 push @not_allowed, $perm;
867 __PACKAGE__->register_method(
868 method => "user_fines_summary",
869 api_name => "open-ils.actor.user.fines.summary",
871 Returns a short summary of the users total open fines, excluding voided fines
872 Params are login_session, user_id
873 Returns a 'mus' object.
877 sub user_fines_summary {
878 my( $self, $client, $login_session, $user_id ) = @_;
880 my $user_obj = $apputils->check_user_session($login_session);
881 if($user_obj->id ne $user_id) {
882 if($apputils->check_user_perms($user_obj->id, $user_obj->home_ou, "VIEW_USER_FINES_SUMMARY")) {
883 return OpenILS::Perm->new("VIEW_USER_FINES_SUMMARY");
887 return $apputils->simple_scalar_request(
889 "open-ils.storage.direct.money.user_summary.search.usr",
897 __PACKAGE__->register_method(
898 method => "user_transactions",
899 api_name => "open-ils.actor.user.transactions",
900 notes => <<" NOTES");
901 Returns a list of open user transactions (mbts objects);
902 Params are login_session, user_id
903 Optional third parameter is the transactions type. defaults to all
906 __PACKAGE__->register_method(
907 method => "user_transactions",
908 api_name => "open-ils.actor.user.transactions.have_charge",
909 notes => <<" NOTES");
910 Returns a list of all open user transactions (mbts objects) that have an initial charge
911 Params are login_session, user_id
912 Optional third parameter is the transactions type. defaults to all
915 __PACKAGE__->register_method(
916 method => "user_transactions",
917 api_name => "open-ils.actor.user.transactions.have_balance",
918 notes => <<" NOTES");
919 Returns a list of all open user transactions (mbts objects) that have a balance
920 Params are login_session, user_id
921 Optional third parameter is the transactions type. defaults to all
924 __PACKAGE__->register_method(
925 method => "user_transactions",
926 api_name => "open-ils.actor.user.transactions.fleshed",
927 notes => <<" NOTES");
928 Returns an object/hash of transaction, circ, title where transaction = an open
929 user transactions (mbts objects), circ is the attached circluation, and title
930 is the title the circ points to
931 Params are login_session, user_id
932 Optional third parameter is the transactions type. defaults to all
935 __PACKAGE__->register_method(
936 method => "user_transactions",
937 api_name => "open-ils.actor.user.transactions.have_charge.fleshed",
938 notes => <<" NOTES");
939 Returns an object/hash of transaction, circ, title where transaction = an open
940 user transactions that has an initial charge (mbts objects), circ is the
941 attached circluation, and title is the title the circ points to
942 Params are login_session, user_id
943 Optional third parameter is the transactions type. defaults to all
946 __PACKAGE__->register_method(
947 method => "user_transactions",
948 api_name => "open-ils.actor.user.transactions.have_balance.fleshed",
949 notes => <<" NOTES");
950 Returns an object/hash of transaction, circ, title where transaction = an open
951 user transaction that has a balance (mbts objects), circ is the attached
952 circluation, and title is the title the circ points to
953 Params are login_session, user_id
954 Optional third parameter is the transaction type. defaults to all
959 sub user_transactions {
960 my( $self, $client, $login_session, $user_id, $type ) = @_;
962 my $user_obj = $apputils->check_user_session($login_session);
963 if($user_obj->id ne $user_id) {
964 if($apputils->check_user_perms($user_obj->id, $user_obj->home_ou, "VIEW_USER_TRANSACTIONS")) {
965 return OpenILS::Perm->new("VIEW_USER_TRANSACTIONS");
969 my $api = $self->api_name();
972 if(defined($type)) { @xact = (xact_type => $type);
973 } else { @xact = (); }
975 if($api =~ /have_charge/) {
977 $trans = $apputils->simple_scalar_request(
979 "open-ils.storage.direct.money.billable_transaction_summary.search_where.atomic",
980 { usr => $user_id, total_owed => { ">" => 0 }, @xact });
982 } elsif($api =~ /have_balance/) {
984 $trans = $apputils->simple_scalar_request(
986 "open-ils.storage.direct.money.billable_transaction_summary.search_where.atomic",
987 { usr => $user_id, balance_owed => { ">" => 0 }, @xact });
991 $trans = $apputils->simple_scalar_request(
993 "open-ils.storage.direct.money.billable_transaction_summary.search_where.atomic",
994 { usr => $user_id, @xact });
997 if($api !~ /fleshed/) { return $trans; }
1002 for my $t (@$trans) {
1006 my $circ = $apputils->simple_scalar_request(
1008 "open-ils.storage.direct.action.circulation.retrieve",
1011 my $title = $apputils->simple_scalar_request(
1013 "open-ils.storage.fleshed.biblio.record_entry.retrieve_by_copy",
1014 $circ->target_copy );
1016 my $u = OpenILS::Utils::ModsParser->new();
1017 $u->start_mods_batch($title->marc());
1018 my $mods = $u->finish_mods_batch();
1020 push @resp, {transaction => $t, circ => $circ, record => $mods };
1030 __PACKAGE__->register_method(
1031 method => "retrieve_groups",
1032 api_name => "open-ils.actor.groups.retrieve",
1033 notes => <<" NOTES");
1034 Returns a list of user groups
1036 sub retrieve_groups {
1037 my( $self, $client ) = @_;
1038 return $apputils->simple_scalar_request(
1040 "open-ils.storage.direct.permission.grp_tree.retrieve.all.atomic");
1094 some old methods that may be good to keep around for now
1097 my( $session, $card ) = @_;
1099 warn "Deleting card with barcode " . $card->barcode() . "\n";
1100 my $req = $session->request(
1101 "open-ils.storage.direct.actor.card.delete",
1103 my $status = $req->gather(1);
1104 if(!defined($status)) {
1105 throw OpenSRF::EX::ERROR
1106 ("Unknown error updating card");
1112 # deletes the patron and any attached addresses and cards
1113 __PACKAGE__->register_method(
1114 method => "delete_patron",
1115 api_name => "open-ils.actor.patron.delete",
1120 my( $self, $client, $patron ) = @_;
1121 my $session = $apputils->start_db_session();
1126 $patron->clear_mailing_address();
1127 $patron->clear_billing_address();
1128 $patron->ischanged(1);
1130 _update_patron($session, $patron);
1131 _delete_address($session,$_) for (@{$patron->addresses()});
1132 _delete_card($session,$_) for (@{$patron->cards()});
1133 _delete_patron($session,$patron);
1134 $apputils->commit_db_session($session);
1136 } catch Error with {
1138 $err = "-*- Failure deleting user: $e";
1139 $apputils->rollback_db_session($session);
1143 if($err) { throw OpenSRF::EX::ERROR ($err); }
1144 warn "Patron Delete complete\n";
1148 sub _delete_patron {
1149 my( $session, $patron ) = @_;
1151 warn "Deleting patron " . $patron->usrname() . "\n";
1153 my $req = $session->request(
1154 "open-ils.storage.direct.actor.user.delete",
1156 my $status = $req->gather(1);
1157 if(!defined($status)) {
1158 throw OpenSRF::EX::ERROR
1159 ("Unknown error updating patron");