C4/SIP/ILS/Patron.pm

   1 #
   2 # ILS::Patron.pm
   3 #
   4 # A Class for hiding the ILS's concept of the patron from the OpenSIP
   5 # system
   6 #
   7
   8 package ILS::Patron;
   9
  10 use strict;
  11 use warnings;
  12 use Exporter;
  13
  14 use Sys::Syslog qw(syslog);
  15 use Data::Dumper;
  16
  17 use C4::Debug;
  18 use C4::Context;
  19 use C4::Dates;
  20 use C4::Koha;
  21 use C4::Members;
  22 use C4::Reserves;
  23 use Digest::MD5 qw(md5_base64);
  24
  25 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
  26
  27 BEGIN {
  28         $VERSION = 2.02;
  29         @ISA = qw(Exporter);
  30         @EXPORT_OK = qw(invalid_patron);
  31 }
  32
  33 our $kp;        # koha patron
  34
  35 sub new {
  36         my ($class, $patron_id) = @_;
  37     my $type = ref($class) || $class;
  38     my $self;
  39         $kp = GetMember($patron_id,'cardnumber');
  40         $debug and warn "new Patron (GetMember): " . Dumper($kp);
  41     unless (defined $kp) {
  42                 syslog("LOG_DEBUG", "new ILS::Patron(%s): no such patron", $patron_id);
  43                 return undef;
  44         }
  45         $kp = GetMemberDetails(undef,$patron_id);
  46         $debug and warn "new Patron (GetMemberDetails): " . Dumper($kp);
  47         my $pw = $kp->{password};    ## FIXME - md5hash -- deal with .
  48         my $dob= $kp->{dateofbirth};
  49         my $fines_out = GetMemberAccountRecords($kp->{borrowernumber});
  50         my $flags = $kp->{flags}; # or warn "Warning: No flags from patron object for '$patron_id'";
  51         my $debarred = $kp->{debarred}; ### 1 if ($kp->{flags}->{DBARRED}->{noissues});
  52         $debug and warn sprintf("Debarred = %s : ",($debarred||'undef')) . Dumper(%{$kp->{flags}});
  53         my %ilspatron;
  54         my $adr     = $kp->{streetnumber} || '';
  55         my $address = $kp->{address}      || '';
  56         $adr .= ($adr && $address) ? " $address" : $address;
  57         {
  58         no warnings;    # any of these $kp->{fields} being concat'd could be undef
  59         $dob =~ s/\-//g;
  60         %ilspatron = (
  61           getmemberdetails_object => $kp,
  62                 name => $kp->{firstname} . " " . $kp->{surname},
  63                   id => $kp->{cardnumber},                      # to SIP, the id is the BARCODE, not userid
  64                   password => $pw,
  65                      ptype => $kp->{categorycode}, # 'A'dult.  Whatever.
  66                  birthdate => $kp->{dateofbirth}, ##$dob,
  67                 branchcode => $kp->{branchcode},
  68                    address => $adr,
  69                 home_phone => $kp->{phone},
  70                 email_addr => $kp->{email},
  71                  charge_ok => (!$debarred), ##  (C4::Context->preference('FinesMode') eq 'charge') || 0,
  72                   renew_ok => (!$debarred),
  73                  recall_ok => (!$debarred),
  74                    hold_ok => (!$debarred),
  75                  card_lost => ($kp->{lost} || $kp->{gonenoaddress} || $flags->{LOST}) ,
  76                 claims_returned => 0,
  77                 fines => $fines_out,
  78                  fees => 0,                     # currently not distinct from fines
  79                 recall_overdue => 0,
  80                   items_billed => 0,
  81                 screen_msg => 'Greetings from Koha. ' . $kp->{opacnote},
  82                 print_line => '',
  83                         items => [],
  84                    hold_items => $flags->{WAITING}{itemlist},
  85                 overdue_items => $flags->{ODUES}{itemlist},
  86                    fine_items => [],
  87                  recall_items => [],
  88                 unavail_holds => [],
  89                 inet => 1,
  90         );
  91         }
  92         for (qw(CHARGES CREDITS GNA LOST DBARRED NOTES)) {
  93                 ($flags->{$_}) or next;
  94                 $ilspatron{screen_msg} .= ($flags->{$_}->{message} || '') ;
  95                 if ($flags->{$_}->{noissues}){
  96                         foreach my $toggle (qw(charge_ok renew_ok recall_ok hold_ok)) {
  97                                 $ilspatron{$toggle} = 0;
  98                         }
  99                 }
 100         }
 101
 102         # FIXME: populate items fine_items recall_items
 103 #   $ilspatron{hold_items}    = (GetReservesFromBorrowernumber($kp->{borrowernumber},'F'));
 104         $ilspatron{unavail_holds} = [(GetReservesFromBorrowernumber($kp->{borrowernumber}))];
 105         my ($count,$issues) = GetPendingIssues($kp->{borrowernumber});
 106         $ilspatron{items} = $issues;
 107         $self = \%ilspatron;
 108         $debug and warn Dumper($self);
 109     syslog("LOG_DEBUG", "new ILS::Patron(%s): found patron '%s'", $patron_id,$self->{id});
 110     bless $self, $type;
 111     return $self;
 112 }
 113
 114 sub id {
 115     my $self = shift;
 116     return $self->{id};
 117 }
 118 sub name {
 119     my $self = shift;
 120     return $self->{name};
 121 }
 122 sub address {
 123     my $self = shift;
 124     return $self->{address};
 125 }
 126 sub email_addr {
 127     my $self = shift;
 128     return $self->{email_addr};
 129 }
 130 sub home_phone {
 131     my $self = shift;
 132     return $self->{home_phone};
 133 }
 134 sub sip_birthdate {
 135     my $self = shift;
 136     return $self->{birthdate};
 137 }
 138 sub ptype {
 139     my $self = shift;
 140     return $self->{ptype};
 141 }
 142 sub language {
 143     my $self = shift;
 144     return $self->{language} || '000'; # Unspecified
 145 }
 146 sub charge_ok {
 147     my $self = shift;
 148     return $self->{charge_ok};
 149 }
 150 sub renew_ok {
 151     my $self = shift;
 152     return $self->{renew_ok};
 153 }
 154 sub recall_ok {
 155     my $self = shift;
 156     return $self->{recall_ok};
 157 }
 158 sub hold_ok {
 159     my $self = shift;
 160     return $self->{hold_ok};
 161 }
 162 sub card_lost {
 163     my $self = shift;
 164     return $self->{card_lost};
 165 }
 166 sub recall_overdue {
 167     my $self = shift;
 168     return $self->{recall_overdue};
 169 }
 170 sub check_password {
 171     my ($self, $pwd) = @_;
 172         my $md5pwd = $self->{password};
 173         # warn sprintf "check_password for %s: '%s' vs. '%s'",($self->{name}||''),($self->{password}||''),($pwd||'');
 174         (defined $pwd   ) or return 0;          # you gotta give me something (at least ''), or no deal
 175         (defined $md5pwd) or return($pwd eq '');        # if the record has a NULL password, accept '' as match
 176         return (md5_base64($pwd) eq $md5pwd);
 177 }
 178 sub currency {
 179     my $self = shift;
 180     return $self->{currency};
 181 }
 182 sub fee_amount {
 183     my $self = shift;
 184     return $self->{fee_amount} || undef;
 185 }
 186 sub screen_msg {
 187     my $self = shift;
 188     return $self->{screen_msg};
 189 }
 190 sub print_line {
 191     my $self = shift;
 192     return $self->{print_line};
 193 }
 194 sub too_many_charged {
 195     my $self = shift;
 196     return $self->{too_many_charged};
 197 }
 198 sub too_many_overdue {
 199     my $self = shift;
 200     return $self->{too_many_overdue};
 201 }
 202 sub too_many_renewal {
 203     my $self = shift;
 204     return $self->{too_many_renewal};
 205 }
 206 sub too_many_claim_return {
 207     my $self = shift;
 208     return $self->{too_many_claim_return};
 209 }
 210 sub too_many_lost {
 211     my $self = shift;
 212     return $self->{too_many_lost};
 213 }
 214 sub excessive_fines {
 215     my $self = shift;
 216     return $self->{excessive_fines};
 217 }
 218 sub excessive_fees {
 219     my $self = shift;
 220     return $self->{excessive_fees};
 221 }
 222 sub too_many_billed {
 223     my $self = shift;
 224     return $self->{too_many_billed};
 225 }
 226 sub getmemberdetails_object {
 227     my $self = shift;
 228     return $self->{getmemberdetails_object};
 229 }
 230
 231 #
 232 # List of outstanding holds placed
 233 #
 234 sub hold_items {
 235     my ($self, $start, $end) = @_;
 236         $self->{hold_items} or return [];
 237     $start = 1 unless defined($start);
 238     $end = scalar @{$self->{hold_items}} unless defined($end);
 239     return [@{$self->{hold_items}}[$start-1 .. $end-1]];
 240 }
 241
 242 #
 243 # remove the hold on item item_id from my hold queue.
 244 # return true if I was holding the item, false otherwise.
 245 #
 246 sub drop_hold {
 247     my ($self, $item_id) = @_;
 248         $item_id or return undef;
 249         my $result = 0;
 250         foreach (qw(hold_items unavail_holds)) {
 251                 $self->{$_} or next;
 252                 for (my $i = 0; $i < scalar @{$self->{$_}}; $i++) {
 253                         my $held_item = $self->{$_}[$i]->{item_id} or next;
 254                         if ($held_item eq $item_id) {
 255                                 splice @{$self->{$_}}, $i, 1;
 256                                 $result++;
 257                         }
 258                 }
 259         }
 260     return $result;
 261 }
 262
 263 sub overdue_items {
 264     my ($self, $start, $end) = @_;
 265         $self->{overdue_items} or return [];
 266     $start = 1 if !defined($start);
 267     $end = scalar @{$self->{overdue_items}} if !defined($end);
 268     return [@{$self->{overdue_items}}[$start-1 .. $end-1]];
 269 }
 270
 271 sub charged_items {
 272     my ($self, $start, $end) = shift;
 273         $self->{items} or return [];
 274     $start = 1 if !defined($start);
 275     $end = scalar @{$self->{items}} if !defined($end);
 276     syslog("LOG_DEBUG", "charged_items: start = %d, end = %d; items(%s)",
 277                         $start, $end, join(', ', @{$self->{items}}));
 278         return [@{$self->{items}}[$start-1 .. $end-1]];
 279 }
 280
 281 sub fine_items {
 282     my ($self, $start, $end) = @_;
 283         $self->{fine_items} or return [];
 284     $start = 1 if !defined($start);
 285     $end = scalar @{$self->{fine_items}} if !defined($end);
 286     return [@{$self->{fine_items}}[$start-1 .. $end-1]];
 287 }
 288
 289 sub recall_items {
 290     my ($self, $start, $end) = @_;
 291         $self->{recall_items} or return [];
 292     $start = 1 if !defined($start);
 293     $end = scalar @{$self->{recall_items}} if !defined($end);
 294     return [@{$self->{recall_items}}[$start-1 .. $end-1]];
 295 }
 296
 297 sub unavail_holds {
 298     my ($self, $start, $end) = @_;
 299         $self->{unavail_holds} or return [];
 300     $start = 1 if !defined($start);
 301     $end = scalar @{$self->{unavail_holds}} if !defined($end);
 302     return [@{$self->{unavail_holds}}[$start-1 .. $end-1]];
 303 }
 304
 305 sub block {
 306     my ($self, $card_retained, $blocked_card_msg) = @_;
 307     foreach my $field ('charge_ok', 'renew_ok', 'recall_ok', 'hold_ok') {
 308                 $self->{$field} = 0;
 309     }
 310     $self->{screen_msg} = $blocked_card_msg || "Card Blocked.  Please contact library staff";
 311     return $self;
 312 }
 313
 314 sub enable {
 315     my $self = shift;
 316     foreach my $field ('charge_ok', 'renew_ok', 'recall_ok', 'hold_ok') {
 317                 $self->{$field} = 1;
 318     }
 319     syslog("LOG_DEBUG", "Patron(%s)->enable: charge: %s, renew:%s, recall:%s, hold:%s",
 320            $self->{id}, $self->{charge_ok}, $self->{renew_ok},
 321            $self->{recall_ok}, $self->{hold_ok});
 322     $self->{screen_msg} = "All privileges restored.";
 323     return $self;
 324 }
 325
 326 sub inet_privileges {
 327     my $self = shift;
 328     return $self->{inet} ? 'Y' : 'N';
 329 }
 330
 331 #
 332 # Messages
 333 #
 334
 335 sub invalid_patron {
 336     return "Please contact library staff";
 337 }
 338
 339 sub charge_denied {
 340     return "Please contact library staff";
 341 }
 342
 343 1;
 344 __END__
 345
 346 =head2 EXAMPLES
 347
 348 our %patron_example = (
 349                   djfiander => {
 350                       name => "David J. Fiander",
 351                       id => 'djfiander',
 352                       password => '6789',
 353                       ptype => 'A', # 'A'dult.  Whatever.
 354                       birthdate => '19640925',
 355                       address => '2 Meadowvale Dr. St Thomas, ON',
 356                       home_phone => '(519) 555 1234',
 357                       email_addr => 'djfiander@hotmail.com',
 358                       charge_ok => 1,
 359                       renew_ok => 1,
 360                       recall_ok => 0,
 361                       hold_ok => 1,
 362                       card_lost => 0,
 363                       claims_returned => 0,
 364                       fines => 100,
 365                       fees => 0,
 366                       recall_overdue => 0,
 367                       items_billed => 0,
 368                       screen_msg => '',
 369                       print_line => '',
 370                       items => [],
 371                       hold_items => [],
 372                       overdue_items => [],
 373                       fine_items => ['Computer Time'],
 374                       recall_items => [],
 375                       unavail_holds => [],
 376                       inet => 1,
 377                   },
 378   );
 379
 380 From borrowers table:
 381 +---------------------+--------------+------+-----+
 382 | Field               | Type         | Null | Key |
 383 +---------------------+--------------+------+-----+
 384 | borrowernumber      | int(11)      | NO   | PRI |
 385 | cardnumber          | varchar(16)  | YES  | UNI |
 386 | surname             | mediumtext   | NO   |     |
 387 | firstname           | text         | YES  |     |
 388 | title               | mediumtext   | YES  |     |
 389 | othernames          | mediumtext   | YES  |     |
 390 | initials            | text         | YES  |     |
 391 | streetnumber        | varchar(10)  | YES  |     |
 392 | streettype          | varchar(50)  | YES  |     |
 393 | address             | mediumtext   | NO   |     |
 394 | address2            | text         | YES  |     |
 395 | city                | mediumtext   | NO   |     |
 396 | zipcode             | varchar(25)  | YES  |     |
 397 | email               | mediumtext   | YES  |     |
 398 | phone               | text         | YES  |     |
 399 | mobile              | varchar(50)  | YES  |     |
 400 | fax                 | mediumtext   | YES  |     |
 401 | emailpro            | text         | YES  |     |
 402 | phonepro            | text         | YES  |     |
 403 | B_streetnumber      | varchar(10)  | YES  |     |
 404 | B_streettype        | varchar(50)  | YES  |     |
 405 | B_address           | varchar(100) | YES  |     |
 406 | B_city              | mediumtext   | YES  |     |
 407 | B_zipcode           | varchar(25)  | YES  |     |
 408 | B_email             | text         | YES  |     |
 409 | B_phone             | mediumtext   | YES  |     |
 410 | dateofbirth         | date         | YES  |     |
 411 | branchcode          | varchar(10)  | NO   | MUL |
 412 | categorycode        | varchar(10)  | NO   | MUL |
 413 | dateenrolled        | date         | YES  |     |
 414 | dateexpiry          | date         | YES  |     |
 415 | gonenoaddress       | tinyint(1)   | YES  |     |
 416 | lost                | tinyint(1)   | YES  |     |
 417 | debarred            | tinyint(1)   | YES  |     |
 418 | contactname         | mediumtext   | YES  |     |
 419 | contactfirstname    | text         | YES  |     |
 420 | contacttitle        | text         | YES  |     |
 421 | guarantorid         | int(11)      | YES  |     |
 422 | borrowernotes       | mediumtext   | YES  |     |
 423 | relationship        | varchar(100) | YES  |     |
 424 | ethnicity           | varchar(50)  | YES  |     |
 425 | ethnotes            | varchar(255) | YES  |     |
 426 | sex                 | varchar(1)   | YES  |     |
 427 | password            | varchar(30)  | YES  |     |
 428 | flags               | int(11)      | YES  |     |
 429 | userid              | varchar(30)  | YES  | MUL |
 430 | opacnote            | mediumtext   | YES  |     |
 431 | contactnote         | varchar(255) | YES  |     |
 432 | sort1               | varchar(80)  | YES  |     |
 433 | sort2               | varchar(80)  | YES  |     |
 434 | altcontactfirstname | varchar(255) | YES  |     |
 435 | altcontactsurname   | varchar(255) | YES  |     |
 436 | altcontactaddress1  | varchar(255) | YES  |     |
 437 | altcontactaddress2  | varchar(255) | YES  |     |
 438 | altcontactaddress3  | varchar(255) | YES  |     |
 439 | altcontactzipcode   | varchar(50)  | YES  |     |
 440 | altcontactphone     | varchar(50)  | YES  |     |
 441 +---------------------+--------------+------+-----+
 442
 443 From C4::Members
 444
 445 $flags->{KEY}
 446 {CHARGES}
 447         {message}     Message showing patron's credit or debt
 448         {noissues}    Set if patron owes >$5.00
 449 {GNA}           Set if patron gone w/o address
 450         {message}     "Borrower has no valid address"
 451         {noissues}    Set.
 452 {LOST}          Set if patron's card reported lost
 453         {message}     Message to this effect
 454         {noissues}    Set.
 455 {DBARRED}       Set if patron is debarred
 456         {message}     Message to this effect
 457         {noissues}    Set.
 458 {NOTES}         Set if patron has notes
 459         {message}     Notes about patron
 460 {ODUES}         Set if patron has overdue books
 461         {message}     "Yes"
 462         {itemlist}    ref-to-array: list of overdue books
 463         {itemlisttext}    Text list of overdue items
 464 {WAITING}       Set if there are items available that the patron reserved
 465         {message}     Message to this effect
 466         {itemlist}    ref-to-array: list of available items
 467
 468 =cut
 469