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::Application::AppUtils;
  18 my $U = 'OpenILS::Application::AppUtils';
  19
  20 our (@ISA, @EXPORT_OK);
  21
  22 @ISA = qw(Exporter);
  23
  24 @EXPORT_OK = qw(invalid_patron);
  25
  26 sub new {
  27     my ($class, $patron_id) = @_;
  28     my $type = ref($class) || $class;
  29     my $self = {};
  30
  31         syslog("LOG_DEBUG", "new OpenILS Patron(%s): searching...", $patron_id);
  32
  33         require OpenILS::Utils::CStoreEditor;
  34         my $e = OpenILS::Utils::CStoreEditor->new;
  35
  36         if(!UNIVERSAL::can($e, 'search_actor_card')) {
  37                 syslog("LOG_WARNING", "Reloading CStoreEditor...");
  38                 delete $INC{'OpenILS/Utils/CStoreEditor.pm'};
  39                 require OpenILS::Utils::CStoreEditor;
  40                 $e = OpenILS::Utils::CStoreEditor->new;
  41         }
  42
  43
  44          my $c = $e->search_actor_card({barcode => $patron_id}, {idlist=>1});
  45          my $user;
  46
  47          if( @$c ) {
  48
  49                 $user = $e->search_actor_user(
  50                         [
  51                                 { card => $$c[0] },
  52                                 {
  53                                         flesh => 1,
  54                                         flesh_fields => {
  55                                                 "au" => [
  56                                                         #"cards",
  57                                                         "card",
  58                                                         "standing_penalties",
  59                                                         "addresses",
  60                                                         "billing_address",
  61                                                         "mailing_address",
  62                                                         #"stat_cat_entries",
  63                                                         'profile',
  64                                                 ]
  65                                         }
  66                                 }
  67                         ]
  68                 );
  69
  70                 $user = (@$user) ? $$user[0] : undef;
  71          }
  72
  73          if(!$user) {
  74                 syslog("LOG_WARNING", "Unable to find patron %s", $patron_id);
  75                 return undef;
  76          }
  77
  78         $self->{user}           = $user;
  79         $self->{id}                     = $patron_id;
  80         $self->{editor} = $e;
  81
  82         syslog("LOG_DEBUG", "new OpenILS Patron(%s): found patron '%s'", $patron_id);
  83
  84         bless $self, $type;
  85         return $self;
  86 }
  87
  88 sub id {
  89     my $self = shift;
  90     return $self->{id};
  91 }
  92
  93 sub name {
  94     my $self = shift;
  95          my $u = $self->{user};
  96          return $u->first_given_name . ' ' .
  97                 $u->second_given_name . ' ' . $u->family_name;
  98 }
  99
 100 sub __addr_string {
 101         my $addr = shift;
 102         return "" unless $addr;
 103         return $addr->street1 .' '.
 104                 $addr->street2 .' '.
 105                 $addr->city .' '.
 106                 $addr->county .' '.
 107                 $addr->state .' '.
 108                 $addr->country .' '.
 109                 $addr->post_code;
 110 }
 111
 112 sub address {
 113         my $self = shift;
 114         my $u = $self->{user};
 115         my $addr = $u->billing_address;
 116         my $str = __addr_string($addr);
 117         my $maddr = $u->mailing_address;
 118         $str .= "\n" . __addr_string($maddr)
 119                 if $maddr and $maddr->id ne $addr->id;
 120         return $str;
 121 }
 122
 123 sub email_addr {
 124     my $self = shift;
 125         return $self->{user}->email;
 126 }
 127
 128 sub home_phone {
 129     my $self = shift;
 130         return $self->{user}->day_phone;
 131 }
 132
 133 sub sip_birthdate {
 134     my $self = shift;
 135         return $self->{user}->dob;
 136 }
 137
 138 sub ptype {
 139     my $self = shift;
 140         return $self->{user}->profile->name;
 141 }
 142
 143 sub language {
 144     my $self = shift;
 145     return '000'; # Unspecified
 146 }
 147
 148 # How much more detail do we need to check here?
 149 sub charge_ok {
 150     my $self = shift;
 151          my $u = $self->{user};
 152          return ($u->barred ne 't') and ($u->card->active ne 'f');
 153 }
 154
 155 # How much more detail do we need to check here?
 156 sub renew_ok {
 157     my $self = shift;
 158          my $u = $self->{user};
 159          return ($u->barred ne 'f') and ($u->card->active ne 'f');
 160 }
 161
 162 sub recall_ok {
 163     my $self = shift;
 164     return 0;
 165 }
 166
 167 sub hold_ok {
 168     my $self = shift;
 169     return 0;
 170 }
 171
 172 # return true if the card provided is marked as lost
 173 sub card_lost {
 174     my $self = shift;
 175     return 0;
 176 }
 177
 178 sub recall_overdue {
 179     my $self = shift;
 180     return 0;
 181 }
 182
 183
 184 sub check_password {
 185         my ($self, $pwd) = @_;
 186         return md5_hex($pwd) eq $self->{user}->passwd;
 187 }
 188
 189
 190 sub currency {
 191         my $self = shift;
 192         return 'usd';
 193 }
 194
 195
 196 sub fee_amount {
 197         my $self = shift;
 198         return 0;
 199 }
 200
 201 sub screen_msg {
 202     my $self = shift;
 203         return '';
 204 }
 205
 206 sub print_line {
 207     my $self = shift;
 208         return '';
 209 }
 210
 211 sub too_many_charged {
 212     my $self = shift;
 213         return 0;
 214 }
 215
 216 sub too_many_overdue {
 217         my $self = shift;
 218         if( $self->{user}->standing_penalties ) {
 219                 return grep { $_->penalty_type eq 'PATRON_EXCEEDS_OVERDUE_COUNT' }
 220                         @{$self->{user}->standing_penalties};
 221         }
 222         return 0;
 223 }
 224
 225 # not completely sure what this means
 226 sub too_many_renewal {
 227     my $self = shift;
 228         return 0;
 229 }
 230
 231 # not relevant, handled by fines/fees
 232 sub too_many_claim_return {
 233     my $self = shift;
 234         return 0;
 235 }
 236
 237 # not relevant, handled by fines/fees
 238 sub too_many_lost {
 239     my $self = shift;
 240         return 0;
 241 }
 242
 243 sub excessive_fines {
 244     my $self = shift;
 245         if( $self->{user}->standing_penalties ) {
 246                 return grep { $_->penalty_type eq 'PATRON_EXCEEDS_FINES' }
 247                         @{$self->{user}->standing_penalties};
 248         }
 249         return 0;
 250 }
 251
 252
 253 # Until someone suggests otherwise, fees and fines are the same
 254
 255 sub excessive_fees {
 256         my $self = shift;
 257         if( $self->{user}->standing_penalties ) {
 258                 return grep { $_->penalty_type eq 'PATRON_EXCEEDS_FINES' }
 259                         @{$self->{user}->standing_penalties};
 260         }
 261         return 0;
 262 }
 263
 264 # not relevant, handled by fines/fees
 265 sub too_many_billed {
 266     my $self = shift;
 267         return 0;
 268 }
 269
 270
 271
 272 #
 273 # List of outstanding holds placed
 274 #
 275 sub hold_items {
 276     my ($self, $start, $end) = @_;
 277
 278          my $holds = $self->{editor}->search_action_hold_request(
 279                 { usr => $self->{user}->id, fulfillment_time => undef }
 280          );
 281
 282         my @holds;
 283         push( @holds, $self->__hold_to_title($_) ) for @$holds;
 284
 285         return (defined $start and defined $end) ?
 286                 [ $holds[($start-1)..($end-1)] ] :
 287                 \@holds;
 288 }
 289
 290 sub __hold_to_title {
 291         my $self = shift;
 292         my $hold = shift;
 293         my $e = $self->{editor};
 294
 295         my( $id, $mods, $title, $volume, $copy );
 296
 297         if( $hold->hold_type eq 'C' ) {
 298                 $copy = $e->retrieve_asset_copy($hold->target);
 299         }
 300
 301         if( $copy || $hold->hold_type eq 'V' ) {
 302                 return $copy->dummy_title if $copy and $copy->call_number == -1;
 303                 $id = ($copy) ? $copy->call_number : $hold->target;
 304                 $volume = $e->retrieve_asset_call_number($id);
 305         }
 306
 307         if( $volume || $hold->hold_type eq 'T' ) {
 308                 $id = ($volume) ? $volume->record : $hold->target;
 309                 $mods = $U->simplereq(
 310                         'open-ils.search',
 311                         'open-ils.search.biblio.record.mods_slim.retrieve', $id );
 312         }
 313
 314         if( $hold->hold_type eq 'M' ) {
 315                 $mods = $U->simplereq(
 316                         'open-ils.search',
 317                         'open-ils.search.biblio.metarecord.mods_slim.retrieve', $hold->target);
 318         }
 319
 320
 321         return ($mods) ? $mods->title : "";
 322 }
 323
 324 #
 325 # remove the hold on item item_id from my hold queue.
 326 # return true if I was holding the item, false otherwise.
 327 #
 328 sub drop_hold {
 329     my ($self, $item_id) = @_;
 330     return 0;
 331 }
 332
 333 sub overdue_items {
 334     my ($self, $start, $end) = @_;
 335          my @overdues;
 336
 337         return (defined $start and defined $end) ?
 338                 [ $overdues[($start-1)..($end-1)] ] :
 339                 \@overdues;
 340 }
 341
 342 sub charged_items {
 343         my ($self, $start, $end) = shift;
 344         my @charges;
 345
 346         return (defined $start and defined $end) ?
 347                 [ $charges[($start-1)..($end-1)] ] :
 348                 \@charges;
 349 }
 350
 351 sub fine_items {
 352         my ($self, $start, $end) = @_;
 353         my @fines;
 354         return (defined $start and defined $end) ?
 355                 [ $fines[($start-1)..($end-1)] ] : \@fines;
 356 }
 357
 358 # not currently supported
 359 sub recall_items {
 360     my ($self, $start, $end) = @_;
 361          return [];
 362 }
 363
 364 sub unavail_holds {
 365         my ($self, $start, $end) = @_;
 366         my @holds;
 367         return (defined $start and defined $end) ?
 368                 [ $holds[($start-1)..($end-1)] ] : \@holds;
 369 }
 370
 371 sub block {
 372     my ($self, $card_retained, $blocked_card_msg) = @_;
 373          # Mark the card as inactive, set patron alert
 374     return $self;
 375 }
 376
 377 # Testing purposes only
 378 sub enable {
 379     my $self = shift;
 380          # Un-mark card as inactive, grep out the patron alert
 381     $self->{screen_msg} = "All privileges restored.";
 382     return $self;
 383 }
 384
 385 #
 386 # Messages
 387 #
 388
 389 sub invalid_patron {
 390     return "Please contact library staff";
 391 }
 392
 393 sub charge_denied {
 394     return "Please contact library staff";
 395 }
 396
 397 1;