[open-ils-commits] r16599 - in trunk/Open-ILS/src/perlmods/OpenILS: . SIP SIP/Transaction (erickson)

svn at svn.open-ils.org svn at svn.open-ils.org
Fri Jun 4 16:53:30 EDT 2010


Author: erickson
Date: 2010-06-04 16:53:25 -0400 (Fri, 04 Jun 2010)
New Revision: 16599

Modified:
   trunk/Open-ILS/src/perlmods/OpenILS/SIP.pm
   trunk/Open-ILS/src/perlmods/OpenILS/SIP/Item.pm
   trunk/Open-ILS/src/perlmods/OpenILS/SIP/Patron.pm
   trunk/Open-ILS/src/perlmods/OpenILS/SIP/Transaction/Checkin.pm
Log:
Checkin overhual for extensions, including item, patron and checkin underpinnings.

Extensions fields added to AUTOLOADable content.

Also fix checkin logic to check for NO_CHANGE and SUCCESS at necessary moments.

Update new code to match berick's #16544.

Add AUTOLOAD to Item and provide a slot to store the raw EG hold object.
Store the hold data down on the item (not the Checkin transaction level).

Allow SIP Patron lookup by usr ID (not barcode).
This is important because we need supplemental data when we find holds info at checkin.
The change is backwards compatible (w/ just 1 arg  it will still be treated as a barcode).

Propagate $inst_id down into checkout core, needed for hold routing logic.

Remove old accessor methods, also make some of the settings checks more flexible w/ regex.

Modified: trunk/Open-ILS/src/perlmods/OpenILS/SIP/Item.pm
===================================================================
--- trunk/Open-ILS/src/perlmods/OpenILS/SIP/Item.pm	2010-06-04 20:53:24 UTC (rev 16598)
+++ trunk/Open-ILS/src/perlmods/OpenILS/SIP/Item.pm	2010-06-04 20:53:25 UTC (rev 16599)
@@ -2,6 +2,7 @@
 use strict; use warnings;
 
 use Sys::Syslog qw(syslog);
+use Carp;
 
 use OpenILS::SIP;
 use OpenILS::SIP::Transaction;
@@ -16,6 +17,61 @@
 
 my %item_db;
 
+# 0 means read-only
+# 1 means read/write    Actually, gloves are off.  Set what you like.
+
+my %fields = (
+    id => 0,
+    #   sip_media_type      => 0,
+    sip_item_properties => 0,
+    #   magnetic_media      => 0,
+    permanent_location => 0,
+    current_location   => 0,
+#   print_line         => 1,
+#   screen_msg         => 1,
+#   itemnumber         => 0,
+#   biblionumber       => 0,
+    hold               => 0,
+    hold_patron_bcode  => 0,
+    hold_patron_name   => 0,
+    barcode            => 0,
+    onloan             => 0,
+    collection_code    => 0,
+    destination_loc    => 0,
+    call_number        => 0,
+    enumchron          => 0,
+    location           => 0,
+    author             => 0,
+    title              => 0,
+    copy               => 0,
+    volume             => 0,
+    record             => 0,
+    mods               => 0,
+);
+
+our $AUTOLOAD;
+sub DESTROY { } # keeps AUTOLOAD from catching inherent DESTROY calls
+
+sub AUTOLOAD {
+    my $self = shift;
+    my $class = ref($self) or croak "$self is not an object";
+    my $name = $AUTOLOAD;
+
+    $name =~ s/.*://;
+
+    unless (exists $fields{$name}) {
+        croak "Cannot access '$name' field of class '$class'";
+    }
+
+    if (@_) {
+        # $fields{$name} or croak "Field '$name' of class '$class' is READ ONLY.";  # nah, go ahead
+        return $self->{$name} = shift;
+    } else {
+        return $self->{$name};
+    }
+}
+
+
 sub new {
     my ($class, $item_id) = @_;
     my $type = ref($class) || $class;
@@ -139,12 +195,16 @@
 	return 1;
 }
 
+sub magnetic_media {
+    my $self = shift;
+    $self->magnetic(@_);
+}
 sub magnetic {
     my $self = shift;
     return 0 unless $self->run_attr_script;
     my $mag = $self->{item_config_result}->{item_config}->{magneticMedia};
     syslog('LOG_DEBUG', "OILS: magnetic = $mag");
-    return ($mag and $mag eq 't') ? 1 : 0;
+    return ($mag and $mag =~ /t(rue)?/io) ? 1 : 0;
 }
 
 sub sip_media_type {
@@ -155,31 +215,10 @@
     return ($media) ? $media : '001';
 }
 
