From 4c42971c6e6ad67a715f6cb66eaa444f639f9642 Mon Sep 17 00:00:00 2001
From: "Joe Atzberger (siptest" <atz4sip@arwen.metavore.com>
Date: Wed, 4 Jun 2008 18:14:48 -0500
Subject: [PATCH] SIP abstraction layer implementation for ILS, Items and
 Patrons.

Signed-off-by: Joshua Ferraro <jmf@liblime.com>
---
 C4/SIP/ILS.pm        | 211 +++++++++++----------------
 C4/SIP/ILS/Item.pm   | 131 +++++++++--------
 C4/SIP/ILS/Patron.pm | 334 ++++++++++++++++++++++++-------------------
 3 files changed, 337 insertions(+), 339 deletions(-)

diff --git a/C4/SIP/ILS.pm b/C4/SIP/ILS.pm
index 559c1ed6bc..14e36bab69 100644
--- a/C4/SIP/ILS.pm
+++ b/C4/SIP/ILS.pm
@@ -18,6 +18,8 @@ use ILS::Transaction::Hold;
 use ILS::Transaction::Renew;
 use ILS::Transaction::RenewAll;
 
+my $debug = 0;
+
 my %supports = (
 		'magnetic media'	=> 1,
 		'security inhibit'	=> 0,
@@ -36,49 +38,44 @@ my %supports = (
 		"patron enable"		=> 1,
 		"hold"			=> 1,
 		"renew"			=> 1,
-		"renew all"		=> 0,
+		"renew all"		=> 1,
 	       );
 
 sub new {
     my ($class, $institution) = @_;
     my $type = ref($class) || $class;
     my $self = {};
-#use Data::Dumper;
-#warn " INSTITUTION:";
-#warn Dumper($institution);
+	use Data::Dumper;
+	$debug and warn "new ILS: INSTITUTION: " . Dumper($institution);
     syslog("LOG_DEBUG", "new ILS '%s'", $institution->{id});
     $self->{institution} = $institution;
-
     return bless $self, $type;
 }
 
 sub find_patron {
     my $self = shift;
-warn "finding patron";
+ 	$debug and warn "ILS: finding patron";
     return ILS::Patron->new(@_);
 }
 
 sub find_item {
     my $self = shift;
-warn "find item";
+	$debug and warn "ILS: finding item";
     return ILS::Item->new(@_);
 }
 
 sub institution {
     my $self = shift;
-
     return $self->{institution}->{id};
 }
 
 sub supports {
     my ($self, $op) = @_;
-
     return (exists($supports{$op}) && $supports{$op});
 }
 
 sub check_inst_id {
     my ($self, $id, $whence) = @_;
-
     if ($id ne $self->{institution}->{id}) {
 	syslog("LOG_WARNING", "%s: received institution '%s', expected '%s'",
 	       $whence, $id, $self->{institution}->{id});
@@ -87,37 +84,33 @@ sub check_inst_id {
 
 sub to_bool {
     my $bool = shift;
-
     # If it's defined, and matches a true sort of string, or is
     # a non-zero number, then it's true.
+	#
+	# FIXME: this test is faulty
+	# 	We're running under warnings and strict.
+	#	But if we don't match regexp, then we go ahead and numerical compare?
+	# 	That means we'd generate a warning on 'FALSE' or ''.
     return defined($bool) && (($bool =~ /true|y|yes/i) || $bool != 0);
 }
 
 sub checkout_ok {
     my $self = shift;
-
     return (exists($self->{policy}->{checkout})
 	    && to_bool($self->{policy}->{checkout}));
 }
-
 sub checkin_ok {
     my $self = shift;
-
     return (exists($self->{policy}->{checkin})
 	    && to_bool($self->{policy}->{checkin}));
 }
-
 sub status_update_ok {
     my $self = shift;
-
     return (exists($self->{policy}->{status_update})
 	    && to_bool($self->{policy}->{status_update}));
-
 }
-
 sub offline_ok {
     my $self = shift;
-
     return (exists($self->{policy}->{offline})
 	    && to_bool($self->{policy}->{offline}));
 }
@@ -168,10 +161,8 @@ sub checkout {
 		}
 		else {
 			syslog("LOG_DEBUG", "ILS::Checkout Issue failed");
-			
 		}
     }
-
     # END TRANSACTION
 
     return $circ;
@@ -195,7 +186,6 @@ sub checkin {
 		delete $item->{patron};
 		delete $item->{due_date};
 		$patron->{items} = [ grep {$_ ne $item_id} @{$patron->{items}} ];
-		
     }
     # END TRANSACTION
 
@@ -232,35 +222,27 @@ sub add_hold {
     my ($self, $patron_id, $patron_pwd, $item_id, $title_id,
 	$expiry_date, $pickup_location, $hold_type, $fee_ack) = @_;
     my ($patron, $item);
-    my $hold;
-    my $trans;
 
+	my $trans = new ILS::Transaction::Hold;
 
-    $trans = new ILS::Transaction::Hold;
-
-    # BEGIN TRANSACTION
     $patron = new ILS::Patron $patron_id;
     if (!$patron
 	|| (defined($patron_pwd) && !$patron->check_password($patron_pwd))) {
-	$trans->screen_msg("Invalid Patron.");
-
-	return $trans;
+		$trans->screen_msg("Invalid Patron.");
+		return $trans;
     }
 
-    $item = new ILS::Item ($item_id || $title_id);
-    if (!$item) {
-	$trans->screen_msg("No such item.");
-
-	# END TRANSACTION (conditionally)
-	return $trans;
-    } elsif ($item->fee && ($fee_ack ne 'Y')) {
-	$trans->screen_msg = "Fee required to place hold.";
+	unless ($item = new ILS::Item ($item_id || $title_id)) {
+		$trans->screen_msg("No such item.");
+		return $trans;
+	}
 
-	# END TRANSACTION (conditionally)
-	return $trans;
+   if ($item->fee and $fee_ack ne 'Y') {
+		$trans->screen_msg = "Fee required to place hold.";
+		return $trans;
     }
 
-    $hold = {
+    my $hold = {
 	item_id         => $item->id,
 	patron_id       => $patron->id,
 	expiration_date => $expiry_date,
@@ -272,68 +254,62 @@ sub add_hold {
     $trans->patron($patron);
     $trans->item($item);
     $trans->pickup_location($pickup_location);
+	$trans->do_hold;
 
-    push(@{$item->hold_queue}, $hold);
+    push(@{$item->hold_queue},     $hold);
     push(@{$patron->{hold_items}}, $hold);
 
-
-    # END TRANSACTION
     return $trans;
 }
 
 sub cancel_hold {
     my ($self, $patron_id, $patron_pwd, $item_id, $title_id) = @_;
     my ($patron, $item, $hold);
-    my $trans;
 
-    $trans = new ILS::Transaction::Hold;
+	my $trans = new ILS::Transaction::Hold;
 
-    # BEGIN TRANSACTION
     $patron = new ILS::Patron $patron_id;
     if (!$patron) {
-	$trans->screen_msg("Invalid patron barcode.");
-
-	return $trans;
+		$trans->screen_msg("Invalid patron barcode.");
+		return $trans;
     } elsif (defined($patron_pwd) && !$patron->check_password($patron_pwd)) {
-	$trans->screen_msg('Invalid patron password.');
-
-	return $trans;
+		$trans->screen_msg('Invalid patron password.');
+		return $trans;
     }
 
-    $item = new ILS::Item ($item_id || $title_id);
-    if (!$item) {
-	$trans->screen_msg("No such item.");
-
-	# END TRANSACTION (conditionally)
-	return $trans;
+    unless ($item = new ILS::Item ($item_id || $title_id)) {
+		$trans->screen_msg("No such item.");
+		return $trans;
     }
 
+    $trans->patron($patron);
+    $trans->item($item);
+	$trans->drop_hold;
+	unless ($trans->ok) {
+		$trans->screen_msg("Error with transaction drop_hold: " . $trans->screen_msg);
+		return $trans;
+	}
     # Remove the hold from the patron's record first
-    $trans->ok($patron->drop_hold($item_id));
-
-    if (!$trans->ok) {
-	# We didn't find it on the patron record
-	$trans->screen_msg("No such hold on patron record.");
+    $trans->ok($patron->drop_hold($item_id));	# different than the transaction drop!
 
-	# END TRANSACTION (conditionally)
-	return $trans;
+    unless ($trans->ok) {
+		# We didn't find it on the patron record
+		$trans->screen_msg("No such hold on patron record.");
+		return $trans;
     }
 
     # Now, remove it from the item record.  If it was on the patron
     # record but not on the item record, we'll treat that as success.
     foreach my $i (0 .. scalar @{$item->hold_queue}) {
-	$hold = $item->hold_queue->[$i];
-
-	if ($hold->{patron_id} eq $patron->id) {
-	    # found it: delete it.
-	    splice @{$item->hold_queue}, $i, 1;
-	    last;
-	}
+		$hold = $item->hold_queue->[$i];
+		if ($hold->{patron_id} eq $patron->id) {
+		    # found it: delete it.
+		    splice @{$item->hold_queue}, $i, 1;
+		    last;		# ?? should we keep going, in case there are multiples
+		}
     }
 
     $trans->screen_msg("Hold Cancelled.");
-    $trans->patron($patron);
-    $trans->item($item);
 
     return $trans;
 }
@@ -352,22 +328,21 @@ sub alter_hold {
 
     # BEGIN TRANSACTION
     $patron = new ILS::Patron $patron_id;
-    if (!$patron) {
-	$trans->screen_msg("Invalid patron barcode.");
-
-	return $trans;
+    unless ($patron) {
+		$trans->screen_msg("Invalid patron barcode: '$patron_id'.");
+		return $trans;
     }
 
     foreach my $i (0 .. scalar @{$patron->{hold_items}}) {
-	$hold = $patron->{hold_items}[$i];
+		$hold = $patron->{hold_items}[$i];
 
 	if ($hold->{item_id} eq $item_id) {
 	    # Found it.  So fix it.
-	    $hold->{expiration_date} = $expiry_date if $expiry_date;
+	    $hold->{expiration_date} = $expiry_date     if $expiry_date;
 	    $hold->{pickup_location} = $pickup_location if $pickup_location;
-	    $hold->{hold_type} = $hold_type if $hold_type;
-
-	    $trans->ok(1);
+	    $hold->{hold_type}       = $hold_type       if $hold_type;
+		$trans->change_hold();
+	    # $trans->ok(1);
 	    $trans->screen_msg("Hold updated.");
 	    $trans->patron($patron);
 	    $trans->item(new ILS::Item $hold->{item_id});
@@ -381,7 +356,7 @@ sub alter_hold {
     # the item, since it's already been updated by the patron code.
 
     if (!$trans->ok) {
-	$trans->screen_msg("No such outstanding hold.");
+		$trans->screen_msg("No such outstanding hold.");
     }
 
     return $trans;
@@ -399,31 +374,33 @@ sub renew {
 
     if (!$patron) {
 		$trans->screen_msg("Invalid patron barcode.");
-
 		return $trans;
     } elsif (!$patron->renew_ok) {
 		$trans->screen_msg("Renewals not allowed.");
-
 		return $trans;
     }
 
-    if (defined($title_id)) {
-	# renewing a title, rather than an item (sort of)
+	# Previously: renewing a title, rather than an item (sort of)
 	# This is gross, but in a real ILS it would be better
+
+    # if (defined($title_id)) {
+	#	foreach my $i (@{$patron->{items}}) {
+	#		$item = new ILS::Item $i;
+	#		last if ($title_id eq $item->title_id);
+	#		$item = undef;
+	#	}
+    # } else {
+		my $j = 0;
+		my $count = scalar @{$patron->{items}};
 		foreach my $i (@{$patron->{items}}) {
-			$item = new ILS::Item $i;
-			last if ($title_id eq $item->title_id);
-			$item = undef;
-		}
-    } else {
-		foreach my $i (@{$patron->{items}}) {
-			if ($i == $item_id) {
+			syslog("LOG_DEBUG", "checking item %s of %s: $item_id vs. %s", ++$j, $count, $i);
+			if ($i eq $item_id) {
 				# We have it checked out
 				$item = new ILS::Item $item_id;
 				last;
 			}
 		}
-    }
+    # }
 
     $trans->item($item);
 
@@ -431,13 +408,12 @@ sub renew {
 	# It's not checked out to $patron_id
 		$trans->screen_msg("Item not checked out to " . $patron->name);
     } elsif (!$item->available($patron_id)) {
-		$trans->screen_msg("Item has outstanding holds");
+		$trans->screen_msg("Item unavailable due to outstanding holds");
     } else {
 		$trans->renewal_ok(1);
-
 		$trans->desensitize(0);	# It's already checked out
 		$trans->do_renew();
-#		warn "done renew $trans->renewal_ok(1);";
+		syslog("LOG_DEBUG", "done renew (%s): %s renews %s", $trans->renewal_ok(1),$patron_id,$item_id);
 
 #		if ($no_block eq 'Y') {
 #			$item->{due_date} = $nb_due_date;
@@ -471,38 +447,21 @@ sub renew_all {
     }
 
     if (!defined($patron)) {
-	$trans->screen_msg("Invalid patron barcode.");
-	return $trans;
+		$trans->screen_msg("Invalid patron barcode.");
+		return $trans;
     } elsif (!$patron->renew_ok) {
-	$trans->screen_msg("Renewals not allowed.");
-	return $trans;
+		$trans->screen_msg("Renewals not allowed.");
+		return $trans;
     } elsif (defined($patron_pwd) && !$patron->check_password($patron_pwd)) {
-	$trans->screen_msg("Invalid patron password.");
-	return $trans;
-    }
-
-    foreach $item_id (@{$patron->{items}}) {
-	my $item = new ILS::Item $item_id;
-
-	if (!defined($item)) {
-	    syslog("LOG_WARNING",
-		   "renew_all: Invalid item id associated with patron '%s'",
-		   $patron->id);
-	    next;
-	}
-
-	if (@{$item->hold_queue}) {
-	    # Can't renew if there are outstanding holds
-	    push @{$trans->unrenewed}, $item_id;
-	} else {
-	    $item->{due_date} = time + (14*24*60*60); # two weeks hence
-	    push @{$trans->renewed}, $item_id;
-	}
+		$trans->screen_msg("Invalid patron password.");
+		return $trans;
     }
 
+	$trans->do_renew_all;
     $trans->ok(1);
-
     return $trans;
 }
 
 1;
+__END__
+
diff --git a/C4/SIP/ILS/Item.pm b/C4/SIP/ILS/Item.pm
index aac797760f..58d4b1085f 100644
--- a/C4/SIP/ILS/Item.pm
+++ b/C4/SIP/ILS/Item.pm
@@ -14,11 +14,24 @@ use Sys::Syslog qw(syslog);
 
 use ILS::Transaction;
 
+use C4::Debug;
+use C4::Context;
 use C4::Biblio;
 use C4::Items;
 use C4::Circulation;
 use C4::Members;
+use C4::Reserves;
 
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
+
+BEGIN {
+	$VERSION = 2.00;
+	require Exporter;
+	@ISA = qw(Exporter);
+	@EXPORT_OK = qw();
+}
+
+=doc 
 our %item_db = (
 		'1565921879' => {
 				 title => "Perl 5 desktop reference",
@@ -42,26 +55,35 @@ our %item_db = (
 				 hold_queue => [],
 			 },
 		);
+=cut
+
+sub priority_sort {
+	defined $a->{priority} or return -1;
+	defined $b->{priority} or return 1;
+	return $a->{priority} <=> $b->{priority};
+}
 
 sub new {
-    my ($class, $item_id) = @_;
-    my $type = ref($class) || $class;
-    my $self;
+	my ($class, $item_id) = @_;
+	my $type = ref($class) || $class;
+	my $self;
 	my $item = GetBiblioFromItemNumber( GetItemnumberFromBarcode($item_id) );
 	
-    if (! $item) {
+	if (! $item) {
 		syslog("LOG_DEBUG", "new ILS::Item('%s'): not found", $item_id);
-		warn "no item $item_id";
+		warn "new ILS::Item($item_id) : No item '$item_id'.";
 		return undef;
-    }
+	}
     $item->{'id'} = $item->{'barcode'};
 	# check if its on issue and if so get the borrower
 	my $issue = GetItemIssue($item->{'itemnumber'});
 	my $borrower = GetMember($issue->{'borrowernumber'},'borrowernumber');
 	$item->{patron} = $borrower->{'cardnumber'};
-    $self = $item;
-
-    bless $self, $type;
+	my @reserves = (@{ GetReservesFromBiblionumber($item->{biblionumber}) });
+	$item->{hold_queue} = [ sort priority_sort @reserves ];
+	$item->{joetest} = 111;
+	$self = $item;
+	bless $self, $type;
 
     syslog("LOG_DEBUG", "new ILS::Item('%s'): found with title '%s'",
 	   $item_id, $self->{title});
@@ -71,155 +93,132 @@ sub new {
 
 sub magnetic {
     my $self = shift;
-
     return $self->{magnetic_media};
 }
-
 sub sip_media_type {
     my $self = shift;
-
     return $self->{sip_media_type};
 }
-
 sub sip_item_properties {
     my $self = shift;
-
     return $self->{sip_item_properties};
 }
 
 sub status_update {
     my ($self, $props) = @_;
     my $status = new ILS::Transaction;
-
     $self->{sip_item_properties} = $props;
     $status->{ok} = 1;
-
     return $status;
 }
-
     
 sub id {
     my $self = shift;
-
     return $self->{id};
 }
-
 sub title_id {
     my $self = shift;
-
     return $self->{title};
 }
-
 sub permanent_location {
     my $self = shift;
-
     return $self->{permanent_location} || '';
 }
-
 sub current_location {
     my $self = shift;
-
     return $self->{current_location} || '';
 }
 
 sub sip_circulation_status {
     my $self = shift;
-
     if ($self->{patron}) {
-	return '04';
+		return '04';
     } elsif (scalar @{$self->{hold_queue}}) {
-	return '08';
+		return '08';
     } else {
-	return '03';
+		return '03';
     }
 }
 
 sub sip_security_marker {
     return '02';
 }
-
 sub sip_fee_type {
     return '01';
 }
 
 sub fee {
     my $self = shift;
-
     return $self->{fee} || 0;
 }
-
 sub fee_currency {
     my $self = shift;
-
-    return $self->{currency} || 'CAD';
+    return $self->{currency} || 'USD';
 }
-
 sub owner {
     my $self = shift;
-
-    return 'UWOLS';
+    return 'CPL';	# FIXME: UWOLS was hardcoded 
 }
-
 sub hold_queue {
     my $self = shift;
-
+	(defined $self->{hold_queue}) or return [];
     return $self->{hold_queue};
 }
 
 sub hold_queue_position {
-    my ($self, $patron_id) = @_;
-    my $i;
-
-    for ($i = 0; $i < scalar @{$self->{hold_queue}}; $i += 1) {
-	if ($self->{hold_queue}[$i]->{patron_id} eq $patron_id) {
-	    return $i + 1;
+	my ($self, $patron_id) = @_;
+	($self->{hold_queue}) or return 0;
+	my $i = 0;
+	foreach (@{$self->{hold_queue}}) {
+		$i++;
+		$_->{patron_id} or next;
+		if ($_->{patron_id} eq $patron_id) {
+			return $i;
+		}
 	}
-    }
     return 0;
 }
 
 sub due_date {
     my $self = shift;
-
     return $self->{due_date} || 0;
 }
-
 sub recall_date {
     my $self = shift;
-
     return $self->{recall_date} || 0;
 }
-
 sub hold_pickup_date {
     my $self = shift;
-
     return $self->{hold_pickup_date} || 0;
 }
-
 sub screen_msg {
     my $self = shift;
-
     return $self->{screen_msg} || '';
 }
-
 sub print_line {
-     my $self = shift;
-
-     return $self->{print_line} || '';
+	my $self = shift;
+	return $self->{print_line} || '';
 }
 
-# An item is available for a patron if
-# 1) It's not checked out and (there's no hold queue OR patron
-#    is at the front of the queue)
+# An item is available for a patron if it is:
+# 1) checked out to the same patron and there's no hold queue
 # OR
-# 2) It's checked out to the patron and there's no hold queue
+# 2) not checked out and (there's no hold queue OR patron
+#    is at the front of the queue)
 sub available {
-     my ($self, $for_patron) = @_;
-
-     return ((!defined($self->{patron_id}) && (!scalar @{$self->{hold_queue}}
-					       || ($self->{hold_queue}[0] eq $for_patron)))
-	     || ($self->{patron_id} && ($self->{patron_id} eq $for_patron)
-		 && !scalar @{$self->{hold_queue}}));
+	my ($self, $for_patron) = @_;
+	my $count = (defined $self->{hold_queue}) ? scalar @{$self->{hold_queue}} : 0;
+	print STDERR "availability check: hold_queue size $count\n";
+    if (defined($self->{patron_id})) {
+	 	($self->{patron_id} eq $for_patron) or return 0;
+		return ($count ? 0 : 1);
+	} else {	# not checked out
+		($count) or return 1;
+		($self->{hold_queue}[0] eq $for_patron) and return 1;
+	}
+	return 0;
 }
 
 1;
+__END__
+
diff --git a/C4/SIP/ILS/Patron.pm b/C4/SIP/ILS/Patron.pm
index b536e2b4bc..84a05fc353 100644
--- a/C4/SIP/ILS/Patron.pm
+++ b/C4/SIP/ILS/Patron.pm
@@ -14,16 +14,25 @@ use Exporter;
 use Sys::Syslog qw(syslog);
 use Data::Dumper;
 
+use C4::Debug;
 use C4::Context;
+use C4::Dates;
 use C4::Koha;
 use C4::Members;
+use C4::Reserves;
 use Digest::MD5 qw(md5_base64);
 
-our (@ISA, @EXPORT_OK);
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
 
-@ISA = qw(Exporter);
+BEGIN {
+	$VERSION = 2.00;
+	@ISA = qw(Exporter);
+	@EXPORT_OK = qw(invalid_patron);
+}
+
+our $kp;	# koha patron
 
-@EXPORT_OK = qw(invalid_patron);
+=doc 
 
 our %patron_example = (
 		  djfiander => {
@@ -55,230 +64,273 @@ our %patron_example = (
 		      unavail_holds => [],
 		      inet => 1,
 		  },
-		  );
+  );
+
+From borrowers table:
++---------------------+--------------+------+-----+
+| Field               | Type         | Null | Key |
++---------------------+--------------+------+-----+
+| borrowernumber      | int(11)      | NO   | PRI |
+| cardnumber          | varchar(16)  | YES  | UNI |
+| surname             | mediumtext   | NO   |     |
+| firstname           | text         | YES  |     |
+| title               | mediumtext   | YES  |     |
+| othernames          | mediumtext   | YES  |     |
+| initials            | text         | YES  |     |
+| streetnumber        | varchar(10)  | YES  |     |
+| streettype          | varchar(50)  | YES  |     |
+| address             | mediumtext   | NO   |     |
+| address2            | text         | YES  |     |
+| city                | mediumtext   | NO   |     |
+| zipcode             | varchar(25)  | YES  |     |
+| email               | mediumtext   | YES  |     |
+| phone               | text         | YES  |     |
+| mobile              | varchar(50)  | YES  |     |
+| fax                 | mediumtext   | YES  |     |
+| emailpro            | text         | YES  |     |
+| phonepro            | text         | YES  |     |
+| B_streetnumber      | varchar(10)  | YES  |     |
+| B_streettype        | varchar(50)  | YES  |     |
+| B_address           | varchar(100) | YES  |     |
+| B_city              | mediumtext   | YES  |     |
+| B_zipcode           | varchar(25)  | YES  |     |
+| B_email             | text         | YES  |     |
+| B_phone             | mediumtext   | YES  |     |
+| dateofbirth         | date         | YES  |     |
+| branchcode          | varchar(10)  | NO   | MUL |
+| categorycode        | varchar(10)  | NO   | MUL |
+| dateenrolled        | date         | YES  |     |
+| dateexpiry          | date         | YES  |     |
+| gonenoaddress       | tinyint(1)   | YES  |     |
+| lost                | tinyint(1)   | YES  |     |
+| debarred            | tinyint(1)   | YES  |     |
+| contactname         | mediumtext   | YES  |     |
+| contactfirstname    | text         | YES  |     |
+| contacttitle        | text         | YES  |     |
+| guarantorid         | int(11)      | YES  |     |
+| borrowernotes       | mediumtext   | YES  |     |
+| relationship        | varchar(100) | YES  |     |
+| ethnicity           | varchar(50)  | YES  |     |
+| ethnotes            | varchar(255) | YES  |     |
+| sex                 | varchar(1)   | YES  |     |
+| password            | varchar(30)  | YES  |     |
+| flags               | int(11)      | YES  |     |
+| userid              | varchar(30)  | YES  | MUL |
+| opacnote            | mediumtext   | YES  |     |
+| contactnote         | varchar(255) | YES  |     |
+| sort1               | varchar(80)  | YES  |     |
+| sort2               | varchar(80)  | YES  |     |
+| altcontactfirstname | varchar(255) | YES  |     |
+| altcontactsurname   | varchar(255) | YES  |     |
+| altcontactaddress1  | varchar(255) | YES  |     |
+| altcontactaddress2  | varchar(255) | YES  |     |
+| altcontactaddress3  | varchar(255) | YES  |     |
+| altcontactzipcode   | varchar(50)  | YES  |     |
+| altcontactphone     | varchar(50)  | YES  |     |
++---------------------+--------------+------+-----+
+
+From C4::Members
+
+$flags->{KEY}
+{CHARGES}
+	{message}     Message showing patron's credit or debt
+	{noissues}    Set if patron owes >$5.00
+{GNA}         	Set if patron gone w/o address
+	{message}     "Borrower has no valid address"
+	{noissues}    Set.
+{LOST}        	Set if patron's card reported lost
+	{message}     Message to this effect
+	{noissues}    Set.
+{DBARRED}     	Set if patron is debarred
+	{message}     Message to this effect
+	{noissues}    Set.
+{NOTES}       	Set if patron has notes
+	{message}     Notes about patron
+{ODUES}       	Set if patron has overdue books
+	{message}     "Yes"
+	{itemlist}    ref-to-array: list of overdue books
+	{itemlisttext}    Text list of overdue items
+{WAITING}     	Set if there are items available that the patron reserved
+	{message}     Message to this effect
+	{itemlist}    ref-to-array: list of available items
+
+=cut
 
 sub new {
-    my ($class, $patron_id) = @_;
+	my ($class, $patron_id) = @_;
     my $type = ref($class) || $class;
     my $self;
-	my %ilspatron;
-	my $kp = GetMember($patron_id,'cardnumber');
-#	use Data::Dumper;
-#	warn Dumper($kp);
-    if ($kp) {
-		my $pw = $kp->{password};    ## FIXME - md5hash -- deal with . 
-		my $dob= $kp->{dateofbirth};
-		$dob =~ s/\-//g;
-		my $fines_out = GetMemberAccountRecords($kp->{borrowernumber});
-		my ($num_cur_issues,$cur_issues) = GetPendingIssues($kp->{borrowernumber});
-		my $debarred = $kp->{debarred}; ### 1 if ($kp->{flags}->{DBARRED}->{noissues});
-# warn "i am debarred: $debarred";
-#warn Dumper(%{$kp->{flags}});
-		my $adr = $kp->{streetnumber} . " ". $kp->{address}; 
-		%ilspatron = (
-		      name => $kp->{firstname} . " " . $kp->{surname},
-		      id => $kp->{cardnumber},
-		      password => $pw,
-		      ptype => $kp->{categorycode}, # 'A'dult.  Whatever.
-		      birthdate => $kp->{dateofbirth}, ##$dob,
-		      address => $adr,
-		      home_phone => $kp->{phone},
-		      email_addr => $kp->{email},
-		      charge_ok => (!$debarred) , ##  (C4::Context->preference('FinesMode') eq 'charge') || 0,
-		      renew_ok => 1,
-			  recall_ok => 1,
-		      hold_ok => 1,
-		      card_lost => ($kp->{lost} || $kp->{gonenoaddress}) ,
-		      claims_returned => 0,
-		      fines => $fines_out,
-		      fees => 0,
-		      recall_overdue => 0,
-		      items_billed => 0,
-		      screen_msg => 'Greetings from Koha',
-		      print_line => '',
-		      items => ['one item','itemstring 2'] ,
-		      hold_items => [],#$kp->{flags}->{WAITING}{itemlist}->{biblionumber},
-		      overdue_items =>[], # [$kp->{flags}->{ODUES}{itemlisttext}],   ### FIXME -> this should be array, not texts string.
-		      fine_items => [],
-		      recall_items => [],
-		      unavail_holds => [],
-		      inet => '',
-			  );
-	} else {
+	$kp = GetMember($patron_id,'cardnumber');
+	$debug and warn "new Patron: " . Dumper($kp);
+    unless (defined $kp) {
 		syslog("LOG_DEBUG", "new ILS::Patron(%s): no such patron", $patron_id);
 		return undef;
-    }
-
-    $self =  \%ilspatron;
-#	warn Dumper($self);
-
+	}
+	my $pw = $kp->{password};    ## FIXME - md5hash -- deal with . 
+	my $dob= $kp->{dateofbirth};
+	my $fines_out = GetMemberAccountRecords($kp->{borrowernumber});
+	my ($num_cur_issues,$cur_issues) = GetPendingIssues($kp->{borrowernumber});
+	my $flags = $kp->{flags}; # or warn "Warning: No flags from patron object for '$patron_id'"; 
+	my $debarred = $kp->{debarred}; ### 1 if ($kp->{flags}->{DBARRED}->{noissues});
+	$debug and warn "Debarred: $debarred = " . Dumper(%{$kp->{flags}});
+	my %ilspatron;
+	my $adr     = $kp->{streetnumber} || '';
+	my $address = $kp->{address}      || ''; 
+	$adr .= ($adr && $address) ? " $address" : $address;
+	{
+	no warnings;	# any of these $kp->{fields} being concat'd could be undef
+	$dob =~ s/\-//g;
+	%ilspatron = (
+		name => $kp->{firstname} . " " . $kp->{surname},
+		  id => $kp->{cardnumber},
+		  password => $pw,
+		     ptype => $kp->{categorycode}, # 'A'dult.  Whatever.
+		 birthdate => $kp->{dateofbirth}, ##$dob,
+		branchcode => $kp->{branchcode},
+		   address => $adr,
+		home_phone => $kp->{phone},
+		email_addr => $kp->{email},
+		 charge_ok => (!$debarred), ##  (C4::Context->preference('FinesMode') eq 'charge') || 0,
+		  renew_ok => (!$debarred),
+		 recall_ok => 0,
+		   hold_ok => 0,
+	 	 card_lost => ($kp->{lost} || $kp->{gonenoaddress} || $flags->{LOST}) ,
+		claims_returned => 0,
+		fines => $fines_out,
+		 fees => 0,
+		recall_overdue => 0,
+		  items_billed => 0,
+		screen_msg => 'Greetings from Koha. ' . $kp->{opacnote},
+		print_line => '',
+		        items => [],
+		   hold_items => $flags->{WAITING}{itemlist},
+		overdue_items => $flags->{ODUES}{itemlist},
+		   fine_items => [],
+		 recall_items => [],
+		unavail_holds => [],
+		inet => 1,
+	);
+	}
+	# FIXME: populate items fine_items recall_items
+#   $ilspatron{hold_items}    = (GetReservesFromBorrowernumber($kp->{borrowernumber},'F'));
+	$ilspatron{unavail_holds} = [(GetReservesFromBorrowernumber($kp->{borrowernumber}))];
+	my ($count,$issues) = GetPendingIssues($kp->{borrowernumber});
+	$ilspatron{items} = $issues;
+	$self = \%ilspatron;
+	$debug and warn Dumper($self);
     syslog("LOG_DEBUG", "new ILS::Patron(%s): found patron '%s'", $patron_id,$self->{id});
-
     bless $self, $type;
     return $self;
 }
 
 sub id {
     my $self = shift;
-
     return $self->{id};
 }
-
 sub name {
     my $self = shift;
-
     return $self->{name};
 }
-
 sub address {
     my $self = shift;
-
     return $self->{address};
 }
-
 sub email_addr {
     my $self = shift;
-
     return $self->{email_addr};
 }
-
 sub home_phone {
     my $self = shift;
-
     return $self->{home_phone};
 }
-
 sub sip_birthdate {
     my $self = shift;
-
     return $self->{birthdate};
 }
-
 sub ptype {
     my $self = shift;
-
     return $self->{ptype};
 }
-
 sub language {
     my $self = shift;
-
     return $self->{language} || '000'; # Unspecified
 }
-
 sub charge_ok {
     my $self = shift;
-
     return $self->{charge_ok};
 }
-
 sub renew_ok {
     my $self = shift;
-
     return $self->{renew_ok};
 }
-
 sub recall_ok {
     my $self = shift;
-
     return $self->{recall_ok};
 }
-
 sub hold_ok {
     my $self = shift;
-
     return $self->{hold_ok};
 }
-
 sub card_lost {
     my $self = shift;
-
     return $self->{card_lost};
 }
-
 sub recall_overdue {
     my $self = shift;
-
     return $self->{recall_overdue};
 }
-
 sub check_password {
     my ($self, $pwd) = @_;
 	my $md5pwd=$self->{password};  ### FIXME -  we're allowing access if user has no password.
-	warn "check $self->{password} $pwd";
-    warn "$self->{name}";	
+	# warn sprintf "check_password for %s: '%s' vs. '%s'",($self->{name}||''),($self->{password}||''),($pwd||'');
 	return (!$self->{password} ||  md5_base64($pwd) eq $md5pwd );
 }
-
 sub currency {
     my $self = shift;
-
     return $self->{currency};
 }
-
 sub fee_amount {
     my $self = shift;
-
     return $self->{fee_amount} || undef;
 }
-
 sub screen_msg {
     my $self = shift;
-
     return $self->{screen_msg};
 }
-
 sub print_line {
     my $self = shift;
-
     return $self->{print_line};
 }
-
 sub too_many_charged {
     my $self = shift;
-
     return $self->{too_many_charged};
 }
-
 sub too_many_overdue {
     my $self = shift;
-
     return $self->{too_many_overdue};
 }
-
 sub too_many_renewal {
     my $self = shift;
-
     return $self->{too_many_renewal};
 }
-
 sub too_many_claim_return {
     my $self = shift;
-
     return $self->{too_many_claim_return};
 }
-
 sub too_many_lost {
     my $self = shift;
-
     return $self->{too_many_lost};
 }
-
 sub excessive_fines {
     my $self = shift;
-
     return $self->{excessive_fines};
 }
-
 sub excessive_fees {
     my $self = shift;
-
     return $self->{excessive_fees};
 }
-
 sub too_many_billed {
     my $self = shift;
-
     return $self->{too_many_billed};
 }
 
@@ -287,10 +339,9 @@ sub too_many_billed {
 #
 sub hold_items {
     my ($self, $start, $end) = @_;
-
-    $start = 1 if !defined($start);
-    $end = scalar @{$self->{hold_items}} if !defined($end);
-
+	$self->{hold_items} or return [];
+    $start = 1 unless defined($start);
+    $end = scalar @{$self->{hold_items}} unless defined($end);
     return [@{$self->{hold_items}}[$start-1 .. $end-1]];
 }
 
@@ -300,99 +351,86 @@ sub hold_items {
 # 
 sub drop_hold {
     my ($self, $item_id) = @_;
-    my $i;
-
-    for ($i = 0; $i < scalar @{$self->{hold_items}}; $i += 1) {
-	if ($self->{hold_items}[$i]->{item_id} eq $item_id) {
-	    splice @{$self->{hold_items}}, $i, 1;
-	    return 1;
+	$item_id or return undef;
+	my $result = 0;
+	foreach (qw(hold_items unavail_holds)) {
+		$self->{$_} or next;
+		for (my $i = 0; $i < scalar @{$self->{$_}}; $i++) {
+			my $held_item = $self->{$_}[$i]->{item_id} or next;
+			if ($held_item eq $item_id) {
+				splice @{$self->{$_}}, $i, 1;
+				$result++;
+			}
+		}
 	}
-    }
-
-    return 0;
+    return $result;
 }
 
 sub overdue_items {
     my ($self, $start, $end) = @_;
-
+	$self->{overdue_items} or return [];
     $start = 1 if !defined($start);
     $end = scalar @{$self->{overdue_items}} if !defined($end);
-
     return [@{$self->{overdue_items}}[$start-1 .. $end-1]];
 }
 
 sub charged_items {
     my ($self, $start, $end) = shift;
-
+	$self->{items} or return [];
     $start = 1 if !defined($start);
     $end = scalar @{$self->{items}} if !defined($end);
-
-    syslog("LOG_DEBUG", "charged_items: start = %d, end = %d", $start, $end);
-    syslog("LOG_DEBUG", "charged_items: items = (%s)",
-	   join(', ', @{$self->{items}}));
-
+    syslog("LOG_DEBUG", "charged_items: start = %d, end = %d; items(%s)",
+			$start, $end, join(', ', @{$self->{items}}));
 	return [@{$self->{items}}[$start-1 .. $end-1]];
 }
 
 sub fine_items {
     my ($self, $start, $end) = @_;
-
+	$self->{fine_items} or return [];
     $start = 1 if !defined($start);
     $end = scalar @{$self->{fine_items}} if !defined($end);
-
     return [@{$self->{fine_items}}[$start-1 .. $end-1]];
 }
 
 sub recall_items {
     my ($self, $start, $end) = @_;
-
+	$self->{recall_items} or return [];
     $start = 1 if !defined($start);
     $end = scalar @{$self->{recall_items}} if !defined($end);
-
     return [@{$self->{recall_items}}[$start-1 .. $end-1]];
 }
 
 sub unavail_holds {
     my ($self, $start, $end) = @_;
-
+	$self->{unavail_holds} or return [];
     $start = 1 if !defined($start);
     $end = scalar @{$self->{unavail_holds}} if !defined($end);
-
     return [@{$self->{unavail_holds}}[$start-1 .. $end-1]];
 }
 
 sub block {
     my ($self, $card_retained, $blocked_card_msg) = @_;
-
     foreach my $field ('charge_ok', 'renew_ok', 'recall_ok', 'hold_ok') {
-	$self->{$field} = 0;
+		$self->{$field} = 0;
     }
-
     $self->{screen_msg} = $blocked_card_msg || "Card Blocked.  Please contact library staff";
-
     return $self;
 }
 
 sub enable {
     my $self = shift;
-
     foreach my $field ('charge_ok', 'renew_ok', 'recall_ok', 'hold_ok') {
-	$self->{$field} = 1;
+		$self->{$field} = 1;
     }
-
     syslog("LOG_DEBUG", "Patron(%s)->enable: charge: %s, renew:%s, recall:%s, hold:%s",
 	   $self->{id}, $self->{charge_ok}, $self->{renew_ok},
 	   $self->{recall_ok}, $self->{hold_ok});
-
     $self->{screen_msg} = "All privileges restored.";
-
     return $self;
 }
 
-
 sub inet_privileges {
     my $self = shift;
-
     return $self->{inet} ? 'Y' : 'N';
 }
 
@@ -409,3 +447,5 @@ sub charge_denied {
 }
 
 1;
+__END__
+
-- 
2.39.5