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