adding copy_location related code ... module plus test script and related events
authorerickson <erickson@dcc99617-32d9-48b4-a31d-7c20da2025e4>
Fri, 3 Feb 2006 16:12:53 +0000 (16:12 +0000)
committererickson <erickson@dcc99617-32d9-48b4-a31d-7c20da2025e4>
Fri, 3 Feb 2006 16:12:53 +0000 (16:12 +0000)
git-svn-id: svn://svn.open-ils.org/ILS/trunk@2951 dcc99617-32d9-48b4-a31d-7c20da2025e4

Open-ILS/src/extras/ils_events.xml
Open-ILS/src/perlmods/OpenILS/Application/AppUtils.pm
Open-ILS/src/perlmods/OpenILS/Application/Circ.pm
Open-ILS/src/perlmods/OpenILS/Application/Circ/CopyLocations.pm [new file with mode: 0644]
Open-ILS/src/support-scripts/oils_header.pl
Open-ILS/src/support-scripts/test-scripts/copy_locations.pl [new file with mode: 0755]

index 19b9778..9f6285f 100644 (file)
                </desc>
        </event>
 
+       <event code='1202' textcode='ITEM_NOT_CATALOGED'>
+               <desc>
+                       The requested item is not cataloged in the database
+               </desc>
+       </event>
+
+
 
 
        <event code='1500' textcode='CIRCULATION_NOT_FOUND'>
                <desc> The max fines object does not exist </desc>
        </event>
 
+       <event code='1515' textcode='COPY_LOCATION_NOT_FOUND'>
+               <desc> The copy location object does not exist </desc>
+       </event>
+
 
 
        <event code='1700' textcode='NON_CAT_TYPE_EXISTS'>
                <desc> The non-cataloged type object already exists </desc>
        </event>
 
+       <event code='1701' textcode='COPY_LOCATION_EXISTS'>
+               <desc> The copy location object already exists </desc>
+       </event>
+
 
        <event code='2000' textcode='BAD_PARAMS'>
                <desc>
index be1b72e..b37075e 100644 (file)
@@ -578,6 +578,15 @@ sub fetch_copy_statuses {
                'open-ils.storage.direct.config.copy_status.retrieve.all.atomic' );
 }
 
