3 # Copyright 2000-2003 Katipo Communications
4 # Copyright 2010 BibLibre
5 # Parts Copyright 2010 Catalyst IT
7 # This file is part of Koha.
9 # Koha is free software; you can redistribute it and/or modify it
10 # under the terms of the GNU General Public License as published by
11 # the Free Software Foundation; either version 3 of the License, or
12 # (at your option) any later version.
14 # Koha is distributed in the hope that it will be useful, but
15 # WITHOUT ANY WARRANTY; without even the implied warranty of
16 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 # GNU General Public License for more details.
19 # You should have received a copy of the GNU General Public License
20 # along with Koha; if not, see <http://www.gnu.org/licenses>.
24 #use warnings; FIXME - Bug 2505
26 use String::Random qw( random_string );
27 use Scalar::Util qw( looks_like_number );
28 use Date::Calc qw/Today check_date Date_to_Days/;
29 use List::MoreUtils qw( uniq );
31 use C4::Log; # logaction
37 use C4::Members::Attributes qw(SearchIdMatchingAttribute UpdateBorrowerAttribute);
38 use C4::NewsChannels; #get slip news
42 use Text::Unaccent qw( unac_string );
43 use Koha::AuthUtils qw(hash_password);
46 use Koha::List::Patron;
48 use Koha::Patron::Categories;
51 our (@ISA,@EXPORT,@EXPORT_OK,$debug);
53 use Module::Load::Conditional qw( can_load );
54 if ( ! can_load( modules => { 'Koha::NorwegianPatronDB' => undef } ) ) {
55 $debug && warn "Unable to load Koha::NorwegianPatronDB";
60 $debug = $ENV{DEBUG} || 0;
68 &GetBorrowersToExpunge
94 C4::Members - Perl Module containing convenience functions for member handling
102 This module contains routines for adding, modifying and deleting members/patrons/borrowers
108 $flags = &patronflags($patron);
110 This function is not exported.
112 The following will be set where applicable:
113 $flags->{CHARGES}->{amount} Amount of debt
114 $flags->{CHARGES}->{noissues} Set if debt amount >$5.00 (or syspref noissuescharge)
115 $flags->{CHARGES}->{message} Message -- deprecated
117 $flags->{CREDITS}->{amount} Amount of credit
118 $flags->{CREDITS}->{message} Message -- deprecated
120 $flags->{ GNA } Patron has no valid address
121 $flags->{ GNA }->{noissues} Set for each GNA
122 $flags->{ GNA }->{message} "Borrower has no valid address" -- deprecated
124 $flags->{ LOST } Patron's card reported lost
125 $flags->{ LOST }->{noissues} Set for each LOST
126 $flags->{ LOST }->{message} Message -- deprecated
128 $flags->{DBARRED} Set if patron debarred, no access
129 $flags->{DBARRED}->{noissues} Set for each DBARRED
130 $flags->{DBARRED}->{message} Message -- deprecated
133 $flags->{ NOTES }->{message} The note itself. NOT deprecated
135 $flags->{ ODUES } Set if patron has overdue books.
136 $flags->{ ODUES }->{message} "Yes" -- deprecated
137 $flags->{ ODUES }->{itemlist} ref-to-array: list of overdue books
138 $flags->{ ODUES }->{itemlisttext} Text list of overdue items -- deprecated
140 $flags->{WAITING} Set if any of patron's reserves are available
141 $flags->{WAITING}->{message} Message -- deprecated
142 $flags->{WAITING}->{itemlist} ref-to-array: list of available items
146 =item C<$flags-E<gt>{ODUES}-E<gt>{itemlist}> is a reference-to-array listing the
147 overdue items. Its elements are references-to-hash, each describing an
148 overdue item. The keys are selected fields from the issues, biblio,
149 biblioitems, and items tables of the Koha database.
151 =item C<$flags-E<gt>{ODUES}-E<gt>{itemlisttext}> is a string giving a text listing of
152 the overdue items, one per line. Deprecated.
154 =item C<$flags-E<gt>{WAITING}-E<gt>{itemlist}> is a reference-to-array listing the
155 available items. Each element is a reference-to-hash whose keys are
156 fields from the reserves table of the Koha database.
160 All the "message" fields that include language generated in this function are deprecated,
161 because such strings belong properly in the display layer.
163 The "message" field that comes from the DB is OK.
167 # TODO: use {anonymous => hashes} instead of a dozen %flaginfo
168 # FIXME rename this function.
169 # DEPRECATED Do not use this subroutine!
172 my ( $patroninformation) = @_;
173 my $dbh=C4::Context->dbh;
174 my $patron = Koha::Patrons->find( $patroninformation->{borrowernumber} );
175 my $account = $patron->account;
176 my $owing = $account->non_issues_charges;
179 my $noissuescharge = C4::Context->preference("noissuescharge") || 5;
180 $flaginfo{'message'} = sprintf 'Patron owes %.02f', $owing;
181 $flaginfo{'amount'} = sprintf "%.02f", $owing;
182 if ( $owing > $noissuescharge && !C4::Context->preference("AllowFineOverride") ) {
183 $flaginfo{'noissues'} = 1;
185 $flags{'CHARGES'} = \%flaginfo;
187 elsif ( ( my $balance = $account->balance ) < 0 ) {
189 $flaginfo{'message'} = sprintf 'Patron has credit of %.02f', -$balance;
190 $flaginfo{'amount'} = sprintf "%.02f", $balance;
191 $flags{'CREDITS'} = \%flaginfo;
194 # Check the debt of the guarntees of this patron
195 my $no_issues_charge_guarantees = C4::Context->preference("NoIssuesChargeGuarantees");
196 $no_issues_charge_guarantees = undef unless looks_like_number( $no_issues_charge_guarantees );
197 if ( defined $no_issues_charge_guarantees ) {
198 my $p = Koha::Patrons->find( $patroninformation->{borrowernumber} );
199 my @guarantees = $p->guarantees();
200 my $guarantees_non_issues_charges;
201 foreach my $g ( @guarantees ) {
202 $guarantees_non_issues_charges += $g->account->non_issues_charges;
205 if ( $guarantees_non_issues_charges > $no_issues_charge_guarantees ) {
207 $flaginfo{'message'} = sprintf 'patron guarantees owe %.02f', $guarantees_non_issues_charges;
208 $flaginfo{'amount'} = $guarantees_non_issues_charges;
209 $flaginfo{'noissues'} = 1 unless C4::Context->preference("allowfineoverride");
210 $flags{'CHARGES_GUARANTEES'} = \%flaginfo;
214 if ( $patroninformation->{'gonenoaddress'}
215 && $patroninformation->{'gonenoaddress'} == 1 )
218 $flaginfo{'message'} = 'Borrower has no valid address.';
219 $flaginfo{'noissues'} = 1;
220 $flags{'GNA'} = \%flaginfo;
222 if ( $patroninformation->{'lost'} && $patroninformation->{'lost'} == 1 ) {
224 $flaginfo{'message'} = 'Borrower\'s card reported lost.';
225 $flaginfo{'noissues'} = 1;
226 $flags{'LOST'} = \%flaginfo;
228 if ( $patroninformation->{'debarred'} && check_date( split( /-/, $patroninformation->{'debarred'} ) ) ) {
229 if ( Date_to_Days(Date::Calc::Today) < Date_to_Days( split( /-/, $patroninformation->{'debarred'} ) ) ) {
231 $flaginfo{'debarredcomment'} = $patroninformation->{'debarredcomment'};
232 $flaginfo{'message'} = $patroninformation->{'debarredcomment'};
233 $flaginfo{'noissues'} = 1;
234 $flaginfo{'dateend'} = $patroninformation->{'debarred'};
235 $flags{'DBARRED'} = \%flaginfo;
238 if ( $patroninformation->{'borrowernotes'}
239 && $patroninformation->{'borrowernotes'} )
242 $flaginfo{'message'} = $patroninformation->{'borrowernotes'};
243 $flags{'NOTES'} = \%flaginfo;
245 my ( $odues, $itemsoverdue ) = C4::Overdues::checkoverdues($patroninformation->{'borrowernumber'});
246 if ( $odues && $odues > 0 ) {
248 $flaginfo{'message'} = "Yes";
249 $flaginfo{'itemlist'} = $itemsoverdue;
250 foreach ( sort { $a->{'date_due'} cmp $b->{'date_due'} }
253 $flaginfo{'itemlisttext'} .=
254 "$_->{'date_due'} $_->{'barcode'} $_->{'title'} \n"; # newline is display layer
256 $flags{'ODUES'} = \%flaginfo;
259 my $waiting_holds = $patron->holds->search({ found => 'W' });
260 my $nowaiting = $waiting_holds->count;
261 if ( $nowaiting > 0 ) {
263 $flaginfo{'message'} = "Reserved items available";
264 $flaginfo{'itemlist'} = $waiting_holds->unblessed;
265 $flags{'WAITING'} = \%flaginfo;
273 my $success = ModMember(borrowernumber => $borrowernumber,
274 [ field => value ]... );
276 Modify borrower's data. All date fields should ALREADY be in ISO format.
279 true on success, or false on failure
286 # trim whitespace from data which has some non-whitespace in it.
287 foreach my $field_name (keys(%data)) {
288 if ( defined $data{$field_name} && $data{$field_name} =~ /\S/ ) {
289 $data{$field_name} =~ s/^\s*|\s*$//g;
293 # test to know if you must update or not the borrower password
294 if (exists $data{password}) {
295 if ($data{password} eq '****' or $data{password} eq '') {
296 delete $data{password};
298 if ( C4::Context->preference('NorwegianPatronDBEnable') && C4::Context->preference('NorwegianPatronDBEnable') == 1 ) {
299 # Update the hashed PIN in borrower_sync.hashed_pin, before Koha hashes it
300 Koha::NorwegianPatronDB::NLUpdateHashedPIN( $data{'borrowernumber'}, $data{password} );
302 $data{password} = hash_password($data{password});
306 my $old_categorycode = Koha::Patrons->find( $data{borrowernumber} )->categorycode;
308 # get only the columns of a borrower
309 my $schema = Koha::Database->new()->schema;
310 my @columns = $schema->source('Borrower')->columns;
311 my $new_borrower = { map { join(' ', @columns) =~ /$_/ ? ( $_ => $data{$_} ) : () } keys(%data) };
313 $new_borrower->{dateofbirth} ||= undef if exists $new_borrower->{dateofbirth};
314 $new_borrower->{dateenrolled} ||= undef if exists $new_borrower->{dateenrolled};
315 $new_borrower->{dateexpiry} ||= undef if exists $new_borrower->{dateexpiry};
316 $new_borrower->{debarred} ||= undef if exists $new_borrower->{debarred};
317 $new_borrower->{sms_provider_id} ||= undef if exists $new_borrower->{sms_provider_id};
318 $new_borrower->{guarantorid} ||= undef if exists $new_borrower->{guarantorid};
320 my $patron = Koha::Patrons->find( $new_borrower->{borrowernumber} );
322 my $borrowers_log = C4::Context->preference("BorrowersLog");
323 if ( $borrowers_log && $patron->cardnumber ne $new_borrower->{cardnumber} )
328 $data{'borrowernumber'},
331 cardnumber_replaced => {
332 previous_cardnumber => $patron->cardnumber,
333 new_cardnumber => $new_borrower->{cardnumber},
336 { utf8 => 1, pretty => 1 }
341 delete $new_borrower->{userid} if exists $new_borrower->{userid} and not $new_borrower->{userid};
343 my $execute_success = $patron->store if $patron->set($new_borrower);
345 if ($execute_success) { # only proceed if the update was a success
346 # If the patron changes to a category with enrollment fee, we add a fee
347 if ( $data{categorycode} and $data{categorycode} ne $old_categorycode ) {
348 if ( C4::Context->preference('FeeOnChangePatronCategory') ) {
349 $patron->add_enrolment_fee_if_needed;
353 # If NorwegianPatronDBEnable is enabled, we set syncstatus to something that a
354 # cronjob will use for syncing with NL
355 if ( C4::Context->preference('NorwegianPatronDBEnable') && C4::Context->preference('NorwegianPatronDBEnable') == 1 ) {
356 my $borrowersync = Koha::Database->new->schema->resultset('BorrowerSync')->find({
357 'synctype' => 'norwegianpatrondb',
358 'borrowernumber' => $data{'borrowernumber'}
360 # Do not set to "edited" if syncstatus is "new". We need to sync as new before
361 # we can sync as changed. And the "new sync" will pick up all changes since
362 # the patron was created anyway.
363 if ( $borrowersync->syncstatus ne 'new' && $borrowersync->syncstatus ne 'delete' ) {
364 $borrowersync->update( { 'syncstatus' => 'edited' } );
366 # Set the value of 'sync'
367 $borrowersync->update( { 'sync' => $data{'sync'} } );
368 # Try to do the live sync
369 Koha::NorwegianPatronDB::NLSync({ 'borrowernumber' => $data{'borrowernumber'} });
372 logaction("MEMBERS", "MODIFY", $data{'borrowernumber'}, "UPDATE (executed w/ arg: $data{'borrowernumber'})") if $borrowers_log;
374 return $execute_success;
379 $issues = &GetAllIssues($borrowernumber, $sortkey, $limit);
381 Looks up what the patron with the given borrowernumber has borrowed,
382 and sorts the results.
384 C<$sortkey> is the name of a field on which to sort the results. This
385 should be the name of a field in the C<issues>, C<biblio>,
386 C<biblioitems>, or C<items> table in the Koha database.
388 C<$limit> is the maximum number of results to return.
390 C<&GetAllIssues> an arrayref, C<$issues>, of hashrefs, the keys of which
391 are the fields from the C<issues>, C<biblio>, C<biblioitems>, and
392 C<items> tables of the Koha database.
398 my ( $borrowernumber, $order, $limit ) = @_;
400 return unless $borrowernumber;
401 $order = 'date_due desc' unless $order;
403 my $dbh = C4::Context->dbh;
405 'SELECT *, issues.timestamp as issuestimestamp, issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
407 LEFT JOIN items on items.itemnumber=issues.itemnumber
408 LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
409 LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
410 WHERE borrowernumber=?
412 SELECT *, old_issues.timestamp as issuestimestamp, old_issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
414 LEFT JOIN items on items.itemnumber=old_issues.itemnumber
415 LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
416 LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
417 WHERE borrowernumber=? AND old_issues.itemnumber IS NOT NULL
420 $query .= " limit $limit";
423 my $sth = $dbh->prepare($query);
424 $sth->execute( $borrowernumber, $borrowernumber );
425 return $sth->fetchall_arrayref( {} );
428 sub checkcardnumber {
429 my ( $cardnumber, $borrowernumber ) = @_;
431 # If cardnumber is null, we assume they're allowed.
432 return 0 unless defined $cardnumber;
434 my $dbh = C4::Context->dbh;
435 my $query = "SELECT * FROM borrowers WHERE cardnumber=?";
436 $query .= " AND borrowernumber <> ?" if ($borrowernumber);
437 my $sth = $dbh->prepare($query);
440 ( $borrowernumber ? $borrowernumber : () )
443 return 1 if $sth->fetchrow_hashref;
445 my ( $min_length, $max_length ) = get_cardnumber_length();
447 if length $cardnumber > $max_length
448 or length $cardnumber < $min_length;
453 =head2 get_cardnumber_length
455 my ($min, $max) = C4::Members::get_cardnumber_length()
457 Returns the minimum and maximum length for patron cardnumbers as
458 determined by the CardnumberLength system preference, the
459 BorrowerMandatoryField system preference, and the width of the
464 sub get_cardnumber_length {
465 my $borrower = Koha::Schema->resultset('Borrower');
466 my $field_size = $borrower->result_source->column_info('cardnumber')->{size};
467 my ( $min, $max ) = ( 0, $field_size ); # borrowers.cardnumber is a nullable varchar(20)
468 $min = 1 if C4::Context->preference('BorrowerMandatoryField') =~ /cardnumber/;
469 if ( my $cardnumber_length = C4::Context->preference('CardnumberLength') ) {
470 # Is integer and length match
471 if ( $cardnumber_length =~ m|^\d+$| ) {
472 $min = $max = $cardnumber_length
473 if $cardnumber_length >= $min
474 and $cardnumber_length <= $max;
476 # Else assuming it is a range
477 elsif ( $cardnumber_length =~ m|(\d*),(\d*)| ) {
478 $min = $1 if $1 and $min < $1;
479 $max = $2 if $2 and $max > $2;
483 $min = $max if $min > $max;
484 return ( $min, $max );
487 =head2 GetBorrowersToExpunge
489 $borrowers = &GetBorrowersToExpunge(
490 not_borrowed_since => $not_borrowed_since,
491 expired_before => $expired_before,
492 category_code => $category_code,
493 patron_list_id => $patron_list_id,
494 branchcode => $branchcode
497 This function get all borrowers based on the given criteria.
501 sub GetBorrowersToExpunge {
504 my $filterdate = $params->{'not_borrowed_since'};
505 my $filterexpiry = $params->{'expired_before'};
506 my $filterlastseen = $params->{'last_seen'};
507 my $filtercategory = $params->{'category_code'};
508 my $filterbranch = $params->{'branchcode'} ||
509 ((C4::Context->preference('IndependentBranches')
510 && C4::Context->userenv
511 && !C4::Context->IsSuperLibrarian()
512 && C4::Context->userenv->{branch})
513 ? C4::Context->userenv->{branch}
515 my $filterpatronlist = $params->{'patron_list_id'};
517 my $dbh = C4::Context->dbh;
521 SELECT borrowers.borrowernumber,
522 MAX(old_issues.timestamp) AS latestissue,
523 MAX(issues.timestamp) AS currentissue
525 JOIN categories USING (categorycode)
529 WHERE guarantorid IS NOT NULL
531 ) as tmp ON borrowers.borrowernumber=tmp.guarantorid
532 LEFT JOIN old_issues USING (borrowernumber)
533 LEFT JOIN issues USING (borrowernumber)|;
534 if ( $filterpatronlist ){
535 $query .= q| LEFT JOIN patron_list_patrons USING (borrowernumber)|;
537 $query .= q| WHERE category_type <> 'S'
538 AND tmp.guarantorid IS NULL
541 if ( $filterbranch && $filterbranch ne "" ) {
542 $query.= " AND borrowers.branchcode = ? ";
543 push( @query_params, $filterbranch );
545 if ( $filterexpiry ) {
546 $query .= " AND dateexpiry < ? ";
547 push( @query_params, $filterexpiry );
549 if ( $filterlastseen ) {
550 $query .= ' AND lastseen < ? ';
551 push @query_params, $filterlastseen;
553 if ( $filtercategory ) {
554 $query .= " AND categorycode = ? ";
555 push( @query_params, $filtercategory );
557 if ( $filterpatronlist ){
558 $query.=" AND patron_list_id = ? ";
559 push( @query_params, $filterpatronlist );
561 $query .= " GROUP BY borrowers.borrowernumber";
563 ) xxx WHERE currentissue IS NULL|;
565 $query.=" AND ( latestissue < ? OR latestissue IS NULL ) ";
566 push @query_params,$filterdate;
569 warn $query if $debug;
571 my $sth = $dbh->prepare($query);
572 if (scalar(@query_params)>0){
573 $sth->execute(@query_params);
580 while ( my $data = $sth->fetchrow_hashref ) {
581 push @results, $data;
588 IssueSlip($branchcode, $borrowernumber, $quickslip)
590 Returns letter hash ( see C4::Letters::GetPreparedLetter )
592 $quickslip is boolean, to indicate whether we want a quick slip
594 IssueSlip populates ISSUESLIP and ISSUEQSLIP, and will make the following expansions:
630 NOTE: Fields from tables issues, items, biblio and biblioitems are available
635 my ($branch, $borrowernumber, $quickslip) = @_;
637 # FIXME Check callers before removing this statement
638 #return unless $borrowernumber;
640 my $patron = Koha::Patrons->find( $borrowernumber );
641 return unless $patron;
643 my $pending_checkouts = $patron->pending_checkouts; # Should be $patron->checkouts->pending?
645 my ($letter_code, %repeat, %loops);
647 my $today_start = dt_from_string->set( hour => 0, minute => 0, second => 0 );
648 my $today_end = dt_from_string->set( hour => 23, minute => 59, second => 0 );
649 $today_start = Koha::Database->new->schema->storage->datetime_parser->format_datetime( $today_start );
650 $today_end = Koha::Database->new->schema->storage->datetime_parser->format_datetime( $today_end );
651 $letter_code = 'ISSUEQSLIP';
653 # issue date or lastreneweddate is today
654 my $todays_checkouts = $pending_checkouts->search(
658 '>=' => $today_start,
662 { '>=' => $today_start, '<=' => $today_end, }
667 while ( my $c = $todays_checkouts->next ) {
668 my $all = $c->unblessed_all_relateds;
678 checkedout => \@checkouts, # Historical syntax
681 issues => [ map { $_->{issues}{itemnumber} } @checkouts ], # TT syntax
685 my $today = Koha::Database->new->schema->storage->datetime_parser->format_datetime( dt_from_string );
686 # Checkouts due in the future
687 my $checkouts = $pending_checkouts->search({ date_due => { '>' => $today } });
688 my @checkouts; my @overdues;
689 while ( my $c = $checkouts->next ) {
690 my $all = $c->unblessed_all_relateds;
699 # Checkouts due in the past are overdues
700 my $overdues = $pending_checkouts->search({ date_due => { '<=' => $today } });
701 while ( my $o = $overdues->next ) {
702 my $all = $o->unblessed_all_relateds;
710 my $news = GetNewsToDisplay( "slip", $branch );
712 $_->{'timestamp'} = $_->{'newdate'};
715 $letter_code = 'ISSUESLIP';
717 checkedout => \@checkouts,
718 overdue => \@overdues,
722 issues => [ map { $_->{issues}{itemnumber} } @checkouts ],
723 overdues => [ map { $_->{issues}{itemnumber} } @overdues ],
724 opac_news => [ map { $_->{opac_news}{idnew} } @news ],
728 return C4::Letters::GetPreparedLetter (
729 module => 'circulation',
730 letter_code => $letter_code,
731 branchcode => $branch,
732 lang => $patron->lang,
734 'branches' => $branch,
735 'borrowers' => $borrowernumber,
742 =head2 AddMember_Auto
747 my ( %borrower ) = @_;
749 my $patron = Koha::Patron->new(\%borrower)->store;
751 return %{ $patron->unblessed };
754 =head2 AddMember_Opac
759 my ( %borrower ) = @_;
761 $borrower{'categorycode'} //= C4::Context->preference('PatronSelfRegistrationDefaultCategory');
762 my $password = $borrower{password};
763 if (not defined $password){
764 my $sr = new String::Random;
765 $sr->{'A'} = [ 'A'..'Z', 'a'..'z' ];
766 $password = $sr->randpattern("AAAAAAAAAA");
767 $borrower{'password'} = $password;
770 %borrower = AddMember_Auto(%borrower);
772 return ( $borrower{'borrowernumber'}, $password );
775 =head2 DeleteExpiredOpacRegistrations
777 Delete accounts that haven't been upgraded from the 'temporary' category
778 Returns the number of removed patrons
782 sub DeleteExpiredOpacRegistrations {
784 my $delay = C4::Context->preference('PatronSelfRegistrationExpireTemporaryAccountsDelay');
785 my $category_code = C4::Context->preference('PatronSelfRegistrationDefaultCategory');
787 return 0 if not $category_code or not defined $delay or $delay eq q||;
790 SELECT borrowernumber
792 WHERE categorycode = ? AND DATEDIFF( NOW(), dateenrolled ) > ? |;
794 my $dbh = C4::Context->dbh;
795 my $sth = $dbh->prepare($query);
796 $sth->execute( $category_code, $delay );
798 while ( my ($borrowernumber) = $sth->fetchrow_array() ) {
799 Koha::Patrons->find($borrowernumber)->delete;
805 =head2 DeleteUnverifiedOpacRegistrations
807 Delete all unverified self registrations in borrower_modifications,
808 older than the specified number of days.
812 sub DeleteUnverifiedOpacRegistrations {
814 my $dbh = C4::Context->dbh;
816 DELETE FROM borrower_modifications
817 WHERE borrowernumber = 0 AND DATEDIFF( NOW(), timestamp ) > ?|;
818 my $cnt=$dbh->do($sql, undef, ($days) );
819 return $cnt eq '0E0'? 0: $cnt;
822 END { } # module clean-up code here (global destructor)