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