]> git.evergreen-ils.org Git - Evergreen.git/blob - Open-ILS/src/perlmods/OpenILS/Application/Circ.pm
more copy status handling
[Evergreen.git] / Open-ILS / src / perlmods / OpenILS / Application / Circ.pm
1 package OpenILS::Application::Circ;
2 use base qw/OpenSRF::Application/;
3 use strict; use warnings;
4
5 use OpenILS::Application::Circ::Circulate;
6 use OpenILS::Application::Circ::Rules;
7 use OpenILS::Application::Circ::Survey;
8 use OpenILS::Application::Circ::StatCat;
9 use OpenILS::Application::Circ::Holds;
10 use OpenILS::Application::Circ::Money;
11 use OpenILS::Application::Circ::NonCat;
12 use OpenILS::Application::Circ::CopyLocations;
13
14 use DateTime;
15 use DateTime::Format::ISO8601;
16
17 use OpenILS::Application::AppUtils;
18 my $apputils = "OpenILS::Application::AppUtils";
19 my $U = $apputils;
20 use OpenSRF::Utils qw/:datetime/;
21 use OpenILS::Utils::ModsParser;
22 use OpenILS::Event;
23 use OpenSRF::EX qw(:try);
24 use OpenSRF::Utils::Logger qw(:logger);
25 use OpenILS::Utils::Fieldmapper;
26 #my $logger = "OpenSRF::Utils::Logger";
27
28
29 # ------------------------------------------------------------------------
30 # Top level Circ package;
31 # ------------------------------------------------------------------------
32
33 sub initialize {
34         my $self = shift;
35         OpenILS::Application::Circ::Circulate->initialize();
36 }
37
38
39 __PACKAGE__->register_method(
40         method => 'retrieve_circ',
41         api_name        => 'open-ils.circ.retrieve',
42         signature => q/
43                 Retrieve a circ object by id
44                 @param authtoken Login session key
45                 @pararm circid The id of the circ object
46         /
47 );
48 sub retrieve_circ {
49         my( $s, $c, $a, $i ) = @_;
50         my($reqr, $evt) = $U->checksesperm($a, 'VIEW_CIRCULATIONS');
51         return $evt if $evt;
52         my $circ;
53         ($circ, $evt) = $U->fetch_circulation($i);
54         return $evt if $evt;
55         return $circ;
56 }
57
58
59 # ------------------------------------------------------------------------
60 # Returns an array of {circ, record} hashes checked out by the user.
61 # ------------------------------------------------------------------------
62 __PACKAGE__->register_method(
63         method  => "checkouts_by_user",
64         api_name        => "open-ils.circ.actor.user.checked_out",
65         NOTES           => <<"  NOTES");
66         Returns a list of open circulations as a pile of objects.  each object
67         contains the relevant copy, circ, and record
68         NOTES
69
70 sub checkouts_by_user {
71         my( $self, $client, $user_session, $user_id ) = @_;
72
73         my( $requestor, $target, $copy, $record, $evt );
74
75         ( $requestor, $target, $evt ) = 
76                 $apputils->checkses_requestor( $user_session, $user_id, 'VIEW_CIRCULATIONS');
77         return $evt if $evt;
78
79         my $circs = $apputils->simplereq(
80                 'open-ils.storage',
81                 "open-ils.storage.direct.action.open_circulation.search.atomic", 
82                 { usr => $target->id, checkin_time => undef } );
83 #               { usr => $target->id } );
84
85         my @results;
86         for my $circ (@$circs) {
87
88                 ( $copy, $evt )  = $apputils->fetch_copy($circ->target_copy);
89                 return $evt if $evt;
90
91                 $logger->debug("Retrieving record for copy " . $circ->target_copy);
92
93                 ($record, $evt) = $apputils->fetch_record_by_copy( $circ->target_copy );
94                 return $evt if $evt;
95
96                 my $mods = $apputils->record_to_mvr($record);
97
98                 push( @results, { copy => $copy, circ => $circ, record => $mods } );
99         }
100
101         return \@results;
102
103 }
104
105
106
107 __PACKAGE__->register_method(
108         method  => "checkouts_by_user_slim",
109         api_name        => "open-ils.circ.actor.user.checked_out.slim",
110         NOTES           => <<"  NOTES");
111         Returns a list of open circulation objects
112         NOTES
113
114 sub checkouts_by_user_slim {
115         my( $self, $client, $user_session, $user_id ) = @_;
116
117         my( $requestor, $target, $copy, $record, $evt );
118
119         ( $requestor, $target, $evt ) = 
120                 $apputils->checkses_requestor( $user_session, $user_id, 'VIEW_CIRCULATIONS');
121         return $evt if $evt;
122
123         $logger->debug( 'User ' . $requestor->id . 
124                 " retrieving checked out items for user " . $target->id );
125
126         # XXX Make the call correct..
127         return $apputils->simplereq(
128                 'open-ils.storage',
129                 "open-ils.storage.direct.action.open_circulation.search.atomic", 
130                 { usr => $target->id, checkin_time => undef } );
131 #               { usr => $target->id } );
132 }
133
134
135
136
137 __PACKAGE__->register_method(
138         method  => "title_from_transaction",
139         api_name        => "open-ils.circ.circ_transaction.find_title",
140         NOTES           => <<"  NOTES");
141         Returns a mods object for the title that is linked to from the 
142         copy from the hold that created the given transaction
143         NOTES
144
145 sub title_from_transaction {
146         my( $self, $client, $login_session, $transactionid ) = @_;
147
148         my( $user, $circ, $title, $evt );
149
150         ( $user, $evt ) = $apputils->checkses( $login_session );
151         return $evt if $evt;
152
153         ( $circ, $evt ) = $apputils->fetch_circulation($transactionid);
154         return $evt if $evt;
155         
156         ($title, $evt) = $apputils->fetch_record_by_copy($circ->target_copy);
157         return $evt if $evt;
158
159         return $apputils->record_to_mvr($title);
160 }
161
162
163 __PACKAGE__->register_method(
164         method  => "set_circ_lost",
165         api_name        => "open-ils.circ.circulation.set_lost",
166         NOTES           => <<"  NOTES");
167         Params are login, barcode
168         login must have SET_CIRC_LOST perms
169         Sets a circulation to lost
170         NOTES
171
172 __PACKAGE__->register_method(
173         method  => "set_circ_lost",
174         api_name        => "open-ils.circ.circulation.set_claims_returned",
175         NOTES           => <<"  NOTES");
176         Params are login, barcode
177         login must have SET_CIRC_MISSING perms
178         Sets a circulation to lost
179         NOTES
180
181 sub set_circ_lost {
182         my( $self, $client, $login, $args ) = @_;
183         my( $user, $circ, $copy, $evt );
184
185         my $barcode             = $$args{barcode};
186         my $backdate    = $$args{backdate};
187
188         ( $user, $evt ) = $U->checkses($login);
189         return $evt if $evt;
190
191         # Grab the related copy
192         ($copy, $evt) = $U->fetch_copy_by_barcode($barcode);
193         return $evt if $evt;
194
195         my $isclaims    = $self->api_name =~ /claims_returned/;
196         my $islost              = $self->api_name =~ /lost/;
197         my $session             = $U->start_db_session(); 
198
199         # grab the circulation
200         ( $circ ) = $U->fetch_open_circulation( $copy->id );
201         return 1 unless $circ;
202
203         if($islost) {
204                 $evt  = _set_circ_lost($copy, $circ, $user, $session) if $islost;
205                 return $evt if $evt;
206         }
207
208         if($isclaims) {
209                 $evt = _set_circ_claims_returned(
210                         $user, $circ, $session, $backdate );
211                 return $evt if $evt;
212
213 #               $evt = $U->check_perms($user->id, $circ->circ_lib, 'SET_CIRC_CLAIMS_RETURNED');
214 #               return $evt if $evt;
215 #               $circ->stop_fines("CLAIMSRETURNED");
216 #
217 #               $logger->activity("user ".$user->id." marking circ".  $circ->id. " as claims returned");
218 #
219 #               # allow the caller to backdate the circulation and void any fines
220 #               # that occurred after the backdate
221 #               if($backdate) {
222 #                       OpenILS::Application::Circ::Circulate::_checkin_handle_backdate(
223 #                               $backdate, $circ, $user, $session );
224 #               }
225 #
226 #               my $patron;
227 #               ($patron, $evt) = $U->fetch_user($circ->usr);
228 #               return $evt if $evt;
229 #               $patron->claims_returned_count( 
230 #                       $patron->claims_returned_count + 1 );
231 #
232 #               my $stat = $U->storagereq(
233 #                       'open-ils.storage.direct.actor.user.update', $patron );
234 #               return $U->DB_UPDATE_FAILED($patron) unless $stat;
235
236         }
237
238         $circ->stop_fines_time('now') unless $circ->stop_fines_time('now');
239         my $s = $session->request(
240                 "open-ils.storage.direct.action.circulation.update", $circ )->gather(1);
241
242         return $U->DB_UPDATE_FAILED($circ) unless defined($s);
243         $U->commit_db_session($session);
244
245         return 1;
246 }
247
248 sub _set_circ_lost {
249         my( $copy, $circ, $reqr, $session ) = @_;
250
251         my $evt = $U->check_perms($reqr->id, $circ->circ_lib, 'SET_CIRC_LOST');
252         return $evt if $evt;
253
254         $logger->activity("user ".$reqr->id." marking copy ".$copy->id.
255                 " lost  for circ ".  $circ->id. " and checking for necessary charges");
256
257         my $newstat = $U->copy_status_from_name('lost');
258         if( $copy->status ne $newstat->id ) {
259
260                 $copy->status($newstat);
261                 $U->update_copy(
262                         copy            => $copy, 
263                         editor  => $reqr->id, 
264                         session => $session);
265         }
266
267         # if the copy has a price defined and/or a processing fee, bill the patron
268         my $amount = $copy->price || 0;
269         my $owner = $U->fetch_copy_owner($copy->id);
270         $logger->info("circ fetching org settings for $owner to determine processing fee");
271         my $settings = $U->simplereq(
272                 'open-ils.actor',
273                 'open-ils.actor.org_unit.settings.retrieve', $owner );
274         my $f = $settings->{'circ.processing_fee'} || 0;
275         $amount += $f;
276         
277         if( $amount > 0 ) {
278
279                 $logger->activity("The system is charging $amount ".
280                         "for lost materials on circulation ".$circ->id);
281
282                 my $bill = Fieldmapper::money::billing->new;
283
284                 $bill->xact( $circ->id );
285                 $bill->amount( $amount );
286                 $bill->billing_type('Lost materials'); # - these strings should be configurable some day
287                 $bill->note('SYSTEM GENERATED');
288
289                 my $id = $session->request(
290                         'open-ils.storage.direct.money.billing.create', $bill )->gather(1);
291
292                 return $U->DB_UPDATE_FAILED($bill) unless defined $id;
293         }
294
295         $circ->stop_fines("LOST");              
296         return undef;
297 }
298
299 sub _set_circ_claims_returned {
300         my( $reqr, $circ, $session, $backdate ) = @_;
301
302         my $evt = $U->check_perms($reqr->id, $circ->circ_lib, 'SET_CIRC_CLAIMS_RETURNED');
303         return $evt if $evt;
304         $circ->stop_fines("CLAIMSRETURNED");
305
306         $logger->activity("user ".$reqr->id.
307                 " marking circ".  $circ->id. " as claims returned");
308
309         # allow the caller to backdate the circulation and void any fines
310         # that occurred after the backdate
311         if($backdate) {
312                 OpenILS::Application::Circ::Circulate::_checkin_handle_backdate(
313                         $backdate, $circ, $reqr, $session );
314         }
315
316         return undef;
317 }
318
319
320
321 __PACKAGE__->register_method (
322         method          => 'set_circ_due_date',
323         api_name                => 'open-ils.circ.circulation.due_date.update',
324         signature       => q/
325                 Updates the due_date on the given circ
326                 @param authtoken
327                 @param circid The id of the circ to update
328                 @param date The timestamp of the new due date
329         /
330 );
331
332 sub set_circ_due_date {
333         my( $s, $c, $authtoken, $circid, $date ) = @_;
334         my ($circ, $evt) = $U->fetch_circulation($circid);
335         return $evt if $evt;
336
337         my $reqr;
338         ($reqr, $evt) = $U->checkses($authtoken);
339         return $evt if $evt;
340
341         $evt = $U->check_perms($reqr->id, $circ->circ_lib, 'CIRC_OVERRIDE_DUE_DATE');
342         return $evt if $evt;
343
344         $date = clense_ISO8601($date);
345         $logger->activity("user ".$reqr->id.
346                 " updating due_date on circ $circid: $date");
347
348         $circ->due_date($date);
349         my $stat = $U->storagereq(
350                 'open-ils.storage.direct.action.circulation.update', $circ);
351         return $U->DB_UPDATE_FAILED unless defined $stat;
352         return $stat;
353 }
354
355
356 __PACKAGE__->register_method(
357         method          => "create_in_house_use",
358         api_name                => 'open-ils.circ.in_house_use.create',
359         signature       =>      q/
360                 Creates an in-house use action.
361                 @param $authtoken The login session key
362                 @param params A hash of params including
363                         'location' The org unit id where the in-house use occurs
364                         'copyid' The copy in question
365                         'count' The number of in-house uses to apply to this copy
366                 @return An array of id's representing the id's of the newly created
367                 in-house use objects or an event on an error
368         /);
369
370 sub create_in_house_use {
371         my( $self, $client, $authtoken, $params ) = @_;
372
373         my( $staff, $evt, $copy );
374         my $org                 = $params->{location};
375         my $copyid              = $params->{copyid};
376         my $count               = $params->{count} || 1;
377         my $use_time    = $params->{use_time} || 'now';
378
379         if(!$copyid) {
380                 my $barcode = $params->{barcode};
381                 ($copy, $evt) = $U->fetch_copy_by_barcode($barcode);
382                 return $evt if $evt;
383                 $copyid = $copy->id;
384         }
385
386         ($staff, $evt) = $U->checkses($authtoken);
387         return $evt if $evt;
388
389         ($copy, $evt) = $U->fetch_copy($copyid) unless $copy;
390         return $evt if $evt;
391
392         $evt = $U->check_perms($staff->id, $org, 'CREATE_IN_HOUSE_USE');
393         return $evt if $evt;
394
395         $logger->activity("User " . $staff->id .
396                 " creating $count in-house use(s) for copy $copyid at location $org");
397
398         if( $use_time ne 'now' ) {
399                 $use_time = clense_ISO8601($use_time);
400                 $logger->debug("in_house_use setting use time to $use_time");
401         }
402
403         my @ids;
404         for(1..$count) {
405                 my $ihu = Fieldmapper::action::in_house_use->new;
406
407                 $ihu->item($copyid);
408                 $ihu->staff($staff->id);
409                 $ihu->org_unit($org);
410                 $ihu->use_time($use_time);
411
412                 my $id = $U->simplereq(
413                         'open-ils.storage',
414                         'open-ils.storage.direct.action.in_house_use.create', $ihu );
415
416                 return $U->DB_UPDATE_FAILED($ihu) unless $id;
417                 push @ids, $id;
418         }
419
420         return \@ids;
421 }
422
423
424
425 __PACKAGE__->register_method(
426         method  => "view_circ_patrons",
427         api_name        => "open-ils.circ.copy_checkout_history.retrieve",
428         notes           => q/
429                 Retrieves the last X users who checked out a given copy
430                 @param authtoken The login session key
431                 @param copyid The copy to check
432                 @param count How far to go back in the item history
433                 @return An array of patron ids
434         /);
435
436 sub view_circ_patrons {
437         my( $self, $client, $authtoken, $copyid, $count ) = @_; 
438
439         my( $requestor, $evt ) = $U->checksesperm(
440                         $authtoken, 'VIEW_COPY_CHECKOUT_HISTORY' );
441         return $evt if $evt;
442
443         return [] unless $count;
444
445         my $circs = $U->storagereq(
446                 'open-ils.storage.direct.action.circulation.search_where.atomic',
447                         { 
448                                 target_copy => $copyid, 
449                                 opac_renewal => 'f',   
450                                 desk_renewal => 'f',
451                                 phone_renewal => 'f',
452                         }, 
453                         { 
454                                 limit => $count, 
455                                 order_by => "xact_start DESC" 
456                         } );
457
458
459         my @users;
460         push(@users, $_->usr) for @$circs;
461         return \@users;
462 }
463
464
465
466 __PACKAGE__->register_method(
467         method          => 'fetch_notes',
468         api_name                => 'open-ils.circ.copy_note.retrieve.all',
469         signature       => q/
470                 Returns an array of copy note objects.  
471                 @param args A named hash of parameters including:
472                         authtoken       : Required if viewing non-public notes
473                         itemid          : The id of the item whose notes we want to retrieve
474                         pub                     : True if all the caller wants are public notes
475                 @return An array of note objects
476         /);
477
478 __PACKAGE__->register_method(
479         method          => 'fetch_notes',
480         api_name                => 'open-ils.circ.call_number_note.retrieve.all',
481         signature       => q/@see open-ils.circ.copy_note.retrieve.all/);
482
483 __PACKAGE__->register_method(
484         method          => 'fetch_notes',
485         api_name                => 'open-ils.circ.title_note.retrieve.all',
486         signature       => q/@see open-ils.circ.copy_note.retrieve.all/);
487
488
489 # NOTE: VIEW_COPY/VOLUME/TITLE_NOTES perms should always be global
490 sub fetch_notes {
491         my( $self, $connection, $args ) = @_;
492
493         my $id = $$args{itemid};
494         my $authtoken = $$args{authtoken};
495         my( $r, $evt);
496
497         if( $self->api_name =~ /copy/ ) {
498                 if( $$args{pub} ) {
499                         return $U->storagereq(
500                                 'open-ils.storage.direct.asset.copy_note.search_where.atomic',
501                                 { owning_copy => $id, pub => 't' } );
502                 } else {
503                         ( $r, $evt ) = $U->checksesperm($authtoken, 'VIEW_COPY_NOTES');
504                         return $evt if $evt;
505                         return $U->storagereq(
506                                 'open-ils.storage.direct.asset.copy_note.search.owning_copy.atomic', $id );
507                 }
508
509         } elsif( $self->api_name =~ /call_number/ ) {
510                 if( $$args{pub} ) {
511                         return $U->storagereq(
512                                 'open-ils.storage.direct.asset.call_number_note.search_where.atomic',
513                                 { call_number => $id, pub => 't' } );
514                 } else {
515                         ( $r, $evt ) = $U->checksesperm($authtoken, 'VIEW_VOLUME_NOTES');
516                         return $evt if $evt;
517                         return $U->storagereq(
518                                 'open-ils.storage.direct.asset.call_number_note.search.call_number.atomic', $id );
519                 }
520
521         } elsif( $self->api_name =~ /title/ ) {
522                 if( $$args{pub} ) {
523                         return $U->storagereq(
524                                 'open-ils.storage.direct.bilbio.record_note.search_where.atomic',
525                                 { record => $id, pub => 't' } );
526                 } else {
527                         ( $r, $evt ) = $U->checksesperm($authtoken, 'VIEW_TITLE_NOTES');
528                         return $evt if $evt;
529                         return $U->storagereq(
530                                 'open-ils.storage.direct.asset.call_number_note.search.call_number.atomic', $id );
531                 }
532         }
533
534         return undef;
535 }
536
537 __PACKAGE__->register_method(
538         method          => 'create_copy_note',
539         api_name                => 'open-ils.circ.copy_note.create',
540         signature       => q/
541                 Creates a new copy note
542                 @param authtoken The login session key
543                 @param note     The note object to create
544                 @return The id of the new note object
545         /);
546
547 sub create_copy_note {
548         my( $self, $connection, $authtoken, $note ) = @_;
549         my( $cnowner, $requestor, $evt );
550
551         ($cnowner, $evt) = $U->fetch_copy_owner($note->owning_copy);
552         return $evt if $evt;
553         ($requestor, $evt) = $U->checkses($authtoken);
554         return $evt if $evt;
555         $evt = $U->check_perms($requestor->id, $cnowner, 'CREATE_COPY_NOTE');
556         return $evt if $evt;
557
558         $note->create_date('now');
559         $note->creator($requestor->id);
560         $note->pub( ($note->pub) ? 't' : 'f' );
561
562         my $id = $U->storagereq(
563                 'open-ils.storage.direct.asset.copy_note.create', $note );
564         return $U->DB_UPDATE_FAILED($note) unless $id;
565
566         $logger->activity("User ".$requestor->id." created a new copy ".
567                 "note [$id] for copy ".$note->owning_copy." with text ".$note->value);
568
569         return $id;
570 }
571
572 __PACKAGE__->register_method(
573         method          => 'delete_copy_note',
574         api_name                =>      'open-ils.circ.copy_note.delete',
575         signature       => q/
576                 Deletes an existing copy note
577                 @param authtoken The login session key
578                 @param noteid The id of the note to delete
579                 @return 1 on success - Event otherwise.
580                 /);
581
582 sub delete_copy_note {
583         my( $self, $conn, $authtoken, $noteid ) = @_;
584         my( $requestor, $note, $owner, $evt );
585
586         ($requestor, $evt) = $U->checkses($authtoken);
587         return $evt if $evt;
588
589         ($note, $evt) = $U->fetch_copy_note($noteid);
590         return $evt if $evt;
591
592         if( $note->creator ne $requestor->id ) {
593                 ($owner, $evt) = $U->fetch_copy_onwer($note->owning_copy);
594                 return $evt if $evt;
595                 $evt = $U->check_perms($requestor->id, $owner, 'DELETE_COPY_NOTE');
596                 return $evt if $evt;
597         }
598
599         my $stat = $U->storagereq(
600                 'open-ils.storage.direct.asset.copy_note.delete', $noteid );
601         return $U->DB_UPDATE_FAILED($noteid) unless $stat;
602
603         $logger->activity("User ".$requestor->id." deleted copy note $noteid");
604         return 1;
605 }
606
607 =head this method is really inefficient - get rid of me
608
609 __PACKAGE__->register_method(
610         method          => 'note_batch',
611         api_name                => 'open-ils.circ.biblio_notes.public.batch.retrieve',
612         signature       => q/
613                 Returns a set of notes for a given set of titles, volumes, and copies.
614                 @param titleid The id of the title who's notes are retrieving
615                 @return A list like so:
616                         {
617                                 "titles"                : [ { id : $id, notes : [ n1, n2 ] },... ]
618                                 "volumes"       : [ { id : $id, notes : [ n1, n2 ] },... ]
619                                 "copies"                : [ { id : $id, notes : [ n1, n2 ] },... ]
620                         }
621         /
622 );
623
624 sub note_batch {
625         my( $self, $conn, $titleid ) = @_;
626
627         my @copies;
628         my $cns = $U->storagereq(
629                 'open-ils.storage.id_list.asset.call_number.search_where.atomic', 
630                 { record => $titleid, deleted => 'f' } );
631                 #'open-ils.storage.id_list.asset.call_number.search.record.atomic', $titleid );
632
633         for my $c (@$cns) {
634                 my $copyids = $U->storagereq(
635                         #'open-ils.storage.id_list.asset.copy.search.call_number.atomic', $c);
636                         'open-ils.storage.id_list.asset.copy.search_where.atomic', { call_number => $c, deleted => 'f' });
637                 push(@copies, @$copyids);
638         }
639
640         return _note_batch( { titles => [$titleid], volumes => $cns, copies => \@copies} );
641 }
642
643
644 sub _note_batch {
645         my $args = shift;
646
647         my %resp;
648         $resp{titles}   = [];
649         $resp{volumes} = [];
650         $resp{copies}   = [];
651
652         my $titles      = (ref($$args{titles})) ? $$args{titles} : [];
653         my $volumes = (ref($$args{volumes})) ? $$args{volumes} : [];
654         my $copies      = (ref($$args{copies})) ? $$args{copies} : [];
655
656         for my $title (@$titles) {
657                 my $notes = $U->storagereq(
658                         'open-ils.storage.direct.biblio.record_note.search_where.atomic', 
659                         { record => $title, pub => 't' });
660                 push(@{$resp{titles}}, {id => $title, notes => $notes}) if @$notes;
661         }
662
663         for my $volume (@$volumes) {
664                 my $notes = $U->storagereq(
665                         'open-ils.storage.direct.asset.call_number_note.search_where.atomic',
666                         { call_number => $volume, pub => 't' });
667                 push( @{$resp{volumes}}, {id => $volume, notes => $notes} ) if @$notes;
668         }
669
670
671         for my $copy (@$copies) {
672                 $logger->debug("Fetching copy notes for copy $copy");
673                 my $notes = $U->storagereq(
674                         'open-ils.storage.direct.asset.copy_note.search_where.atomic',
675                         { owning_copy => $copy, pub => 't' });
676                 push( @{$resp{copies}}, { id => $copy, notes => $notes }) if @$notes;
677         }
678
679         return \%resp;
680 }
681
682 =cut
683
684
685
686
687
688
689
690 1;