C4/SIP/ILS/Item.pm

   1 #
   2 # ILS::Item.pm
   3 #
   4 # A Class for hiding the ILS's concept of the item from OpenSIP
   5 #
   6
   7 package C4::SIP::ILS::Item;
   8
   9 use strict;
  10 use warnings;
  11
  12 use Sys::Syslog qw(syslog);
  13 use Carp;
  14
  15 use C4::SIP::ILS::Transaction;
  16
  17 use C4::Debug;
  18 use C4::Context;
  19 use C4::Biblio;
  20 use C4::Items;
  21 use C4::Circulation;
  22 use C4::Members;
  23 use C4::Reserves;
  24 use Koha::Database;
  25
  26 our $VERSION = 3.07.00.049;
  27
  28 =encoding UTF-8
  29
  30 =head1 EXAMPLE
  31
  32  our %item_db = (
  33     '1565921879' => {
  34         title => "Perl 5 desktop reference",
  35         id => '1565921879',
  36         sip_media_type => '001',
  37         magnetic_media => 0,
  38         hold_queue => [],
  39     },
  40     '0440242746' => {
  41         title => "The deep blue alibi",
  42         id => '0440242746',
  43         sip_media_type => '001',
  44         magnetic_media => 0,
  45         hold_queue => [
  46             {
  47             itemnumber => '823',
  48             priority => '1',
  49             reservenotes => undef,
  50             constrainttype => 'a',
  51             reservedate => '2008-10-09',
  52             found => undef,
  53             rtimestamp => '2008-10-09 11:15:06',
  54             biblionumber => '406',
  55             borrowernumber => '756',
  56             branchcode => 'CPL'
  57             }
  58         ],
  59     },
  60     '660' => {
  61         title => "Harry Potter y el cáliz de fuego",
  62         id => '660',
  63         sip_media_type => '001',
  64         magnetic_media => 0,
  65         hold_queue => [],
  66     },
  67 );
  68 =cut
  69
  70 sub priority_sort {
  71     defined $a->{priority} or return -1;
  72     defined $b->{priority} or return 1;
  73     return $a->{priority} <=> $b->{priority};
  74 }
  75
  76 sub new {
  77         my ($class, $item_id) = @_;
  78         my $type = ref($class) || $class;
  79         my $self;
  80     my $itemnumber = GetItemnumberFromBarcode($item_id);
  81         my $item = GetBiblioFromItemNumber($itemnumber);    # actually biblio.*, biblioitems.* AND items.*  (overkill)
  82         if (! $item) {
  83                 syslog("LOG_DEBUG", "new ILS::Item('%s'): not found", $item_id);
  84                 warn "new ILS::Item($item_id) : No item '$item_id'.";
  85         return;
  86         }
  87     $item->{  'itemnumber'   } = $itemnumber;
  88     $item->{      'id'       } = $item->{barcode};     # to SIP, the barcode IS the id.
  89     $item->{permanent_location}= $item->{homebranch};
  90     $item->{'collection_code'} = $item->{ccode};
  91     $item->{  'call_number'  } = $item->{itemcallnumber};
  92
  93     my $it = C4::Context->preference('item-level_itypes') ? $item->{itype} : $item->{itemtype};
  94     my $itemtype = Koha::Database->new()->schema()->resultset('Itemtype')->find( $it );
  95     $item->{sip_media_type} = $itemtype->sip_media_type() if $itemtype;
  96
  97         # check if its on issue and if so get the borrower
  98         my $issue = GetItemIssue($item->{'itemnumber'});
  99     if ($issue) {
 100         $item->{due_date} = $issue->{date_due};
 101     }
 102         my $borrower = GetMember(borrowernumber=>$issue->{'borrowernumber'});
 103         $item->{patron} = $borrower->{'cardnumber'};
 104     my $reserves = GetReservesFromBiblionumber({ biblionumber => $item->{biblionumber} });
 105     $item->{hold_queue} = [ sort priority_sort @$reserves ];
 106         $item->{hold_shelf}    = [( grep {   defined $_->{found}  and $_->{found} eq 'W' } @{$item->{hold_queue}} )];
 107         $item->{pending_queue} = [( grep {(! defined $_->{found}) or  $_->{found} ne 'W' } @{$item->{hold_queue}} )];
 108         $self = $item;
 109         bless $self, $type;
 110
 111     syslog("LOG_DEBUG", "new ILS::Item('%s'): found with title '%s'",
 112            $item_id, $self->{title});
 113
 114     return $self;
 115 }
 116
 117 # 0 means read-only
 118 # 1 means read/write
 119
 120 my %fields = (
 121     id                  => 0,
 122     sip_media_type      => 0,
 123     sip_item_properties => 0,
 124     magnetic_media      => 0,
 125     permanent_location  => 0,
 126     current_location    => 0,
 127     print_line          => 1,
 128     screen_msg          => 1,
 129     itemnumber          => 0,
 130     biblionumber        => 0,
 131     barcode             => 0,
 132     onloan              => 0,
 133     collection_code     => 0,
 134     call_number         => 0,
 135     enumchron           => 0,
 136     location            => 0,
 137     author              => 0,
 138     title               => 0,
 139 );
 140
 141 sub next_hold {
 142     my $self = shift;
 143     # use Data::Dumper; warn "next_hold() hold_shelf: " . Dumper($self->{hold_shelf}); warn "next_hold() pending_queue: " . $self->{pending_queue};
 144     foreach (@{$self->hold_shelf}) {    # If this item was taken from the hold shelf, then that reserve still governs
 145         next unless ($_->{itemnumber} and $_->{itemnumber} == $self->{itemnumber});
 146         return $_;
 147     }
 148     if (scalar @{$self->{pending_queue}}) {    # Otherwise, if there is at least one hold, the first (best priority) gets it
 149         return  $self->{pending_queue}->[0];
 150     }
 151     return;
 152 }
 153
 154 # hold_patron_id is NOT the barcode.  It's the borrowernumber.
 155 # If a return triggers capture for a hold the borrowernumber is passed
 156 # and saved so that other hold info can be retrieved
 157 sub hold_patron_id {
 158     my $self = shift;
 159     my $id   = shift;
 160     if ($id) {
 161         $self->{hold}->{borrowernumber} = $id;
 162     }
 163     if ($self->{hold} ) {
 164         return $self->{hold}->{borrowernumber};
 165     }
 166     return;
 167
 168 }
 169 sub hold_patron_name {
 170     my $self = shift;
 171     my $borrowernumber = (@_ ? shift: $self->hold_patron_id()) or return;
 172     my $holder = GetMember(borrowernumber=>$borrowernumber);
 173     unless ($holder) {
 174         syslog("LOG_ERR", "While checking hold, GetMember failed for borrowernumber '$borrowernumber'");
 175         return;
 176     }
 177     my $email = $holder->{email} || '';
 178     my $phone = $holder->{phone} || '';
 179     my $extra = ($email and $phone) ? " ($email, $phone)" :  # both populated, employ comma
 180                 ($email or  $phone) ? " ($email$phone)"   :  # only 1 populated, we don't care which: no comma
 181                 "" ;                                         # neither populated, empty string
 182     my $name = $holder->{firstname} ? $holder->{firstname} . ' ' : '';
 183     $name .= $holder->{surname} . $extra;
 184     return $name;
 185 }
 186
 187 sub hold_patron_bcode {
 188     my $self = shift;
 189     my $borrowernumber = (@_ ? shift: $self->hold_patron_id()) or return;
 190     my $holder = GetMember(borrowernumber => $borrowernumber);
 191     if ($holder) {
 192         if ($holder->{cardnumber}) {
 193             return $holder->{cardnumber};
 194         }
 195     }
 196     return;
 197 }
 198
 199 sub destination_loc {
 200     my $self = shift;
 201     my $set_loc = shift;
 202     if ($set_loc) {
 203         $self->{dest_loc} = $set_loc;
 204     }
 205     if ($self->{dest_loc} ) {
 206         return $self->{dest_loc};
 207     }
 208     return q{};
 209 }
 210
 211 our $AUTOLOAD;
 212
 213 sub DESTROY { } # keeps AUTOLOAD from catching inherent DESTROY calls
 214
 215 sub AUTOLOAD {
 216     my $self = shift;
 217     my $class = ref($self) or croak "$self is not an object";
 218     my $name = $AUTOLOAD;
 219
 220     $name =~ s/.*://;
 221
 222     unless (exists $fields{$name}) {
 223                 croak "Cannot access '$name' field of class '$class'";
 224     }
 225
 226         if (@_) {
 227         $fields{$name} or croak "Field '$name' of class '$class' is READ ONLY.";
 228                 return $self->{$name} = shift;
 229         } else {
 230                 return $self->{$name};
 231         }
 232 }
 233
 234 sub status_update {     # FIXME: this looks unimplemented
 235     my ($self, $props) = @_;
 236     my $status = C4::SIP::ILS::Transaction->new();
 237     $self->{sip_item_properties} = $props;
 238     $status->{ok} = 1;
 239     return $status;
 240 }
 241
 242 sub title_id {
 243     my $self = shift;
 244     return $self->{title};
 245 }
 246
 247 sub sip_circulation_status {
 248     my $self = shift;
 249     if ($self->{patron}) {
 250                 return '04';    # charged
 251     } elsif (scalar @{$self->{hold_queue}}) {
 252                 return '08';    # waiting on hold shelf
 253     } else {
 254                 return '03';    # available
 255     }                   # FIXME: 01-13 enumerated in spec.
 256 }
 257
 258 sub sip_security_marker {
 259     my $self = shift;
 260     return '02';        # FIXME? 00-other; 01-None; 02-Tattle-Tape Security Strip (3M); 03-Whisper Tape (3M)
 261 }
 262 sub sip_fee_type {
 263     my $self = shift;
 264     return '01';    # FIXME? 01-09 enumerated in spec.  We just use O1-other/unknown.
 265 }
 266
 267 sub fee {
 268     my $self = shift;
 269     return $self->{fee} || 0;
 270 }
 271 sub fee_currency {
 272     my $self = shift;
 273     return $self->{currency} || 'USD';
 274 }
 275 sub owner {
 276     my $self = shift;
 277     return $self->{homebranch};
 278 }
 279 sub hold_queue {
 280     my $self = shift;
 281         (defined $self->{hold_queue}) or return [];
 282     return $self->{hold_queue};
 283 }
 284 sub pending_queue {
 285     my $self = shift;
 286         (defined $self->{pending_queue}) or return [];
 287     return $self->{pending_queue};
 288 }
 289 sub hold_shelf {
 290     my $self = shift;
 291         (defined $self->{hold_shelf}) or return [];
 292     return $self->{hold_shelf};
 293 }
 294
 295 sub hold_queue_position {
 296         my ($self, $patron_id) = @_;
 297         ($self->{hold_queue}) or return 0;
 298         my $i = 0;
 299         foreach (@{$self->{hold_queue}}) {
 300                 $i++;
 301                 $_->{patron_id} or next;
 302                 if ($self->barcode_is_borrowernumber($patron_id, $_->{borrowernumber})) {
 303                         return $i;  # maybe should return $_->{priority}
 304                 }
 305         }
 306     return 0;
 307 }
 308
 309 sub due_date {
 310     my $self = shift;
 311     return $self->{due_date} || 0;
 312 }
 313 sub recall_date {
 314     my $self = shift;
 315     return $self->{recall_date} || 0;
 316 }
 317 sub hold_pickup_date {
 318     my $self = shift;
 319     return $self->{hold_pickup_date} || 0;
 320 }
 321
 322 # This is a partial check of "availability".  It is not supposed to check everything here.
 323 # An item is available for a patron if it is:
 324 # 1) checked out to the same patron
 325 #    AND no pending (i.e. non-W) hold queue
 326 # OR
 327 # 2) not checked out
 328 #    AND (not on hold_shelf OR is on hold_shelf for patron)
 329 #
 330 # What this means is we are consciously allowing the patron to checkout (but not renew) an item that DOES
 331 # have non-W holds on it, but has not been "picked" from the stacks.  That is to say, the
 332 # patron has retrieved the item before the librarian.
 333 #
 334 # We don't check if the patron is at the front of the pending queue in the first case, because
 335 # they should not be able to place a hold on an item they already have.
 336
 337 sub available {
 338         my ($self, $for_patron) = @_;
 339         my $count  = (defined $self->{pending_queue}) ? scalar @{$self->{pending_queue}} : 0;
 340         my $count2 = (defined $self->{hold_shelf}   ) ? scalar @{$self->{hold_shelf}   } : 0;
 341         $debug and print STDERR "availability check: pending_queue size $count, hold_shelf size $count2\n";
 342     if (defined($self->{patron_id})) {
 343                 ($self->{patron_id} eq $for_patron) or return 0;
 344                 return ($count ? 0 : 1);
 345         } else {        # not checked out
 346         ($count2) and return $self->barcode_is_borrowernumber($for_patron, $self->{hold_shelf}[0]->{borrowernumber});
 347         }
 348         return 0;
 349 }
 350
 351 sub _barcode_to_borrowernumber {
 352     my $known = shift;
 353     return unless defined $known;
 354     my $member = GetMember(cardnumber=>$known) or return;
 355     return $member->{borrowernumber};
 356 }
 357 sub barcode_is_borrowernumber {    # because hold_queue only has borrowernumber...
 358     my $self = shift;
 359     my $barcode = shift;
 360     my $number  = shift or return;    # can't be zero
 361     return unless defined $barcode; # might be 0 or 000 or 000000
 362     my $converted = _barcode_to_borrowernumber($barcode);
 363     return unless $converted;
 364     return ($number == $converted);
 365 }
 366 sub fill_reserve {
 367     my $self = shift;
 368     my $hold = shift or return;
 369     foreach (qw(biblionumber borrowernumber reservedate)) {
 370         $hold->{$_} or return;
 371     }
 372     return ModReserveFill($hold);
 373 }
 374 1;
 375 __END__
 376