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