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