From b90dcfe0333351eac86aa19c735cbd899fae040b Mon Sep 17 00:00:00 2001 From: erickson Date: Fri, 16 Dec 2005 23:02:36 +0000 Subject: [PATCH] oils_header is just a generic perl header script to load the usual modules. It also provides a number of utility methods (login, etc.) container.pl is just some container testing code git-svn-id: svn://svn.open-ils.org/ILS/trunk@2428 dcc99617-32d9-48b4-a31d-7c20da2025e4 --- Open-ILS/src/support-scripts/oils_header.pl | 155 ++++++++++++++++++ .../support-scripts/test-scripts/container.pl | 62 +++++++ 2 files changed, 217 insertions(+) create mode 100755 Open-ILS/src/support-scripts/oils_header.pl create mode 100755 Open-ILS/src/support-scripts/test-scripts/container.pl diff --git a/Open-ILS/src/support-scripts/oils_header.pl b/Open-ILS/src/support-scripts/oils_header.pl new file mode 100755 index 0000000000..0d81c47381 --- /dev/null +++ b/Open-ILS/src/support-scripts/oils_header.pl @@ -0,0 +1,155 @@ +#!/usr/bin/perl + +#---------------------------------------------------------------- +# Generic header for tesing OpenSRF methods +#---------------------------------------------------------------- + +use strict; +use warnings; +use Data::Dumper; +use OpenSRF::System; +use OpenSRF::AppSession; +use OpenSRF::EX qw(:try); +use Time::HiRes qw/time/; +use Digest::MD5 qw(md5_hex); +use OpenILS::Utils::Fieldmapper; +use OpenILS::Application::AppUtils; +use OpenSRF::Utils::Logger qw/:logger/; + + +# Some useful objects +our $apputils = "OpenILS::Application::AppUtils"; +our $memcache; +our $user; +our $authtoken; +our $authtime; + +# Some constants for our services +our $AUTH = 'open-ils.auth'; +our $STORAGE = 'open-ils.storage'; +our $SEARCH = 'open-ils.search'; +our $CIRC = 'open-ils.circ'; +our $CAT = 'open-ils.cat'; +our $MATH = 'opensrf.math'; +our $SETTINGS = 'opensrf.settings'; +our $ACTOR = 'open-ils.actor'; + + +#---------------------------------------------------------------- +# Exit a script +#---------------------------------------------------------------- +sub err { + my ($pkg, $file, $line, $sub) = _caller(); + die "Script halted with error ". + "($pkg : $file : $line : $sub):\n" . shift() . "\n"; +} + +#---------------------------------------------------------------- +# Print with newline +#---------------------------------------------------------------- +sub printl { print "@_\n"; } + +#---------------------------------------------------------------- +# Print with Data::Dumper +#---------------------------------------------------------------- +sub debug { printl(Dumper(@_)); } + + +#---------------------------------------------------------------- +# This is not the function you're looking for +#---------------------------------------------------------------- +sub _caller { + my ($pkg, $file, $line, $sub) = caller(2); + if(!$line) { + ($pkg, $file, $line) = caller(1); + $sub = ""; + } + return ($pkg, $file, $line, $sub); +} + + +#---------------------------------------------------------------- +# Connect to the servers +#---------------------------------------------------------------- +sub osrf_connect { + my $config = shift; + err("Bootstrap config required") unless $config; + OpenSRF::System->bootstrap_client( config_file => $config ); +} + +#---------------------------------------------------------------- +# Get a handle for the memcache object +#---------------------------------------------------------------- +sub osrf_cache { + eval 'use OpenSRF::Utils::Cache;'; + $memcache = OpenSRF::Utils::Cache->new('global') unless $memcache; + return $memcache; +} + +#---------------------------------------------------------------- +# Is the given object an OILS event? +#---------------------------------------------------------------- +sub oils_is_event { + my $e = shift; + if( $e and ref($e) eq 'HASH' ) { + return 1 if defined($e->{ilsevent}); + } + return 0; +} + +#---------------------------------------------------------------- +# If the given object is an event, this prints the event info +# and exits the script +#---------------------------------------------------------------- +sub oils_event_die { + my $evt = shift; + my ($pkg, $file, $line, $sub) = _caller(); + if(oils_is_event($evt)) { + if($evt->{ilsevent}) { + printl("\nReceived Event($pkg : $file : $line : $sub): \n" . Dumper($evt)); + exit 1; + } + } +} + + +#---------------------------------------------------------------- +# Login to the auth server and set the global $authtoken var +#---------------------------------------------------------------- +sub oils_login { + my( $username, $password ) = @_; + + my $seed = $apputils->simplereq( $AUTH, + 'open-ils.auth.authenticate.init', $username ); + err("No auth seed") unless $seed; + + my $response = $apputils->simplereq( $AUTH, + 'open-ils.auth.authenticate.complete', $username, + md5_hex($seed . md5_hex($password))); + err("No auth response returned on login") unless $response; + + oils_event_die($response); + + $authtime = $response->{payload}->{authtime}; + $authtoken = $response->{payload}->{authtoken}; + return $authtoken; +} + +#---------------------------------------------------------------- +# Fetches the user object and sets the global $user var +#---------------------------------------------------------------- +sub oils_fetch_session { + my $ses = shift; + my $resp = $apputils->simplereq( $AUTH, + 'open-ils.auth.session.retrieve', $ses, 'staff' ); + oils_event_die($resp); + return $user = $resp; +} + +#---------------------------------------------------------------- +# var $response = simplereq( $service, $method, @params ); +#---------------------------------------------------------------- +sub simplereq { return $apputils->simplereq(@_); } + + +1; diff --git a/Open-ILS/src/support-scripts/test-scripts/container.pl b/Open-ILS/src/support-scripts/test-scripts/container.pl new file mode 100755 index 0000000000..936184c1fb --- /dev/null +++ b/Open-ILS/src/support-scripts/test-scripts/container.pl @@ -0,0 +1,62 @@ +#!/usr/bin/perl + +#---------------------------------------------------------------- +# Code for testing the container API +#---------------------------------------------------------------- + +require '../oils_header.pl'; + +my $config = shift; +my $username = shift || 'admin'; +my $password = shift || 'open-ils'; + +osrf_connect($config); +oils_login($username, $password); +oils_fetch_session($authtoken); + +my %types; +my $meth = 'open-ils.storage.direct.container'; +$types{'biblio'} = "biblio_record_entry_bucket"; +$types{'callnumber'} = "call_number_bucket"; +$types{'copy'} = "copy_bucket"; +$types{'user'} = "user_bucket"; + +my %containers; + +containers_create(); +containers_delete(); + + +sub containers_create { + + for my $type ( keys %types ) { + my $bucket = "Fieldmapper::container::" . $types{$type}; + $bucket = $bucket->new; + $bucket->owner($user->id); + $bucket->name("TestBucket"); + $bucket->btype("TestType"); + + my $resp = simplereq($ACTOR, + 'open-ils.actor.container.bucket.create', + $authtoken, $type, $bucket ); + + oils_event_die($resp); + printl("Created new $type bucket with id $resp"); + $containers{$type} = $resp; + } +} + +sub containers_delete { + for my $type (keys %containers) { + my $id = $containers{$type}; + + my $resp = simplereq( $ACTOR, + 'open-ils.actor.container.bucket.delete', + $authtoken, $type, $id ); + + oils_event_die($resp); + printl("Deleted bucket $id"); + } +} + + -- 2.43.2