returning title, copy, and circ objects on checkin
[Evergreen.git] / 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