+sub fetch_copy_location {
+       my( $self, $id ) = @_;
+       my $evt;
+       my $cl = $self->storagereq(
+               'open-ils.storage.direct.asset.copy_location.retrieve', $id );
+       $evt = OpenILS::Event->new('COPY_LOCATION_NOT_FOUND') unless $cl;
+       return ($cl, $evt);
+}
+
 sub fetch_copy_locations {
        my $self = shift; 
        return $self->simplereq(
@@ -585,6 +594,16 @@ sub fetch_copy_locations {
                'open-ils.storage.direct.asset.copy_location.retrieve.all.atomic');
 }
 
+sub fetch_copy_location_by_name {
+       my( $self, $name, $org ) = @_;
+       my $evt;
+       my $cl = $self->storagereq(
+               'open-ils.storage.direct.asset.copy_location.search_where',
+                       { name => $name, owning_lib => $org } );
+       $evt = OpenILS::Event->new('COPY_LOCATION_NOT_FOUND') unless $cl;
+       return ($cl, $evt);
+}
+
 sub fetch_callnumber {
        my( $self, $id ) = @_;
        my $evt = undef;
@@ -707,6 +726,12 @@ sub fetch_max_fine_by_name {
        return ($obj, $evt);
 }
 
+sub storagereq {
+       my( $self, $method, @params ) = @_;
+       return $self->simplereq(
+               'open-ils.storage', $method, @params );
+}
+
 
 
 1;
index afa19c8..5d535f7 100644 (file)
@@ -9,6 +9,7 @@ use OpenILS::Application::Circ::StatCat;
 use OpenILS::Application::Circ::Holds;
 use OpenILS::Application::Circ::Money;
 use OpenILS::Application::Circ::NonCat;
+use OpenILS::Application::Circ::CopyLocations;
 
 use OpenILS::Application::AppUtils;
 my $apputils = "OpenILS::Application::AppUtils";
diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Circ/CopyLocations.pm b/Open-ILS/src/perlmods/OpenILS/Application/Circ/CopyLocations.pm
new file mode 100644 (file)
index 0000000..7d10219
--- /dev/null
@@ -0,0 +1,134 @@
+package OpenILS::Application::Circ::CopyLocations;
+use base 'OpenSRF::Application';
+use strict; use warnings;
+use Data::Dumper;
+$Data::Dumper::Indent = 0;
+use OpenSRF::EX qw(:try);
+use OpenSRF::Utils::Logger qw(:logger);
+use OpenILS::Application::AppUtils;
+use OpenILS::Utils::Fieldmapper;
+my $U = "OpenILS::Application::AppUtils";
+
+
+__PACKAGE__->register_method(
+       api_name                => "open-ils.circ.copy_location.retrieve.all",
+       method          => 'cl_retrieve_all',
+       argc                    =>      1,
+       signature       => q/
+               Retrieves the ranged set of copy locations for the requested org.
+               If no org is provided, the home org of the requestor is used.
+               @param authtoken The login session key
+               @param orgId The org location id
+               @return An array of copy location objects
+               /);
+
+sub cl_retrieve_all {
+       my( $self, $client, $authtoken, $orgId ) = @_;
+       my( $requestor, $evt ) = $U->checkses($authtoken);
+       return $evt if $evt;
+       $orgId = defined($orgId) ? $orgId : $requestor->home_ou;
+       $logger->debug("Fetching ranged copy location set for org $orgId");
+       return $U->storagereq(
+               'open-ils.storage.ranged.asset.copy_location.retrieve.atomic', $orgId);
+}
+
+__PACKAGE__->register_method(
+       api_name                => 'open-ils.circ.copy_location.create',
+       method          => 'cl_create',
+       argc                    => 2,
+       signature       => q/
+               Creates a new copy location.  Requestor must have the CREATE_COPY_LOCATION
+               permission at the location specified on the new location object
+               @param authtoken The login session key
+               @param copyLoc The new copy location object
+               @return The if of the new location object on success, event on error
+       /);
+
+sub cl_create {
+       my( $self, $client, $authtoken, $copyLoc ) = @_;
+       my( $requestor, $evt ) = $U->checkses($authtoken);
+       return $evt if $evt;
+       $evt = $U->check_perms($requestor->id, 
+               $copyLoc->owning_lib, 'CREATE_COPY_LOCATION');
+       return $evt if $evt;
+
+       my $cl;
+       ($cl, $evt) = $U->fetch_copy_location_by_name($copyLoc->name, $copyLoc->owning_lib);
+       return OpenILS::Event->new('COPY_LOCATION_EXISTS') if $cl;
+
+       my $id = $U->storagereq(
+               'open-ils.storage.direct.asset.copy_location.create', $copyLoc );
+
+       return $U->DB_UPDATE_FAILED($copyLoc) unless $id;
+       return $id;
+}
+
+__PACKAGE__->register_method (
+       api_name                => 'open-ils.circ.copy_location.delete',
+       method          => 'cl_delete',
+       argc                    => 2,
+       signature       => q/
+               Deletes a copy location. Requestor must have the 
+               DELETE_COPY_LOCATION permission.
+               @param authtoken The login session key
+               @param id The copy location object id
+               @return 1 on success, event on error
+       /);
+
+sub cl_delete {
+       my( $self, $client, $authtoken, $id ) = @_;
+       my( $requestor, $evt ) = $U->checkses($authtoken);
+       return $evt if $evt;
+
+       my $cl;
+       ($cl, $evt) = $U->fetch_copy_location($id);
+       return $evt if $evt;
+
+       $evt = $U->check_perms($requestor->id, 
+               $cl->owning_lib, 'DELETE_COPY_LOCATION');
+       return $evt if $evt;
+
+       my $resp = $U->storagereq(
+               'open-ils.storage.direct.asset.copy_location.delete', $id );
+       
+       return $U->DB_UPDATE_FAILED unless $resp;
+       return 1;
+}
+
+__PACKAGE__->register_method (
+       api_name                => 'open-ils.circ.copy_location.update',
+       method          => 'cl_update',
+       argc                    => 2,
+       signature       => q/
+               Updates a copy location object.  Requestor must have 
+               the UPDATE_COPY_LOCATION permission
+               @param authtoken The login session key
+               @param copyLoc  The copy location object
+               @return 1 on success, event on error
+       /);
+
+sub cl_update {
+       my( $self, $client, $authtoken, $copyLoc ) = @_;
+
+       my( $requestor, $evt ) = $U->checkses($authtoken);
+       return $evt if $evt;
+
+       my $cl; 
+       ($cl, $evt) = $U->fetch_copy_location($copyLoc->id);
+       return $evt if $evt;
+
+       $evt = $U->check_perms($requestor->id, 
+               $cl->owning_lib, 'UPDATE_COPY_LOCATION');
+       return $evt if $evt;
+
+       $copyLoc->owning_lib($cl->owning_lib); #disallow changing of the lib
+
+       my $resp = $U->storagereq(
+               'open-ils.storage.direct.asset.copy_location.update', $copyLoc );
+       
+       return 1; # if there was no exception thrown, then the update was a success
+}
+
+
+
+666;
index 1239512..ea27f25 100755 (executable)
@@ -128,7 +128,9 @@ sub oils_event_die {
 # Login to the auth server and set the global $authtoken var
 #----------------------------------------------------------------
 sub oils_login {
-       my( $username, $password ) = @_;
+       my( $username, $password, $type ) = @_;
+
+       $type |= "staff";
 
        my $seed = $apputils->simplereq( $AUTH, 
                'open-ils.auth.authenticate.init', $username );
@@ -136,7 +138,7 @@ sub oils_login {
 
        my $response = $apputils->simplereq( $AUTH, 
                'open-ils.auth.authenticate.complete', $username, 
-               md5_hex($seed . md5_hex($password)), "staff");
+               md5_hex($seed . md5_hex($password)), $type);
        err("No auth response returned on login") unless $response;
 
        oils_event_die($response);
diff --git a/Open-ILS/src/support-scripts/test-scripts/copy_locations.pl b/Open-ILS/src/support-scripts/test-scripts/copy_locations.pl
new file mode 100755 (executable)
index 0000000..4464774
--- /dev/null
@@ -0,0 +1,79 @@
+#!/usr/bin/perl
+
+#----------------------------------------------------------------
+# Code for testing the container API
+#----------------------------------------------------------------
+
+require '../oils_header.pl';
+use vars qw/ $apputils $memcache $user $authtoken $authtime /;
+use strict; use warnings;
+
+#----------------------------------------------------------------
+err("\nusage: $0 <config> <oils_login_username> ".
+       " <oils_login_password> <name> <org>\n".
+       "Where <name> is the copy location name and <org> is the \n".
+       "org that houses the new location object\n") unless $ARGV[4];
+#----------------------------------------------------------------
+
+my $config             = shift; 
+my $username   = shift;
+my $password   = shift;
+my $name                       = shift;
+my $org                        = shift;
+
+sub go {
+       osrf_connect($config);
+       oils_login($username, $password);
+       my $cl =create_cl($name, $org);
+       update_cl($cl);
+#      print_cl($org);
+       delete_cl($cl);
+}
+
+go();
+
+#----------------------------------------------------------------
+
+sub create_cl {
+       my( $name, $org ) = @_;
+
+       my $cl = Fieldmapper::asset::copy_location->new;
+       $cl->owning_lib($org);
+       $cl->name($name);
+       $cl->circulate(0);
+       $cl->opac_visible(0);
+       $cl->holdable(0);
+
+       my $resp = simplereq(
+               CIRC(), 'open-ils.circ.copy_location.create', $authtoken, $cl );
+
+       oils_event_die($resp);
+       printl("Copy location $name successfully created");
+       $cl->id($resp);
+       return $cl;
+}
+
+sub print_cl {
+       my( $org ) = @_;
+       debug( simplereq(
+               CIRC(), 'open-ils.circ.copy_location.retrieve.all', $authtoken, $org ) );
+}
+
+sub update_cl {
+       my $cl = shift;
+       $cl->name( 'test_' . $cl->name );
+       my $resp = simplereq(
+               CIRC(), 'open-ils.circ.copy_location.update', $authtoken, $cl );
+       oils_event_die($resp);
+       printl("Successfully set copy location name to ".$cl->name);
+}
+
+sub delete_cl {
+       my $cl = shift;
+       my $resp = simplereq(
+               CIRC(), 'open-ils.circ.copy_location.delete', $authtoken, $cl->id );
+       oils_event_die($resp);
+       printl("Copy location successfully deleted");
+}
+
+