iNCIPit.cgi

   1 #! /usr/bin/perl
   2
   3 # This file is part of iNCIPit
   4 #
   5 # iNCIPit is free software: you can redistribute it and/or modify it
   6 # under the terms of the GNU General Public License as published by
   7 # the Free Software Foundation, either version 2 of the License, or
   8 # (at your option) any later version.
   9 #
  10 # iNCIPit is distributed in the hope that it will be useful, but WITHOUT
  11 # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
  12 # or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public
  13 # License for more details.
  14 #
  15 # You should have received a copy of the GNU General Public License
  16 # along with iNCIPit. If not, see <http://www.gnu.org/licenses/>.
  17
  18 use warnings;
  19 use strict;
  20 use XML::LibXML;
  21 use CGI::XMLPost;
  22 use HTML::Entities;
  23 use CGI::Carp;
  24 use XML::XPath;
  25 use OpenSRF::System;
  26 use OpenSRF::Utils::SettingsClient;
  27 use Digest::MD5 qw/md5_hex/;
  28 use OpenILS::Utils::Fieldmapper;
  29 use OpenILS::Utils::CStoreEditor qw/:funcs/;
  30 use OpenILS::Const qw/:const/;
  31 use Scalar::Util qw(reftype blessed);
  32 use MARC::Record;
  33 use MARC::Field;
  34 use MARC::File::XML;
  35 use POSIX qw/strftime/;
  36 use DateTime;
  37 use Config::Tiny;
  38
  39 my $U = "OpenILS::Application::AppUtils";
  40
  41 my $conf = load_config( 'iNCIPit.ini' );
  42
  43 # reject non-https access unless configured otherwise
  44 unless ($conf->{access}->{permit_plaintext} =~ m/^yes$/i) {
  45     unless ($ENV{HTTPS} eq 'on') {
  46         print "Content-type: text/plain\n\n";
  47         print "Access denied.\n";
  48         exit 0;
  49     }
  50 }
  51
  52 # TODO: support for multiple load balancer IPs
  53 my $lb_ip = $conf->{access}->{load_balancer_ip};
  54
  55 # if we are behind a load balancer, check to see that the
  56 # actual client IP is permitted
  57 if ($lb_ip) {
  58     my @allowed_ips = split(/ *, */, $conf->{access}->{allowed_client_ips});
  59
  60     my $forwarded = $ENV{HTTP_X_FORWARDED_FOR};
  61     my $ok = 0;
  62
  63     foreach my $check_ip (@allowed_ips) {
  64         $ok = 1 if ($check_ip eq $forwarded);
  65     }
  66
  67     # if we have a load balancer IP and are relying on
  68     # X-Forwarded-For, deny requests other than those
  69     # from the load balancer
  70     # TODO: support for chained X-Forwarded-For -- ignore all but last
  71     unless ($ok && $ENV{REMOTE_ADDR} eq $lb_ip) {
  72         print "Content-type: text/plain\n\n";
  73         print "Access denied.\n";
  74         exit 0;
  75     }
  76 }
  77
  78 my $xmlpost = CGI::XMLPost->new();
  79 my $xml     = $xmlpost->data();
  80
  81 # log posted data
  82 # XXX: posted ncip message log filename should be in config.
  83 open POST_DATA, ">>post_data.txt";
  84 print POST_DATA $xml;
  85 close POST_DATA;
  86
  87 # initialize the parser
  88 my $parser = new XML::LibXML;
  89 my $doc = $parser->load_xml( string => $xml );
  90
  91 my %session = login();
  92
  93 if ( defined( $session{authtoken} ) ) {
  94     $doc->exists('/NCIPMessage/LookupUser')           ? lookupUser()       : (
  95     $doc->exists('/NCIPMessage/ItemRequested')        ? item_request()     : (
  96     $doc->exists('/NCIPMessage/ItemShipped')          ? item_shipped()     : (
  97     $doc->exists('/NCIPMessage/ItemCheckedOut')       ? item_checked_out() : (
  98     $doc->exists('/NCIPMessage/CheckOutItem')         ? check_out_item()   : (
  99     $doc->exists('/NCIPMessage/ItemCheckedIn')        ? item_checked_in()  : (
 100     $doc->exists('/NCIPMessage/CheckInItem')          ? check_in_item()    : (
 101     $doc->exists('/NCIPMessage/ItemReceived')         ? item_received()    : (
 102     $doc->exists('/NCIPMessage/AcceptItem')           ? accept_item()      : (
 103     $doc->exists('/NCIPMessage/ItemRequestCancelled') ? item_cancelled()   : (
 104     $doc->exists('/NCIPMessage/ItemRenewed')          ? item_renew()       : (
 105     $doc->exists('/NCIPMessage/RenewItem')            ? renew_item()       :
 106     fail("UNKNOWN NCIPMessage")
 107     )))))))))));
 108
 109     logout();
 110 } else {
 111     fail("Unable to perform action : Unknown Service Request");
 112 }
 113
 114 # load and parse config file
 115 sub load_config {
 116     my $file = shift;
 117
 118     my $Config = Config::Tiny->new;
 119     $Config = Config::Tiny->read( $file ) ||
 120         die( "Error reading config file ", $file, ": ", Config::Tiny->errstr, "\n" );
 121     return $Config;
 122 }
 123
 124 # load and parse userpriv_map file, returning a hashref
 125 sub load_userpriv_map {
 126     my $filename = shift;
 127     my $map = {};
 128     if (open(my $fh, "<", $filename)) {
 129         while (my $entry = <$fh>) {
 130             chomp($entry);
 131             my ($from, $to) = split(m/:/, $entry);
 132             $map->{$from} = $to;
 133         }
 134         close $fh;
 135     }
 136     return $map;
 137 }
 138
 139 sub lookup_userpriv {
 140     my $input = shift;
 141     my $map = shift;
 142     if (defined($map->{$input})) { # if we have a mapping for this profile
 143         return $map->{$input}; # return value from mapping hash
 144     } else {
 145         return $input; # return original value
 146     }
 147 }
 148
 149 sub logit {
 150     my ( $msg, $func, $more_info ) = @_;
 151     open RESP_DATA, ">>resp_data.txt";
 152     print RESP_DATA $msg;
 153     print RESP_DATA $more_info unless !$more_info;
 154     close RESP_DATA;
 155     print $msg || fail($func);
 156 }
 157
 158 sub staff_log {
 159     my ( $taiv, $faiv, $more_info ) = @_;
 160     my $now = localtime();
 161     open STAFF_LOG, ">>staff_data.csv";
 162     print STAFF_LOG "$now, $faiv, $taiv, $more_info\n";
 163     close STAFF_LOG;
 164 }
 165
 166 sub item_renew {
 167     my $faidSchemeX = $doc->findvalue('/NCIPMessage/ItemRenewed/InitiationHeader/FromAgencyId/UniqueAgencyId/Scheme');
 168     my $faidScheme = HTML::Entities::encode($faidSchemeX);
 169     my $faidValue  = $doc->find('/NCIPMessage/ItemRenewed/InitiationHeader/FromAgencyId/UniqueAgencyId/Value');
 170     my $taidSchemeX = $doc->findvalue('/NCIPMessage/ItemRenewed/InitiationHeader/ToAgencyId/UniqueAgencyId/Scheme');
 171     my $taidScheme = HTML::Entities::encode($taidSchemeX);
 172     my $taidValue  = $doc->find('/NCIPMessage/ItemRenewed/InitiationHeader/ToAgencyId/UniqueAgencyId/Value');
 173
 174     my $pid = $doc->findvalue('/NCIPMessage/ItemRenewed/UniqueUserId/UserIdentifierValue');
 175     my $visid = $doc->findvalue('/NCIPMessage/ItemRenewed/ItemOptionalFields/ItemDescription/VisibleItemId/VisibleItemIdentifier') . $faidValue;
 176     my $due_date = $doc->findvalue('/NCIPMessage/ItemRenewed/DateDue');
 177
 178     my $r = renewal( $visid, $due_date );
 179
 180     my $hd = <<ITEMRENEWAL;
 181 Content-type: text/xml
 182
 183
 184 <!DOCTYPE NCIPMessage PUBLIC "-//NISO//NCIP DTD Version 1.0//EN" "http://www.niso.org/ncip/v1_0/imp1/dtd/ncip_v1_0.dtd">
 185 <NCIPMessage version="http://www.niso.org/ncip/v1_0/imp1/dtd/ncip_v1_0.dtd">
 186     <ItemRenewedResponse>
 187         <ResponseHeader>
 188             <FromAgencyId>
 189                 <UniqueAgencyId>
 190                     <Scheme>$faidScheme</Scheme>
 191                     <Value>$faidValue</Value>
 192                 </UniqueAgencyId>
 193             </FromAgencyId>
 194             <ToAgencyId>
 195                 <UniqueAgencyId>
 196                     <Scheme>$taidScheme</Scheme>
 197                     <Value>$taidValue</Value>
 198                 </UniqueAgencyId>
 199             </ToAgencyId>
 200         </ResponseHeader>
 201         <UniqueItemId>
 202             <ItemIdentifierValue datatype="string">$visid</ItemIdentifierValue>
 203         </UniqueItemId>
 204     </ItemRenewedResponse>
 205 </NCIPMessage>
 206
 207 ITEMRENEWAL
 208
 209     my $more_info = <<MOREINFO;
 210
 211 VISID             = $visid
 212 Desired Due Date     = $due_date
 213
 214 MOREINFO
 215
 216     logit( $hd, ( caller(0) )[3], $more_info );
 217     staff_log( $taidValue, $faidValue,
 218             "ItemRenewal -> Patronid : "
 219           . $pid
 220           . " | Visid : "
 221           . $visid
 222           . " | Due Date : "
 223           . $due_date );
 224 }
 225
 226 sub renew_item {
 227     my $faidSchemeX = $doc->findvalue('/NCIPMessage/RenewItem/InitiationHeader/FromAgencyId/UniqueAgencyId/Scheme');
 228     my $faidScheme = HTML::Entities::encode($faidSchemeX);
 229     my $faidValue  = $doc->find('/NCIPMessage/RenewItem/InitiationHeader/FromAgencyId/UniqueAgencyId/Value');
 230     my $taidSchemeX = $doc->findvalue('/NCIPMessage/RenewItem/InitiationHeader/ToAgencyId/UniqueAgencyId/Scheme');
 231     my $taidScheme = HTML::Entities::encode($taidSchemeX);
 232     my $taidValue  = $doc->find('/NCIPMessage/RenewItem/InitiationHeader/ToAgencyId/UniqueAgencyId/Value');
 233
 234     my $pid = $doc->findvalue('/NCIPMessage/RenewItem/UniqueUserId/UserIdentifierValue');
 235     my $unique_item_id = $doc->findvalue('/NCIPMessage/RenewItem/UniqueItemId/ItemIdentifierValue');
 236     my $due_date = $doc->findvalue('/NCIPMessage/RenewItem/DateDue');
 237
 238     # we are using the UniqueItemId value as a barcode here
 239     my $r = renewal( $unique_item_id, $due_date );
 240
 241     my $hd = <<ITEMRENEWAL;
 242 Content-type: text/xml
 243
 244
 245 <!DOCTYPE NCIPMessage PUBLIC "-//NISO//NCIP DTD Version 1.0//EN" "http://www.niso.org/ncip/v1_0/imp1/dtd/ncip_v1_0.dtd">
 246 <NCIPMessage version="http://www.niso.org/ncip/v1_0/imp1/dtd/ncip_v1_0.dtd">
 247     <RenewItemResponse>
 248         <ResponseHeader>
 249             <FromAgencyId>
 250                 <UniqueAgencyId>
 251                     <Scheme>$faidScheme</Scheme>
 252                     <Value>$faidValue</Value>
 253                 </UniqueAgencyId>
 254             </FromAgencyId>
 255             <ToAgencyId>
 256                 <UniqueAgencyId>
 257                     <Scheme>$taidScheme</Scheme>
 258                     <Value>$taidValue</Value>
 259                 </UniqueAgencyId>
 260             </ToAgencyId>
 261         </ResponseHeader>
 262         <UniqueItemId>
 263             <ItemIdentifierValue datatype="string">$unique_item_id</ItemIdentifierValue>
 264         </UniqueItemId>
 265     </RenewItemResponse>
 266 </NCIPMessage>
 267
 268 ITEMRENEWAL
 269
 270     my $more_info = <<MOREINFO;
 271
 272 UNIQUEID             = $unique_item_id
 273 Desired Due Date     = $due_date
 274
 275 MOREINFO
 276
 277     logit( $hd, ( caller(0) )[3], $more_info );
 278     staff_log( $taidValue, $faidValue,
 279             "RenewItem -> Patronid : "
 280           . $pid
 281           . " | Uniqueid: : "
 282           . $unique_item_id
 283           . " | Due Date : "
 284           . $due_date );
 285 }
 286
 287 sub accept_item {
 288     my $faidSchemeX = $doc->findvalue('/NCIPMessage/AcceptItem/InitiationHeader/FromAgencyId/UniqueAgencyId/Scheme');
 289     my $faidScheme = HTML::Entities::encode($faidSchemeX);
 290     my $faidValue  = $doc->find('/NCIPMessage/AcceptItem/InitiationHeader/FromAgencyId/UniqueAgencyId/Value');
 291     my $taidSchemeX = $doc->findvalue('/NCIPMessage/AcceptItem/InitiationHeader/ToAgencyId/UniqueAgencyId/Scheme');
 292     my $taidScheme = HTML::Entities::encode($taidSchemeX);
 293     my $taidValue  = $doc->find('/NCIPMessage/AcceptItem/InitiationHeader/ToAgencyId/UniqueAgencyId/Value');
 294     my $visid = $doc->findvalue('/NCIPMessage/AcceptItem/ItemOptionalFields/ItemDescription/VisibleItemId/VisibleItemIdentifier') . $faidValue;
 295     my $request_id = $doc->findvalue('/NCIPMessage/AcceptItem/UniqueRequestId/RequestIdentifierValue') || "unknown";
 296     my $patron = $doc->findvalue('/NCIPMessage/AcceptItem/UserOptionalFields/VisibleUserId/VisibleUserIdentifier');
 297     my $copy = copy_from_barcode($visid);
 298     fail( "accept_item: " . $copy->{textcode} . " $visid" ) unless ( blessed $copy);
 299     my $r2 = update_copy( $copy, $conf->{status}->{hold} ); # put into INN-Reach Hold status
 300
 301 # TODO: this should probably fulfill the original hold, not just change the status.  Eventually we should split the hold type, as holds arriving are not the same as holds needing to be sent
 302
 303     my $hd = <<ACCEPTITEM;
 304 Content-type: text/xml
 305
 306
 307 <!DOCTYPE NCIPMessage PUBLIC "-//NISO//NCIP DTD Version 1.0//EN" "http://www.niso.org/ncip/v1_0/imp1/dtd/ncip_v1_0.dtd">
 308 <NCIPMessage version="http://www.niso.org/ncip/v1_0/imp1/dtd/ncip_v1_0.dtd">
 309     <AcceptItemResponse>
 310         <ResponseHeader>
 311             <FromAgencyId>
 312                 <UniqueAgencyId>
 313                     <Scheme>$faidScheme</Scheme>
 314                     <Value>$faidValue</Value>
 315                 </UniqueAgencyId>
 316             </FromAgencyId>
 317             <ToAgencyId>
 318                 <UniqueAgencyId>
 319                     <Scheme>$taidScheme</Scheme>
 320                     <Value>$taidValue</Value>
 321                 </UniqueAgencyId>
 322             </ToAgencyId>
 323         </ResponseHeader>
 324     <UniqueRequestId>
 325             <ItemIdentifierValue datatype="string">$request_id</ItemIdentifierValue>
 326         </UniqueRequestId>
 327         <UniqueItemId>
 328             <ItemIdentifierValue datatype="string">$visid</ItemIdentifierValue>
 329         </UniqueItemId>
 330     </AcceptItemResponse>
 331 </NCIPMessage>
 332
 333 ACCEPTITEM
 334
 335     logit( $hd, ( caller(0) )[3] );
 336     staff_log( $taidValue, $faidValue,
 337         "AcceptItem -> Request Id : " . $request_id . " | Patron Id : " . $patron . " | Visible Id :" . $visid );
 338 }
 339
 340 sub item_received {
 341     my $faidSchemeX = $doc->findvalue('/NCIPMessage/ItemReceived/InitiationHeader/FromAgencyId/UniqueAgencyId/Scheme');
 342     my $faidScheme = HTML::Entities::encode($faidSchemeX);
 343     my $faidValue = $doc->find('/NCIPMessage/ItemReceived/InitiationHeader/FromAgencyId/UniqueAgencyId/Value');
 344     my $taidSchemeX = $doc->findvalue('/NCIPMessage/ItemReceived/InitiationHeader/ToAgencyId/UniqueAgencyId/Scheme');
 345     my $taidScheme = HTML::Entities::encode($taidSchemeX);
 346     my $taidValue  = $doc->find('/NCIPMessage/ItemReceived/InitiationHeader/ToAgencyId/UniqueAgencyId/Value');
 347     my $visid = $doc->findvalue('/NCIPMessage/ItemReceived/ItemOptionalFields/ItemDescription/VisibleItemId/VisibleItemIdentifier') . $faidValue;
 348     my $copy = copy_from_barcode($visid);
 349     fail( $copy->{textcode} . " $visid" ) unless ( blessed $copy);
 350     my $r1 = checkin($visid) if ( $copy->status == OILS_COPY_STATUS_CHECKED_OUT ); # checkin the item before delete if ItemCheckedIn step was skipped
 351     my $r2 = delete_copy($copy);
 352
 353     my $hd = <<ITEMRECEIVED;
 354 Content-type: text/xml
 355
 356
 357 <!DOCTYPE NCIPMessage PUBLIC "-//NISO//NCIP DTD Version 1.0//EN" "http://www.niso.org/ncip/v1_0/imp1/dtd/ncip_v1_0.dtd">
 358 <NCIPMessage version="http://www.niso.org/ncip/v1_0/imp1/dtd/ncip_v1_0.dtd">
 359     <ItemReceivedResponse>
 360         <ResponseHeader>
 361             <FromAgencyId>
 362                 <UniqueAgencyId>
 363                     <Scheme>$faidScheme</Scheme>
 364                     <Value>$faidValue</Value>
 365                 </UniqueAgencyId>
 366             </FromAgencyId>
 367             <ToAgencyId>
 368                 <UniqueAgencyId>
 369                     <Scheme>$taidScheme</Scheme>
 370                     <Value>$taidValue</Value>
 371                 </UniqueAgencyId>
 372             </ToAgencyId>
 373         </ResponseHeader>
 374         <UniqueItemId>
 375             <ItemIdentifierValue datatype="string">$visid</ItemIdentifierValue>
 376         </UniqueItemId>
 377     </ItemReceivedResponse>
 378 </NCIPMessage>
 379
 380 ITEMRECEIVED
 381
 382     logit( $hd, ( caller(0) )[3] );
 383     staff_log( $taidValue, $faidValue, "ItemReceived -> Visible ID : " . $visid );
 384 }
 385
 386 sub item_cancelled {
 387     my $faidSchemeX = $doc->findvalue('/NCIPMessage/ItemRequestCancelled/InitiationHeader/FromAgencyId/UniqueAgencyId/Scheme');
 388     my $faidScheme = HTML::Entities::encode($faidSchemeX);
 389     my $faidValue  = $doc->find('/NCIPMessage/ItemRequestCancelled/InitiationHeader/FromAgencyId/UniqueAgencyId/Value');
 390
 391     my $taidSchemeX = $doc->findvalue('/NCIPMessage/ItemRequestCancelled/InitiationHeader/ToAgencyId/UniqueAgencyId/Scheme');
 392     my $taidScheme = HTML::Entities::encode($taidSchemeX);
 393     my $taidValue  = $doc->find('/NCIPMessage/ItemRequestCancelled/InitiationHeader/ToAgencyId/UniqueAgencyId/Value');
 394     my $UniqueItemIdAgencyIdValue = $doc->findvalue('/NCIPMessage/ItemRequestCancelled/UniqueItemId/UniqueAgencyId/Value');
 395
 396     my $barcode = $doc->findvalue('/NCIPMessage/ItemRequestCancelled/UniqueItemId/ItemIdentifierValue');
 397
 398     if ( $barcode =~ /^i/ ) {    # delete copy only if barcode is an iNUMBER
 399         $barcode .= $faidValue;
 400         my $copy = copy_from_barcode($barcode);
 401         fail( $copy->{textcode} . " $barcode" ) unless ( blessed $copy);
 402         my $r = delete_copy($copy);
 403     } else {
 404
 405         # remove hold!
 406         my $copy = copy_from_barcode($barcode);
 407         fail( $copy->{textcode} . " $barcode" ) unless ( blessed $copy);
 408         my $r = update_copy( $copy, 0 ); # TODO: we need to actually remove the hold, not just reset to available
 409     }
 410
 411     my $hd = <<ITEMREQUESTCANCELLED;
 412 Content-type: text/xml
 413
 414
 415 <!DOCTYPE NCIPMessage PUBLIC "-//NISO//NCIP DTD Version 1.0//EN" "http://www.niso.org/ncip/v1_0/imp1/dtd/ncip_v1_0.dtd">
 416 <NCIPMessage version="http://www.niso.org/ncip/v1_0/imp1/dtd/ncip_v1_0.dtd">
 417     <ItemRequestCancelledResponse>
 418         <ResponseHeader>
 419             <FromAgencyId>
 420                 <UniqueAgencyId>
 421                     <Scheme>$faidScheme</Scheme>
 422                     <Value>$faidValue</Value>
 423                 </UniqueAgencyId>
 424             </FromAgencyId>
 425             <ToAgencyId>
 426                 <UniqueAgencyId>
 427                     <Scheme>$taidScheme</Scheme>
 428                     <Value>$taidValue</Value>
 429                 </UniqueAgencyId>
 430             </ToAgencyId>
 431         </ResponseHeader>
 432         <UniqueItemId>
 433             <ItemIdentifierValue datatype="string">$barcode</ItemIdentifierValue>
 434         </UniqueItemId>
 435     </ItemRequestCancelledResponse>
 436 </NCIPMessage>
 437
 438 ITEMREQUESTCANCELLED
 439
 440     logit( $hd, ( caller(0) )[3] );
 441     staff_log( $taidValue, $faidValue,
 442         "ItemRequestCancelled -> Barcode : " . $barcode );
 443 }
 444
 445 sub item_checked_in {
 446     my $faidSchemeX = $doc->findvalue('/NCIPMessage/ItemCheckedIn/InitiationHeader/FromAgencyId/UniqueAgencyId/Scheme');
 447     my $faidScheme = HTML::Entities::encode($faidSchemeX);
 448     my $faidValue  = $doc->find('/NCIPMessage/ItemCheckedIn/InitiationHeader/FromAgencyId/UniqueAgencyId/Value');
 449     my $taidSchemeX = $doc->findvalue('/NCIPMessage/ItemCheckedIn/InitiationHeader/ToAgencyId/UniqueAgencyId/Scheme');
 450     my $taidScheme = HTML::Entities::encode($taidSchemeX);
 451     my $taidValue  = $doc->find('/NCIPMessage/ItemCheckedIn/InitiationHeader/ToAgencyId/UniqueAgencyId/Value');
 452
 453     my $visid = $doc->findvalue('/NCIPMessage/ItemCheckedIn/ItemOptionalFields/ItemDescription/VisibleItemId/VisibleItemIdentifier') . $faidValue;
 454     my $r = checkin($visid);
 455     my $copy = copy_from_barcode($visid);
 456     fail( $copy->{textcode} . " $visid" ) unless ( blessed $copy);
 457     my $r2 = update_copy( $copy, $conf->{status}->{transit_return} ); # "INN-Reach Transit Return" status
 458
 459     my $hd = <<ITEMCHECKEDIN;
 460 Content-type: text/xml
 461
 462
 463 <!DOCTYPE NCIPMessage PUBLIC "-//NISO//NCIP DTD Version 1.0//EN" "http://www.niso.org/ncip/v1_0/imp1/dtd/ncip_v1_0.dtd">
 464 <NCIPMessage version="http://www.niso.org/ncip/v1_0/imp1/dtd/ncip_v1_0.dtd">
 465     <ItemCheckedInResponse>
 466         <ResponseHeader>
 467             <FromAgencyId>
 468                 <UniqueAgencyId>
 469                     <Scheme>$faidScheme</Scheme>
 470                     <Value>$faidValue</Value>
 471                 </UniqueAgencyId>
 472             </FromAgencyId>
 473             <ToAgencyId>
 474                 <UniqueAgencyId>
 475                     <Scheme>$taidScheme</Scheme>
 476                     <Value>$taidValue</Value>
 477                 </UniqueAgencyId>
 478             </ToAgencyId>
 479         </ResponseHeader>
 480         <UniqueItemId>
 481             <ItemIdentifierValue datatype="string">$visid</ItemIdentifierValue>
 482         </UniqueItemId>
 483     </ItemCheckedInResponse>
 484 </NCIPMessage>
 485
 486 ITEMCHECKEDIN
 487
 488     logit( $hd, ( caller(0) )[3] );
 489     staff_log( $taidValue, $faidValue, "ItemCheckedIn -> Visible ID : " . $visid );
 490 }
 491
 492 sub item_checked_out {
 493     my $faidSchemeX = $doc->findvalue('/NCIPMessage/ItemCheckedOut/InitiationHeader/FromAgencyId/UniqueAgencyId/Scheme');
 494     my $faidScheme = HTML::Entities::encode($faidSchemeX);
 495     my $faidValue  = $doc->find('/NCIPMessage/ItemCheckedOut/InitiationHeader/FromAgencyId/UniqueAgencyId/Value');
 496     my $taidSchemeX = $doc->findvalue('/NCIPMessage/ItemCheckedOut/InitiationHeader/ToAgencyId/UniqueAgencyId/Scheme');
 497     my $taidScheme = HTML::Entities::encode($taidSchemeX);
 498     my $taidValue  = $doc->find('/NCIPMessage/ItemCheckedOut/InitiationHeader/ToAgencyId/UniqueAgencyId/Value');
 499
 500     my $patron_barcode = $doc->findvalue('/NCIPMessage/ItemCheckedOut/UserOptionalFields/VisibleUserId/VisibleUserIdentifier');
 501     my $due_date = $doc->findvalue('/NCIPMessage/ItemCheckedOut/DateDue');
 502     my $visid = $doc->findvalue('/NCIPMessage/ItemCheckedOut/ItemOptionalFields/ItemDescription/VisibleItemId/VisibleItemIdentifier') . $faidValue;
 503
 504     my $copy = copy_from_barcode($visid);
 505     fail( $copy->{textcode} . " $visid" ) unless ( blessed $copy);
 506     my $r = update_copy( $copy, 0 ); # seemed like copy had to be available before it could be checked out, so ...
 507     my $r1 = checkin($visid) if ( $copy->status == OILS_COPY_STATUS_CHECKED_OUT ); # double posted itemcheckedout messages cause error ... trying to simplify
 508     my $r2 = checkout( $visid, $patron_barcode, $due_date );
 509
 510     my $hd = <<ITEMCHECKEDOUT;
 511 Content-type: text/xml
 512
 513
 514 <!DOCTYPE NCIPMessage PUBLIC "-//NISO//NCIP DTD Version 1.0//EN" "http://www.niso.org/ncip/v1_0/imp1/dtd/ncip_v1_0.dtd">
 515 <NCIPMessage version="http://www.niso.org/ncip/v1_0/imp1/dtd/ncip_v1_0.dtd">
 516     <ItemCheckedOutResponse>
 517         <ResponseHeader>
 518             <FromAgencyId>
 519                 <UniqueAgencyId>
 520                     <Scheme>$faidScheme</Scheme>
 521                     <Value>$faidValue</Value>
 522                 </UniqueAgencyId>
 523             </FromAgencyId>
 524             <ToAgencyId>
 525                 <UniqueAgencyId>
 526                     <Scheme>$taidScheme</Scheme>
 527                     <Value>$taidValue</Value>
 528                 </UniqueAgencyId>
 529             </ToAgencyId>
 530         </ResponseHeader>
 531         <UniqueItemId>
 532             <ItemIdentifierValue datatype="string">$visid</ItemIdentifierValue>
 533         </UniqueItemId>
 534     </ItemCheckedOutResponse>
 535 </NCIPMessage>
 536
 537 ITEMCHECKEDOUT
 538
 539     logit( $hd, ( caller(0) )[3] );
 540     staff_log( $taidValue, $faidValue,
 541         "ItemCheckedOut -> Visible Id : " . $visid . " | Patron Barcode : " . $patron_barcode . " | Due Date : " . $due_date );
 542 }
 543
 544 sub check_out_item {
 545     my $faidSchemeX = $doc->findvalue('/NCIPMessage/CheckOutItem/InitiationHeader/FromAgencyId/UniqueAgencyId/Scheme');
 546     my $faidScheme = HTML::Entities::encode($faidSchemeX);
 547     my $faidValue  = $doc->find('/NCIPMessage/CheckOutItem/InitiationHeader/FromAgencyId/UniqueAgencyId/Value');
 548     my $taidSchemeX = $doc->findvalue('/NCIPMessage/CheckOutItem/InitiationHeader/ToAgencyId/UniqueAgencyId/Scheme');
 549     my $taidScheme = HTML::Entities::encode($taidSchemeX);
 550     my $taidValue  = $doc->find('/NCIPMessage/CheckOutItem/InitiationHeader/ToAgencyId/UniqueAgencyId/Value');
 551
 552     my $mdate = $doc->findvalue('/NCIPMessage/CheckOutItem/MandatedAction/DateEventOccurred');
 553     my $patron_barcode = "zyyyy";    # XXX: CUSTOMIZATION NEEDED XXX institution/eg_as_item_agency user lookup here
 554
 555     # For CheckOutItem and INN-REACH, this value will correspond with our local barcode
 556     my $barcode = $doc->findvalue('/NCIPMessage/CheckOutItem/UniqueItemId/ItemIdentifierValue');
 557
 558     # TODO: watch for possible real ids here?
 559     my $due_date = $doc->findvalue('/NCIPMessage/CheckOutItem/DateDue');
 560
 561     my $copy = copy_from_barcode($barcode);
 562     fail( $copy->{textcode} . " $barcode" ) unless ( blessed $copy);
 563
 564     my $r2 = checkout( $barcode, $patron_barcode, $due_date );
 565
 566     # TODO: check for checkout exception (like OPEN_CIRCULATION_EXISTS)
 567
 568     my $hd = <<CHECKOUTITEM;
 569 Content-type: text/xml
 570
 571
 572 <!DOCTYPE NCIPMessage PUBLIC "-//NISO//NCIP DTD Version 1.0//EN" "http://www.niso.org/ncip/v1_0/imp1/dtd/ncip_v1_0.dtd">
 573 <NCIPMessage version="http://www.niso.org/ncip/v1_0/imp1/dtd/ncip_v1_0.dtd">
 574     <CheckOutItemResponse>
 575         <ResponseHeader>
 576             <FromAgencyId>
 577                 <UniqueAgencyId>
 578                     <Scheme>$faidScheme</Scheme>
 579                     <Value>$faidValue</Value>
 580                 </UniqueAgencyId>
 581             </FromAgencyId>
 582             <ToAgencyId>
 583                 <UniqueAgencyId>
 584                     <Scheme>$taidScheme</Scheme>
 585                     <Value>$taidValue</Value>
 586                 </UniqueAgencyId>
 587             </ToAgencyId>
 588         </ResponseHeader>
 589         <UniqueItemId>
 590             <ItemIdentifierValue datatype="string">$barcode</ItemIdentifierValue>
 591         </UniqueItemId>
 592     </CheckOutItemResponse>
 593 </NCIPMessage>
 594
 595 CHECKOUTITEM
 596
 597     logit( $hd, ( caller(0) )[3] );
 598     staff_log( $taidValue, $faidValue,
 599         "CheckOutItem -> Barcode : " . $barcode . " | Patron Barcode : " . $patron_barcode . " | Due Date : " . $due_date );
 600 }
 601
 602 sub check_in_item {
 603     my $faidSchemeX = $doc->findvalue('/NCIPMessage/CheckInItem/InitiationHeader/FromAgencyId/UniqueAgencyId/Scheme');
 604     my $faidScheme = HTML::Entities::encode($faidSchemeX);
 605     my $faidValue  = $doc->find('/NCIPMessage/CheckInItem/InitiationHeader/FromAgencyId/UniqueAgencyId/Value');
 606     my $taidSchemeX = $doc->findvalue('/NCIPMessage/CheckInItem/InitiationHeader/ToAgencyId/UniqueAgencyId/Scheme');
 607     my $taidScheme = HTML::Entities::encode($taidSchemeX);
 608     my $taidValue  = $doc->find('/NCIPMessage/CheckInItem/InitiationHeader/ToAgencyId/UniqueAgencyId/Value');
 609
 610     # For CheckInItem and INN-REACH, this value will correspond with our local barcode
 611     my $barcode = $doc->findvalue('/NCIPMessage/CheckInItem/UniqueItemId/ItemIdentifierValue');
 612     my $r = checkin($barcode);
 613     fail($r) if $r =~ /^COPY_NOT_CHECKED_OUT/;
 614     # TODO: do we need to do these next steps?  checkin() should handle everything, and we want this to end up in 'reshelving'.  If we are worried about transits, we should handle (abort) them, not just change the status
 615     ##my $copy = copy_from_barcode($barcode);
 616     ##fail($copy->{textcode}." $barcode") unless (blessed $copy);
 617     ##  my $r2 = update_copy($copy,0); # Available now
 618
 619     my $hd = <<CHECKINITEM;
 620 Content-type: text/xml
 621
 622
 623 <!DOCTYPE NCIPMessage PUBLIC "-//NISO//NCIP DTD Version 1.0//EN" "http://www.niso.org/ncip/v1_0/imp1/dtd/ncip_v1_0.dtd">
 624 <NCIPMessage version="http://www.niso.org/ncip/v1_0/imp1/dtd/ncip_v1_0.dtd">
 625     <CheckInItemResponse>
 626         <ResponseHeader>
 627             <FromAgencyId>
 628                 <UniqueAgencyId>
 629                     <Scheme>$faidScheme</Scheme>
 630                     <Value>$faidValue</Value>
 631                 </UniqueAgencyId>
 632             </FromAgencyId>
 633             <ToAgencyId>
 634                 <UniqueAgencyId>
 635                     <Scheme>$taidScheme</Scheme>
 636                     <Value>$taidValue</Value>
 637                 </UniqueAgencyId>
 638             </ToAgencyId>
 639         </ResponseHeader>
 640         <UniqueItemId>
 641             <ItemIdentifierValue datatype="string">$barcode</ItemIdentifierValue>
 642         </UniqueItemId>
 643     </CheckInItemResponse>
 644 </NCIPMessage>
 645
 646 CHECKINITEM
 647
 648     logit( $hd, ( caller(0) )[3] );
 649     staff_log( $taidValue, $faidValue, "CheckInItem -> Barcode : " . $barcode );
 650 }
 651
 652 sub item_shipped {
 653     my $faidSchemeX = $doc->findvalue('/NCIPMessage/ItemShipped/InitiationHeader/FromAgencyId/UniqueAgencyId/Scheme');
 654     my $faidScheme = HTML::Entities::encode($faidSchemeX);
 655     my $faidValue  = $doc->find('/NCIPMessage/ItemShipped/InitiationHeader/FromAgencyId/UniqueAgencyId/Value');
 656     my $taidSchemeX = $doc->findvalue('/NCIPMessage/ItemShipped/InitiationHeader/ToAgencyId/UniqueAgencyId/Scheme');
 657     my $taidScheme = HTML::Entities::encode($taidSchemeX);
 658     my $taidValue  = $doc->find('/NCIPMessage/ItemShipped/InitiationHeader/ToAgencyId/UniqueAgencyId/Value');
 659
 660     my $visid = $doc->findvalue('/NCIPMessage/ItemShipped/ItemOptionalFields/ItemDescription/VisibleItemId/VisibleItemIdentifier') . $faidValue;
 661     my $barcode = $doc->findvalue('/NCIPMessage/ItemShipped/UniqueItemId/ItemIdentifierValue') . $faidValue;
 662     my $title = $doc->findvalue('/NCIPMessage/ItemShipped/ItemOptionalFields/BibliographicDescription/Title');
 663     my $callnumber = $doc->findvalue('/NCIPMessage/ItemShipped/ItemOptionalFields/ItemDescription/CallNumber');
 664
 665     my $copy = copy_from_barcode($barcode);
 666     fail( $copy->{textcode} . " $barcode" ) unless ( blessed $copy);
 667     my $r = update_copy_shipped( $copy, $conf->{status}->{transit}, $visid ); # put copy into INN-Reach Transit status & modify barcode = Visid != tempIIIiNumber
 668
 669     my $hd = <<ITEMSHIPPED;
 670 Content-type: text/xml
 671
 672
 673 <!DOCTYPE NCIPMessage PUBLIC "-//NISO//NCIP DTD Version 1.0//EN" "http://www.niso.org/ncip/v1_0/imp1/dtd/ncip_v1_0.dtd">
 674 <NCIPMessage version="http://www.niso.org/ncip/v1_0/imp1/dtd/ncip_v1_0.dtd">
 675     <ItemShippedResponse>
 676         <ResponseHeader>
 677             <FromAgencyId>
 678                 <UniqueAgencyId>
 679                     <Scheme>$faidScheme</Scheme>
 680                     <Value>$faidValue</Value>
 681                 </UniqueAgencyId>
 682             </FromAgencyId>
 683             <ToAgencyId>
 684                 <UniqueAgencyId>
 685                     <Scheme>$taidScheme</Scheme>
 686                     <Value>$taidValue</Value>
 687                 </UniqueAgencyId>
 688             </ToAgencyId>
 689         </ResponseHeader>
 690         <UniqueItemId>
 691             <ItemIdentifierValue datatype="string">$visid</ItemIdentifierValue>
 692         </UniqueItemId>
 693     </ItemShippedResponse>
 694 </NCIPMessage>
 695
 696 ITEMSHIPPED
 697
 698     logit( $hd, ( caller(0) )[3] );
 699     staff_log( $taidValue, $faidValue,
 700         "ItemShipped -> Visible Id : " . $visid . " | Barcode : " . $barcode . " | Title : " . $title . " | Call Number : " . $callnumber );
 701 }
 702
 703 sub item_request {
 704     my $faidSchemeX = $doc->findvalue('/NCIPMessage/ItemRequested/InitiationHeader/FromAgencyId/UniqueAgencyId/Scheme');
 705     my $faidScheme = HTML::Entities::encode($faidSchemeX);
 706     my $faidValue  = $doc->find('/NCIPMessage/ItemRequested/InitiationHeader/FromAgencyId/UniqueAgencyId/Value');
 707
 708     my $taidSchemeX = $doc->findvalue('/NCIPMessage/ItemRequested/InitiationHeader/ToAgencyId/UniqueAgencyId/Scheme');
 709     my $taidScheme = HTML::Entities::encode($taidSchemeX);
 710     my $taidValue  = $doc->find('/NCIPMessage/ItemRequested/InitiationHeader/ToAgencyId/UniqueAgencyId/Value');
 711     my $UniqueItemIdAgencyIdValue = $doc->findvalue('/NCIPMessage/ItemRequested/UniqueItemId/UniqueAgencyId/Value');
 712
 713     # TODO: should we use the VisibleID for item agency variation of this method call
 714
 715     my $pid = $doc->findvalue('/NCIPMessage/ItemRequested/UniqueUserId/UserIdentifierValue');
 716     my $barcode = $doc->findvalue('/NCIPMessage/ItemRequested/UniqueItemId/ItemIdentifierValue');
 717     my $author = $doc->findvalue('/NCIPMessage/ItemRequested/ItemOptionalFields/BibliographicDescription/Author');
 718     my $title = $doc->findvalue('/NCIPMessage/ItemRequested/ItemOptionalFields/BibliographicDescription/Title');
 719     my $callnumber = $doc->findvalue('/NCIPMessage/ItemRequested/ItemOptionalFields/ItemDescription/CallNumber');
 720     my $medium_type = $doc->find('/NCIPMessage/ItemRequested/ItemOptionalFields/BibliographicDescription/MediumType/Value');
 721
 722     my $r = "default error checking response";
 723
 724     if ( $barcode =~ /^i/ ) {    # XXX EG is User Agency # create copy only if barcode is an iNUMBER
 725         my $copy_status_id = $conf->{status}->{loan_requested}; # INN-Reach Loan Requested - local configured status
 726         $barcode .= $faidValue;
 727         # we want our custom status to be then end result, so create the copy with status of "Available, then hold it, then update the status
 728         $r = create_copy( $title, $callnumber, $barcode, 0, $medium_type );
 729         my $copy = copy_from_barcode($barcode);
 730         my $r2   = place_simple_hold( $copy->id, $pid );
 731         my $r3   = update_copy( $copy, $copy_status_id );
 732     } else {    # XXX EG is Item Agency
 733         unless ( $conf->{behavior}->{no_item_agency_holds} =~ m/^y/i ) {
 734             # place hold for user UniqueUserId/UniqueAgencyId/Value = institution account
 735             my $copy = copy_from_barcode($barcode);
 736             my $pid2 = 1013459; # XXX CUSTOMIZATION NEEDED XXX # this is the id of a user representing your DCB system, TODO: use agency information to create and link to individual accounts per agency, if needed
 737             $r = place_simple_hold( $copy->id, $pid2 );
 738             my $r2 = update_copy( $copy, $conf->{status}->{hold} ); # put into INN-Reach Hold status
 739         }
 740     }
 741
 742     my $hd = <<ITEMREQ;
 743 Content-type: text/xml
 744
 745
 746 <!DOCTYPE NCIPMessage PUBLIC "-//NISO//NCIP DTD Version 1.0//EN" "http://www.niso.org/ncip/v1_0/imp1/dtd/ncip_v1_0.dtd">
 747 <NCIPMessage version="http://www.niso.org/ncip/v1_0/imp1/dtd/ncip_v1_0.dtd">
 748     <ItemRequestedResponse>
 749         <ResponseHeader>
 750             <FromAgencyId>
 751                 <UniqueAgencyId>
 752                     <Scheme>$faidScheme</Scheme>
 753                     <Value>$faidValue</Value>
 754                 </UniqueAgencyId>
 755             </FromAgencyId>
 756             <ToAgencyId>
 757                 <UniqueAgencyId>
 758                     <Scheme>$taidScheme</Scheme>
 759                     <Value>$taidValue</Value>
 760                 </UniqueAgencyId>
 761             </ToAgencyId>
 762         </ResponseHeader>
 763         <UniqueUserId>
 764             <UniqueAgencyId>
 765                 <Scheme datatype="string">$taidScheme</Scheme>
 766                 <Value datatype="string">$taidValue</Value>
 767             </UniqueAgencyId>
 768             <UserIdentifierValue datatype="string">$pid</UserIdentifierValue>
 769         </UniqueUserId>
 770         <UniqueItemId>
 771             <ItemIdentifierValue datatype="string">$barcode</ItemIdentifierValue>
 772         </UniqueItemId>
 773         <ItemOptionalFields>
 774             <BibliographicDescription>
 775         <Author datatype="string">$author</Author>
 776         <Title datatype="string">$title</Title>
 777             </BibliographicDescription>
 778             <ItemDescription>
 779                 <CallNumber datatype="string">$callnumber</CallNumber>
 780             </ItemDescription>
 781        </ItemOptionalFields>
 782     </ItemRequestedResponse>
 783 </NCIPMessage>
 784
 785 ITEMREQ
 786
 787     logit( $hd, ( caller(0) )[3] );
 788     staff_log( $taidValue, $faidValue,
 789         "ItemRequested -> Barcode : " . $barcode . " | Title : " . $title . " | Call Number : " . $callnumber . " | Patronid :" . $pid );
 790 }
 791
 792 sub lookupUser {
 793
 794     my $faidScheme = $doc->findvalue('/NCIPMessage/LookupUser/InitiationHeader/FromAgencyId/UniqueAgencyId/Scheme');
 795     $faidScheme = HTML::Entities::encode($faidScheme);
 796     my $faidValue = $doc->find('/NCIPMessage/LookupUser/InitiationHeader/FromAgencyId/UniqueAgencyId/Value');
 797     my $taidScheme = $doc->findvalue('/NCIPMessage/LookupUser/InitiationHeader/ToAgencyId/UniqueAgencyId/Scheme');
 798     $taidScheme = HTML::Entities::encode($taidScheme);
 799
 800     my $taidValue = $doc->find('/NCIPMessage/LookupUser/InitiationHeader/ToAgencyId/UniqueAgencyId/Value');
 801     my $id = $doc->findvalue('/NCIPMessage/LookupUser/VisibleUserId/VisibleUserIdentifier');
 802     my $uidValue = user_id_from_barcode($id);
 803
 804     if ( !defined($uidValue)
 805         || ( ref($uidValue) && reftype($uidValue) eq 'HASH' ) )
 806     {
 807         do_lookup_user_error_stanza("PATRON_NOT_FOUND : $id");
 808         die;
 809     }
 810
 811     my ( $propername, $email, $good_until, $userpriv, $block_stanza ) =
 812       ( "name here", "", "good until", "", "" );    # defaults
 813
 814     my $patron = flesh_user($uidValue);
 815
 816     #if (blessed($patron)) {
 817     my $patron_ok = 1;
 818     my @penalties = @{ $patron->standing_penalties };
 819
 820     if ( $patron->deleted eq 't' ) {
 821         do_lookup_user_error_stanza("PATRON_DELETED : $uidValue");
 822         die;
 823     } elsif ( $patron->barred eq 't' ) {
 824         do_lookup_user_error_stanza("PATRON_BARRED : $uidValue");
 825         die;
 826     } elsif ( $patron->active eq 'f' ) {
 827         do_lookup_user_error_stanza("PATRON_INACTIVE : $uidValue");
 828         die;
 829     }
 830
 831     elsif ( $#penalties > -1 ) {
 832
 833 #                my $penalty;
 834 #                   foreach $penalty (@penalties) {
 835 #                    if (defined($penalty->standing_penalty->block_list)) {
 836 #                            my @block_list = split(/\|/, $penalty->standing_penalty->block_list);
 837 #                            foreach my $block (@block_list) {
 838 #                                foreach my $block_on (@$block_types) {
 839 #                                    if ($block eq $block_on) {
 840 #                                        $block_stanza .= "\n".$penalty->standing_penalty->name;
 841 #                                        $patron_ok = 0;
 842 #                                    }
 843 #                                    last unless ($patron_ok);
 844 #                            }
 845 #                                last unless ($patron_ok);
 846 #                          }
 847 #                     }
 848 #                }
 849         $block_stanza = qq(
 850             <BlockOrTrap>
 851                 <UniqueAgencyId>
 852                     <Scheme datatype="string">http://just.testing.now</Scheme>
 853                     <Value datatype="string">$faidValue</Value>
 854                 </UniqueAgencyId>
 855                 <BlockOrTrapType>
 856                     <Scheme datatype="string">http://just.testing.now</Scheme>
 857                     <Value datatype="string">Block Hold</Value>
 858                 </BlockOrTrapType>
 859             </BlockOrTrap>);
 860     }
 861
 862     if ( defined( $patron->email ) && $conf->{behavior}->{omit_patron_email} !~ m/^y/i ) {
 863         $email = qq(
 864             <UserAddressInformation>
 865                 <ElectronicAddress>
 866                     <ElectronicAddressType>
 867                         <Scheme datatype="string">http://testing.now</Scheme>
 868                         <Value datatype="string">mailto</Value>
 869                     </ElectronicAddressType>
 870                     <ElectronicAddressData datatype="string">)
 871           . HTML::Entities::encode( $patron->email )
 872           . qq(</ElectronicAddressData>
 873                 </ElectronicAddress>
 874             </UserAddressInformation>);
 875     }
 876
 877     $propername = $patron->first_given_name . " " . $patron->family_name;
 878     $good_until = $patron->expire_date || "unknown";
 879     $userpriv = $patron->profile->name;
 880
 881     my $userpriv_map = load_userpriv_map( $conf->{path}->{userpriv_map} );
 882
 883     if ($userpriv_map) {
 884         $userpriv = lookup_userpriv($userpriv, $userpriv_map);
 885     }
 886
 887     #} else {
 888     #    do_lookup_user_error_stanza("PATRON_NOT_FOUND : $id");
 889     #    die;
 890     #}
 891     my $uniqid = $patron->id;
 892     my $visid  = $patron->card->barcode;
 893     my $hd = <<LOOKUPUSERRESPONSE;
 894 Content-type: text/xml
 895
 896
 897 <!DOCTYPE NCIPMessage PUBLIC "-//NISO//NCIP DTD Version 1.0//EN" "http://www.niso.org/ncip/v1_0/imp1/dtd/ncip_v1_0.dtd">
 898 <NCIPMessage version="http://www.niso.org/ncip/v1_0/imp1/dtd/ncip_v1_0.dtd">
 899     <LookupUserResponse>
 900         <ResponseHeader>
 901             <FromAgencyId>
 902                 <UniqueAgencyId>
 903                     <Scheme>$taidScheme</Scheme>
 904                     <Value>$taidValue</Value>
 905                 </UniqueAgencyId>
 906             </FromAgencyId>
 907             <ToAgencyId>
 908                 <UniqueAgencyId>
 909                    <Scheme>$faidScheme</Scheme>
 910                    <Value>$faidValue</Value>
 911                 </UniqueAgencyId>
 912             </ToAgencyId>
 913         </ResponseHeader>
 914         <UniqueUserId>
 915             <UniqueAgencyId>
 916                 <Scheme>$taidScheme</Scheme>
 917                 <Value>$taidValue</Value>
 918             </UniqueAgencyId>
 919             <UserIdentifierValue>$uniqid</UserIdentifierValue>
 920         </UniqueUserId>
 921         <UserOptionalFields>
 922             <VisibleUserId>
 923                 <VisibleUserIdentifierType>
 924                     <Scheme datatype="string">http://blah.com</Scheme>
 925                     <Value datatype="string">Barcode</Value>
 926                 </VisibleUserIdentifierType>
 927                 <VisibleUserIdentifier datatype="string">$visid</VisibleUserIdentifier>
 928             </VisibleUserId>
 929             <NameInformation>
 930                 <PersonalNameInformation>
 931                     <UnstructuredPersonalUserName datatype="string">$propername</UnstructuredPersonalUserName>
 932                 </PersonalNameInformation>
 933             </NameInformation>
 934             <UserPrivilege>
 935                 <UniqueAgencyId>
 936                     <Scheme datatype="string">$faidScheme</Scheme>
 937                     <Value datatype="string">$faidValue</Value>
 938                 </UniqueAgencyId>
 939                 <AgencyUserPrivilegeType>
 940                     <Scheme datatype="string">http://testing.purposes.only</Scheme>
 941                     <Value datatype="string">$userpriv</Value>
 942                 </AgencyUserPrivilegeType>
 943                 <ValidToDate datatype="string">$good_until</ValidToDate>
 944             </UserPrivilege> $email $block_stanza
 945         </UserOptionalFields>
 946    </LookupUserResponse>
 947 </NCIPMessage>
 948
 949 LOOKUPUSERRESPONSE
 950
 951     logit( $hd, ( caller(0) )[3] );
 952     staff_log( $taidValue, $faidValue,
 953             "LookupUser -> Patron Barcode : "
 954           . $id
 955           . " | Patron Id : "
 956           . $uidValue
 957           . " | User Name : "
 958           . $propername
 959           . " | User Priv : "
 960           . $userpriv );
 961 }
 962
 963 sub fail {
 964     my $error_msg =
 965       shift || "THIS IS THE DEFAULT / DO NOT HANG III NCIP RESP MSG";
 966     print "Content-type: text/xml\n\n";
 967
 968     print <<ITEMREQ;
 969 <!DOCTYPE NCIPMessage PUBLIC "-//NISO//NCIP DTD Version 1.0//EN" "http://www.niso.org/ncip/v1_0/imp1/dtd/ncip_v1_0.dtd">
 970 <NCIPMessage version="http://www.niso.org/ncip/v1_0/imp1/dtd/ncip_v1_0.dtd">
 971     <ItemRequestedResponse>
 972         <ResponseHeader>
 973             <FromAgencyId>
 974                 <UniqueAgencyId>
 975                     <Scheme>http://136.181.125.166:6601/IRCIRCD?target=get_scheme_values&amp;scheme=UniqueAgencyId</Scheme>
 976                     <Value></Value>
 977                 </UniqueAgencyId>
 978             </FromAgencyId>
 979             <ToAgencyId>
 980                 <UniqueAgencyId>
 981                     <Scheme>http://136.181.125.166:6601/IRCIRCD?target=get_scheme_values&amp;scheme=UniqueAgencyId</Scheme>
 982                     <Value>$error_msg</Value>
 983                 </UniqueAgencyId>
 984             </ToAgencyId>
 985         </ResponseHeader>
 986     </ItemRequestedResponse>
 987 </NCIPMessage>
 988
 989 ITEMREQ
 990
 991     # XXX: we should log FromAgencyId and ToAgencyId values here, but they are not available to the code at this point
 992     staff_log( '', '',
 993         ( ( caller(0) )[3] . " -> " . $error_msg ) );
 994     die;
 995 }
 996
 997 sub do_lookup_user_error_stanza {
 998
 999     # XXX: we should include FromAgencyId and ToAgencyId values, but they are not available to the code at this point
1000     my $error = shift;
1001     my $hd    = <<LOOKUPPROB;
1002 Content-type: text/xml
1003
1004
1005 <!DOCTYPE NCIPMessage PUBLIC "-//NISO//NCIP DTD Version 1.0//EN" "http://www.niso.org/ncip/v1_0/imp1/dtd/ncip_v1_0.dtd">
1006 <NCIPMessage version="http://www.niso.org/ncip/v1_0/imp1/dtd/ncip_v1_0.dtd">
1007     <LookupUserResponse>
1008         <ResponseHeader>
1009             <FromAgencyId>
1010                 <UniqueAgencyId>
1011                     <Scheme></Scheme>
1012                     <Value></Value>
1013                 </UniqueAgencyId>
1014             </FromAgencyId>
1015             <ToAgencyId>
1016                 <UniqueAgencyId>
1017                     <Scheme></Scheme>
1018                     <Value></Value>
1019                 </UniqueAgencyId>
1020             </ToAgencyId>
1021         </ResponseHeader>
1022         <Problem>
1023             <ProcessingError>
1024                 <ProcessingErrorType>
1025                     <Scheme>http://www.niso.org/ncip/v1_0/schemes/processingerrortype/lookupuserprocessingerror.scm</Scheme>
1026                     <Value>$error</Value>
1027                 </ProcessingErrorType>
1028                 <ProcessingErrorElement>
1029                     <ElementName>AuthenticationInput</ElementName>
1030                 </ProcessingErrorElement>
1031             </ProcessingError>
1032         </Problem>
1033     </LookupUserResponse>
1034 </NCIPMessage>
1035
1036 LOOKUPPROB
1037
1038     logit( $hd, ( caller(0) )[3] );
1039     # XXX: we should log FromAgencyId and ToAgencyId values here, but they are not available to the code at this point
1040     staff_log( '', '', ( ( caller(0) )[3] . " -> " . $error ) );
1041     die;
1042 }
1043
1044 # Login to the OpenSRF system/Evergreen.
1045 #
1046 # Returns a hash with the authtoken, authtime, and expiration (time in
1047 # seconds since 1/1/1970).
1048 sub login {
1049
1050  # XXX: local opensrf core conf filename should be in config.
1051  # XXX: STAFF account with ncip service related permissions should be in config.
1052     my $bootstrap = '/openils/conf/opensrf_core.xml';
1053     my $uname     = $conf->{auth}->{username};
1054     my $password  = $conf->{auth}->{password};
1055
1056     # Bootstrap the client
1057     OpenSRF::System->bootstrap_client( config_file => $bootstrap );
1058     my $idl = OpenSRF::Utils::SettingsClient->new->config_value("IDL");
1059     Fieldmapper->import( IDL => $idl );
1060
1061     # Initialize CStoreEditor:
1062     OpenILS::Utils::CStoreEditor->init;
1063
1064     my $seed = OpenSRF::AppSession->create('open-ils.auth')
1065       ->request( 'open-ils.auth.authenticate.init', $uname )->gather(1);
1066
1067     return undef unless $seed;
1068
1069     my $response = OpenSRF::AppSession->create('open-ils.auth')->request(
1070         'open-ils.auth.authenticate.complete',
1071         {
1072             username => $uname,
1073             password => md5_hex( $seed . md5_hex($password) ),
1074             type     => 'staff'
1075         }
1076     )->gather(1);
1077
1078     return undef unless $response;
1079
1080     my %result;
1081     $result{'authtoken'}  = $response->{payload}->{authtoken};
1082     $result{'authtime'}   = $response->{payload}->{authtime};
1083     $result{'expiration'} = time() + $result{'authtime'}
1084       if ( defined( $result{'authtime'} ) );
1085     return %result;
1086 }
1087
1088 # Check the time versus the session expiration time and login again if
1089 # the session has expired, consequently resetting the session
1090 # paramters. We want to run this before doing anything that requires
1091 # us to have a current session in OpenSRF.
1092 #
1093 # Arguments
1094 # none
1095 #
1096 # Returns
1097 # Nothing
1098 sub check_session_time {
1099     if ( time() > $session{'expiration'} ) {
1100         %session = login();
1101         if ( !%session ) {
1102             die("Failed to reinitialize the session after expiration.");
1103         }
1104     }
1105 }
1106
1107 # Retrieve the logged in user.
1108 #
1109 sub get_session {
1110     my $response =
1111       OpenSRF::AppSession->create('open-ils.auth')
1112       ->request( 'open-ils.auth.session.retrieve', $session{authtoken} )
1113       ->gather(1);
1114     return $response;
1115 }
1116
1117 # Logout/destroy the OpenSRF session
1118 #
1119 # Argument is
1120 # none
1121 #
1122 # Returns
1123 # Does not return anything
1124 sub logout {
1125     if ( time() < $session{'expiration'} ) {
1126         my $response =
1127           OpenSRF::AppSession->create('open-ils.auth')
1128           ->request( 'open-ils.auth.session.delete', $session{authtoken} )
1129           ->gather(1);
1130         if ($response) {
1131
1132             # strong.silent.success
1133             exit(0);
1134         } else {
1135             fail("Logout unsuccessful. Good-bye, anyway.");
1136         }
1137     }
1138 }
1139
1140 sub update_copy {
1141     check_session_time();
1142     my ( $copy, $status_id ) = @_;
1143     my $e = new_editor( authtoken => $session{authtoken} );
1144     return $e->event->{textcode} unless ( $e->checkauth );
1145     $e->xact_begin;
1146     $copy->status($status_id);
1147     return $e->event unless $e->update_asset_copy($copy);
1148     $e->commit;
1149     return 'SUCCESS';
1150 }
1151
1152 # my paranoia re barcode on shipped items using visid for unique value
1153 sub update_copy_shipped {
1154     check_session_time();
1155     my ( $copy, $status_id, $barcode ) = @_;
1156     my $e = new_editor( authtoken => $session{authtoken} );
1157     return $e->event->{textcode} unless ( $e->checkauth );
1158     $e->xact_begin;
1159     $copy->status($status_id);
1160     $copy->barcode($barcode);
1161     return $e->event unless $e->update_asset_copy($copy);
1162     $e->commit;
1163     return 'SUCCESS';
1164 }
1165
1166 # Delete a copy
1167 #
1168 # Argument
1169 # Fieldmapper asset.copy object
1170 #
1171 # Returns
1172 # "SUCCESS" on success
1173 # Event textcode if an error occurs
1174 sub delete_copy {
1175     check_session_time();
1176     my ($copy) = @_;
1177
1178     my $e = new_editor( authtoken => $session{authtoken} );
1179     return $e->event->{textcode} unless ( $e->checkauth );
1180
1181     # Get the calnumber
1182     my $vol = $e->retrieve_asset_call_number( $copy->call_number );
1183     return $e->event->{textcode} unless ($vol);
1184
1185     # Get the biblio.record_entry
1186     my $bre = $e->retrieve_biblio_record_entry( $vol->record );
1187     return $e->event->{textcode} unless ($bre);
1188
1189     # Delete everything in a transaction and rollback if anything fails.
1190     # TODO: I think there is a utility function which handles all this
1191     $e->xact_begin;
1192     my $r;    # To hold results of editor calls
1193     $r = $e->delete_asset_copy($copy);
1194     unless ($r) {
1195         my $lval = $e->event->{textcode};
1196         $e->rollback;
1197         return $lval;
1198     }
1199     my $list =
1200       $e->search_asset_copy( { call_number => $vol->id, deleted => 'f' } );
1201     unless (@$list) {
1202         $r = $e->delete_asset_call_number($vol);
1203         unless ($r) {
1204             my $lval = $e->event->{textcode};
1205             $e->rollback;
1206             return $lval;
1207         }
1208         $list = $e->search_asset_call_number( { record => $bre->id, deleted => 'f' } );
1209         unless (@$list) {
1210             $r = $e->delete_biblio_record_entry($bre);
1211             unless ($r) {
1212                 my $lval = $e->event->{textcode};
1213                 $e->rollback;
1214                 return $lval;
1215             }
1216         }
1217     }
1218     $e->commit;
1219     return 'SUCCESS';
1220 }
1221
1222 # Get asset.copy from asset.copy.barcode.
1223 # Arguments
1224 # copy barcode
1225 #
1226 # Returns
1227 # asset.copy fieldmaper object
1228 # or hash on error
1229 sub copy_from_barcode {
1230     check_session_time();
1231     my ($barcode) = @_;
1232     my $response =
1233       OpenSRF::AppSession->create('open-ils.search')
1234       ->request( 'open-ils.search.asset.copy.find_by_barcode', $barcode )
1235       ->gather(1);
1236     return $response;
1237 }
1238
1239 sub locid_from_barcode {
1240     my ($barcode) = @_;
1241     my $response =
1242       OpenSRF::AppSession->create('open-ils.search')
1243       ->request( 'open-ils.search.biblio.find_by_barcode', $barcode )
1244       ->gather(1);
1245     return $response->{ids}[0];
1246 }
1247
1248 # Convert a MARC::Record to XML for Evergreen
1249 #
1250 # Copied from Dyrcona's issa framework which copied
1251 # it from MVLC's Safari Load program which copied it
1252 # from some code in the Open-ILS example import scripts.
1253 #
1254 # Argument
1255 # A MARC::Record object
1256 #
1257 # Returns
1258 # String with XML for the MARC::Record as Evergreen likes it
1259 sub convert2marcxml {
1260     my $input = shift;
1261     ( my $xml = $input->as_xml_record() ) =~ s/\n//sog;
1262     $xml =~ s/^<\?xml.+\?\s*>//go;
1263     $xml =~ s/>\s+</></go;
1264     $xml =~ s/\p{Cc}//go;
1265     $xml = $U->entityize($xml);
1266     $xml =~ s/[\x00-\x1f]//go;
1267     return $xml;
1268 }
1269
1270 # Create a copy and marc record
1271 #
1272 # Arguments
1273 # title
1274 # call number
1275 # copy barcode
1276 #
1277 # Returns
1278 # bib id on succes
1279 # event textcode on failure
1280 sub create_copy {
1281     check_session_time();
1282     my ( $title, $callnumber, $barcode, $copy_status_id, $medium_type ) = @_;
1283
1284     my $e = new_editor( authtoken => $session{authtoken} );
1285     return $e->event->{textcode} unless ( $e->checkauth );
1286
1287     my $r = $e->allowed( [ 'CREATE_COPY', 'CREATE_MARC', 'CREATE_VOLUME' ] );
1288     if ( ref($r) eq 'HASH' ) {
1289         return $r->{textcode} . ' ' . $r->{ilsperm};
1290     }
1291
1292     # Check if the barcode exists in asset.copy and bail if it does.
1293     my $list = $e->search_asset_copy( { deleted => 'f', barcode => $barcode } );
1294     if (@$list) {
1295 # in the future, can we update it, if it exists and only if it is an INN-Reach status item ?
1296         $e->finish;
1297         fail( 'BARCODE_EXISTS ! Barcode : ' . $barcode );
1298         die;
1299     }
1300
1301     # Create MARC record
1302     my $record = MARC::Record->new();
1303     $record->encoding('UTF-8');
1304     $record->leader('00881nam a2200193 4500');
1305     my $datespec = strftime( "%Y%m%d%H%M%S.0", localtime );
1306     my @fields = ();
1307     push( @fields, MARC::Field->new( '005', $datespec ) );
1308     push( @fields, MARC::Field->new( '082', '0', '4', 'a' => $callnumber ) );
1309     push( @fields, MARC::Field->new( '245', '0', '0', 'a' => $title ) );
1310     $record->append_fields(@fields);
1311
1312     # Convert the record to XML
1313     my $xml = convert2marcxml($record);
1314
1315     my $bre =
1316       OpenSRF::AppSession->create('open-ils.cat')
1317       ->request( 'open-ils.cat.biblio.record.xml.import',
1318         $session{authtoken}, $xml, 'System Local', 1 )->gather(1);
1319     return $bre->{textcode} if ( ref($bre) eq 'HASH' );
1320
1321     # Create volume record
1322     my $vol =
1323       OpenSRF::AppSession->create('open-ils.cat')
1324       ->request( 'open-ils.cat.call_number.find_or_create', $session{authtoken}, $callnumber, $bre->id, $conf->{volume}->{owning_lib} )
1325       ->gather(1);
1326     return $vol->{textcode} if ( $vol->{textcode} );
1327
1328     # Retrieve the user
1329     my $user = get_session;
1330
1331     # Create copy record
1332     my $copy = Fieldmapper::asset::copy->new();
1333     # XXX CUSTOMIZATION NEEDED XXX
1334     # You will need to either create a circ mod for every expected medium type,
1335     # OR you should create a single circ mod for all requests from the external
1336     # system.
1337     # Adjust these lines as needed.
1338     #    $copy->circ_modifier(qq($medium_type)); # XXX CUSTOMIZATION NEEDED XXX
1339     # OR
1340     $copy->circ_modifier($conf->{copy}->{circ_modifier});
1341     $copy->barcode($barcode);
1342     $copy->call_number( $vol->{acn_id} );
1343     $copy->circ_lib($conf->{copy}->{circ_lib});
1344     $copy->circulate('t');
1345     $copy->holdable('t');
1346     $copy->opac_visible('t');
1347     $copy->deleted('f');
1348     $copy->fine_level(2);
1349     $copy->loan_duration(2);
1350     $copy->location($conf->{copy}->{location});
1351     $copy->status($copy_status_id);
1352     $copy->editor('1');
1353     $copy->creator('1');
1354
1355     # Add the configured stat cat entries.
1356     #my @stat_cats;
1357     #my $nodes = $xpath->find("/copy/stat_cat_entry");
1358     #foreach my $node ($nodes->get_nodelist) {
1359     #    next unless ($node->isa('XML::XPath::Node::Element'));
1360     #    my $stat_cat_id = $node->getAttribute('stat_cat');
1361     #    my $value = $node->string_value();
1362     #    # Need to search for an existing asset.stat_cat_entry
1363     #        my $asce = $e->search_asset_stat_cat_entry({'stat_cat' => $stat_cat_id, 'value' => $value})->[0];
1364     #    unless ($asce) {
1365     #        # if not, create a new one and use its id.
1366     #        $asce = Fieldmapper::asset::stat_cat_entry->new();
1367     #        $asce->stat_cat($stat_cat_id);
1368     #        $asce->value($value);
1369     #        $asce->owner($ou->id);
1370     #        $e->xact_begin;
1371     #        $asce = $e->create_asset_stat_cat_entry($asce);
1372     #        $e->xact_commit;
1373     #    }
1374     #    push(@stat_cats, $asce);
1375     #}
1376
1377     $e->xact_begin;
1378     $copy = $e->create_asset_copy($copy);
1379
1380     #if (scalar @stat_cats) {
1381     #    foreach my $asce (@stat_cats) {
1382     #        my $ascecm = Fieldmapper::asset::stat_cat_entry_copy_map->new();
1383     #        $ascecm->stat_cat($asce->stat_cat);
1384     #        $ascecm->stat_cat_entry($asce->id);
1385     #        $ascecm->owning_copy($copy->id);
1386     #        $ascecm = $e->create_asset_stat_cat_entry_copy_map($ascecm);
1387     #    }
1388     #}
1389     $e->commit;
1390     return $e->event->{textcode} unless ($r);
1391     return 'SUCCESS';
1392 }
1393
1394 # Checkout a copy to a patron
1395 #
1396 # Arguments
1397 # copy barcode
1398 # patron barcode
1399 #
1400 # Returns
1401 # textcode of the OSRF response.
1402 sub checkout {
1403     check_session_time();
1404     my ( $copy_barcode, $patron_barcode, $due_date ) = @_;
1405
1406     # Check for copy:
1407     my $copy = copy_from_barcode($copy_barcode);
1408     unless ( defined($copy) && blessed($copy) ) {
1409         return 'COPY_BARCODE_NOT_FOUND : ' . $copy_barcode;
1410     }
1411
1412     # Check for user
1413     my $uid = user_id_from_barcode($patron_barcode);
1414     return 'PATRON_BARCODE_NOT_FOUND : ' . $patron_barcode if ( ref($uid) );
1415
1416     my $response = OpenSRF::AppSession->create('open-ils.circ')->request(
1417         'open-ils.circ.checkout.full.override',
1418         $session{authtoken},
1419         {
1420             copy_barcode => $copy_barcode,
1421             patron_id    => $uid,
1422             due_date     => $due_date
1423         }
1424     )->gather(1);
1425     return $response->{textcode};
1426 }
1427
1428 sub renewal {
1429     check_session_time();
1430     my ( $copy_barcode, $due_date ) = @_;
1431
1432     # Check for copy:
1433     my $copy = copy_from_barcode($copy_barcode);
1434     unless ( defined($copy) && blessed($copy) ) {
1435         return 'COPY_BARCODE_NOT_FOUND : ' . $copy_barcode;
1436     }
1437
1438     my $response = OpenSRF::AppSession->create('open-ils.circ')->request(
1439         'open-ils.circ.renew.override',
1440         $session{authtoken},
1441         {
1442             copy_barcode => $copy_barcode,
1443             due_date     => $due_date
1444         }
1445     )->gather(1);
1446     return $response->{textcode};
1447 }
1448
1449 # Check a copy in
1450 #
1451 # Arguments
1452 # copy barcode
1453 #
1454 # Returns
1455 # "SUCCESS" on success
1456 # textcode of a failed OSRF request
1457 # 'COPY_NOT_CHECKED_OUT' when the copy is not checked out
1458
1459 sub checkin {
1460     check_session_time();
1461     my ($barcode) = @_;
1462
1463     my $copy = copy_from_barcode($barcode);
1464     return $copy->{textcode} unless ( blessed $copy);
1465
1466     return ("COPY_NOT_CHECKED_OUT $barcode")
1467       unless ( $copy->status == OILS_COPY_STATUS_CHECKED_OUT );
1468
1469     my $e = new_editor( authtoken => $session{authtoken} );
1470     return $e->event->{textcode} unless ( $e->checkauth );
1471
1472     my $circ = $e->search_action_circulation(
1473         [ { target_copy => $copy->id, xact_finish => undef } ] )->[0];
1474     my $r =
1475       OpenSRF::AppSession->create('open-ils.circ')
1476       ->request( 'open-ils.circ.checkin.override',
1477         $session{authtoken}, { force => 1, copy_id => $copy->id } )->gather(1);
1478     return 'SUCCESS' if ( $r->{textcode} eq 'ROUTE_ITEM' );
1479     return $r->{textcode};
1480 }
1481
1482 # Get actor.usr.id from barcode.
1483 # Arguments
1484 # patron barcode
1485 #
1486 # Returns
1487 # actor.usr.id
1488 # or hash on error
1489 sub user_id_from_barcode {
1490     check_session_time();
1491     my ($barcode) = @_;
1492
1493     my $response;
1494
1495     my $e = new_editor( authtoken => $session{authtoken} );
1496     return $response unless ( $e->checkauth );
1497
1498     my $card = $e->search_actor_card( { barcode => $barcode, active => 't' } );
1499     return $e->event unless ($card);
1500
1501     $response = $card->[0]->usr if (@$card);
1502
1503     $e->finish;
1504
1505     return $response;
1506 }
1507
1508 # Place a simple hold for a patron.
1509 #
1510 # Arguments
1511 # Target object appropriate for type of hold
1512 # Patron for whom the hold is place
1513 #
1514 # Returns
1515 # "SUCCESS" on success
1516 # textcode of a failed OSRF request
1517 # "HOLD_TYPE_NOT_SUPPORTED" if the hold type is not supported
1518 # (Currently only support 'T' and 'C')
1519
1520 # simple hold should be removed and full holds sub should be used instead - pragmatic solution only
1521
1522 sub place_simple_hold {
1523     check_session_time();
1524
1525     #my ($type, $target, $patron, $pickup_ou) = @_;
1526     my ( $target, $patron_id ) = @_;
1527
1528     require $conf->{path}->{oils_header};
1529     use vars qw/ $apputils $memcache $user $authtoken $authtime /;
1530
1531     osrf_connect( $conf->{path}->{opensrf_core} );
1532     oils_login( $conf->{auth}->{username}, $conf->{auth}->{password} );
1533     my $ahr = Fieldmapper::action::hold_request->new();
1534     $ahr->hold_type('C');
1535     # The targeter doesn't like our special statuses, and changing the status after the targeter finishes is difficult because it runs asynchronously.  Our workaround is to create the hold frozen, unfreeze it, then run the targeter manually.
1536     $ahr->target($target);
1537     $ahr->usr($patron_id);
1538     $ahr->requestor($conf->{hold}->{requestor});
1539     # NOTE: When User Agency, we don't know the pickup location until ItemShipped time
1540     # TODO: When Item Agency and using holds, set this to requested copy's circ lib?
1541     $ahr->pickup_lib($conf->{hold}->{init_pickup_lib});
1542     $ahr->phone_notify(''); # TODO: set this based on usr prefs
1543     $ahr->email_notify(1); # TODO: set this based on usr prefs
1544     $ahr->frozen('t');
1545     my $resp = simplereq( CIRC(), 'open-ils.circ.holds.create', $authtoken, $ahr );
1546     my $e = new_editor( xact => 1, authtoken => $session{authtoken} );
1547     $ahr = $e->retrieve_action_hold_request($resp);    # refresh from db
1548     $ahr->frozen('f');
1549     $e->update_action_hold_request($ahr);
1550     $e->commit;
1551     $U->storagereq( 'open-ils.storage.action.hold_request.copy_targeter', undef, $ahr->id );
1552
1553     #oils_event_die($resp);
1554     my $errors = "";
1555     if ( ref($resp) eq 'ARRAY' ) {
1556         ( $errors .= "error : " . $_->{textcode} ) for @$resp;
1557         return $errors;
1558     } elsif ( ref($resp) ne 'HASH' ) {
1559         return "Hold placed! hold_id = " . $resp . "\n";
1560     }
1561 }
1562
1563 # Flesh user information
1564 # Arguments
1565 # actor.usr.id
1566 #
1567 # Returns
1568 # fieldmapped, fleshed user or
1569 # event hash on error
1570 sub flesh_user {
1571     check_session_time();
1572     my ($id) = @_;
1573     my $response =
1574       OpenSRF::AppSession->create('open-ils.actor')
1575       ->request( 'open-ils.actor.user.fleshed.retrieve',
1576         $session{'authtoken'}, $id,
1577         [ 'card', 'cards', 'standing_penalties', 'home_ou', 'profile' ] )
1578       ->gather(1);
1579     return $response;
1580 }