Open-ILS/src/perlmods/OpenILS/SIP/Patron.pm

   1 #
   2 #
   3 # A Class for hiding the ILS's concept of the patron from the OpenSIP
   4 # system
   5 #
   6
   7 package OpenILS::SIP::Patron;
   8
   9 use strict;
  10 use warnings;
  11 use Exporter;
  12
  13 use Sys::Syslog qw(syslog);
  14 use Data::Dumper;
  15 use Digest::MD5 qw(md5_hex);
  16
  17 use OpenILS::SIP;
  18 use OpenILS::Application::AppUtils;
  19 use OpenILS::Application::Actor;
  20 my $U = 'OpenILS::Application::AppUtils';
  21
  22 our (@ISA, @EXPORT_OK);
  23
  24 @ISA = qw(Exporter);
  25
  26 @EXPORT_OK = qw(invalid_patron);
  27
  28 sub new {
  29     my ($class, $patron_id) = @_;
  30     my $type = ref($class) || $class;
  31     my $self = {};
  32
  33         syslog("LOG_DEBUG", "new OpenILS Patron(%s): searching...", $patron_id);
  34
  35         my $e = OpenILS::SIP->editor();
  36
  37         my $c = $e->search_actor_card({barcode => $patron_id}, {idlist=>1});
  38         my $user;
  39
  40         if( @$c ) {
  41
  42                 $user = $e->search_actor_user(
  43                         [
  44                                 { card => $$c[0] },
  45                                 {
  46                                         flesh => 1,
  47                                         flesh_fields => {
  48                                                 "au" => [
  49                                                         #"cards",
  50                                                         "card",
  51                                                         "standing_penalties",
  52                                                         "addresses",
  53                                                         "billing_address",
  54                                                         "mailing_address",
  55                                                         #"stat_cat_entries",
  56                                                         'profile',
  57                                                 ]
  58                                         }
  59                                 }
  60                         ]
  61                 );
  62
  63                 $user = (@$user) ? $$user[0] : undef;
  64          }
  65
  66          if(!$user) {
  67                 syslog("LOG_WARNING", "Unable to find patron %s", $patron_id);
  68                 return undef;
  69          }
  70
  71         $self->{user}           = $user;
  72         $self->{id}                     = $patron_id;
  73         $self->{editor} = $e;
  74
  75         syslog("LOG_DEBUG", "new OpenILS Patron(%s): found patron : barred=%s, card:active=%s",
  76                 $patron_id, $self->{user}->barred, $self->{user}->card->active );
  77
  78         bless $self, $type;
  79         return $self;
  80 }
  81
  82 sub id {
  83     my $self = shift;
  84     return $self->{id};
  85 }
  86
  87 sub name {
  88     my $self = shift;
  89          my $u = $self->{user};
  90          return $u->first_given_name . ' ' .
  91                 $u->second_given_name . ' ' . $u->family_name;
  92 }
  93
  94 sub __addr_string {
  95         my $addr = shift;
  96         return "" unless $addr;
  97         return $addr->street1 .' '.
  98                 $addr->street2 .' '.
  99                 $addr->city .' '.
 100                 $addr->county .' '.
 101                 $addr->state .' '.
 102                 $addr->country .' '.
 103                 $addr->post_code;
 104 }
 105
 106 sub address {
 107         my $self = shift;
 108         my $u = $self->{user};
 109         my $addr = $u->billing_address;
 110         my $str = __addr_string($addr);
 111         my $maddr = $u->mailing_address;
 112         $str .= "\n" . __addr_string($maddr)
 113                 if $maddr and $maddr->id ne $addr->id;
 114         return $str;
 115 }
 116
 117 sub email_addr {
 118     my $self = shift;
 119         return $self->{user}->email;
 120 }
 121
 122 sub home_phone {
 123     my $self = shift;
 124         return $self->{user}->day_phone;
 125 }
 126
 127 sub sip_birthdate {
 128     my $self = shift;
 129         return $self->{user}->dob;
 130 }
 131
 132 sub ptype {
 133     my $self = shift;
 134         return $self->{user}->profile->name;
 135 }
 136
 137 sub language {
 138     my $self = shift;
 139     return '000'; # Unspecified
 140 }
 141
 142 # How much more detail do we need to check here?
 143 sub charge_ok {
 144     my $self = shift;
 145          my $u = $self->{user};
 146          return (($u->barred eq 'f') and ($u->card->active eq 't'));
 147 }
 148
 149 # How much more detail do we need to check here?
 150 sub renew_ok {
 151     my $self = shift;
 152          return $self->charge_ok;
 153 }
 154
 155 sub recall_ok {
 156     my $self = shift;
 157     return 0;
 158 }
 159
 160 sub hold_ok {
 161     my $self = shift;
 162     return 0;
 163 }
 164
 165 # return true if the card provided is marked as lost
 166 sub card_lost {
 167     my $self = shift;
 168     return 0;
 169 }
 170
 171 sub recall_overdue {
 172     my $self = shift;
 173     return 0;
 174 }
 175
 176
 177 sub check_password {
 178         my ($self, $pwd) = @_;
 179         return md5_hex($pwd) eq $self->{user}->passwd;
 180 }
 181
 182
 183 sub currency {
 184         my $self = shift;
 185         return 'USD';
 186 }
 187
 188 sub fee_amount {
 189         my $self = shift;
 190         return 0;
 191 }
 192
 193 sub screen_msg {
 194     my $self = shift;
 195         return '';
 196 }
 197
 198 sub print_line {
 199     my $self = shift;
 200         return '';
 201 }
 202
 203 sub too_many_charged {
 204     my $self = shift;
 205         return 0;
 206 }
 207
 208 sub too_many_overdue {
 209         my $self = shift;
 210         if( $self->{user}->standing_penalties ) {
 211                 return grep { $_->penalty_type eq 'PATRON_EXCEEDS_OVERDUE_COUNT' }
 212                         @{$self->{user}->standing_penalties};
 213         }
 214         return 0;
 215 }
 216
 217 # not completely sure what this means
 218 sub too_many_renewal {
 219     my $self = shift;
 220         return 0;
 221 }
 222
 223 # not relevant, handled by fines/fees
 224 sub too_many_claim_return {
 225     my $self = shift;
 226         return 0;
 227 }
 228
 229 # not relevant, handled by fines/fees
 230 sub too_many_lost {
 231     my $self = shift;
 232         return 0;
 233 }
 234
 235 sub excessive_fines {
 236     my $self = shift;
 237         if( $self->{user}->standing_penalties ) {
 238                 return grep { $_->penalty_type eq 'PATRON_EXCEEDS_FINES' }
 239                         @{$self->{user}->standing_penalties};
 240         }
 241         return 0;
 242 }
 243
 244
 245 # Until someone suggests otherwise, fees and fines are the same
 246
 247 sub excessive_fees {
 248         my $self = shift;
 249         if( $self->{user}->standing_penalties ) {
 250                 return grep { $_->penalty_type eq 'PATRON_EXCEEDS_FINES' }
 251                         @{$self->{user}->standing_penalties};
 252         }
 253         return 0;
 254 }
 255
 256 # not relevant, handled by fines/fees
 257 sub too_many_billed {
 258     my $self = shift;
 259         return 0;
 260 }
 261
 262
 263
 264 #
 265 # List of outstanding holds placed
 266 #
 267 sub hold_items {
 268     my ($self, $start, $end) = @_;
 269
 270          my $holds = $self->{editor}->search_action_hold_request(
 271                 { usr => $self->{user}->id, fulfillment_time => undef }
 272          );
 273
 274         my @holds;
 275         push( @holds, $self->__hold_to_title($_) ) for @$holds;
 276
 277         return (defined $start and defined $end) ?
 278                 [ $holds[($start-1)..($end-1)] ] :
 279                 \@holds;
 280 }
 281
 282 sub __hold_to_title {
 283         my $self = shift;
 284         my $hold = shift;
 285         my $e = $self->{editor};
 286
 287         my( $id, $mods, $title, $volume, $copy );
 288
 289         return __copy_to_title($e,
 290                 $e->retrieve_asset_copy($hold->target))
 291                 if $hold->hold_type eq 'C';
 292
 293         return __volume_to_title($e,
 294                 $e->retrieve_asset_call_number($hold->target))
 295                 if $hold->hold_type eq 'V';
 296
 297         return __record_to_title(
 298                 $e, $hold->target) if $hold->hold_type eq 'T';
 299
 300         return __metarecord_to_title(
 301                 $e, $hold->target) if $hold->hold_type eq 'M';
 302 }
 303
 304 sub __copy_to_title {
 305         my( $e, $copy ) = @_;
 306         syslog('LOG_DEBUG', "copy_to_title(%s)", $copy->id);
 307         return $copy->dummy_title if $copy->call_number == -1;
 308         my $vol = $e->retrieve_asset_call_number($copy->call_number);
 309         return __volume_to_title($e, $vol);
 310 }
 311
 312
 313 sub __volume_to_title {
 314         my( $e, $volume ) = @_;
 315         syslog('LOG_DEBUG', "volume_to_title(%s)", $volume->id);
 316         return __record_to_title($e, $volume->record);
 317 }
 318
 319
 320 sub __record_to_title {
 321         my( $e, $title_id ) = @_;
 322         syslog('LOG_DEBUG', "record_to_title($title_id)");
 323         my $mods = $U->simplereq(
 324                 'open-ils.search',
 325                 'open-ils.search.biblio.record.mods_slim.retrieve', $title_id );
 326         return ($mods) ? $mods->title : "";
 327 }
 328
 329 sub __metarecord_to_title {
 330         my( $e, $m_id ) = @_;
 331         syslog('LOG_DEBUG', "metarecord_to_title($m_id)");
 332         my $mods = $U->simplereq(
 333                 'open-ils.search',
 334                 'open-ils.search.biblio.metarecord.mods_slim.retrieve', $m_id);
 335         return ($mods) ? $mods->title : "";
 336 }
 337
 338
 339 #
 340 # remove the hold on item item_id from my hold queue.
 341 # return true if I was holding the item, false otherwise.
 342 #
 343 sub drop_hold {
 344     my ($self, $item_id) = @_;
 345     return 0;
 346 }
 347
 348 sub __patron_items_info {
 349         my $self = shift;
 350         return if $self->{items_info};
 351         $self->{item_info} =
 352                 OpenILS::Application::Actor::_checked_out(
 353                         0, $self->{editor}, $self->{user}->id);;
 354 }
 355
 356 sub overdue_items {
 357         my ($self, $start, $end) = @_;
 358
 359         $self->__patron_items_info();
 360         my @overdues = @{$self->{item_info}->{overdue}};
 361         #$overdues[$_] = __circ_to_title($self->{editor}, $overdues[$_]) for @overdues;
 362
 363         my @o;
 364         for my $circid (@overdues) {
 365                 next unless $circid;
 366                 syslog('LOG_DEBUG', "overdue_items() fleshing circ $circid");
 367                 push( @o, __circ_to_title($self->{editor}, $circid) );
 368         }
 369         @overdues = @o;
 370
 371         return (defined $start and defined $end) ?
 372                 [ $overdues[($start-1)..($end-1)] ] : \@overdues;
 373 }
 374
 375 sub __circ_to_title {
 376         my( $e, $circ ) = @_;
 377         return unless $circ;
 378         $circ = $e->retrieve_action_circulation($circ);
 379         return __copy_to_title( $e,
 380                 $e->retrieve_asset_copy($circ->target_copy) );
 381 }
 382
 383 sub charged_items {
 384         my ($self, $start, $end) = shift;
 385
 386         $self->__patron_items_info();
 387
 388         my @charges = (
 389                 @{$self->{item_info}->{out}},
 390                 @{$self->{item_info}->{overdue}}
 391                 );
 392
 393         #$charges[$_] = __circ_to_title($self->{editor}, $charges[$_]) for @charges;
 394
 395         my @c;
 396         for my $circid (@charges) {
 397                 next unless $circid;
 398                 syslog('LOG_DEBUG', "charged_items() fleshing circ $circid");
 399                 push( @c, __circ_to_title($self->{editor}, $circid) );
 400         }
 401         @charges = @c;
 402
 403         return (defined $start and defined $end) ?
 404                 [ $charges[($start-1)..($end-1)] ] :
 405                 \@charges;
 406 }
 407
 408 sub fine_items {
 409         my ($self, $start, $end) = @_;
 410         my @fines;
 411         return (defined $start and defined $end) ?
 412                 [ $fines[($start-1)..($end-1)] ] : \@fines;
 413 }
 414
 415 # not currently supported
 416 sub recall_items {
 417     my ($self, $start, $end) = @_;
 418          return [];
 419 }
 420
 421 sub unavail_holds {
 422         my ($self, $start, $end) = @_;
 423         my @holds;
 424         return (defined $start and defined $end) ?
 425                 [ $holds[($start-1)..($end-1)] ] : \@holds;
 426 }
 427
 428 sub block {
 429         my ($self, $card_retained, $blocked_card_msg) = @_;
 430
 431         my $u = $self->{user};
 432         my $e = $self->{editor};
 433
 434         syslog('LOG_INFO', "Blocking user %s", $u->card->barcode );
 435
 436         if(!$e->{xact}) { $e->reset; $e->{xact} = 1; }
 437
 438         return $self if $u->card->active eq 'f';
 439
 440         $u->card->active('f');
 441         if( ! $e->update_actor_card($u->card) ) {
 442                 syslog('LOG_ERR', "Block card update failed: %s", $e->event->{textcode});
 443                 $e->xact_rollback;
 444                 return $self;
 445         }
 446
 447         # retrieve the un-fleshed user object for update
 448         $u = $e->retrieve_actor_user($u->id);
 449         my $note = $u->alert_message || "";
 450         $note = "CARD BLOCKED BY SELF-CHECK MACHINE\n$note"; # XXX Config option
 451
 452         $u->alert_message($note);
 453
 454         if( ! $e->update_actor_user($u) ) {
 455                 syslog('LOG_ERR', "Block: patron alert update failed: %s", $e->event->{textcode});
 456                 $e->xact_rollback;
 457                 return $self;
 458         }
 459
 460         # stay in synch
 461         $self->{user}->alert_message( $note );
 462
 463         $e->commit; # commits and resets
 464         $self->{editor} = OpenILS::SIP->reset_editor();
 465         return $self;
 466 }
 467
 468 # Testing purposes only
 469 sub enable {
 470     my $self = shift;
 471          # Un-mark card as inactive, grep out the patron alert
 472     $self->{screen_msg} = "All privileges restored.";
 473     return $self;
 474 }
 475
 476 #
 477 # Messages
 478 #
 479
 480 sub invalid_patron {
 481     return "Please contact library staff";
 482 }
 483
 484 sub charge_denied {
 485     return "Please contact library staff";
 486 }
 487
 488 1;