From 60e7293020494af50cd652391416ed4ac82aa665 Mon Sep 17 00:00:00 2001 From: erickson Date: Fri, 30 Jun 2006 16:34:10 +0000 Subject: [PATCH] added money activity method git-svn-id: svn://svn.open-ils.org/ILS/trunk@4863 dcc99617-32d9-48b4-a31d-7c20da2025e4 --- .../perlmods/OpenILS/Application/Collections.pm | 179 ++++++++++++++++++++- .../support-scripts/test-scripts/collections.pl | 34 ++-- 2 files changed, 202 insertions(+), 11 deletions(-) diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Collections.pm b/Open-ILS/src/perlmods/OpenILS/Application/Collections.pm index 0aa9db48e5..96bf5a537b 100644 --- a/Open-ILS/src/perlmods/OpenILS/Application/Collections.pm +++ b/Open-ILS/src/perlmods/OpenILS/Application/Collections.pm @@ -38,11 +38,37 @@ sub users_of_interest { my $org = $e->search_actor_org_unit({shortname => $location}) or return $e->event; $org = $org->[0]; - return $e->event unless $e->allowed('VIEW_USER', $org->id); - return $U->storagereq( + # they need global perms to view users so no org is provided + return $e->event unless $e->allowed('VIEW_USER'); + + my $data = $U->storagereq( 'open-ils.storage.money.collections.users_of_interest.atomic', $age, $fine_level, $location); + + return [] unless $data and @$data; + + for (@$data) { + my $u = $e->retrieve_actor_user( + [ + $_->{usr}, + { + flesh => 1, + flesh_fields => {au => ["groups","profile"]}, + select => {au => ["profile","id","dob"]} + } + ] + ); + + $_->{usr} = { + id => $u->id, + dob => $u->dob, + profile => $u->profile->name, + groups => [ map { $_->name } @{$u->groups} ], + }; + } + + return $data; } @@ -155,4 +181,153 @@ sub remove_from_collections { return OpenILS::Event->new('SUCCESS'); } + +__PACKAGE__->register_method( + method => 'transaction_details', + api_name => 'open-ils.collections.user_transaction_details.retrieve', + signature => q/ + / +); + +sub transaction_details { + my( $self, $conn, $auth, $start_date, $end_date, $location, $user_list ) = @_; + + return OpenILS::Event->new('BAD_PARAMS') + unless ($auth and $start_date and $end_date and $location and $user_list); + + my $e = new_editor(authtoken => $auth); + return $e->event unless $e->checkauth; + + # they need global perms to view users so no org is provided + return $e->event unless $e->allowed('VIEW_USER'); + + my $org = $e->search_actor_org_unit({shortname => $location}) + or return $e->event; $org = $org->[0]; + + my @data; + for my $uid (@$user_list) { + my $blob = {}; + + $blob->{usr} = $e->retrieve_actor_user( + [ + $uid, + { + "flesh" => 1, + "flesh_fields" => { + "au" => [ + "cards", + "card", + "standing_penalties", + "addresses", + "billing_address", + "mailing_address", + "stat_cat_entries" + ] + } + } + ] + ); + + $blob->{transactions} = { + circulations => + fetch_circ_xacts($e, $uid, $org->id, $start_date, $end_date), + grocery => + fetch_grocery_xacts($e, $uid, $org->id, $start_date, $end_date) + }; + + push( @data, $blob ); + } + + return \@data; +} + + +# -------------------------------------------------------------- +# Collect all open circs for the user +# For each circ, see if any billing were created or payments +# were made during the given time period +# -------------------------------------------------------------- +sub fetch_circ_xacts { + my $e = shift; + my $uid = shift; + my $orgid = shift; + my $start_date = shift; + my $end_date = shift; + + my @data; + + # first get all open circs for this user + my $circs = $e->search_action_circulation( + { + usr => $uid, + circ_lib => $orgid, + xact_finish => undef, + }, + {idlist => 1} + ); + + for my $cid (@$circs) { + + # see if any billings were created in the given time range + my $bills = $e->search_money_billing ( + { + xact => $cid, + billing_ts => { ">=" => $start_date }, + billing_ts => { "<=" => $end_date }, + }, + {idlist =>1} + ); + + my $payments = []; + + if( !@$bills ) { + + # see if any payments were created in the given range + $payments = $e->search_money_payment ( + { + xact => $cid, + payment_ts => { ">=" => $start_date }, + payment_ts => { "<=" => $end_date }, + }, + {idlist =>1} + ); + } + + + if( @$bills or @$payments ) { + + # if any payments or bills were created in the given range, + # flesh the circ and add it to the set + push( @data, + $e->retrieve_action_circulation( + [ + $cid, + { + flesh => 1, + flesh_fields => { + circ => [ "billings", "payments", "circ_lib" ] + } + } + ] + ) + ); + } + } + + return \@data; +} + + +sub fetch_grocery_xacts { + my $e = shift; + my $uid = shift; + my $orgid = shift; + my $start_date = shift; + my $end_date = shift; + + return []; +} + + + 1; diff --git a/Open-ILS/src/support-scripts/test-scripts/collections.pl b/Open-ILS/src/support-scripts/test-scripts/collections.pl index 2bce18fbb0..5091f019f0 100644 --- a/Open-ILS/src/support-scripts/test-scripts/collections.pl +++ b/Open-ILS/src/support-scripts/test-scripts/collections.pl @@ -6,6 +6,8 @@ use RPC::XML qw/smart_encode/; use RPC::XML::Client; use Data::Dumper; # for debugging +die "usage: $0 \n" unless $ARGV[1]; + my $host = 'http://10.4.0.122/xml-rpc/'; my $fine_age = '1 day'; @@ -17,34 +19,44 @@ my $password = shift; my $authkey = login( $username, $password ); -die "login failed\n" unless $authkey; my $resp = request( 'open-ils.collections', 'open-ils.collections.users_of_interest.retrieve', $authkey, $fine_age, $fine_limit, $location ); -my $data = $resp->value; +my $user_data = $resp->value; -for my $d (@$data) { - print "last billing = " . $d->{last_pertinent_billing} . "\n"; - print "location id = " . $d->{location} . "\n"; +for my $d (@$user_data) { + print "last billing = " . $d->{last_pertinent_billing} . "\n"; + print "location id = " . $d->{location} . "\n"; print "threshold_amount = " . $d->{threshold_amount} . "\n"; - print "user barcode = " . $d->{usr} . "\n"; + print "user id = " . $d->{usr}->{id} . "\n"; + print "user dob = " . $d->{usr}->{dob} . "\n"; + print "user profile = " . $d->{usr}->{profile} . "\n"; + print "additional groups = ". join(', ', @{$d->{usr}->{groups}}) . "\n"; print '-'x60 . "\n"; } -# -------------------------------------------------------------------- +#request open-ils.collections open-ils.collections.user_transaction_details.retrieve "0d8681807cfa142310fec267c729641a", "2006-01-01", "WGRL-VR", [ 1000500 ] + +#print Dumper $user_data; + + + +# -------------------------------------------------------------------- # -------------------------------------------------------------------- # This sends an XML-RPC request and returns the RPC::XML::response -# object. $obj->value gives the Perl, $obj->as_string gives the XML +# object. +# $resp->value gives the Perl, +# $resp->as_string gives the XML # -------------------------------------------------------------------- sub request { my( $service, $method, @args ) = @_; @@ -81,7 +93,11 @@ sub login { die "No login response returned\n" unless $response; - return $response->{payload}->{authtoken}; + my $key = $response->{payload}->{authtoken}; + + die "Login failed\n" unless $key; + + return $key; } -- 2.11.0