From dff652523ea26af35ecb527c1547a44da616f64c Mon Sep 17 00:00:00 2001 From: erickson Date: Thu, 5 Jan 2006 23:41:08 +0000 Subject: [PATCH] some small cleaning added some utility methods spidermonkey can now take arbitrary perl objects and push them into and retrieve them from the JS runtime. this only works if support JS libs are provided to the constructor git-svn-id: svn://svn.open-ils.org/ILS/trunk@2635 dcc99617-32d9-48b4-a31d-7c20da2025e4 --- .../perlmods/OpenILS/Application/AppUtils.pm | 25 ++++++++++++ .../src/perlmods/OpenILS/Application/Circ.pm | 4 ++ .../OpenILS/Application/Circ/Money.pm | 6 ++- .../OpenILS/Application/Circ/Rules.pm | 1 - .../perlmods/OpenILS/Utils/ScriptRunner.pm | 7 +++- .../perlmods/OpenILS/Utils/SpiderMonkey.pm | 40 +++++++++++++++++-- 6 files changed, 76 insertions(+), 7 deletions(-) diff --git a/Open-ILS/src/perlmods/OpenILS/Application/AppUtils.pm b/Open-ILS/src/perlmods/OpenILS/Application/AppUtils.pm index 9c34f00ec7..d38f9a4510 100644 --- a/Open-ILS/src/perlmods/OpenILS/Application/AppUtils.pm +++ b/Open-ILS/src/perlmods/OpenILS/Application/AppUtils.pm @@ -547,5 +547,30 @@ sub fetch_container_item { } +sub fetch_patron_standings { + my $self = shift; + $logger->debug("Fetching patron standings"); + return $self->simplereq( + 'open-ils.storage', + 'open-ils.storage.direct.config.standing.retrieve.all.atomic'); +} + + +sub fetch_permission_group_tree { + my $self = shift; + $logger->debug("Fetching patron profiles"); + return $self->simplereq( + 'open-ils.storage', + "open-ils.storage.direct.permission.grp_tree.retrieve.all.atomic"); +} + + +sub fetch_patron_summary { + my( $self, $userid ) = @_; + $logger->debug("Fetching patron summary for $userid"); + return $self->simplereq( + 'open-ils.storage', + "open-ils.storage.action.circulation.patron_summary", $userid ); +} 1; diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Circ.pm b/Open-ILS/src/perlmods/OpenILS/Application/Circ.pm index ec27ede410..08a9fe8a82 100644 --- a/Open-ILS/src/perlmods/OpenILS/Application/Circ.pm +++ b/Open-ILS/src/perlmods/OpenILS/Application/Circ.pm @@ -2,6 +2,7 @@ package OpenILS::Application::Circ; use base qw/OpenSRF::Application/; use strict; use warnings; +use OpenILS::Application::Circ::Circulate; use OpenILS::Application::Circ::Rules; use OpenILS::Application::Circ::Survey; use OpenILS::Application::Circ::StatCat; @@ -25,6 +26,7 @@ use OpenSRF::Utils::Logger qw(:logger); sub initialize { my $self = shift; OpenILS::Application::Circ::Rules->initialize(); + OpenILS::Application::Circ::Circulate->initialize(); } @@ -51,6 +53,7 @@ sub checkouts_by_user { my $circs = $apputils->simplereq( 'open-ils.storage', "open-ils.storage.direct.action.open_circulation.search.atomic", +# { usr => $target->id, xact_finish => undef } ); { usr => $target->id } ); my @results; @@ -97,6 +100,7 @@ sub checkouts_by_user_slim { return $apputils->simplereq( 'open-ils.storage', "open-ils.storage.direct.action.open_circulation.search.atomic", +# { usr => $target->id, xact_finish => undef } ); { usr => $target->id } ); } diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Circ/Money.pm b/Open-ILS/src/perlmods/OpenILS/Application/Circ/Money.pm index c00adb8b59..1deaec2177 100644 --- a/Open-ILS/src/perlmods/OpenILS/Application/Circ/Money.pm +++ b/Open-ILS/src/perlmods/OpenILS/Application/Circ/Money.pm @@ -133,13 +133,17 @@ sub make_payments { sub _update_patron_credit { my( $session, $userid, $credit ) = @_; - return if $credit < 0; + return if $credit <= 0; my $patron = $session->request( 'open-ils.storage.direct.actor.user.retrieve', $userid )->gather(1); + $logger->activity( "Adding to patron [$userid] credit: $credit" ); + $patron->credit_forward_balance( $patron->credit_forward_balance + $credit); + + $logger->debug("Total patron credit is now " . $patron->credit_forward_balance ); my $res = $session->request( 'open-ils.storage.direct.actor.user.update', $patron )->gather(1); diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Circ/Rules.pm b/Open-ILS/src/perlmods/OpenILS/Application/Circ/Rules.pm index 6f97d38d39..ab86c73c96 100644 --- a/Open-ILS/src/perlmods/OpenILS/Application/Circ/Rules.pm +++ b/Open-ILS/src/perlmods/OpenILS/Application/Circ/Rules.pm @@ -121,7 +121,6 @@ sub _grab_patron_profiles { my $session = shift; if(!$patron_profiles) { my $profile_req = $session->request( - #"open-ils.storage.direct.actor.profile.retrieve.all.atomic"); "open-ils.storage.direct.permission.grp_tree.retrieve.all.atomic"); $patron_profiles = $profile_req->gather(1); $patron_profiles = diff --git a/Open-ILS/src/perlmods/OpenILS/Utils/ScriptRunner.pm b/Open-ILS/src/perlmods/OpenILS/Utils/ScriptRunner.pm index c3d4e2e9f9..596c798ab1 100644 --- a/Open-ILS/src/perlmods/OpenILS/Utils/ScriptRunner.pm +++ b/Open-ILS/src/perlmods/OpenILS/Utils/ScriptRunner.pm @@ -10,8 +10,7 @@ sub new { $class = ref($class) || $class; my $type = $params{type} || 'js'; - my $file = $params{file}; - my $thingy = OpenILS::Utils::SpiderMonkey->new( $file ) if( $type =~ /js/i ); + my $thingy = OpenILS::Utils::SpiderMonkey->new( %params ) if( $type =~ /js/i ); if($thingy) { $thingy->init; @@ -25,6 +24,10 @@ sub new { sub init {$logger->error("METHOD NOT DEFINED"); } sub context {$logger->error("METHOD NOT DEFINED"); } +# generic insertion method +sub insert {$logger->error("METHOD NOT DEFINED"); } +# generic retrieval method +sub retrieve {$logger->error("METHOD NOT DEFINED"); } sub insert_fm { $logger->error("METHOD NOT DEFINED"); } sub insert_hash { $logger->error("METHOD NOT DEFINED"); } # loads an external script diff --git a/Open-ILS/src/perlmods/OpenILS/Utils/SpiderMonkey.pm b/Open-ILS/src/perlmods/OpenILS/Utils/SpiderMonkey.pm index 2e16aac37b..7839b1e13e 100644 --- a/Open-ILS/src/perlmods/OpenILS/Utils/SpiderMonkey.pm +++ b/Open-ILS/src/perlmods/OpenILS/Utils/SpiderMonkey.pm @@ -4,11 +4,12 @@ use OpenSRF::Utils::Logger qw(:logger); use OpenILS::Utils::ScriptRunner; use base 'OpenILS::Utils::ScriptRunner'; use JavaScript::SpiderMonkey; +use JSON; sub new { - my ( $class, $file ) = @_; + my ( $class, %params ) = @_; $class = ref($class) || $class; - my $self = { file => $file }; + my $self = { file => $params{file}, libs => $params{libs} }; return bless( $self, $class ); } @@ -28,8 +29,10 @@ sub init { $js->function_set("log_info", sub { $logger->info(@_); return 1;} ); $js->function_set("log_debug", sub { $logger->debug(@_); return 1;} ); $js->function_set("log_internal", sub { $logger->internal(@_); return 1;} ); + $js->function_set("debug", sub { $logger->debug(@_); return 1;} ); + $js->function_set("alert", sub { $logger->warn(@_); return 1;} ); $self->context($js); - return $self; + $self->load_lib($_) for @{$self->{libs}}; } @@ -68,6 +71,37 @@ sub _js_prop_name { return $name; } +sub insert { + my( $self, $key, $val ) = @_; + my $str = JSON->perl2JSON($val); + warn "Inserting string: $str\n"; + my $js = $self->context; + $js->object_by_path($key); + if( ! $js->eval("$key = JSON2js('$str')")) { + $logger->error("Error inserting value with key $key: $@"); + return 0; + } + return 1; +} + +sub retrieve { + my( $self, $key ) = @_; + my $val; + my $js = $self->context; + + $js->object_by_path("obj"); + $js->property_by_path("obj.out"); + + if( ! $js->eval("obj.out = js2JSON($key);")) { + $logger->error("Error retrieving value with $key: $@"); + return undef; + } + my $str = $js->property_get("obj.out"); + warn "Retrieving [$key] string: $str\n"; + return JSON->JSON2perl($str); +} + + sub insert_fm { my( $self, $key, $fm ) = @_; -- 2.43.2