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