Open-ILS/src/perlmods/OpenILS/Application/Circ/Circulate.pm

   1 package OpenILS::Application::Circ::Circulate;
   2 use base 'OpenSRF::Application';
   3 use strict; use warnings;
   4 use OpenSRF::EX qw(:try);
   5 use Data::Dumper;
   6 use OpenSRF::Utils;
   7 use OpenSRF::Utils::Cache;
   8 use Digest::MD5 qw(md5_hex);
   9 use OpenILS::Utils::ScriptRunner;
  10 use OpenILS::Application::AppUtils;
  11 use OpenILS::Application::Circ::Holds;
  12 use OpenILS::Application::Circ::Transit;
  13 use OpenSRF::Utils::Logger qw(:logger);
  14
  15 $Data::Dumper::Indent = 0;
  16 my $apputils    = "OpenILS::Application::AppUtils";
  17 my $U                           = $apputils;
  18 my $holdcode    = "OpenILS::Application::Circ::Holds";
  19 my $transcode   = "OpenILS::Application::Circ::Transit";
  20
  21 my %scripts;                    # - circulation script filenames
  22 my $script_libs;                # - any additional script libraries
  23 my %cache;                              # - db objects cache
  24 my %contexts;                   # - Script runner contexts
  25 my $cache_handle;               # - memcache handle
  26
  27 sub PRECAT_FINE_LEVEL { return 2; }
  28 sub PRECAT_LOAN_DURATION { return 2; }
  29
  30 my $SUCCESS;
  31
  32
  33 # for security, this is a process-defined and not
  34 # a client-defined variable
  35 my $__isrenewal = 0;
  36 my $__islost            = 0;
  37
  38 # ------------------------------------------------------------------------------
  39 # Load the circ script from the config
  40 # ------------------------------------------------------------------------------
  41 sub initialize {
  42
  43         my $self = shift;
  44         $cache_handle = OpenSRF::Utils::Cache->new('global');
  45         my $conf = OpenSRF::Utils::SettingsClient->new;
  46         my @pfx2 = ( "apps", "open-ils.circ","app_settings" );
  47         my @pfx = ( @pfx2, "scripts" );
  48
  49         my $p           = $conf->config_value(  @pfx, 'circ_permit_patron' );
  50         my $c           = $conf->config_value(  @pfx, 'circ_permit_copy' );
  51         my $d           = $conf->config_value(  @pfx, 'circ_duration' );
  52         my $f           = $conf->config_value(  @pfx, 'circ_recurring_fines' );
  53         my $m           = $conf->config_value(  @pfx, 'circ_max_fines' );
  54         my $pr  = $conf->config_value(  @pfx, 'circ_permit_renew' );
  55         my $ph  = $conf->config_value(  @pfx, 'circ_permit_hold' );
  56         my $lb  = $conf->config_value(  @pfx2, 'script_path' );
  57
  58         $logger->error( "Missing circ script(s)" )
  59                 unless( $p and $c and $d and $f and $m and $pr and $ph );
  60
  61         $scripts{circ_permit_patron}    = $p;
  62         $scripts{circ_permit_copy}              = $c;
  63         $scripts{circ_duration}                 = $d;
  64         $scripts{circ_recurring_fines}= $f;
  65         $scripts{circ_max_fines}                = $m;
  66         $scripts{circ_permit_renew}     = $pr;
  67         $scripts{hold_permit_permit}    = $ph;
  68
  69         $lb = [ $lb ] unless ref($lb);
  70         $script_libs = $lb;
  71
  72         $logger->debug("Loaded rules scripts for circ: " .
  73                 "circ permit patron: $p, circ permit copy: $c, ".
  74                 "circ duration :$d , circ recurring fines : $f, " .
  75                 "circ max fines : $m, circ renew permit : $pr, permit hold: $ph");
  76
  77
  78         $SUCCESS = OpenILS::Event->new('SUCCESS');
  79 }
  80
  81
  82 # ------------------------------------------------------------------------------
  83 # Loads the necessary circ objects and pushes them into the script environment
  84 # Returns ( $data, $evt ).  if $evt is defined, then an
  85 # unexpedted event occurred and should be dealt with / returned to the caller
  86 # ------------------------------------------------------------------------------
  87 sub create_circ_ctx {
  88         my %params = @_;
  89         $U->logmark;
  90
  91         my $evt;
  92         my $ctx = \%params;
  93
  94         $evt = _ctx_add_patron_objects($ctx, %params);
  95         return (undef,$evt) if $evt;
  96
  97         if(!$params{noncat}) {
  98                 if( $evt = _ctx_add_copy_objects($ctx, %params) ) {
  99                         $ctx->{precat} = 1 if($evt->{textcode} eq 'COPY_NOT_FOUND')
 100                 } else {
 101                         $ctx->{precat} = 1 if ( $ctx->{copy}->call_number == -1 ); # special case copy
 102                 }
 103         }
 104
 105         _doctor_patron_object($ctx) if $ctx->{patron};
 106         _doctor_copy_object($ctx) if $ctx->{copy};
 107
 108         if(!$ctx->{no_runner}) {
 109                 _build_circ_script_runner($ctx);
 110                 _add_script_runner_methods($ctx);
 111         }
 112
 113         return $ctx;
 114 }
 115
 116 sub _ctx_add_patron_objects {
 117         my( $ctx, %params) = @_;
 118         $U->logmark;
 119
 120         if(!defined($cache{patron_standings})) {
 121                 $cache{patron_standings} = $U->fetch_patron_standings();
 122                 $cache{group_tree} = $U->fetch_permission_group_tree();
 123         }
 124
 125         $ctx->{patron_standings} = $cache{patron_standings};
 126         $ctx->{group_tree} = $cache{group_tree};
 127
 128         $ctx->{patron_circ_summary} =
 129                 $U->fetch_patron_circ_summary($ctx->{patron}->id)
 130                 if $params{fetch_patron_circsummary};
 131
 132         return undef;
 133 }
 134
 135
 136 sub _find_copy_by_attr {
 137         my %params = @_;
 138         $U->logmark;
 139         my $evt;
 140
 141         my $copy = $params{copy} || undef;
 142
 143         if(!$copy) {
 144
 145                 ( $copy, $evt ) =
 146                         $U->fetch_copy($params{copyid}) if $params{copyid};
 147                 return (undef,$evt) if $evt;
 148
 149                 if(!$copy) {
 150                         ( $copy, $evt ) =
 151                                 $U->fetch_copy_by_barcode( $params{barcode} ) if $params{barcode};
 152                         return (undef,$evt) if $evt;
 153                 }
 154         }
 155         return ( $copy, $evt );
 156 }
 157
 158 sub _ctx_add_copy_objects {
 159         my($ctx, %params)  = @_;
 160         $U->logmark;
 161         my $evt;
 162         my $copy;
 163
 164         $cache{copy_statuses} = $U->fetch_copy_statuses
 165                 if( $params{fetch_copy_statuses} and !defined($cache{copy_statuses}) );
 166
 167         $cache{copy_locations} = $U->fetch_copy_locations
 168                 if( $params{fetch_copy_locations} and !defined($cache{copy_locations}));
 169
 170         $ctx->{copy_statuses} = $cache{copy_statuses};
 171         $ctx->{copy_locations} = $cache{copy_locations};
 172
 173         ($copy, $evt) = _find_copy_by_attr(%params);
 174         return $evt if $evt;
 175
 176         if( $copy ) {
 177                 $logger->debug("Copy status: " . $copy->status);
 178                 ( $ctx->{title}, $evt ) = $U->fetch_record_by_copy( $copy->id );
 179                 return $evt if $evt;
 180                 $ctx->{copy} = $copy;
 181         }
 182
 183         return undef;
 184 }
 185
 186
 187 # ------------------------------------------------------------------------------
 188 # Fleshes parts of the patron object
 189 # ------------------------------------------------------------------------------
 190 sub _doctor_copy_object {
 191         my $ctx = shift;
 192         $U->logmark;
 193         my $copy = $ctx->{copy} || return undef;
 194
 195         $logger->debug("Doctoring copy object...");
 196
 197         # set the copy status to a status name
 198         $copy->status( _get_copy_status( $copy, $ctx->{copy_statuses} ) );
 199
 200         # set the copy location to the location object
 201         $copy->location( _get_copy_location( $copy, $ctx->{copy_locations} ) );
 202
 203         $copy->circ_lib( $U->fetch_org_unit($copy->circ_lib) );
 204 }
 205
 206
 207 # ------------------------------------------------------------------------------
 208 # Fleshes parts of the patron object
 209 # ------------------------------------------------------------------------------
 210 sub _doctor_patron_object {
 211         my $ctx = shift;
 212         $U->logmark;
 213         my $patron = $ctx->{patron} || return undef;
 214
 215         # push the standing object into the patron
 216         if(ref($ctx->{patron_standings})) {
 217                 for my $s (@{$ctx->{patron_standings}}) {
 218                         if( $s->id eq $ctx->{patron}->standing ) {
 219                                 $patron->standing($s);
 220                                 $logger->debug("Set patron standing to ". $s->value);
 221                         }
 222                 }
 223         }
 224
 225         # set the patron ptofile to the profile name
 226         $patron->profile( _get_patron_profile(
 227                 $patron, $ctx->{group_tree} ) ) if $ctx->{group_tree};
 228
 229         # flesh the org unit
 230         $patron->home_ou(
 231                 $U->fetch_org_unit( $patron->home_ou ) ) if $patron;
 232
 233 }
 234
 235 # recurse and find the patron profile name from the tree
 236 # another option would be to grab the groups for the patron
 237 # and cycle through those until the "profile" group has been found
 238 sub _get_patron_profile {
 239         my( $patron, $group_tree ) = @_;
 240         return $group_tree if ($group_tree->id eq $patron->profile);
 241         return undef unless ($group_tree->children);
 242
 243         for my $child (@{$group_tree->children}) {
 244                 my $ret = _get_patron_profile( $patron, $child );
 245                 return $ret if $ret;
 246         }
 247         return undef;
 248 }
 249
 250 sub _get_copy_status {
 251         my( $copy, $cstatus ) = @_;
 252         $U->logmark;
 253         my $s = undef;
 254         for my $status (@$cstatus) {
 255                 $s = $status if( $status->id eq $copy->status )
 256         }
 257         $logger->debug("Retrieving copy status: " . $s->name) if $s;
 258         return $s;
 259 }
 260
 261 sub _get_copy_location {
 262         my( $copy, $locations ) = @_;
 263         $U->logmark;
 264         my $l = undef;
 265         for my $loc (@$locations) {
 266                 $l = $loc if $loc->id eq $copy->location;
 267         }
 268         $logger->debug("Retrieving copy location: " . $l->name ) if $l;
 269         return $l;
 270 }
 271
 272
 273 # ------------------------------------------------------------------------------
 274 # Constructs and shoves data into the script environment
 275 # ------------------------------------------------------------------------------
 276 sub _build_circ_script_runner {
 277         my $ctx = shift;
 278         $U->logmark;
 279
 280         $logger->debug("Loading script environment for circulation");
 281
 282         my $runner;
 283         if( $runner = $contexts{$ctx->{type}} ) {
 284                 $runner->refresh_context;
 285         } else {
 286                 $runner = OpenILS::Utils::ScriptRunner->new unless $runner;
 287                 $contexts{type} = $runner;
 288         }
 289
 290         for(@$script_libs) {
 291                 $logger->debug("Loading circ script lib path $_");
 292                 $runner->add_path( $_ );
 293         }
 294
 295
 296         $runner->insert( 'environment.patron',          $ctx->{patron}, 1);
 297         $runner->insert( 'environment.title',           $ctx->{title}, 1);
 298         $runner->insert( 'environment.copy',            $ctx->{copy}, 1);
 299
 300         # circ script result
 301         $runner->insert( 'result', {} );
 302         $runner->insert( 'result.event', 'SUCCESS' );
 303
 304         $runner->insert('environment.isRenewal', 1) if $__isrenewal;
 305         $runner->insert('environment.isNonCat', 1) if $ctx->{noncat};
 306         $runner->insert('environment.nonCatType', $ctx->{noncat_type}) if $ctx->{noncat};
 307
 308         if(ref($ctx->{patron_circ_summary})) {
 309                 $runner->insert( 'environment.patronItemsOut', $ctx->{patron_circ_summary}->[0], 1 );
 310                 $runner->insert( 'environment.patronFines', $ctx->{patron_circ_summary}->[1], 1 );
 311         }
 312
 313         $ctx->{runner} = $runner;
 314         return $runner;
 315 }
 316
 317
 318 sub _add_script_runner_methods {
 319         my $ctx = shift;
 320         $U->logmark;
 321         my $runner = $ctx->{runner};
 322
 323         if( $ctx->{copy} ) {
 324
 325                 # allows a script to fetch a hold that is currently targeting the
 326                 # copy in question
 327                 $runner->insert_method( 'environment.copy', '__OILS_FUNC_fetch_hold', sub {
 328                                 my $key = shift;
 329                                 my $hold = $holdcode->fetch_related_holds($ctx->{copy}->id);
 330                                 $hold = undef unless $hold;
 331                                 $runner->insert( $key, $hold, 1 );
 332                         }
 333                 );
 334         }
 335 }
 336
 337 # ------------------------------------------------------------------------------
 338
 339 __PACKAGE__->register_method(
 340         method  => "permit_circ",
 341         api_name        => "open-ils.circ.checkout.permit",
 342         notes           => q/
 343                 Determines if the given checkout can occur
 344                 @param authtoken The login session key
 345                 @param params A trailing hash of named params including
 346                         barcode : The copy barcode,
 347                         patron : The patron the checkout is occurring for,
 348                         renew : true or false - whether or not this is a renewal
 349                 @return The event that occurred during the permit check.
 350         /);
 351
 352 sub permit_circ {
 353         my( $self, $client, $authtoken, $params ) = @_;
 354         $U->logmark;
 355
 356         my ( $requestor, $patron, $ctx, $evt, $circ );
 357
 358         # check permisson of the requestor
 359         ( $requestor, $patron, $evt ) =
 360                 $U->checkses_requestor(
 361                 $authtoken, $params->{patron}, 'VIEW_PERMIT_CHECKOUT' );
 362         return $evt if $evt;
 363
 364         # fetch and build the circulation environment
 365         if( !( $ctx = $params->{_ctx}) ) {
 366
 367                 ( $ctx, $evt ) = create_circ_ctx( %$params,
 368                         patron                                                  => $patron,
 369                         requestor                                               => $requestor,
 370                         type                                                            => 'circ',
 371                         fetch_patron_circ_summary       => 1,
 372                         fetch_copy_statuses                     => 1,
 373                         fetch_copy_locations                    => 1,
 374                         );
 375                 return $evt if $evt;
 376         }
 377
 378         ($circ, $evt) = $U->fetch_open_circulation($ctx->{copy}->id)
 379                 if ( !$__isrenewal and $ctx->{copy});
 380
 381         return OpenILS::Event->new('OPEN_CIRCULATION_EXISTS') if $circ;
 382
 383         return _run_permit_scripts($ctx);
 384 }
 385
 386
 387
 388 # Runs the patron and copy permit scripts
 389 # if this is a non-cat circulation, the copy permit script
 390 # is not run
 391 sub _run_permit_scripts {
 392         my $ctx                 = shift;
 393         my $runner              = $ctx->{runner};
 394         my $patronid    = $ctx->{patron}->id;
 395         my $barcode             = ($ctx->{copy}) ? $ctx->{copy}->barcode : undef;
 396         $U->logmark;
 397
 398         $runner->load($scripts{circ_permit_patron});
 399         $runner->run or throw OpenSRF::EX::ERROR ("Circ Permit Patron Script Died: $@");
 400         my $evtname = $runner->retrieve('result.event');
 401         $logger->activity("circ_permit_patron for user $patronid returned event: $evtname");
 402
 403         return OpenILS::Event->new($evtname) if $evtname ne 'SUCCESS';
 404
 405         my $key = _cache_permit_key();
 406
 407         if( $ctx->{noncat} ) {
 408                 $logger->debug("Exiting circ permit early because item is a non-cataloged item");
 409                 return OpenILS::Event->new('SUCCESS', payload => $key);
 410         }
 411
 412         if($ctx->{precat}) {
 413                 $logger->debug("Exiting circ permit early because copy is pre-cataloged");
 414                 return OpenILS::Event->new('ITEM_NOT_CATALOGED', payload => $key);
 415         }
 416
 417         $runner->load($scripts{circ_permit_copy});
 418         $runner->run or throw OpenSRF::EX::ERROR ("Circ Permit Copy Script Died: $@");
 419         $evtname = $runner->retrieve('result.event');
 420         $logger->activity("circ_permit_copy for user $patronid ".
 421                 "and copy $barcode returned event: $evtname");
 422
 423         return OpenILS::Event->new($evtname, payload => $key) if( $evtname eq 'SUCCESS' );
 424         return OpenILS::Event->new($evtname);
 425 }
 426
 427 # takes copyid, patronid, and requestor id
 428 sub _cache_permit_key {
 429         my $key = md5_hex( time() . rand() . "$$" );
 430         $logger->debug("Setting circ permit key to $key");
 431         $cache_handle->put_cache( "oils_permit_key_$key", 1, 300 );
 432         return $key;
 433 }
 434
 435 sub _check_permit_key {
 436         my $key = shift;
 437         $logger->debug("Fetching circ permit key $key");
 438         my $k = "oils_permit_key_$key";
 439         my $one = $cache_handle->get_cache($k);
 440         $cache_handle->delete_cache($k);
 441         return ($one) ? 1 : 0;
 442 }
 443
 444
 445 # ------------------------------------------------------------------------------
 446
 447 __PACKAGE__->register_method(
 448         method  => "checkout",
 449         api_name        => "open-ils.circ.checkout",
 450         notes => q/
 451                 Checks out an item
 452                 @param authtoken The login session key
 453                 @param params A named hash of params including:
 454                         copy                    The copy object
 455                         barcode         If no copy is provided, the copy is retrieved via barcode
 456                         copyid          If no copy or barcode is provide, the copy id will be use
 457                         patron          The patron's id
 458                         noncat          True if this is a circulation for a non-cataloted item
 459                         noncat_type     The non-cataloged type id
 460                         noncat_circ_lib The location for the noncat circ.
 461                         precat          The item has yet to be cataloged
 462                         dummy_title The temporary title of the pre-cataloded item
 463                         dummy_author The temporary authr of the pre-cataloded item
 464                                 Default is the home org of the staff member
 465                 @return The SUCCESS event on success, any other event depending on the error
 466         /);
 467
 468 sub checkout {
 469         my( $self, $client, $authtoken, $params ) = @_;
 470         $U->logmark;
 471
 472         my ( $requestor, $patron, $ctx, $evt, $circ, $copy );
 473         my $key = $params->{permit_key};
 474
 475         # if this is a renewal, then the requestor does not have to
 476         # have checkout privelages
 477         ( $requestor, $evt ) = $U->checkses($authtoken) if $__isrenewal;
 478         ( $requestor, $evt ) = $U->checksesperm( $authtoken, 'COPY_CHECKOUT' ) unless $__isrenewal;
 479
 480         $logger->debug("REQUESTOR event: " . ref($requestor));
 481
 482         return $evt if $evt;
 483         ( $patron, $evt ) = $U->fetch_user($params->{patron});
 484         return $evt if $evt;
 485
 486
 487         # set the circ lib to the home org of the requestor if not specified
 488         my $circlib = (defined($params->{circ_lib})) ?
 489                 $params->{circ_lib} : $requestor->home_ou;
 490
 491         # if this is a non-cataloged item, check it out and return
 492         return _checkout_noncat(
 493                 $key, $requestor, $patron, %$params ) if $params->{noncat};
 494
 495         # if this item has yet to be cataloged, make sure a dummy copy exists
 496         ( $params->{copy}, $evt ) = _make_precat_copy(
 497                 $requestor, $circlib, $params ) if $params->{precat};
 498         return $evt if $evt;
 499
 500         # fetch and build the circulation environment
 501         if( !( $ctx = $params->{_ctx}) ) {
 502                 ( $ctx, $evt ) = create_circ_ctx( %$params,
 503                         patron                                                  => $patron,
 504                         requestor                                               => $requestor,
 505                         session                                                 => $U->start_db_session(),
 506                         type                                                            => 'circ',
 507                         fetch_patron_circ_summary       => 1,
 508                         fetch_copy_statuses                     => 1,
 509                         fetch_copy_locations                    => 1,
 510                         );
 511                 return $evt if $evt;
 512         }
 513         $ctx->{session} = $U->start_db_session() unless $ctx->{session};
 514
 515         my $cid = ($params->{precat}) ? -1 : $ctx->{copy}->id;
 516         return OpenILS::Event->new('CIRC_PERMIT_BAD_KEY')
 517                 unless _check_permit_key($key);
 518
 519         $ctx->{circ_lib} = $circlib;
 520
 521         $evt = _run_checkout_scripts($ctx);
 522         return $evt if $evt;
 523
 524         _build_checkout_circ_object($ctx);
 525
 526         $evt = _commit_checkout_circ_object($ctx);
 527         return $evt if $evt;
 528
 529         $evt = _update_checkout_copy($ctx);
 530         return $evt if $evt;
 531
 532         my $holds;
 533         ($holds, $evt) = _handle_related_holds($ctx);
 534         return $evt if $evt;
 535
 536
 537         $logger->debug("Checkin committing objects with session thread trace: ".$ctx->{session}->session_id);
 538         $U->commit_db_session($ctx->{session});
 539         my $record = $U->record_to_mvr($ctx->{title}) unless $ctx->{precat};
 540
 541         return OpenILS::Event->new('SUCCESS',
 542                 payload => {
 543                         copy                                    => $U->unflesh_copy($ctx->{copy}),
 544                         circ                                    => $ctx->{circ},
 545                         record                          => $record,
 546                         holds_fulfilled => $holds,
 547                 } );
 548 }
 549
 550
 551 sub _make_precat_copy {
 552         my ( $requestor, $circlib, $params ) =  @_;
 553         $U->logmark;
 554         my( $copy, undef ) = _find_copy_by_attr(%$params);
 555
 556         if($copy) {
 557                 $logger->debug("Pre-cat copy already exists in checkout: ID=" . $copy->id);
 558                 return ($copy, undef);
 559         }
 560
 561         $logger->debug("Creating a new precataloged copy in checkout with barcode " . $params->{barcode});
 562
 563         my $evt = OpenILS::Event->new(
 564                 'BAD_PARAMS', desc => "Dummy title or author not provided" )
 565                 unless ( $params->{dummy_title} and $params->{dummy_author} );
 566         return (undef, $evt) if $evt;
 567
 568         $copy = Fieldmapper::asset::copy->new;
 569         $copy->circ_lib($circlib);
 570         $copy->creator($requestor->id);
 571         $copy->editor($requestor->id);
 572         $copy->barcode($params->{barcode});
 573         $copy->call_number(-1); #special CN for precat materials
 574         $copy->loan_duration(&PRECAT_LOAN_DURATION);  # these two should come from constants
 575         $copy->fine_level(&PRECAT_FINE_LEVEL);
 576
 577         $copy->dummy_title($params->{dummy_title});
 578         $copy->dummy_author($params->{dummy_author});
 579
 580         my $id = $U->storagereq(
 581                 'open-ils.storage.direct.asset.copy.create', $copy );
 582         return (undef, $U->DB_UPDATE_FAILED($copy)) unless $copy;
 583
 584         $logger->debug("Pre-cataloged copy successfully created");
 585         return $U->fetch_copy($id);
 586 }
 587
 588
 589 sub _run_checkout_scripts {
 590         my $ctx = shift;
 591         $U->logmark;
 592         my $evt;
 593         my $circ;
 594
 595         my $runner = $ctx->{runner};
 596
 597         $runner->insert('result.durationLevel');
 598         $runner->insert('result.durationRule');
 599         $runner->insert('result.recurringFinesRule');
 600         $runner->insert('result.recurringFinesLevel');
 601         $runner->insert('result.maxFine');
 602
 603         $runner->load($scripts{circ_duration});
 604         $runner->run or throw OpenSRF::EX::ERROR ("Circ Duration Script Died: $@");
 605         my $duration = $runner->retrieve('result.durationRule');
 606         $logger->debug("Circ duration script yielded a duration rule of: $duration");
 607
 608         $runner->load($scripts{circ_recurring_fines});
 609         $runner->run or throw OpenSRF::EX::ERROR ("Circ Recurring Fines Script Died: $@");
 610         my $recurring = $runner->retrieve('result.recurringFinesRule');
 611         $logger->debug("Circ recurring fines script yielded a rule of: $recurring");
 612
 613         $runner->load($scripts{circ_max_fines});
 614         $runner->run or throw OpenSRF::EX::ERROR ("Circ Max Fine Script Died: $@");
 615         my $max_fine = $runner->retrieve('result.maxFine');
 616         $logger->debug("Circ max_fine fines script yielded a rule of: $max_fine");
 617
 618         ($duration, $evt) = $U->fetch_circ_duration_by_name($duration);
 619         return $evt if $evt;
 620         ($recurring, $evt) = $U->fetch_recurring_fine_by_name($recurring);
 621         return $evt if $evt;
 622         ($max_fine, $evt) = $U->fetch_max_fine_by_name($max_fine);
 623         return $evt if $evt;
 624
 625         $ctx->{duration_level}                  = $runner->retrieve('result.durationLevel');
 626         $ctx->{recurring_fines_level} = $runner->retrieve('result.recurringFinesLevel');
 627         $ctx->{duration_rule}                   = $duration;
 628         $ctx->{recurring_fines_rule}    = $recurring;
 629         $ctx->{max_fine_rule}                   = $max_fine;
 630
 631         return undef;
 632 }
 633
 634 sub _build_checkout_circ_object {
 635         my $ctx = shift;
 636         $U->logmark;
 637
 638         my $circ                        = new Fieldmapper::action::circulation;
 639         my $duration    = $ctx->{duration_rule};
 640         my $max                 = $ctx->{max_fine_rule};
 641         my $recurring   = $ctx->{recurring_fines_rule};
 642         my $copy                        = $ctx->{copy};
 643         my $patron              = $ctx->{patron};
 644         my $dur_level   = $ctx->{duration_level};
 645         my $rec_level   = $ctx->{recurring_fines_level};
 646
 647         $circ->duration( $duration->shrt ) if ($dur_level == 1);
 648         $circ->duration( $duration->normal ) if ($dur_level == 2);
 649         $circ->duration( $duration->extended ) if ($dur_level == 3);
 650
 651         $circ->recuring_fine( $recurring->low ) if ($rec_level =~ /low/io);
 652         $circ->recuring_fine( $recurring->normal ) if ($rec_level =~ /normal/io);
 653         $circ->recuring_fine( $recurring->high ) if ($rec_level =~ /high/io);
 654
 655         $circ->duration_rule( $duration->name );
 656         $circ->recuring_fine_rule( $recurring->name );
 657         $circ->max_fine_rule( $max->name );
 658         $circ->max_fine( $max->amount );
 659
 660         $circ->fine_interval($recurring->recurance_interval);
 661         $circ->renewal_remaining( $duration->max_renewals );
 662         $circ->target_copy( $copy->id );
 663         $circ->usr( $patron->id );
 664         $circ->circ_lib( $ctx->{circ_lib} );
 665
 666         if( $__isrenewal ) {
 667                 $logger->debug("Circ is a renewal.  Setting renewal_remaining to " . $ctx->{renewal_remaining} );
 668                 $circ->opac_renewal(1);
 669                 $circ->renewal_remaining($ctx->{renewal_remaining});
 670                 $circ->circ_staff($ctx->{requestor}->id);
 671         }
 672
 673         # if a patron is renewing, 'requestor' will be the patron
 674         $circ->circ_staff( $ctx->{requestor}->id );
 675         _set_circ_due_date($circ);
 676         $ctx->{circ} = $circ;
 677 }
 678
 679 sub _create_due_date {
 680         my $duration = shift;
 681         $U->logmark;
 682
 683         my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
 684                 gmtime(OpenSRF::Utils->interval_to_seconds($duration) + int(time()));
 685
 686         $year += 1900; $mon += 1;
 687         my $due_date = sprintf(
 688         '%s-%0.2d-%0.2dT%s:%0.2d:%0.s2-00',
 689         $year, $mon, $mday, $hour, $min, $sec);
 690         return $due_date;
 691 }
 692
 693 sub _set_circ_due_date {
 694         my $circ = shift;
 695         $U->logmark;
 696         my $dd = _create_due_date($circ->duration);
 697         $logger->debug("Checkout setting due date on circ to: $dd");
 698         $circ->due_date($dd);
 699 }
 700
 701 # Sets the editor, edit_date, un-fleshes the copy, and updates the copy in the DB
 702 sub _update_checkout_copy {
 703         my $ctx = shift;
 704         $U->logmark;
 705         my $copy = $ctx->{copy};
 706
 707         my $s = $U->copy_status_from_name('checked out');
 708         $copy->status( $s->id ) if $s;
 709
 710         my $evt = $U->update_copy( session => $ctx->{session},
 711                 copy => $copy, editor => $ctx->{requestor}->id );
 712         return (undef,$evt) if $evt;
 713
 714         return undef;
 715 }
 716
 717 # commits the circ object to the db then fleshes the circ with rules objects
 718 sub _commit_checkout_circ_object {
 719
 720         my $ctx = shift;
 721         my $circ = $ctx->{circ};
 722         $U->logmark;
 723
 724         $circ->clear_id;
 725         my $r = $ctx->{session}->request(
 726                 "open-ils.storage.direct.action.circulation.create", $circ )->gather(1);
 727
 728         return $U->DB_UPDATE_FAILED($circ) unless $r;
 729
 730         $logger->debug("Created a new circ object in checkout: $r");
 731
 732         $circ->id($r);
 733         $circ->duration_rule($ctx->{duration_rule});
 734         $circ->max_fine_rule($ctx->{max_fine_rule});
 735         $circ->recuring_fine_rule($ctx->{recurring_fines_rule});
 736
 737         return undef;
 738 }
 739
 740
 741 # sees if there are any holds that this copy
 742 sub _handle_related_holds {
 743
 744         my $ctx         = shift;
 745         my $copy                = $ctx->{copy};
 746         my $patron      = $ctx->{patron};
 747         my $holds       = $holdcode->fetch_related_holds($copy->id);
 748         $U->logmark;
 749         my @fulfilled;
 750
 751         # XXX should we fulfill all the holds or just the first
 752         if(ref($holds) && @$holds) {
 753
 754                 # for now, just sort by id to get what should be the oldest hold
 755                 $holds = [ sort { $a->id <=> $b->id } @$holds ];
 756                 $holds = [ grep { $_->usr eq $patron->id } @$holds ];
 757
 758                 if(@$holds) {
 759                         my $hold = $holds->[0];
 760
 761                         $logger->debug("Related hold found in checkout: " . $hold->id );
 762
 763                         $hold->fulfillment_time('now');
 764                         my $r = $ctx->{session}->request(
 765                                 "open-ils.storage.direct.action.hold_request.update", $hold )->gather(1);
 766                         return (undef,$U->DB_UPDATE_FAILED( $hold )) unless $r;
 767                         push( @fulfilled, $hold->id );
 768                 }
 769         }
 770
 771         return (\@fulfilled, undef);
 772 }
 773
 774
 775 sub _checkout_noncat {
 776         my ( $key, $requestor, $patron, %params ) = @_;
 777         my( $circ, $circlib, $evt );
 778         $U->logmark;
 779
 780         $circlib = $params{noncat_circ_lib} || $requestor->home_ou;
 781
 782         return OpenILS::Event->new('CIRC_PERMIT_BAD_KEY')
 783                 unless _check_permit_key($key);
 784
 785         ( $circ, $evt ) = OpenILS::Application::Circ::NonCat::create_non_cat_circ(
 786                         $requestor->id, $patron->id, $circlib, $params{noncat_type} );
 787
 788         return $evt if $evt;
 789         return OpenILS::Event->new(
 790                 'SUCCESS', payload => { noncat_circ => $circ } );
 791 }
 792
 793
 794 # ------------------------------------------------------------------------------
 795
 796 __PACKAGE__->register_method(
 797         method  => "checkin",
 798         api_name        => "open-ils.circ.checkin",
 799         notes           => <<"  NOTES");
 800         PARAMS( authtoken, barcode => bc )
 801         Checks in based on barcode
 802         Returns an event object whose payload contains the record, circ, and copy
 803         If the item needs to be routed, the event is a ROUTE_ITEM event
 804         with an additional 'route_to' variable set on the event
 805         NOTES
 806
 807 sub checkin {
 808         my( $self, $client, $authtoken, $params ) = @_;
 809         $U->logmark;
 810
 811         my( $ctx, $requestor, $evt, $circ, $copy, $payload );
 812
 813         ( $requestor, $evt ) = $U->checkses($authtoken) if $__isrenewal;
 814         ( $requestor, $evt ) = $U->checksesperm(
 815                 $authtoken, 'COPY_CHECKIN' ) unless $__isrenewal;
 816         return $evt if $evt;
 817
 818         if( !( $ctx = $params->{_ctx}) ) {
 819                 ( $ctx, $evt ) = create_circ_ctx( %$params,
 820                         requestor                                               => $requestor,
 821                         session                                                 => $U->start_db_session(),
 822                         type                                                            => 'circ',
 823                         #fetch_patron_circ_summary      => 1,
 824                         fetch_copy_statuses                     => 1,
 825                         fetch_copy_locations                    => 1,
 826                         no_runner                                               => 1,
 827                         );
 828                 return $evt if $evt;
 829         }
 830         $ctx->{session} = $U->start_db_session() unless $ctx->{session};
 831
 832         $copy = $ctx->{copy};
 833         return OpenILS::Event->new('COPY_NOT_FOUND') unless $copy;
 834
 835         $payload = { copy => $copy };
 836         $payload->{record} =
 837                 $U->record_to_mvr($ctx->{title})
 838                         if($ctx->{title} and !$ctx->{precat});
 839
 840 #       if( $copy->status ==
 841 #               $U->copy_status_from_name($cache{copy_statuses}, 'lost')->id) {
 842 #               $__islost = 1;
 843 #       } else { $__islost = 0; }
 844
 845         my $status = $U->copy_status_from_name('in transit');
 846         if( $copy->status == $status->id ) {
 847
 848                 # if this copy is in transit, send it to transit_receive.
 849                 $evt = $transcode->transit_receive( $copy, $requestor, $ctx->{session} );
 850                 if( !$U->event_equals($evt, 'SUCCESS')) {
 851                         $evt->{payload}->{copy} = $U->unflesh_copy($copy);
 852                         return $evt;
 853                 }
 854                 $evt = undef;
 855         }
 856
 857         # set the status to available for now for ease of debugging
 858         $copy->status( $U->copy_status_from_name('available')->id );
 859
 860         # set the status to reshelving XXX needs to fall back to
 861         # 'available' after a configurable amount of time
 862         #$copy->status( $U->copy_status_from_name('reshelving')->id );
 863
 864         # grab the open circ attached to this copy
 865         ( $circ, $evt ) = $U->fetch_open_circulation($copy->id);
 866         if($evt) {
 867                 $evt->{payload} = $payload;
 868                 $evt->{payload}->{copy} = $U->unflesh_copy($copy);
 869                 return $evt;
 870         }
 871
 872         $ctx->{circ} = $circ;
 873         $payload->{circ} = $circ;
 874
 875         # update the circ and copy in the db
 876         return $evt if($evt = _update_checkin_circ_and_copy($ctx));
 877
 878         # ------------------------------------------------------------------------------
 879         # If we get to this point, then the checkin will succeed.  We just need to
 880         # see if there is any other processing required on this copy
 881         # ------------------------------------------------------------------------------
 882
 883         if( !($evt = _check_checkin_holds($ctx)) ) {
 884                 # if no hold is found for the copy, see if it needs to be transited
 885                 if( $copy->circ_lib != $requestor->home_ou ) {
 886                         $logger->debug("Checkin copy needs to go back to it's circ lib: ".
 887                                 "current loc: ".$requestor->home_ou.", copy circ_lib: ".$copy->circ_lib);
 888                         $evt = OpenILS::Event->new('ROUTE_ITEM', org => $copy->circ_lib );
 889                 }
 890         }
 891
 892         $logger->debug("Checkin committing objects...");
 893         $U->commit_db_session($ctx->{session});
 894
 895         # if the item is not cataloged and no superceding
 896         # events exist, return the proper event
 897         if ( $copy->call_number == -1 and !$evt ) {
 898                 $evt = OpenILS::Event->new('ITEM_NOT_CATALOGED') }
 899
 900         $evt = $SUCCESS if (!$evt or $__isrenewal);
 901         $evt->{payload} = $payload;
 902
 903         $logger->info("Checkin of copy ".$copy->id." returned event: ".$evt->{textcode});
 904
 905         $evt->{payload}->{copy} = $U->unflesh_copy($copy);
 906
 907         return $evt;
 908 }
 909
 910 sub _check_checkin_holds {
 911
 912         my $ctx                 = shift;
 913         my $session             = $ctx->{session};
 914         my $requestor   = $ctx->{requestor};
 915         my $copy                        = $ctx->{copy};
 916
 917         $logger->debug("Searching for a local hold on a copy: " . $session->session_id);
 918
 919         my ( $hold, $evt ) =
 920                 $holdcode->find_local_hold( $session, $copy, $requestor );
 921
 922         if($hold) {
 923                 $evt = OpenILS::Event->new(
 924                         'COPY_NEEDED_FOR_HOLD', org => $hold->pickup_lib);
 925         }
 926 }
 927
 928
 929 sub _update_checkin_circ_and_copy {
 930         my $ctx = shift;
 931         $U->logmark;
 932
 933         my $circ = $ctx->{circ};
 934         my $copy = $ctx->{copy};
 935         my $requestor = $ctx->{requestor};
 936         my $session = $ctx->{session};
 937
 938         my ( $obt, $evt ) = $U->fetch_open_billable_transaction($circ->id);
 939         return $evt if $evt;
 940
 941         $circ->stop_fines('CHECKIN');
 942         $circ->stop_fines('RENEW') if $__isrenewal;
 943         $circ->stop_fines('LOST') if($__islost);
 944         $circ->xact_finish('now') if($obt->balance_owed <= 0 and !$__islost);
 945         $circ->stop_fines_time('now');
 946         $circ->checkin_time('now');
 947         $circ->checkin_staff($requestor->id);
 948
 949         # if the requestor set a backdate, void all the bills after
 950         # the backdate time
 951         if(my $backdate = $ctx->{backdate}) {
 952
 953                 $logger->activity("User ".$requestor->id.
 954                         " backdating checkin copy [".$ctx->{barcode}."] to date: $backdate");
 955
 956                 $circ->xact_finish($backdate);
 957
 958                 my $bills = $session->request( # XXX what other search criteria??
 959                         "open-ils.storage.direct.money.billing.search_where.atomic",
 960                         billing_ts => { ">=" => $backdate })->gather(1);
 961
 962                 if($bills) {
 963                         for my $bill (@$bills) {
 964                                 $bill->voided('t');
 965                                 my $s = $session->request(
 966                                         "open-ils.storage.direct.money.billing.update", $bill)->gather(1);
 967                                 return $U->DB_UPDATE_FAILED($bill) unless $s;
 968                         }
 969                 }
 970         }
 971
 972         $logger->debug("Checkin committing copy and circ objects");
 973         $evt = $U->update_copy( session => $session,
 974                 copy => $copy, editor => $requestor->id );
 975         return $evt if $evt;
 976
 977         $ctx->{session}->request(
 978                 'open-ils.storage.direct.action.circulation.update', $circ )->gather(1);
 979
 980         return undef;
 981 }
 982
 983
 984
 985 # ------------------------------------------------------------------------------
 986
 987 __PACKAGE__->register_method(
 988         method  => "renew",
 989         api_name        => "open-ils.circ.renew",
 990         notes           => <<"  NOTES");
 991         PARAMS( authtoken, circ => circ_id );
 992         open-ils.circ.renew(login_session, circ_object);
 993         Renews the provided circulation.  login_session is the requestor of the
 994         renewal and if the logged in user is not the same as circ->usr, then
 995         the logged in user must have RENEW_CIRC permissions.
 996         NOTES
 997
 998 sub renew {
 999         my( $self, $client, $authtoken, $params ) = @_;
1000         $U->logmark;
1001
1002         my ( $requestor, $patron, $ctx, $evt, $circ, $copy );
1003         $__isrenewal = 1;
1004
1005         # if requesting a renewal for someone else, you must have
1006         # renew privelages
1007         ( $requestor, $patron, $evt ) = $U->checkses_requestor(
1008                 $authtoken, $params->{patron}, 'RENEW_CIRC' );
1009         return $evt if $evt;
1010
1011
1012         # fetch and build the circulation environment
1013         ( $ctx, $evt ) = create_circ_ctx( %$params,
1014                 patron                                                  => $patron,
1015                 requestor                                               => $requestor,
1016                 patron                                                  => $patron,
1017                 type                                                            => 'circ',
1018                 fetch_patron_circ_summary       => 1,
1019                 fetch_copy_statuses                     => 1,
1020                 fetch_copy_locations                    => 1,
1021                 );
1022         return $evt if $evt;
1023         $params->{_ctx} = $ctx;
1024
1025         # make sure they have some renewals left and make sure the circulation exists
1026         ($circ, $evt) = _check_renewal_remaining($ctx);
1027         return $evt if $evt;
1028         $ctx->{old_circ} = $circ;
1029         my $renewals = $circ->renewal_remaining - 1;
1030
1031         # run the renew permit script
1032         return $evt if( ($evt = _run_renew_scripts($ctx)) );
1033
1034         # checkin the cop
1035         #$ctx->{patron} = $ctx->{patron}->id;
1036         $evt = $self->checkin($client, $authtoken, $ctx );
1037                 #{ barcode => $params->{barcode}, patron => $params->{patron}} );
1038
1039         return $evt unless $U->event_equals($evt, 'SUCCESS');
1040
1041         # re-fetch the context since objects have changed in the checkin
1042         ( $ctx, $evt ) = create_circ_ctx( %$params,
1043                 patron                                                  => $patron,
1044                 requestor                                               => $requestor,
1045                 patron                                                  => $patron,
1046                 type                                                            => 'circ',
1047                 fetch_patron_circ_summary       => 1,
1048                 fetch_copy_statuses                     => 1,
1049                 fetch_copy_locations                    => 1,
1050                 );
1051         return $evt if $evt;
1052         $params->{_ctx} = $ctx;
1053         $ctx->{renewal_remaining} = $renewals;
1054
1055         # run the circ permit scripts
1056         $evt = $self->permit_circ( $client, $authtoken, $params );
1057         if( $U->event_equals($evt, 'ITEM_NOT_CATALOGED')) {
1058                 $ctx->{precat} = 1;
1059         } else {
1060                 return $evt unless $U->event_equals($evt, 'SUCCESS');
1061         }
1062         $params->{permit_key} = $evt->{payload};
1063
1064
1065         # checkout the item again
1066         $evt = $self->checkout($client, $authtoken, $params );
1067
1068         $__isrenewal = 0;
1069         return $evt;
1070 }
1071
1072 sub _check_renewal_remaining {
1073         my $ctx = shift;
1074         $U->logmark;
1075         my( $circ, $evt ) = $U->fetch_open_circulation($ctx->{copy}->id);
1076         return (undef, $evt) if $evt;
1077         $evt = OpenILS::Event->new(
1078                 'MAX_RENEWALS_REACHED') if $circ->renewal_remaining < 1;
1079         return ($circ, $evt);
1080 }
1081
1082 sub _run_renew_scripts {
1083         my $ctx = shift;
1084         my $runner = $ctx->{runner};
1085         $U->logmark;
1086
1087         $runner->load($scripts{circ_permit_renew});
1088         $runner->run or throw OpenSRF::EX::ERROR ("Circ Permit Renew Script Died: $@");
1089         my $evtname = $runner->retrieve('result.event');
1090         $logger->activity("circ_permit_renew for user ".$ctx->{patron}->id." returned event: $evtname");
1091
1092         return OpenILS::Event->new($evtname) if $evtname ne 'SUCCESS';
1093         return undef;
1094 }
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104 666;
1105