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