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