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, $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         if( !( $ctx = $params->{_ctx}) ) {
 806                 ( $ctx, $evt ) = create_circ_ctx( %$params,
 807                         requestor                                               => $requestor,
 808                         session                                                 => $U->start_db_session(),
 809                         type                                                            => 'circ',
 810                         fetch_patron_circ_summary       => 1,
 811                         fetch_copy_statuses                     => 1,
 812                         fetch_copy_locations                    => 1,
 813                         no_runner                                               => 1,
 814                         );
 815                 return $evt if $evt;
 816         }
 817         $ctx->{session} = $U->start_db_session() unless $ctx->{session};
 818
 819         $copy = $ctx->{copy};
 820         return OpenILS::Event->new('COPY_NOT_FOUND') unless $copy;
 821
 822 #       if( $copy->status ==
 823 #               $U->copy_status_from_name($cache{copy_statuses}, 'lost')->id) {
 824 #               $__islost = 1;
 825 #       } else { $__islost = 0; }
 826
 827         my $status = $U->copy_status_from_name($cache{copy_statuses}, 'in transit');
 828         if( $copy->status == $status->id ) {
 829                 # if this copy is in transit, send it to transit_receive.
 830                 $evt = transit_receive( $copy->id, $requestor, $ctx->{session} );
 831                 return $evt unless $U->event_equals($evt, 'SUCCESS');
 832                 $copy = $evt->{payload};
 833                 $evt = undef;
 834         }
 835
 836         $copy->status( $U->copy_status_from_name(
 837                 $cache{copy_statuses}, 'available')->id );
 838
 839
 840         ( $circ, $evt ) = $U->fetch_open_circulation($copy->id);
 841         return $evt if $evt;
 842         $ctx->{circ} = $circ;
 843
 844         return $evt if($evt = _update_checkin_circ_and_copy($ctx));
 845
 846         $logger->debug("Checkin committing objects with ".
 847                 "session thread trace: ".$ctx->{session}->session_id);
 848         $U->commit_db_session($ctx->{session});
 849
 850         my $record = $U->record_to_mvr($ctx->{title}) if($ctx->{title} and ! $ctx->{precat});
 851         my $payload = {
 852                 copy            => $ctx->{copy},
 853                 circ            => $ctx->{circ},
 854                 record  => $record };
 855
 856         return OpenILS::Event->new('ITEM_NOT_CATALOGED',
 857                 payload => $payload ) if $copy->call_number == -1;
 858
 859         return OpenILS::Event->new('SUCCESS', payload => $payload );
 860 }
 861
 862
 863 sub _update_checkin_circ_and_copy {
 864         my $ctx = shift;
 865         $U->logmark;
 866
 867         my $circ = $ctx->{circ};
 868         my $copy = $ctx->{copy};
 869         my $requestor = $ctx->{requestor};
 870         my $session = $ctx->{session};
 871
 872         my ( $obt, $evt ) = $U->fetch_open_billable_transaction($circ->id);
 873         return $evt if $evt;
 874
 875         $circ->stop_fines('CHECKIN');
 876         $circ->stop_fines('RENEW') if $__isrenewal;
 877         $circ->stop_fines('LOST') if($__islost);
 878         $circ->xact_finish('now') if($obt->balance_owed <= 0 and !$__islost);
 879         $circ->stop_fines_time('now');
 880         $circ->checkin_time('now');
 881         $circ->checkin_staff($requestor->id);
 882
 883         # if the requestor set a backdate, void all the bills after
 884         # the backdate time
 885         if(my $backdate = $ctx->{backdate}) {
 886
 887                 $logger->activity("User ".$requestor->id.
 888                         " backdating checkin copy [".$ctx->{barcode}."] to date: $backdate");
 889
 890                 $circ->xact_finish($backdate);
 891
 892                 my $bills = $session->request( # XXX what other search criteria??
 893                         "open-ils.storage.direct.money.billing.search_where.atomic",
 894                         billing_ts => { ">=" => $backdate })->gather(1);
 895
 896                 if($bills) {
 897                         for my $bill (@$bills) {
 898                                 $bill->voided('t');
 899                                 my $s = $session->request(
 900                                         "open-ils.storage.direct.money.billing.update", $bill)->gather(1);
 901                                 return $U->DB_UPDATE_FAILED($bill) unless $s;
 902                         }
 903                 }
 904         }
 905
 906         $logger->debug("Checkin committing copy and circ objects");
 907         $evt = $U->update_copy( session => $session,
 908                 copy => $copy, editor => $requestor->id );
 909         return $evt if $evt;
 910
 911         $ctx->{session}->request(
 912                 'open-ils.storage.direct.action.circulation.update', $circ )->gather(1);
 913
 914         return undef;
 915 }
 916
 917
 918
 919 # ------------------------------------------------------------------------------
 920
 921 __PACKAGE__->register_method(
 922         method  => "renew",
 923         api_name        => "open-ils.circ.renew",
 924         notes           => <<"  NOTES");
 925         PARAMS( authtoken, circ => circ_id );
 926         open-ils.circ.renew(login_session, circ_object);
 927         Renews the provided circulation.  login_session is the requestor of the
 928         renewal and if the logged in user is not the same as circ->usr, then
 929         the logged in user must have RENEW_CIRC permissions.
 930         NOTES
 931
 932 sub renew {
 933         my( $self, $client, $authtoken, $params ) = @_;
 934         $U->logmark;
 935
 936         my ( $requestor, $patron, $ctx, $evt, $circ, $copy );
 937         $__isrenewal = 1;
 938
 939         # if requesting a renewal for someone else, you must have
 940         # renew privelages
 941         ( $requestor, $patron, $evt ) = $U->checkses_requestor(
 942                 $authtoken, $params->{patron}, 'RENEW_CIRC' );
 943         return $evt if $evt;
 944
 945
 946         # fetch and build the circulation environment
 947         ( $ctx, $evt ) = create_circ_ctx( %$params,
 948                 patron                                                  => $patron,
 949                 requestor                                               => $requestor,
 950                 type                                                            => 'circ',
 951                 fetch_patron_circ_summary       => 1,
 952                 fetch_copy_statuses                     => 1,
 953                 fetch_copy_locations                    => 1,
 954                 );
 955         return $evt if $evt;
 956         $params->{_ctx} = $ctx;
 957
 958         # make sure they have some renewals left and make sure the circulation exists
 959         ($circ, $evt) = _check_renewal_remaining($ctx);
 960         return $evt if $evt;
 961         $ctx->{old_circ} = $circ;
 962         my $renewals = $circ->renewal_remaining - 1;
 963
 964         # run the renew permit script
 965         return $evt if( ($evt = _run_renew_scripts($ctx)) );
 966
 967         # checkin the cop
 968         $ctx->{patron} = $ctx->{patron}->id;
 969         $evt = $self->checkin($client, $authtoken, $ctx );
 970                 #{ barcode => $params->{barcode}, patron => $params->{patron}} );
 971
 972         return $evt unless $U->event_equals($evt, 'SUCCESS');
 973
 974         # re-fetch the context since objects have changed in the checkin
 975         ( $ctx, $evt ) = create_circ_ctx( %$params,
 976                 patron                                                  => $patron,
 977                 requestor                                               => $requestor,
 978                 type                                                            => 'circ',
 979                 fetch_patron_circ_summary       => 1,
 980                 fetch_copy_statuses                     => 1,
 981                 fetch_copy_locations                    => 1,
 982                 );
 983         return $evt if $evt;
 984         $params->{_ctx} = $ctx;
 985         $ctx->{renewal_remaining} = $renewals;
 986
 987         # run the circ permit scripts
 988         $evt = $self->permit_circ( $client, $authtoken, $params );
 989         if( $U->event_equals($evt, 'ITEM_NOT_CATALOGED')) {
 990                 $ctx->{precat} = 1;
 991         } else {
 992                 return $evt unless $U->event_equals($evt, 'SUCCESS');
 993         }
 994         $params->{permit_key} = $evt->{payload};
 995
 996
 997         # checkout the item again
 998         $evt = $self->checkout($client, $authtoken, $params );
 999
1000         $__isrenewal = 0;
1001         return $evt;
1002 }
1003
1004 sub _check_renewal_remaining {
1005         my $ctx = shift;
1006         $U->logmark;
1007         my( $circ, $evt ) = $U->fetch_open_circulation($ctx->{copy}->id);
1008         return (undef, $evt) if $evt;
1009         $evt = OpenILS::Event->new(
1010                 'MAX_RENEWALS_REACHED') if $circ->renewal_remaining < 1;
1011         return ($circ, $evt);
1012 }
1013
1014 sub _run_renew_scripts {
1015         my $ctx = shift;
1016         my $runner = $ctx->{runner};
1017         $U->logmark;
1018
1019         $runner->load($scripts{circ_permit_renew});
1020         $runner->run or throw OpenSRF::EX::ERROR ("Circ Permit Renew Script Died: $@");
1021         my $evtname = $runner->retrieve('result.event');
1022         $logger->activity("circ_permit_renew for user ".$ctx->{patron}." returned event: $evtname");
1023
1024         return OpenILS::Event->new($evtname) if $evtname ne 'SUCCESS';
1025         return undef;
1026 }
1027
1028
1029
1030 sub transit_receive {
1031         my ( $copyid, $requestor, $session ) = @_;
1032         $U->logmark;
1033
1034         my( $copy, $evt ) = $U->fetch_copy($copyid);
1035         my( $transit, $hold_transit );
1036         my $cstats = $cache{copy_statuses};
1037
1038         my $status_name = $U->copy_status_to_name($cstats, $copy->status );
1039         $logger->debug("Attempting transit receive on copy $copyid. Copy status is $status_name");
1040
1041         # fetch the transit
1042         ($transit, $evt) = $U->fetch_open_transit_by_copy($copyid);
1043         return $evt if $evt;
1044
1045         if( $transit->dest != $requestor->home_ou ) {
1046                 $logger->activity("Fowarding transit on copy which is destined ".
1047                         "for a different location. copy=$copyid,current ".
1048                         "location=".$requestor->home_ou.",destination location=".$transit->dest);
1049
1050                 return OpenILS::Event->new('ROUTE_ITEM', org => $transit->dest );
1051         }
1052
1053         # The transit is received, set the receive time
1054         $transit->dest_recv_time('now');
1055         my $r = $session->request(
1056                 'open-ils.storage.direct.action.transit_copy.update', $transit )->gather(1);
1057         return $U->DB_UPDATE_FAILED($transit) unless $r;
1058
1059         # if this is a hold transit, finalize the hold transit
1060         return $evt if( ($evt = _finish_hold_transit(
1061                 $session, $requestor, $copy, $transit->id )) );
1062
1063         $U->logmark;
1064
1065         #recover this copy's status from the transit
1066         $copy->status( $transit->copy_status );
1067         return OpenILS::Event->('SUCCESS', payload => $copy);
1068
1069 }
1070
1071 # ------------------------------------------------------------------------------
1072 # If we have a hold transit, set the copy's status to 'on holds shelf',
1073 # update the copy, and return the ROUTE_TO_COPY_LOATION event
1074 # ------------------------------------------------------------------------------
1075 sub _finish_hold_transit {
1076         my( $session, $requestor, $copy, $transid ) = @_;
1077         $U->logmark;
1078         my ($hold_transit, $evt) = $U->fetch_hold_transit( $transid );
1079         return undef unless $hold_transit;
1080
1081         my $cstats = $cache{copy_statuses};
1082         my $s = $U->copy_status_from_name($cstats, 'on holds shelf');
1083         $logger->info("Hold transit found: ".$hold_transit->id.". Routing to holds shelf");
1084
1085         $copy->status($s->id);
1086         $copy->editor($requestor->id);
1087         $copy->edit_date('now');
1088
1089         my $r = $session->request(
1090                 'open-ils.storage.direct.asset.copy.update', $copy )->gather(1);
1091         return $U->DB_UPDATE_FAILED($copy) unless $r;
1092
1093         return OpenILS::Event->new('ROUTE_TO_COPY_LOCATION', location => $s->id );
1094 }
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106 666;
1107