-sub sip_item_properties {
-    my $self = shift;
-    return "";
-}
-
-sub status_update {     # FIXME: this looks unimplemented
-    my ($self, $props) = @_;
-    my $status = OpenILS::SIP::Transaction->new;
-    $self->{sip_item_properties} = $props;
-    $status->{ok} = 1;
-    return $status;
-}
-
-
-sub id {
-    my $self = shift;
-    return $self->{id};
-}
-
 sub title_id {
     my $self = shift;
     my $t =  ($self->{mods}) ? $self->{mods}->title : $self->{copy}->dummy_title;
-    $t = OpenILS::SIP::clean_text($t);
-
-    return $t;
+    return OpenILS::SIP::clean_text($t);
 }
 
 sub permanent_location {
@@ -232,7 +271,7 @@
     return '01';    # FIXME? 01-09 enumerated in spec.  We just use O1-other/unknown.
 }
 
-sub fee {
+sub fee {           # TODO
     my $self = shift;
     return 0;
 }
@@ -253,7 +292,7 @@
     return [];
 }
 
-sub hold_queue_position {
+sub hold_queue_position {       # TODO
     my ($self, $patron_id) = @_;
     return 1;
 }
@@ -281,12 +320,12 @@
     return $due;
 }
 
-sub recall_date {
+sub recall_date {       # TODO
     my $self = shift;
     return 0;
 }
 
-sub hold_pickup_date {
+sub hold_pickup_date {  # TODO
     my $self = shift;
     return 0;
 }

Modified: trunk/Open-ILS/src/perlmods/OpenILS/SIP/Patron.pm
===================================================================
--- trunk/Open-ILS/src/perlmods/OpenILS/SIP/Patron.pm	2010-06-04 20:53:24 UTC (rev 16598)
+++ trunk/Open-ILS/src/perlmods/OpenILS/SIP/Patron.pm	2010-06-04 20:53:25 UTC (rev 16599)
@@ -35,15 +35,23 @@
 # OpenILS::SIP::Patron->new(    usr => $id);       
 
 sub new {
-    my ($class, $patron_id) = @_;
+    my $class = shift;
+    my $key   = (@_ > 1) ? shift : 'barcode';  # if we have multiple args, the first is the key index (default barcode)
+    my $patron_id = shift;
+
+    if ($key ne 'usr' and $key ne 'barcode') {
+        syslog("LOG_ERROR", "Patron (card) lookup requested by illegeal key '$key'");
+        return;
+    }
+
     my $type = ref($class) || $class;
     my $self = {};
 
-	syslog("LOG_DEBUG", "OILS: new OpenILS Patron(%s): searching...", $patron_id);
+    syslog("LOG_DEBUG", "OILS: new OpenILS Patron(%s => %s): searching...", $key, $patron_id);
 
-	my $e = OpenILS::SIP->editor();
+    my $e = OpenILS::SIP->editor();
 
-	my $c = $e->search_actor_card({barcode => $patron_id}, {idlist=>1});
+    my $c = $e->search_actor_card({$key => $patron_id}, {idlist=>1});
 	my $user;
 
 	if( @$c ) {
@@ -73,21 +81,22 @@
 		$user = (@$user) ? $$user[0] : undef;
 	 }
 
-	 if(!$user) {
-		syslog("LOG_WARNING", "OILS: Unable to find patron %s", $patron_id);
-		return undef;
-	 }
+    if(!$user) {
+        syslog("LOG_WARNING", "OILS: Unable to find patron %s => %s", $key, $patron_id);
+        return undef;
+    }
 
+    $self->{editor} = $e;
     $self->{user}   = $user;
-    $self->{id}     = $patron_id;
-    $self->{editor}	= $e;
+    $self->{id}     = ($key eq 'barcode') ? $patron_id : $user->card->barcode;   # The barcode IS the ID to SIP.  
+    # We give back the passed barcode if the key was indeed a barcode, just to be safe.  Otherwise pull it from the card.
 
-	syslog("LOG_DEBUG", "OILS: new OpenILS Patron(%s): found patron : barred=%s, card:active=%s", 
-		$patron_id, $self->{user}->barred, $self->{user}->card->active );
+    syslog("LOG_DEBUG", "OILS: new OpenILS Patron(%s => %s): found patron : barred=%s, card:active=%s", 
+        $key, $patron_id, $user->barred, $user->card->active );
 
 
-	bless $self, $type;
-	return $self;
+    bless $self, $type;
+    return $self;
 }
 
 sub id {
@@ -520,8 +529,7 @@
 
 	return $self if $u->card->active eq 'f';
 
-    # connect and start a new transaction
-    $e->xact_begin;
+    $e->xact_begin;    # connect and start a new transaction
 
 	$u->card->active('f');
 	if( ! $e->update_actor_card($u->card) ) {
@@ -552,21 +560,23 @@
 
 # Testing purposes only
 sub enable {
-    my ($self, $card_retained, $blocked_card_msg) = @_;
+    my ($self, $card_retained) = @_;
     $self->{screen_msg} = "All privileges restored.";
 
-# Un-mark card as inactive, grep out the patron alert
+    # Un-mark card as inactive, grep out the patron alert
+    my $e = $self->{editor};
     my $u = $self->{user};
-    my $e = $self->{editor} = OpenILS::SIP->reset_editor();
 
     syslog('LOG_INFO', "OILS: Unblocking user %s", $u->card->barcode );
 
     return $self if $u->card->active eq 't';
 
+    $e->xact_begin;    # connect and start a new transaction
+
     $u->card->active('t');
     if( ! $e->update_actor_card($u->card) ) {
         syslog('LOG_ERR', "OILS: Unblock card update failed: %s", $e->event->{textcode});
-        $e->xact_rollback;
+        $e->rollback; # rollback + disconnect
         return $self;
     }
 
@@ -580,15 +590,14 @@
 
     if( ! $e->update_actor_user($u) ) {
         syslog('LOG_ERR', "OILS: Unblock: patron alert update failed: %s", $e->event->{textcode});
-        $e->xact_rollback;
+        $e->rollback; # rollback + disconnect
         return $self;
     }
 
     # stay in synch
     $self->{user}->alert_message( $note );
 
-    $e->commit; # commits and resets
-    $self->{editor} = OpenILS::SIP->reset_editor();
+    $e->commit; # commits and disconnects
     return $self;
 }
 

Modified: trunk/Open-ILS/src/perlmods/OpenILS/SIP/Transaction/Checkin.pm
===================================================================
--- trunk/Open-ILS/src/perlmods/OpenILS/SIP/Transaction/Checkin.pm	2010-06-04 20:53:24 UTC (rev 16598)
+++ trunk/Open-ILS/src/perlmods/OpenILS/SIP/Transaction/Checkin.pm	2010-06-04 20:53:25 UTC (rev 16599)
@@ -8,32 +8,41 @@
 use strict;
 
 use POSIX qw(strftime);
+use Sys::Syslog qw(syslog);
+use Data::Dumper;
 
 use OpenILS::SIP;
 use OpenILS::SIP::Transaction;
-use Data::Dumper;
-use Sys::Syslog qw(syslog);
-
+use OpenILS::Const qw/:const/;
 use OpenILS::Application::AppUtils;
 my $U = 'OpenILS::Application::AppUtils';
 
-our @ISA = qw(OpenILS::SIP::Transaction);
+use base qw(OpenILS::SIP::Transaction);
 
+my $debug = 0;
+
 my %fields = (
-	      magnetic => 0,
-	      sort_bin => undef,
-	      );
+    magnetic => 0,
+    sort_bin => undef,
+    # 3M extensions: (most of the data is stored under Item)
+#   collection_code  => undef,
+#   call_number      => undef,
+    destination_loc  => undef,
+    alert_type       => undef,  # 00,01,02,03,04 or 99
+#   hold_patron_id   => undef,
+#   hold_patron_name => "",
+#   hold             => undef,
+);
 
 sub new {
     my $class = shift;;
-    my $self = $class->SUPER::new(@_);
-    my $element;
+    my $self = $class->SUPER::new(@_);              # start with an Transaction object
 
-	foreach $element (keys %fields) {
-		$self->{_permitted}->{$element} = $fields{$element};
-	}
+    foreach (keys %fields) {
+        $self->{_permitted}->{$_} = $fields{$_};    # overlaying _permitted
+    }
 
-    @{$self}{keys %fields} = values %fields;
+    @{$self}{keys %fields} = values %fields;        # copying defaults into object
 
     return bless $self, $class;
 }
@@ -43,39 +52,116 @@
     return !$self->{item}->magnetic;
 }
 
-
 sub do_checkin {
-	my $self = shift;
+    my $self = shift;
+    my ($inst_id, $trans_date, $return_date, $current_loc, $item_props) = @_; # most unused
+    $inst_id ||= '';
 
-	my $resp = $U->simplereq( 
-		'open-ils.circ', 
-		'open-ils.circ.checkin', 
-		$self->{authtoken}, { barcode => $self->{item}->id } );
+    my $resp = $U->simplereq(
+        'open-ils.circ',
+        'open-ils.circ.checkin',
+        $self->{authtoken},
+        { barcode => $self->{item}->id }
+    );
 
-	if( my $code = $U->event_code($resp) ) {
-		my $txt = $resp->{textcode};
-		if( $txt ne 'ROUTE_ITEM' ) {
-			syslog('LOG_INFO', "OILS: Checkin failed with event $code : $txt");
-			$self->ok(0);
-			return 0;
-		}
-	}
+    if ($debug) {
+        open (DUMP, ">/tmp/sip_do_checkin.dump");
+        print DUMP Dumper($resp);
+        close DUMP;
+    }
 
-	my $circ = $resp->{payload}->{circ};
+    my $code = $U->event_code($resp);
+    my $txt  = $code ? $resp->{textcode} : '';
 
-	unless( $circ ) {
-		$self->ok(0);
-		return 0;
-	}
+    $resp->{org} &&= OpenILS::SIP::shortname_from_id($resp->{org}); # Convert id to shortname
 
-	$self->{item}->{patron} = 
-		OpenILS::SIP->editor->search_actor_card(
-		{ usr => $circ->usr, active => 't' } )->[0]->barcode;
+    $self->destination_loc($resp->{org}) if $resp->{org};
 
-	$self->ok(1);
+    $debug and warn "Checkin textcode: $txt, org: " . ($resp->{org} || '');
 
-	return 1;
+    if ($txt eq 'ROUTE_ITEM') {
+        # $self->destination_loc($resp->{org});   # org value already converted and added (above)
+        $self->alert_type('04');            # send to other branch
+    }
+    elsif ($txt and $txt ne 'NO_CHANGE' and $txt ne 'SUCCESS') {
+        syslog('LOG_WARNING', "OILS: Checkin returned unrecognized event $code : $txt");
+        # $self->ok(0);   # maybe still ok?
+        $self->alert_type('00');            # unknown
+    }
+    
+    my $payload = $resp->{payload} || {};
+
+    # Two places to look for hold data.  These are more important and more definitive than above.
+    if ($payload->{remote_hold}) {
+        $self->item->hold($payload->{remote_hold});     # actually only used for checkin at non-owning branch w/ hold at same branch
+    }
+    elsif ($payload->{hold}) {
+        $self->item->hold($payload->{hold});
+    }
+
+    if ($self->item->hold) {
+        my $holder = OpenILS::SIP->find_patron('usr' => $self->item->hold->usr)
+            or warn "OpenILS::SIP->find_patron cannot find hold usr => '" . $self->item->hold->usr . "'";
+        $self->item->hold_patron_bcode( $holder->id   );
+        $self->item->hold_patron_name(  $holder->name );     # Item already had the holder ID, we really just needed the name
+        $self->item->destination_loc( OpenILS::SIP::shortname_from_id($self->item->hold->pickup_lib) );   # must use pickup_lib as method
+        my $atype = ($self->item->destination_loc eq $inst_id)  ? '01' : '02';
+        $self->alert_type($atype);
+    }
+
+    $self->alert(1) if defined $self->alert_type;  # alert_type could be "00", hypothetically
+
+    my $circ = $resp->{payload}->{circ} || '';
+    my $copy = $resp->{payload}->{copy} || '';
+    if ($copy) {
+        ref($copy->call_number) and $self->item->call_number( $copy->call_number->label );
+        # ref($copy->location   ) and $self->item->collection_code($copy->location->name);
+        # This is misleading because if there is a hold we don't want to point back to the owning library OR its location.
+    }
+
+    if ( $circ ) {
+        # $self->item->{patron} = OpenILS::SIP::patron_barcode_from_id($circ->usr);     # Item.pm already does this for us!
+        $self->ok(1);
+    } elsif ($txt eq 'NO_CHANGE' or $txt eq 'SUCCESS' or $txt eq 'ROUTE_ITEM') {
+        $self->ok(1);       # NO_CHANGE means it wasn't checked out anyway, no problem
+    } else {
+        $self->alert(1);
+        $self->alert_type('00') unless $self->alert_type;   # wasn't checked out, but *something* changed
+        # $self->ok(0);     # maybe still ok?
+    }
 }
 
+1;
+__END__
 
-1;
+Successful Checkin event payload includes:
+    $payload->{copy}   (unfleshed)
+    $payload->{record} 
+    $payload->{circ}   
+    $payload->{transit}
+    $payload->{cancelled_hold_transit}
+    $payload->{hold}   
+    $payload->{patron} 
+
+Some EVENT strings:
+    SUCCESS                => ,
+    ASSET_COPY_NOT_FOUND   => ,
+    NO_CHANGE              => ,
+    PERM_FAILURE           => ,
+    CIRC_CLAIMS_RETURNED   => ,
+    COPY_ALERT_MESSAGE     => ,
+    COPY_STATUS_LOST       => ,
+    COPY_STATUS_MISSING    => ,
+    COPY_BAD_STATUS        => ,
+    ITEM_DEPOSIT_PAID      => ,
+    ROUTE_ITEM             => ,
+    DATABASE_UPDATE_FAILED => ,
+    DATABASE_QUERY_FAILED  => ,
+
+# alert_type:
+#   00 - Unknown
+#   01 - hold in local library
+#   02 - hold for other branch
+#   03 - hold for ILL (not used in EG)
+#   04 - send to other branch (no hold)
+#   99 - Other

Modified: trunk/Open-ILS/src/perlmods/OpenILS/SIP.pm
===================================================================
--- trunk/Open-ILS/src/perlmods/OpenILS/SIP.pm	2010-06-04 20:53:24 UTC (rev 16598)
+++ trunk/Open-ILS/src/perlmods/OpenILS/SIP.pm	2010-06-04 20:53:25 UTC (rev 16599)
@@ -131,6 +131,15 @@
     return $text;
 }
 
+sub shortname_from_id {
+    my $id = shift or return;
+    return editor()->search_actor_org_unit({id => $id})->[0]->shortname;
+}
+sub patron_barcode_from_id {
+    my $id = shift or return;
+    return editor()->search_actor_card({ usr => $id, active => 't' })->[0]->barcode;
+}
+
 sub format_date {
 	my $class = shift;
 	my $date = shift;
@@ -330,29 +339,28 @@
 
 
 sub checkin {
-	my ($self, $item_id, $trans_date, $return_date,
-	$current_loc, $item_props, $cancel) = @_;
+	my ($self, $item_id, $inst_id, $trans_date, $return_date,
+        $current_loc, $item_props, $cancel) = @_;
 
 	$self->verify_session;
 
-	syslog('LOG_DEBUG', "OILS: OpenILS::Checkin on item=$item_id");
+	syslog('LOG_DEBUG', "OILS: OpenILS::Checkin of item=$item_id (to $inst_id)");
 	
-    my $patron;
     my $xact = OpenILS::SIP::Transaction::Checkin->new(authtoken => $self->{authtoken});
-    my $item = $self->find_item($item_id);
+    my $item = OpenILS::SIP::Item->new($item_id);
 
-	$xact->item($item);
+    unless ( $xact->item($item) ) {
+        $xact->ok(0);
+        # $circ->alert(1); $circ->alert_type(99);
+        $xact->screen_msg("Invalid Item Barcode: '$item_id'");
+        syslog('LOG_INFO', "OILS: Checkin failed.  " . $xact->screen_msg() );
+        return $xact;
+    }
 
-	if(!$xact->item) {
-		$xact->screen_msg("Invalid item barcode: $item_id");
-		$xact->ok(0);
-		return $xact;
-	}
-
-	$xact->do_checkin( $trans_date, $return_date, $current_loc, $item_props );
+	$xact->do_checkin( $inst_id, $trans_date, $return_date, $current_loc, $item_props );
 	
 	if ($xact->ok) {
-        $xact->patron($patron = $self->find_patron($item->{patron}));
+        $xact->patron($self->find_patron($item->{patron}));
         delete $item->{patron};
         delete $item->{due_date};
         syslog('LOG_INFO', "OILS: Checkin succeeded");



More information about the open-ils-commits mailing list