use Scalar::Util qw( looks_like_number );
use Date::Calc qw/Today check_date Date_to_Days/;
use List::MoreUtils qw( uniq );
+use JSON qw(to_json);
use C4::Log; # logaction
use C4::Overdues;
use C4::Reserves;
use DateTime;
use Koha::Database;
use Koha::DateUtils;
-use Text::Unaccent qw( unac_string );
use Koha::AuthUtils qw(hash_password);
use Koha::Database;
use Koha::Holds;
use Koha::List::Patron;
use Koha::Patrons;
use Koha::Patron::Categories;
-use Koha::Schema;
our (@ISA,@EXPORT,@EXPORT_OK,$debug);
-use Module::Load::Conditional qw( can_load );
-if ( ! can_load( modules => { 'Koha::NorwegianPatronDB' => undef } ) ) {
- $debug && warn "Unable to load Koha::NorwegianPatronDB";
-}
-
-
BEGIN {
$debug = $ENV{DEBUG} || 0;
require Exporter;
#Get data
push @EXPORT, qw(
- &GetPendingIssues
&GetAllIssues
&GetBorrowersToExpunge
&IssueSlip
-
- GetOverduesForPatron
- );
-
- #Modify data
- push @EXPORT, qw(
- &ModMember
- &changepassword
- );
-
- #Insert data
- push @EXPORT, qw(
- &AddMember
- &AddMember_Auto
- &AddMember_Opac
);
#Check data
push @EXPORT, qw(
&checkuserpassword
- &Check_Userid
- &Generate_Userid
- &fixup_cardnumber
&checkcardnumber
);
}
=head1 DESCRIPTION
-This module contains routines for adding, modifying and deleting members/patrons/borrowers
+This module contains routines for adding, modifying and deleting members/patrons/borrowers
=head1 FUNCTIONS
$flags->{WAITING}->{message} Message -- deprecated
$flags->{WAITING}->{itemlist} ref-to-array: list of available items
-=over
+=over
=item C<$flags-E<gt>{ODUES}-E<gt>{itemlist}> is a reference-to-array listing the
overdue items. Its elements are references-to-hash, each describing an
=back
-All the "message" fields that include language generated in this function are deprecated,
+All the "message" fields that include language generated in this function are deprecated,
because such strings belong properly in the display layer.
The "message" field that comes from the DB is OK.
# TODO: use {anonymous => hashes} instead of a dozen %flaginfo
# FIXME rename this function.
+# DEPRECATED Do not use this subroutine!
sub patronflags {
my %flags;
my ( $patroninformation) = @_;
return ( \%flags );
}
-
-=head2 ModMember
-
- my $success = ModMember(borrowernumber => $borrowernumber,
- [ field => value ]... );
-
-Modify borrower's data. All date fields should ALREADY be in ISO format.
-
-return :
-true on success, or false on failure
-
-=cut
-
-sub ModMember {
- my (%data) = @_;
-
- # trim whitespace from data which has some non-whitespace in it.
- foreach my $field_name (keys(%data)) {
- if ( defined $data{$field_name} && $data{$field_name} =~ /\S/ ) {
- $data{$field_name} =~ s/^\s*|\s*$//g;
- }
- }
-
- # test to know if you must update or not the borrower password
- if (exists $data{password}) {
- if ($data{password} eq '****' or $data{password} eq '') {
- delete $data{password};
- } else {
- if ( C4::Context->preference('NorwegianPatronDBEnable') && C4::Context->preference('NorwegianPatronDBEnable') == 1 ) {
- # Update the hashed PIN in borrower_sync.hashed_pin, before Koha hashes it
- Koha::NorwegianPatronDB::NLUpdateHashedPIN( $data{'borrowernumber'}, $data{password} );
- }
- $data{password} = hash_password($data{password});
- }
- }
-
- my $old_categorycode = Koha::Patrons->find( $data{borrowernumber} )->categorycode;
-
- # get only the columns of a borrower
- my $schema = Koha::Database->new()->schema;
- my @columns = $schema->source('Borrower')->columns;
- my $new_borrower = { map { join(' ', @columns) =~ /$_/ ? ( $_ => $data{$_} ) : () } keys(%data) };
-
- $new_borrower->{dateofbirth} ||= undef if exists $new_borrower->{dateofbirth};
- $new_borrower->{dateenrolled} ||= undef if exists $new_borrower->{dateenrolled};
- $new_borrower->{dateexpiry} ||= undef if exists $new_borrower->{dateexpiry};
- $new_borrower->{debarred} ||= undef if exists $new_borrower->{debarred};
- $new_borrower->{sms_provider_id} ||= undef if exists $new_borrower->{sms_provider_id};
- $new_borrower->{guarantorid} ||= undef if exists $new_borrower->{guarantorid};
-
- my $patron = Koha::Patrons->find( $new_borrower->{borrowernumber} );
-
- delete $new_borrower->{userid} if exists $new_borrower->{userid} and not $new_borrower->{userid};
-
- my $execute_success = $patron->store if $patron->set($new_borrower);
-
- if ($execute_success) { # only proceed if the update was a success
- # If the patron changes to a category with enrollment fee, we add a fee
- if ( $data{categorycode} and $data{categorycode} ne $old_categorycode ) {
- if ( C4::Context->preference('FeeOnChangePatronCategory') ) {
- $patron->add_enrolment_fee_if_needed;
- }
- }
-
- # If NorwegianPatronDBEnable is enabled, we set syncstatus to something that a
- # cronjob will use for syncing with NL
- if ( C4::Context->preference('NorwegianPatronDBEnable') && C4::Context->preference('NorwegianPatronDBEnable') == 1 ) {
- my $borrowersync = Koha::Database->new->schema->resultset('BorrowerSync')->find({
- 'synctype' => 'norwegianpatrondb',
- 'borrowernumber' => $data{'borrowernumber'}
- });
- # Do not set to "edited" if syncstatus is "new". We need to sync as new before
- # we can sync as changed. And the "new sync" will pick up all changes since
- # the patron was created anyway.
- if ( $borrowersync->syncstatus ne 'new' && $borrowersync->syncstatus ne 'delete' ) {
- $borrowersync->update( { 'syncstatus' => 'edited' } );
- }
- # Set the value of 'sync'
- $borrowersync->update( { 'sync' => $data{'sync'} } );
- # Try to do the live sync
- Koha::NorwegianPatronDB::NLSync({ 'borrowernumber' => $data{'borrowernumber'} });
- }
-
- logaction("MEMBERS", "MODIFY", $data{'borrowernumber'}, "UPDATE (executed w/ arg: $data{'borrowernumber'})") if C4::Context->preference("BorrowersLog");
- }
- return $execute_success;
-}
-
-=head2 AddMember
-
- $borrowernumber = &AddMember(%borrower);
-
-insert new borrower into table
-
-(%borrower keys are database columns. Database columns could be
-different in different versions. Please look into database for correct
-column names.)
-
-Returns the borrowernumber upon success
-
-Returns as undef upon any db error without further processing
-
-=cut
-
-#'
-sub AddMember {
- my (%data) = @_;
- my $dbh = C4::Context->dbh;
- my $schema = Koha::Database->new()->schema;
-
- my $category = Koha::Patron::Categories->find( $data{categorycode} );
- unless ($category) {
- Koha::Exceptions::BadParameter->throw(
- error => 'Invalid parameter passed',
- parameter => 'categorycode'
- );
- }
-
- # trim whitespace from data which has some non-whitespace in it.
- foreach my $field_name (keys(%data)) {
- if ( defined $data{$field_name} && $data{$field_name} =~ /\S/ ) {
- $data{$field_name} =~ s/^\s*|\s*$//g;
- }
- }
-
- # generate a proper login if none provided
- $data{'userid'} = Generate_Userid( $data{'borrowernumber'}, $data{'firstname'}, $data{'surname'} )
- if ( $data{'userid'} eq '' || !Check_Userid( $data{'userid'} ) );
-
- # add expiration date if it isn't already there
- $data{dateexpiry} ||= $category->get_expiry_date;
-
- # add enrollment date if it isn't already there
- unless ( $data{'dateenrolled'} ) {
- $data{'dateenrolled'} = output_pref( { dt => dt_from_string, dateonly => 1, dateformat => 'iso' } );
- }
-
- if ( C4::Context->preference("autoMemberNum") ) {
- if ( not exists $data{cardnumber} or not defined $data{cardnumber} or $data{cardnumber} eq '' ) {
- $data{cardnumber} = fixup_cardnumber( $data{cardnumber} );
- }
- }
-
- $data{'privacy'} =
- $category->default_privacy() eq 'default' ? 1
- : $category->default_privacy() eq 'never' ? 2
- : $category->default_privacy() eq 'forever' ? 0
- : undef;
-
- $data{'privacy_guarantor_checkouts'} = 0 unless defined( $data{'privacy_guarantor_checkouts'} );
-
- # Make a copy of the plain text password for later use
- my $plain_text_password = $data{'password'};
-
- # create a disabled account if no password provided
- $data{'password'} = ($data{'password'})? hash_password($data{'password'}) : '!';
-
- # we don't want invalid dates in the db (mysql has a bad habit of inserting 0000-00-00
- $data{'dateofbirth'} = undef if ( not $data{'dateofbirth'} );
- $data{'debarred'} = undef if ( not $data{'debarred'} );
- $data{'sms_provider_id'} = undef if ( not $data{'sms_provider_id'} );
- $data{'guarantorid'} = undef if ( not $data{'guarantorid'} );
-
- # get only the columns of Borrower
- # FIXME Do we really need this check?
- my @columns = $schema->source('Borrower')->columns;
- my $new_member = { map { join(' ',@columns) =~ /$_/ ? ( $_ => $data{$_} ) : () } keys(%data) } ;
-
- delete $new_member->{borrowernumber};
-
- my $patron = Koha::Patron->new( $new_member )->store;
- $data{borrowernumber} = $patron->borrowernumber;
-
- # If NorwegianPatronDBEnable is enabled, we set syncstatus to something that a
- # cronjob will use for syncing with NL
- if ( exists $data{'borrowernumber'} && C4::Context->preference('NorwegianPatronDBEnable') && C4::Context->preference('NorwegianPatronDBEnable') == 1 ) {
- Koha::Database->new->schema->resultset('BorrowerSync')->create({
- 'borrowernumber' => $data{'borrowernumber'},
- 'synctype' => 'norwegianpatrondb',
- 'sync' => 1,
- 'syncstatus' => 'new',
- 'hashed_pin' => Koha::NorwegianPatronDB::NLEncryptPIN( $plain_text_password ),
- });
- }
-
- logaction("MEMBERS", "CREATE", $data{'borrowernumber'}, "") if C4::Context->preference("BorrowersLog");
-
- $patron->add_enrolment_fee_if_needed;
-
- return $data{borrowernumber};
-}
-
-=head2 Check_Userid
-
- my $uniqueness = Check_Userid($userid,$borrowernumber);
-
- $borrowernumber is optional (i.e. it can contain a blank value). If $userid is passed with a blank $borrowernumber variable, the database will be checked for all instances of that userid (i.e. userid=? AND borrowernumber != '').
-
- If $borrowernumber is provided, the database will be checked for every instance of that userid coupled with a different borrower(number) than the one provided.
-
- return :
- 0 for not unique (i.e. this $userid already exists)
- 1 for unique (i.e. this $userid does not exist, or this $userid/$borrowernumber combination already exists)
-
-=cut
-
-sub Check_Userid {
- my ( $uid, $borrowernumber ) = @_;
-
- return 0 unless ($uid); # userid is a unique column, we should assume NULL is not unique
-
- return 0 if ( $uid eq C4::Context->config('user') );
-
- my $rs = Koha::Database->new()->schema()->resultset('Borrower');
-
- my $params;
- $params->{userid} = $uid;
- $params->{borrowernumber} = { '!=' => $borrowernumber } if ($borrowernumber);
-
- my $count = $rs->count( $params );
-
- return $count ? 0 : 1;
-}
-
-=head2 Generate_Userid
-
- my $newuid = Generate_Userid($borrowernumber, $firstname, $surname);
-
- Generate a userid using the $surname and the $firstname (if there is a value in $firstname).
-
- $borrowernumber is optional (i.e. it can contain a blank value). A value is passed when generating a new userid for an existing borrower. When a new userid is created for a new borrower, a blank value is passed to this sub.
-
- return :
- new userid ($firstname.$surname if there is a $firstname, or $surname if there is no value in $firstname) plus offset (0 if the $newuid is unique, or a higher numeric value if Check_Userid finds an existing match for the $newuid in the database).
-
-=cut
-
-sub Generate_Userid {
- my ($borrowernumber, $firstname, $surname) = @_;
- my $newuid;
- my $offset = 0;
- #The script will "do" the following code and increment the $offset until Check_Userid = 1 (i.e. until $newuid comes back as unique)
- do {
- $firstname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
- $surname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
- $newuid = lc(($firstname)? "$firstname.$surname" : $surname);
- $newuid = unac_string('utf-8',$newuid);
- $newuid .= $offset unless $offset == 0;
- $offset++;
-
- } while (!Check_Userid($newuid,$borrowernumber));
-
- return $newuid;
-}
-
-=head2 fixup_cardnumber
-
-Warning: The caller is responsible for locking the members table in write
-mode, to avoid database corruption.
-
-=cut
-
-use vars qw( @weightings );
-my @weightings = ( 8, 4, 6, 3, 5, 2, 1 );
-
-sub fixup_cardnumber {
- my ($cardnumber) = @_;
- my $autonumber_members = C4::Context->boolean_preference('autoMemberNum') || 0;
-
- # Find out whether member numbers should be generated
- # automatically. Should be either "1" or something else.
- # Defaults to "0", which is interpreted as "no".
-
- # if ($cardnumber !~ /\S/ && $autonumber_members) {
- ($autonumber_members) or return $cardnumber;
- my $checkdigit = C4::Context->preference('checkdigit');
- my $dbh = C4::Context->dbh;
- if ( $checkdigit and $checkdigit eq 'katipo' ) {
-
- # if checkdigit is selected, calculate katipo-style cardnumber.
- # otherwise, just use the max()
- # purpose: generate checksum'd member numbers.
- # We'll assume we just got the max value of digits 2-8 of member #'s
- # from the database and our job is to increment that by one,
- # determine the 1st and 9th digits and return the full string.
- my $sth = $dbh->prepare(
- "select max(substring(borrowers.cardnumber,2,7)) as new_num from borrowers"
- );
- $sth->execute;
- my $data = $sth->fetchrow_hashref;
- $cardnumber = $data->{new_num};
- if ( !$cardnumber ) { # If DB has no values,
- $cardnumber = 1000000; # start at 1000000
- } else {
- $cardnumber += 1;
- }
-
- my $sum = 0;
- for ( my $i = 0 ; $i < 8 ; $i += 1 ) {
- # read weightings, left to right, 1 char at a time
- my $temp1 = $weightings[$i];
-
- # sequence left to right, 1 char at a time
- my $temp2 = substr( $cardnumber, $i, 1 );
-
- # mult each char 1-7 by its corresponding weighting
- $sum += $temp1 * $temp2;
- }
-
- my $rem = ( $sum % 11 );
- $rem = 'X' if $rem == 10;
-
- return "V$cardnumber$rem";
- } else {
-
- my $sth = $dbh->prepare(
- 'SELECT MAX( CAST( cardnumber AS SIGNED ) ) FROM borrowers WHERE cardnumber REGEXP "^-?[0-9]+$"'
- );
- $sth->execute;
- my ($result) = $sth->fetchrow;
- return $result + 1;
- }
- return $cardnumber; # just here as a fallback/reminder
-}
-
-=head2 GetPendingIssues
-
- my $issues = &GetPendingIssues(@borrowernumber);
-
-Looks up what the patron with the given borrowernumber has borrowed.
-
-C<&GetPendingIssues> returns a
-reference-to-array where each element is a reference-to-hash; the
-keys are the fields from the C<issues>, C<biblio>, and C<items> tables.
-The keys include C<biblioitems> fields.
-
-=cut
-
-sub GetPendingIssues {
- my @borrowernumbers = @_;
-
- unless (@borrowernumbers ) { # return a ref_to_array
- return \@borrowernumbers; # to not cause surprise to caller
- }
-
- # Borrowers part of the query
- my $bquery = '';
- for (my $i = 0; $i < @borrowernumbers; $i++) {
- $bquery .= ' issues.borrowernumber = ?';
- if ($i < $#borrowernumbers ) {
- $bquery .= ' OR';
- }
- }
-
- # FIXME: namespace collision: each table has "timestamp" fields. Which one is "timestamp" ?
- # FIXME: circ/ciculation.pl tries to sort by timestamp!
- # FIXME: namespace collision: other collisions possible.
- # FIXME: most of this data isn't really being used by callers.
- my $query =
- "SELECT issues.*,
- items.*,
- biblio.*,
- biblioitems.volume,
- biblioitems.number,
- biblioitems.itemtype,
- biblioitems.isbn,
- biblioitems.issn,
- biblioitems.publicationyear,
- biblioitems.publishercode,
- biblioitems.volumedate,
- biblioitems.volumedesc,
- biblioitems.lccn,
- biblioitems.url,
- borrowers.firstname,
- borrowers.surname,
- borrowers.cardnumber,
- issues.timestamp AS timestamp,
- issues.renewals AS renewals,
- issues.borrowernumber AS borrowernumber,
- items.renewals AS totalrenewals
- FROM issues
- LEFT JOIN items ON items.itemnumber = issues.itemnumber
- LEFT JOIN biblio ON items.biblionumber = biblio.biblionumber
- LEFT JOIN biblioitems ON items.biblioitemnumber = biblioitems.biblioitemnumber
- LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber
- WHERE
- $bquery
- ORDER BY issues.issuedate"
- ;
-
- my $sth = C4::Context->dbh->prepare($query);
- $sth->execute(@borrowernumbers);
- my $data = $sth->fetchall_arrayref({});
- my $today = dt_from_string;
- foreach (@{$data}) {
- if ($_->{issuedate}) {
- $_->{issuedate} = dt_from_string($_->{issuedate}, 'sql');
- }
- $_->{date_due_sql} = $_->{date_due};
- # FIXME no need to have this value
- $_->{date_due} or next;
- $_->{date_due_sql} = $_->{date_due};
- # FIXME no need to have this value
- $_->{date_due} = dt_from_string($_->{date_due}, 'sql');
- if ( DateTime->compare($_->{date_due}, $today) == -1 ) {
- $_->{overdue} = 1;
- }
- }
- return $data;
-}
-
=head2 GetAllIssues
$issues = &GetAllIssues($borrowernumber, $sortkey, $limit);
my $dbh = C4::Context->dbh;
my $query =
'SELECT *, issues.timestamp as issuestimestamp, issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
- FROM issues
+ FROM issues
LEFT JOIN items on items.itemnumber=issues.itemnumber
LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
- WHERE borrowernumber=?
+ WHERE borrowernumber=?
UNION ALL
- SELECT *, old_issues.timestamp as issuestimestamp, old_issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
- FROM old_issues
+ SELECT *, old_issues.timestamp as issuestimestamp, old_issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
+ FROM old_issues
LEFT JOIN items on items.itemnumber=old_issues.itemnumber
LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
=cut
sub get_cardnumber_length {
- my $borrower = Koha::Schema->resultset('Borrower');
+ my $borrower = Koha::Database->new->schema->resultset('Borrower');
my $field_size = $borrower->result_source->column_info('cardnumber')->{size};
my ( $min, $max ) = ( 0, $field_size ); # borrowers.cardnumber is a nullable varchar(20)
$min = 1 if C4::Context->preference('BorrowerMandatoryField') =~ /cardnumber/;
my $filtercategory = $params->{'category_code'};
my $filterbranch = $params->{'branchcode'} ||
((C4::Context->preference('IndependentBranches')
- && C4::Context->userenv
+ && C4::Context->userenv
&& !C4::Context->IsSuperLibrarian()
&& C4::Context->userenv->{branch})
? C4::Context->userenv->{branch}
- : "");
+ : "");
my $filterpatronlist = $params->{'patron_list_id'};
my $dbh = C4::Context->dbh;
warn $query if $debug;
my $sth = $dbh->prepare($query);
- if (scalar(@query_params)>0){
+ if (scalar(@query_params)>0){
$sth->execute(@query_params);
}
else {
$sth->execute;
}
-
+
my @results;
while ( my $data = $sth->fetchrow_hashref ) {
push @results, $data;
<<issues.*>>
</checkedout>
- NOTE: Not all table fields are available, pleasee see GetPendingIssues for a list of available fields.
+ NOTE: Fields from tables issues, items, biblio and biblioitems are available
=cut
my $patron = Koha::Patrons->find( $borrowernumber );
return unless $patron;
- my @issues = @{ GetPendingIssues($borrowernumber) };
-
- for my $issue (@issues) {
- $issue->{date_due} = $issue->{date_due_sql};
- if ($quickslip) {
- my $today = output_pref({ dt => dt_from_string, dateformat => 'iso', dateonly => 1 });
- if ( substr( $issue->{issuedate}, 0, 10 ) eq $today
- or substr( $issue->{lastreneweddate}, 0, 10 ) eq $today ) {
- $issue->{now} = 1;
- };
- }
- }
-
- # Sort on timestamp then on issuedate then on issue_id
- # useful for tests and could be if modified in a batch
- @issues = sort {
- $b->{timestamp} <=> $a->{timestamp}
- or $b->{issuedate} <=> $a->{issuedate}
- or $b->{issue_id} <=> $a->{issue_id}
- } @issues;
+ my $pending_checkouts = $patron->pending_checkouts; # Should be $patron->checkouts->pending?
my ($letter_code, %repeat, %loops);
if ( $quickslip ) {
+ my $today_start = dt_from_string->set( hour => 0, minute => 0, second => 0 );
+ my $today_end = dt_from_string->set( hour => 23, minute => 59, second => 0 );
+ $today_start = Koha::Database->new->schema->storage->datetime_parser->format_datetime( $today_start );
+ $today_end = Koha::Database->new->schema->storage->datetime_parser->format_datetime( $today_end );
$letter_code = 'ISSUEQSLIP';
- my @checkouts = map {
- 'biblio' => $_,
- 'items' => $_,
- 'biblioitems' => $_,
- 'issues' => $_,
- }, grep { $_->{'now'} } @issues;
+
+ # issue date or lastreneweddate is today
+ my $todays_checkouts = $pending_checkouts->search(
+ {
+ -or => {
+ issuedate => {
+ '>=' => $today_start,
+ '<=' => $today_end,
+ },
+ lastreneweddate =>
+ { '>=' => $today_start, '<=' => $today_end, }
+ }
+ }
+ );
+ my @checkouts;
+ while ( my $c = $todays_checkouts->next ) {
+ my $all = $c->unblessed_all_relateds;
+ push @checkouts, {
+ biblio => $all,
+ items => $all,
+ biblioitems => $all,
+ issues => $all,
+ };
+ }
+
%repeat = (
- checkedout => \@checkouts, # History syntax
+ checkedout => \@checkouts, # Historical syntax
);
%loops = (
issues => [ map { $_->{issues}{itemnumber} } @checkouts ], # TT syntax
);
}
else {
- my @checkouts = map {
- 'biblio' => $_,
- 'items' => $_,
- 'biblioitems' => $_,
- 'issues' => $_,
- }, grep { !$_->{'overdue'} } @issues;
- my @overdues = map {
- 'biblio' => $_,
- 'items' => $_,
- 'biblioitems' => $_,
- 'issues' => $_,
- }, grep { $_->{'overdue'} } @issues;
+ my $today = Koha::Database->new->schema->storage->datetime_parser->format_datetime( dt_from_string );
+ # Checkouts due in the future
+ my $checkouts = $pending_checkouts->search({ date_due => { '>' => $today } });
+ my @checkouts; my @overdues;
+ while ( my $c = $checkouts->next ) {
+ my $all = $c->unblessed_all_relateds;
+ push @checkouts, {
+ biblio => $all,
+ items => $all,
+ biblioitems => $all,
+ issues => $all,
+ };
+ }
+
+ # Checkouts due in the past are overdues
+ my $overdues = $pending_checkouts->search({ date_due => { '<=' => $today } });
+ while ( my $o = $overdues->next ) {
+ my $all = $o->unblessed_all_relateds;
+ push @overdues, {
+ biblio => $all,
+ items => $all,
+ biblioitems => $all,
+ issues => $all,
+ };
+ }
my $news = GetNewsToDisplay( "slip", $branch );
my @news = map {
$_->{'timestamp'} = $_->{'newdate'};
);
}
-=head2 AddMember_Auto
-
-=cut
-
-sub AddMember_Auto {
- my ( %borrower ) = @_;
-
- $borrower{'cardnumber'} ||= fixup_cardnumber();
-
- $borrower{'borrowernumber'} = AddMember(%borrower);
-
- return ( %borrower );
-}
-
-=head2 AddMember_Opac
-
-=cut
-
-sub AddMember_Opac {
- my ( %borrower ) = @_;
-
- $borrower{'categorycode'} //= C4::Context->preference('PatronSelfRegistrationDefaultCategory');
- if (not defined $borrower{'password'}){
- my $sr = new String::Random;
- $sr->{'A'} = [ 'A'..'Z', 'a'..'z' ];
- my $password = $sr->randpattern("AAAAAAAAAA");
- $borrower{'password'} = $password;
- }
-
- %borrower = AddMember_Auto(%borrower);
-
- return ( $borrower{'borrowernumber'}, $borrower{'password'} );
-}
-
=head2 DeleteExpiredOpacRegistrations
Delete accounts that haven't been upgraded from the 'temporary' category
my $category_code = C4::Context->preference('PatronSelfRegistrationDefaultCategory');
return 0 if not $category_code or not defined $delay or $delay eq q||;
+ my $date_enrolled = dt_from_string();
+ $date_enrolled->subtract( days => $delay );
- my $query = qq|
-SELECT borrowernumber
-FROM borrowers
-WHERE categorycode = ? AND DATEDIFF( NOW(), dateenrolled ) > ? |;
+ my $registrations_to_del = Koha::Patrons->search({
+ dateenrolled => {'<=' => $date_enrolled->ymd},
+ categorycode => $category_code,
+ });
- my $dbh = C4::Context->dbh;
- my $sth = $dbh->prepare($query);
- $sth->execute( $category_code, $delay );
my $cnt=0;
- while ( my ($borrowernumber) = $sth->fetchrow_array() ) {
- Koha::Patrons->find($borrowernumber)->delete;
+ while ( my $registration = $registrations_to_del->next() ) {
+ next if $registration->checkouts->count || $registration->account->balance;
+ $registration->delete;
$cnt++;
}
return $cnt;
return $cnt eq '0E0'? 0: $cnt;
}
-sub GetOverduesForPatron {
- my ( $borrowernumber ) = @_;
-
- my $sql = "
- SELECT *
- FROM issues, items, biblio, biblioitems
- WHERE items.itemnumber=issues.itemnumber
- AND biblio.biblionumber = items.biblionumber
- AND biblio.biblionumber = biblioitems.biblionumber
- AND issues.borrowernumber = ?
- AND date_due < NOW()
- ";
-
- my $sth = C4::Context->dbh->prepare( $sql );
- $sth->execute( $borrowernumber );
-
- return $sth->fetchall_arrayref({});
-}
-
END { } # module clean-up code here (global destructor)
1;
projects / koha.git / blobdiff