lib/NCIP/ILS/Evergreen.pm

   1 # ---------------------------------------------------------------
   2 # Copyright © 2014 Jason J.A. Stephenson <jason@sigio.com>
   3 #
   4 # This file is part of NCIPServer.
   5 #
   6 # NCIPServer is free software; you can redistribute it and/or modify
   7 # it under the terms of the GNU General Public License as published by
   8 # the Free Software Foundation; either version 2 of the License, or
   9 # (at your option) any later version.
  10 #
  11 # NCIPServer is distributed in the hope that it will be useful, but
  12 # WITHOUT ANY WARRANTY; without even the implied warranty of
  13 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  14 # General Public License for more details.
  15 #
  16 # You should have received a copy of the GNU General Public License
  17 # along with NCIPServer.  If not, see <http://www.gnu.org/licenses/>.
  18 # ---------------------------------------------------------------
  19 package NCIP::ILS::Evergreen;
  20
  21 use Modern::Perl;
  22 use XML::LibXML::Simple qw(XMLin);
  23 use DateTime;
  24 use DateTime::Format::ISO8601;
  25 use Digest::MD5 qw/md5_hex/;
  26 use OpenSRF::System;
  27 use OpenSRF::Utils qw/:datetime/;
  28 use OpenSRF::Utils::SettingsClient;
  29 use OpenILS::Utils::Fieldmapper;
  30 use OpenILS::Application::AppUtils;
  31 use OpenILS::Const qw/:const/;
  32 use MARC::Record;
  33 use MARC::Field;
  34 use MARC::File::XML;
  35
  36 # We need a bunch of NCIP::* objects.
  37 use NCIP::Response;
  38 use NCIP::Problem;
  39 use NCIP::User;
  40 use NCIP::User::OptionalFields;
  41 use NCIP::User::AddressInformation;
  42 use NCIP::User::Id;
  43 use NCIP::User::BlockOrTrap;
  44 use NCIP::User::Privilege;
  45 use NCIP::User::PrivilegeStatus;
  46 use NCIP::StructuredPersonalUserName;
  47 use NCIP::StructuredAddress;
  48 use NCIP::ElectronicAddress;
  49
  50 # Inherit from NCIP::ILS.
  51 use parent qw(NCIP::ILS);
  52
  53 # Default values we define for things that might be missing in our
  54 # runtime environment or configuration file that absolutely must have
  55 # values.
  56 #
  57 # OILS_NCIP_CONFIG_DEFAULT is the default location to find our
  58 # driver's configuration file.  This location can be overridden by
  59 # setting the path in the OILS_NCIP_CONFIG environment variable.
  60 #
  61 # BIB_SOURCE_DEFAULT is the config.bib_source.id to use when creating
  62 # "short" bibs.  It is used only if no entry is supplied in the
  63 # configuration file.  The provided default is 2, the id of the
  64 # "System Local" source that comes with a default Evergreen
  65 # installation.
  66 use constant {
  67     OILS_NCIP_CONFIG_DEFAULT => '/openils/conf/oils_ncip.xml',
  68     BIB_SOURCE_DEFAULT => 2
  69 };
  70
  71 # A common Evergreen code shortcut to use AppUtils:
  72 my $U = 'OpenILS::Application::AppUtils';
  73
  74 # The usual constructor:
  75 sub new {
  76     my $class = shift;
  77     $class = ref($class) if (ref $class);
  78
  79     # Instantiate our parent with the rest of the arguments.  It
  80     # creates a blessed hashref.
  81     my $self = $class->SUPER::new(@_);
  82
  83     # Look for our configuration file, load, and parse it:
  84     $self->_configure();
  85
  86     # Bootstrap OpenSRF and prepare some OpenILS components.
  87     $self->_bootstrap();
  88
  89     # Initialize the rest of our internal state.
  90     $self->_init();
  91
  92     return $self;
  93 }
  94
  95 sub lookupuser {
  96     my $self = shift;
  97     my $request = shift;
  98
  99     # Check our session and login if necessary.
 100     $self->login() unless ($self->checkauth());
 101
 102     my $message_type = $self->parse_request_type($request);
 103
 104     # Let's go ahead and create our response object. We need this even
 105     # if there is a problem.
 106     my $response = NCIP::Response->new({type => $message_type . "Response"});
 107     $response->header($self->make_header($request));
 108
 109     # Need to parse the request object to get the user barcode.
 110     my ($barcode, $idfield) = $self->find_user_barcode($request);
 111
 112     # If we can't find a barcode, report a problem.
 113     unless ($barcode) {
 114         $idfield = 'AuthenticationInputType' unless ($idfield);
 115         # Fill in a problem object and stuff it in the response.
 116         my $problem = NCIP::Problem->new();
 117         $problem->ProblemType('Needed Data Missing');
 118         $problem->ProblemDetail('Cannot find user barcode in message.');
 119         $problem->ProblemElement($idfield);
 120         $problem->ProblemValue('Barcode');
 121         $response->problem($problem);
 122         return $response;
 123     }
 124
 125     # Look up our patron by barcode:
 126     my $user = $U->simplereq(
 127         'open-ils.actor',
 128         'open-ils.actor.user.fleshed.retrieve_by_barcode',
 129         $self->{session}->{authtoken},
 130         $barcode,
 131         1
 132     );
 133
 134     # Check for a failure, or a deleted, inactive, or expired user,
 135     # and if so, return empty userdata.
 136     if (!$user || $U->event_code($user) || $U->is_true($user->deleted())
 137             || !grep {$_->barcode() eq $barcode && $U->is_true($_->active())} @{$user->cards()}) {
 138
 139         my $problem = NCIP::Problem->new();
 140         $problem->ProblemType('Unknown User');
 141         $problem->ProblemDetail("User with barcode $barcode unknown");
 142         $problem->ProblemElement($idfield);
 143         $problem->ProblemValue($barcode);
 144         $response->problem($problem);
 145         return $response;
 146     }
 147
 148     # We got the information, so lets fill in our userdata.
 149     my $userdata = NCIP::User->new();
 150
 151     # Make an array of the user's active barcodes.
 152     my $ids = [];
 153     foreach my $card (@{$user->cards()}) {
 154         if ($U->is_true($card->active())) {
 155             my $id = NCIP::User::Id->new({
 156                 UserIdentifierType => 'Barcode',
 157                 UserIdentifierValue => $card->barcode()
 158             });
 159             push(@$ids, $id);
 160         }
 161     }
 162     $userdata->UserId($ids);
 163
 164     # Check if they requested any optional fields and return those.
 165     my $elements = $request->{$message_type}->{UserElementType};
 166     if ($elements) {
 167         $elements = [$elements] unless (ref $elements eq 'ARRAY');
 168         my $optionalfields = NCIP::User::OptionalFields->new();
 169
 170         # First, we'll look for name information.
 171         if (grep {$_ eq 'Name Information'} @$elements) {
 172             my $name = NCIP::StructuredPersonalUserName->new();
 173             $name->Surname($user->family_name());
 174             $name->GivenName($user->first_given_name());
 175             $name->Prefix($user->prefix());
 176             $name->Suffix($user->suffix());
 177             $optionalfields->NameInformation($name);
 178         }
 179
 180         # Next, check for user address information.
 181         if (grep {$_ eq 'User Address Information'} @$elements) {
 182             my $addresses = [];
 183
 184             # See if the user has any valid, physcial addresses.
 185             foreach my $addr (@{$user->addresses()}) {
 186                 next if ($U->is_true($addr->pending()));
 187                 my $address = NCIP::User::AddressInformation->new({UserAddressRoleType=>$addr->address_type()});
 188                 my $physical = NCIP::StructuredAddress->new();
 189                 $physical->Line1($addr->street1());
 190                 $physical->Line2($addr->street2());
 191                 $physical->Locality($addr->city());
 192                 $physical->Region($addr->state());
 193                 $physical->PostalCode($addr->post_code());
 194                 $physical->Country($addr->country());
 195                 $address->PhysicalAddress($physical);
 196                 push @$addresses, $address;
 197             }
 198
 199             # Right now, we're only sharing email address if the user
 200             # has it. We don't share phone numbers.
 201             if ($user->email()) {
 202                 my $address = NCIP::User::AddressInformation->new({UserAddressRoleType=>'Email Address'});
 203                 $address->ElectronicAddress(
 204                     NCIP::ElectronicAddress->new({
 205                         Type=>'Email Address',
 206                         Data=>$user->email()
 207                     })
 208                 );
 209                 push @$addresses, $address;
 210             }
 211
 212             $optionalfields->UserAddressInformation($addresses);
 213         }
 214
 215         # Check for User Privilege.
 216         if (grep {$_ eq 'User Privilege'} @$elements) {
 217             # Get the user's group:
 218             my $pgt = $U->simplereq(
 219                 'open-ils.pcrud',
 220                 'open-ils.pcrud.retrieve.pgt',
 221                 $self->{session}->{authtoken},
 222                 $user->profile());
 223             if ($pgt) {
 224                 my $privilege = NCIP::User::Privilege->new();
 225                 $privilege->AgencyId($user->home_ou->shortname());
 226                 $privilege->AgencyUserPrivilegeType($pgt->name());
 227                 $privilege->ValidToDate($user->expire_date());
 228                 $privilege->ValidFromDate($user->create_date());
 229
 230                 my $status = 'Active';
 231                 if (_expired($user)) {
 232                     $status = 'Expired';
 233                 } elsif ($U->is_true($user->barred())) {
 234                     $status = 'Barred';
 235                 } elsif (!$U->is_true($user->active())) {
 236                     $status = 'Inactive';
 237                 }
 238                 if ($status) {
 239                     $privilege->UserPrivilegeStatus(
 240                         NCIP::User::PrivilegeStatus->new({
 241                             UserPrivilegeStatusType => $status
 242                         })
 243                     );
 244                 }
 245
 246                 $optionalfields->UserPrivilege([$privilege]);
 247             }
 248         }
 249
 250         # Check for Block Or Trap.
 251         if (grep {$_ eq 'Block Or Trap'} @$elements) {
 252             my $blocks = [];
 253
 254             # First, let's check if the profile is blocked from ILL.
 255             if (grep {$_->id() == $user->profile()} @{$self->{blocked_profiles}}) {
 256                 my $block = NCIP::User::BlockOrTrap->new();
 257                 $block->AgencyId($user->home_ou->shortname());
 258                 $block->BlockOrTrapType('Block Interlibrary Loan');
 259                 push @$blocks, $block;
 260             }
 261
 262             # Next, we loop through the user's standing penalties
 263             # looking for blocks on CIRC, HOLD, and RENEW.
 264             my ($have_circ, $have_renew, $have_hold) = (0,0,0);
 265             foreach my $penalty (@{$user->standing_penalties()}) {
 266                 next unless($penalty->standing_penalty->block_list());
 267                 my @block_list = split(/\|/, $penalty->standing_penalty->block_list());
 268                 my $ou = $U->simplereq(
 269                     'open-ils.pcrud',
 270                     'open-ils.pcrud.retrieve.aou',
 271                     $self->{session}->{authtoken},
 272                     $penalty->org_unit());
 273
 274                 # Block checkout.
 275                 if (!$have_circ && grep {$_ eq 'CIRC'} @block_list) {
 276                     my $bot = NCIP::User::BlockOrTrap->new();
 277                     $bot->AgencyId($ou->shortname());
 278                     $bot->BlockOrTrapType('Block Checkout');
 279                     push @$blocks, $bot;
 280                     $have_circ = 1;
 281                 }
 282
 283                 # Block holds.
 284                 if (!$have_hold && grep {$_ eq 'HOLD' || $_ eq 'FULFILL'} @block_list) {
 285                     my $bot = NCIP::User::BlockOrTrap->new();
 286                     $bot->AgencyId($ou->shortname());
 287                     $bot->BlockOrTrapType('Block Holds');
 288                     push @$blocks, $bot;
 289                     $have_hold = 1;
 290                 }
 291
 292                 # Block renewals.
 293                 if (!$have_renew && grep {$_ eq 'RENEW'} @block_list) {
 294                     my $bot = NCIP::User::BlockOrTrap->new();
 295                     $bot->AgencyId($ou->shortname());
 296                     $bot->BlockOrTrapType('Block Renewals');
 297                     push @$blocks, $bot;
 298                     $have_renew = 1;
 299                 }
 300
 301                 # Stop after we report one of each, even if more
 302                 # blocks remain.
 303                 last if ($have_circ && $have_renew && $have_hold);
 304             }
 305
 306             $optionalfields->BlockOrTrap($blocks);
 307         }
 308
 309         $userdata->UserOptionalFields($optionalfields);
 310     }
 311
 312     $response->data($userdata);
 313
 314     return $response;
 315 }
 316
 317 # Implementation functions that might be useful to a subclass.
 318
 319 # Login via OpenSRF to Evergreen.
 320 sub login {
 321     my $self = shift;
 322
 323     # Get the authentication seed.
 324     my $seed = $U->simplereq(
 325         'open-ils.auth',
 326         'open-ils.auth.authenticate.init',
 327         $self->{config}->{credentials}->{username}
 328     );
 329
 330     # Actually login.
 331     if ($seed) {
 332         my $response = $U->simplereq(
 333             'open-ils.auth',
 334             'open-ils.auth.authenticate.complete',
 335             {
 336                 username => $self->{config}->{credentials}->{username},
 337                 password => md5_hex(
 338                     $seed . md5_hex($self->{config}->{credentials}->{password})
 339                 ),
 340                 type => 'staff',
 341                 workstation => $self->{config}->{credentials}->{workstation}
 342             }
 343         );
 344         if ($response) {
 345             $self->{session}->{authtoken} = $response->{payload}->{authtoken};
 346             $self->{session}->{authtime} = $response->{payload}->{authtime};
 347         }
 348     }
 349 }
 350
 351 # Return 1 if we have a 'valid' authtoken, 0 if not.
 352 sub checkauth {
 353     my $self = shift;
 354
 355     # We use AppUtils to do the heavy lifting.
 356     if (defined($self->{session})) {
 357         if ($U->check_user_session($self->{session}->{authtoken})) {
 358             return 1;
 359         } else {
 360             return 0;
 361         }
 362     }
 363
 364     # If we reach here, we don't have a session, so we are definitely
 365     # not logged in.
 366     return 0;
 367 }
 368
 369 # private subroutines not meant to be used directly by subclasses.
 370 # Most have to do with setup and/or state checking of implementation
 371 # components.
 372
 373 # Find, load, and parse our configuration file:
 374 sub _configure {
 375     my $self = shift;
 376
 377     # Find the configuration file via variables:
 378     my $file = OILS_NCIP_CONFIG_DEFAULT;
 379     $file = $ENV{OILS_NCIP_CONFIG} if ($ENV{OILS_NCIP_CONFIG});
 380
 381     $self->{config} = XMLin($file, NormaliseSpace => 2,
 382                             ForceArray => ['block_profile', 'stat_cat_entry']);
 383 }
 384
 385 # Bootstrap OpenSRF::System and load the IDL.
 386 sub _bootstrap {
 387     my $self = shift;
 388
 389     my $bootstrap_config = $self->{config}->{bootstrap};
 390     OpenSRF::System->bootstrap_client(config_file => $bootstrap_config);
 391
 392     my $idl = OpenSRF::Utils::SettingsClient->new->config_value("IDL");
 393     Fieldmapper->import(IDL => $idl);
 394 }
 395
 396 # Login and then initialize some object data based on the
 397 # configuration.
 398 sub _init {
 399     my $self = shift;
 400
 401     # Login to Evergreen.
 402     $self->login();
 403
 404     # Retrieve the work_ou as an object.
 405     my $work_ou = $U->simplereq(
 406         'open-ils.pcrud',
 407         'open-ils.pcrud.search.aou',
 408         $self->{session}->{authtoken},
 409         {shortname => $self->{config}->{credentials}->{work_ou}}
 410     );
 411     $self->{work_ou} = $work_ou->[0] if ($work_ou && @$work_ou);
 412
 413     # Load the barred groups as pgt objects into a blocked_profiles
 414     # list.
 415     $self->{blocked_profiles} = [];
 416     foreach (@{$self->{config}->{patrons}->{block_profile}}) {
 417         if (ref $_) {
 418             my $pgt = $U->simplereq(
 419                 'open-ils.pcrud',
 420                 'open-ils.pcrud.retrieve.pgt',
 421                 $self->{session}->{authtoken},
 422                 $_->{grp});
 423             push(@{$self->{blocked_profiles}}, $pgt) if ($pgt);
 424         } else {
 425             my $result = $U->simplereq(
 426                 'open-ils.pcrud',
 427                 'open-ils.pcrud.search.pgt',
 428                 $self->{session}->{authtoken},
 429                 {name => $_});
 430             if ($result && @$result) {
 431                 map {push(@{$self->{blocked_profiles}}, $_)} @$result;
 432             }
 433         }
 434     }
 435
 436     # Load the bib source if we're not using precats.
 437     unless ($self->{config}->{items}->{use_precats}) {
 438         # Retrieve the default
 439         my $cbs = $U->simplereq(
 440             'open-ils.pcrud',
 441             'open-ils.pcrud.retrieve.cbs',
 442             $self->{session}->{authtoken},
 443             BIB_SOURCE_DEFAULT);
 444         my $data = $self->{config}->{items}->{bib_source};
 445         if ($data) {
 446             $data = $data->[0] if (ref($data) eq 'ARRAY');
 447             if (ref $data) {
 448                 my $result = $U->simplereq(
 449                     'open-ils.pcrud',
 450                     'open-ils.pcrud.retrieve.cbs',
 451                     $self->{session}->{authtoken},
 452                     $data->{cbs});
 453                 $cbs = $result if ($result);
 454             } else {
 455                 my $result = $U->simplereq(
 456                     'open-ils.pcrud',
 457                     'open-ils.pcrud.search.cbs',
 458                     $self->{session}->{authtoken},
 459                     {source => $data});
 460                 if ($result && @$result) {
 461                     $cbs = $result->[0]; # Use the first one.
 462                 }
 463             }
 464         }
 465         $self->{bib_source} = $cbs;
 466     }
 467
 468     # Load the required asset.stat_cat_entries:
 469     $self->{stat_cat_entries} = [];
 470     foreach (@{$self->{config}->{items}->{stat_cat_entry}}) {
 471         # Must have the stat_cat attr and the name, so we must have a
 472         # reference.
 473         next unless(ref $_);
 474         # We want to limit the search to the work org and its
 475         # ancestors.
 476         my $ancestors = $U->get_org_ancestors($self->{work_ou}->id());
 477         my $result = $U->simplereq(
 478             'open-ils.cstore',
 479             'open-ils.cstore.direct.asset.stat_cat_entry.search',
 480             {
 481                 stat_cat => $_->{stat_cat},
 482                 value => $_->{content},
 483                 owner => $ancestors
 484             }
 485         );
 486         if ($result && @$result) {
 487             map {push(@{$self->{stat_cat_entries}}, $_)} @$result;
 488         }
 489     }
 490 }
 491
 492 # Standalone, "helper" functions.  These do not take an object or
 493 # class reference.
 494
 495 # Check if a user is past their expiration date.
 496 sub _expired {
 497     my $user = shift;
 498     my $expired = 0;
 499
 500     # Users might not expire.  If so, they have no expire_date.
 501     if ($user->expire_date()) {
 502         my $expires = DateTime::Format::ISO8601->parse_datetime(
 503             cleanse_ISO8601($user->expire_date())
 504         )->epoch();
 505         my $now = DateTime->now()->epoch();
 506         $expired = $now > $expires;
 507     }
 508
 509     return $expired;
 510 }
 511
 512 1;