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::Context;
  18 use C4::Koha;
  19 use C4::Members;
  20 use Digest::MD5 qw(md5_base64);
  21
  22 our (@ISA, @EXPORT_OK);
  23
  24 @ISA = qw(Exporter);
  25
  26 @EXPORT_OK = qw(invalid_patron);
  27
  28 our %patron_example = (
  29                   djfiander => {
  30                       name => "David J. Fiander",
  31                       id => 'djfiander',
  32                       password => '6789',
  33                       ptype => 'A', # 'A'dult.  Whatever.
  34                       birthdate => '19640925',
  35                       address => '2 Meadowvale Dr. St Thomas, ON',
  36                       home_phone => '(519) 555 1234',
  37                       email_addr => 'djfiander@hotmail.com',
  38                       charge_ok => 1,
  39                       renew_ok => 1,
  40                       recall_ok => 0,
  41                       hold_ok => 1,
  42                       card_lost => 0,
  43                       claims_returned => 0,
  44                       fines => 100,
  45                       fees => 0,
  46                       recall_overdue => 0,
  47                       items_billed => 0,
  48                       screen_msg => '',
  49                       print_line => '',
  50                       items => [],
  51                       hold_items => [],
  52                       overdue_items => [],
  53                       fine_items => ['Computer Time'],
  54                       recall_items => [],
  55                       unavail_holds => [],
  56                       inet => 1,
  57                   },
  58                   );
  59
  60 sub new {
  61     my ($class, $patron_id) = @_;
  62     my $type = ref($class) || $class;
  63     my $self;
  64         my %ilspatron;
  65         my $kp = GetMember($patron_id,'cardnumber');
  66 #       use Data::Dumper;
  67 #       warn Dumper($kp);
  68     if ($kp) {
  69                 my $pw = $kp->{password};    ## FIXME - md5hash -- deal with .
  70                 my $dob= $kp->{dateofbirth};
  71                 $dob =~ s/\-//g;
  72                 my $fines_out = GetMemberAccountRecords($kp->{borrowernumber});
  73                 my ($num_cur_issues,$cur_issues) = GetPendingIssues($kp->{borrowernumber});
  74                 my $debarred = $kp->{debarred}; ### 1 if ($kp->{flags}->{DBARRED}->{noissues});
  75 # warn "i am debarred: $debarred";
  76 #warn Dumper(%{$kp->{flags}});
  77                 my $adr = $kp->{streetnumber} . " ". $kp->{address};
  78                 %ilspatron = (
  79                       name => $kp->{firstname} . " " . $kp->{surname},
  80                       id => $kp->{cardnumber},
  81                       password => $pw,
  82                       ptype => $kp->{categorycode}, # 'A'dult.  Whatever.
  83                       birthdate => $kp->{dateofbirth}, ##$dob,
  84                       address => $adr,
  85                       home_phone => $kp->{phone},
  86                       email_addr => $kp->{email},
  87                       charge_ok => (!$debarred) , ##  (C4::Context->preference('FinesMode') eq 'charge') || 0,
  88                       renew_ok => 1,
  89                           recall_ok => 1,
  90                       hold_ok => 1,
  91                       card_lost => ($kp->{lost} || $kp->{gonenoaddress}) ,
  92                       claims_returned => 0,
  93                       fines => $fines_out,
  94                       fees => 0,
  95                       recall_overdue => 0,
  96                       items_billed => 0,
  97                       screen_msg => 'Greetings from Koha',
  98                       print_line => '',
  99                       items => ['one item','itemstring 2'] ,
 100                       hold_items => [],#$kp->{flags}->{WAITING}{itemlist}->{biblionumber},
 101                       overdue_items =>[], # [$kp->{flags}->{ODUES}{itemlisttext}],   ### FIXME -> this should be array, not texts string.
 102                       fine_items => [],
 103                       recall_items => [],
 104                       unavail_holds => [],
 105                       inet => '',
 106                           );
 107         } else {
 108                 syslog("LOG_DEBUG", "new ILS::Patron(%s): no such patron", $patron_id);
 109                 return undef;
 110     }
 111
 112     $self =  \%ilspatron;
 113 #       warn Dumper($self);
 114
 115     syslog("LOG_DEBUG", "new ILS::Patron(%s): found patron '%s'", $patron_id,$self->{id});
 116
 117     bless $self, $type;
 118     return $self;
 119 }
 120
 121 sub id {
 122     my $self = shift;
 123
 124     return $self->{id};
 125 }
 126
 127 sub name {
 128     my $self = shift;
 129
 130     return $self->{name};
 131 }
 132
 133 sub address {
 134     my $self = shift;
 135
 136     return $self->{address};
 137 }
 138
 139 sub email_addr {
 140     my $self = shift;
 141
 142     return $self->{email_addr};
 143 }
 144
 145 sub home_phone {
 146     my $self = shift;
 147
 148     return $self->{home_phone};
 149 }
 150
 151 sub sip_birthdate {
 152     my $self = shift;
 153
 154     return $self->{birthdate};
 155 }
 156
 157 sub ptype {
 158     my $self = shift;
 159
 160     return $self->{ptype};
 161 }
 162
 163 sub language {
 164     my $self = shift;
 165
 166     return $self->{language} || '000'; # Unspecified
 167 }
 168
 169 sub charge_ok {
 170     my $self = shift;
 171
 172     return $self->{charge_ok};
 173 }
 174
 175 sub renew_ok {
 176     my $self = shift;
 177
 178     return $self->{renew_ok};
 179 }
 180
 181 sub recall_ok {
 182     my $self = shift;
 183
 184     return $self->{recall_ok};
 185 }
 186
 187 sub hold_ok {
 188     my $self = shift;
 189
 190     return $self->{hold_ok};
 191 }
 192
 193 sub card_lost {
 194     my $self = shift;
 195
 196     return $self->{card_lost};
 197 }
 198
 199 sub recall_overdue {
 200     my $self = shift;
 201
 202     return $self->{recall_overdue};
 203 }
 204
 205 sub check_password {
 206     my ($self, $pwd) = @_;
 207         my $md5pwd=$self->{password};  ### FIXME -  we're allowing access if user has no password.
 208         warn "check $self->{password} $pwd";
 209     warn "$self->{name}";
 210         return (!$self->{password} ||  md5_base64($pwd) eq $md5pwd );
 211 }
 212
 213 sub currency {
 214     my $self = shift;
 215
 216     return $self->{currency};
 217 }
 218
 219 sub fee_amount {
 220     my $self = shift;
 221
 222     return $self->{fee_amount} || undef;
 223 }
 224
 225 sub screen_msg {
 226     my $self = shift;
 227
 228     return $self->{screen_msg};
 229 }
 230
 231 sub print_line {
 232     my $self = shift;
 233
 234     return $self->{print_line};
 235 }
 236
 237 sub too_many_charged {
 238     my $self = shift;
 239
 240     return $self->{too_many_charged};
 241 }
 242
 243 sub too_many_overdue {
 244     my $self = shift;
 245
 246     return $self->{too_many_overdue};
 247 }
 248
 249 sub too_many_renewal {
 250     my $self = shift;
 251
 252     return $self->{too_many_renewal};
 253 }
 254
 255 sub too_many_claim_return {
 256     my $self = shift;
 257
 258     return $self->{too_many_claim_return};
 259 }
 260
 261 sub too_many_lost {
 262     my $self = shift;
 263
 264     return $self->{too_many_lost};
 265 }
 266
 267 sub excessive_fines {
 268     my $self = shift;
 269
 270     return $self->{excessive_fines};
 271 }
 272
 273 sub excessive_fees {
 274     my $self = shift;
 275
 276     return $self->{excessive_fees};
 277 }
 278
 279 sub too_many_billed {
 280     my $self = shift;
 281
 282     return $self->{too_many_billed};
 283 }
 284
 285 #
 286 # List of outstanding holds placed
 287 #
 288 sub hold_items {
 289     my ($self, $start, $end) = @_;
 290
 291     $start = 1 if !defined($start);
 292     $end = scalar @{$self->{hold_items}} if !defined($end);
 293
 294     return [@{$self->{hold_items}}[$start-1 .. $end-1]];
 295 }
 296
 297 #
 298 # remove the hold on item item_id from my hold queue.
 299 # return true if I was holding the item, false otherwise.
 300 #
 301 sub drop_hold {
 302     my ($self, $item_id) = @_;
 303     my $i;
 304
 305     for ($i = 0; $i < scalar @{$self->{hold_items}}; $i += 1) {
 306         if ($self->{hold_items}[$i]->{item_id} eq $item_id) {
 307             splice @{$self->{hold_items}}, $i, 1;
 308             return 1;
 309         }
 310     }
 311
 312     return 0;
 313 }
 314
 315 sub overdue_items {
 316     my ($self, $start, $end) = @_;
 317
 318     $start = 1 if !defined($start);
 319     $end = scalar @{$self->{overdue_items}} if !defined($end);
 320
 321     return [@{$self->{overdue_items}}[$start-1 .. $end-1]];
 322 }
 323
 324 sub charged_items {
 325     my ($self, $start, $end) = shift;
 326
 327     $start = 1 if !defined($start);
 328     $end = scalar @{$self->{items}} if !defined($end);
 329
 330     syslog("LOG_DEBUG", "charged_items: start = %d, end = %d", $start, $end);
 331     syslog("LOG_DEBUG", "charged_items: items = (%s)",
 332            join(', ', @{$self->{items}}));
 333
 334         return [@{$self->{items}}[$start-1 .. $end-1]];
 335 }
 336
 337 sub fine_items {
 338     my ($self, $start, $end) = @_;
 339
 340     $start = 1 if !defined($start);
 341     $end = scalar @{$self->{fine_items}} if !defined($end);
 342
 343     return [@{$self->{fine_items}}[$start-1 .. $end-1]];
 344 }
 345
 346 sub recall_items {
 347     my ($self, $start, $end) = @_;
 348
 349     $start = 1 if !defined($start);
 350     $end = scalar @{$self->{recall_items}} if !defined($end);
 351
 352     return [@{$self->{recall_items}}[$start-1 .. $end-1]];
 353 }
 354
 355 sub unavail_holds {
 356     my ($self, $start, $end) = @_;
 357
 358     $start = 1 if !defined($start);
 359     $end = scalar @{$self->{unavail_holds}} if !defined($end);
 360
 361     return [@{$self->{unavail_holds}}[$start-1 .. $end-1]];
 362 }
 363
 364 sub block {
 365     my ($self, $card_retained, $blocked_card_msg) = @_;
 366
 367     foreach my $field ('charge_ok', 'renew_ok', 'recall_ok', 'hold_ok') {
 368         $self->{$field} = 0;
 369     }
 370
 371     $self->{screen_msg} = $blocked_card_msg || "Card Blocked.  Please contact library staff";
 372
 373     return $self;
 374 }
 375
 376 sub enable {
 377     my $self = shift;
 378
 379     foreach my $field ('charge_ok', 'renew_ok', 'recall_ok', 'hold_ok') {
 380         $self->{$field} = 1;
 381     }
 382
 383     syslog("LOG_DEBUG", "Patron(%s)->enable: charge: %s, renew:%s, recall:%s, hold:%s",
 384            $self->{id}, $self->{charge_ok}, $self->{renew_ok},
 385            $self->{recall_ok}, $self->{hold_ok});
 386
 387     $self->{screen_msg} = "All privileges restored.";
 388
 389     return $self;
 390 }
 391
 392
 393 sub inet_privileges {
 394     my $self = shift;
 395
 396     return $self->{inet} ? 'Y' : 'N';
 397 }
 398
 399 #
 400 # Messages
 401 #
 402
 403 sub invalid_patron {
 404     return "Please contact library staff";
 405 }
 406
 407 sub charge_denied {
 408     return "Please contact library staff";
 409 }
 410
 411 1;