use String::Random qw( random_string );
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;
@ISA = qw(Exporter);
#Get data
push @EXPORT, qw(
- &GetMember
- &GetPendingIssues
&GetAllIssues
- &GetFirstValidEmailAddress
- &GetNoticeEmailAddress
-
- &GetMemberAccountRecords
- &GetBorNotifyAcctRecord
-
&GetBorrowersToExpunge
&IssueSlip
-
- GetOverduesForPatron
);
#Modify data
#Insert data
push @EXPORT, qw(
- &AddMember
&AddMember_Auto
&AddMember_Opac
);
#Check data
push @EXPORT, qw(
- &checkuniquemember
&checkuserpassword
- &Check_Userid
- &Generate_Userid
- &fixup_cardnumber
&checkcardnumber
);
}
# 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) = @_;
my $dbh=C4::Context->dbh;
- my ($balance, $owing) = GetMemberAccountBalance( $patroninformation->{'borrowernumber'});
+ my $patron = Koha::Patrons->find( $patroninformation->{borrowernumber} );
+ my $account = $patron->account;
+ my $owing = $account->non_issues_charges;
if ( $owing > 0 ) {
my %flaginfo;
my $noissuescharge = C4::Context->preference("noissuescharge") || 5;
}
$flags{'CHARGES'} = \%flaginfo;
}
- elsif ( $balance < 0 ) {
+ elsif ( ( my $balance = $account->balance ) < 0 ) {
my %flaginfo;
$flaginfo{'message'} = sprintf 'Patron has credit of %.02f', -$balance;
$flaginfo{'amount'} = sprintf "%.02f", $balance;
my @guarantees = $p->guarantees();
my $guarantees_non_issues_charges;
foreach my $g ( @guarantees ) {
- my ( $b, $n, $o ) = C4::Members::GetMemberAccountBalance( $g->id );
- $guarantees_non_issues_charges += $n;
+ $guarantees_non_issues_charges += $g->account->non_issues_charges;
}
if ( $guarantees_non_issues_charges > $no_issues_charge_guarantees ) {
$flags{'ODUES'} = \%flaginfo;
}
- my $patron = Koha::Patrons->find( $patroninformation->{borrowernumber} );
my $waiting_holds = $patron->holds->search({ found => 'W' });
my $nowaiting = $waiting_holds->count;
if ( $nowaiting > 0 ) {
}
-=head2 GetMember
-
- $borrower = &GetMember(%information);
-
-Retrieve the first patron record meeting on criteria listed in the
-C<%information> hash, which should contain one or more
-pairs of borrowers column names and values, e.g.,
-
- $borrower = GetMember(borrowernumber => id);
-
-C<&GetBorrower> returns a reference-to-hash whose keys are the fields of
-the C<borrowers> table in the Koha database.
-
-FIXME: GetMember() is used throughout the code as a lookup
-on a unique key such as the borrowernumber, but this meaning is not
-enforced in the routine itself.
-
-=cut
-
-#'
-sub GetMember {
- my ( %information ) = @_;
- if (exists $information{borrowernumber} && !defined $information{borrowernumber}) {
- #passing mysql's kohaadmin?? Makes no sense as a query
- return;
- }
- my $dbh = C4::Context->dbh;
- my $select =
- q{SELECT borrowers.*, categories.category_type, categories.description
- FROM borrowers
- LEFT JOIN categories on borrowers.categorycode=categories.categorycode WHERE };
- my $more_p = 0;
- my @values = ();
- for (keys %information ) {
- if ($more_p) {
- $select .= ' AND ';
- }
- else {
- $more_p++;
- }
-
- if (defined $information{$_}) {
- $select .= "$_ = ?";
- push @values, $information{$_};
- }
- else {
- $select .= "$_ IS NULL";
- }
- }
- $debug && warn $select, " ",values %information;
- my $sth = $dbh->prepare("$select");
- $sth->execute(@values);
- my $data = $sth->fetchall_arrayref({});
- #FIXME interface to this routine now allows generation of a result set
- #so whole array should be returned but bowhere in the current code expects this
- if (@{$data} ) {
- return $data->[0];
- }
-
- return;
-}
-
=head2 ModMember
my $success = ModMember(borrowernumber => $borrowernumber,
my $patron = Koha::Patrons->find( $new_borrower->{borrowernumber} );
+ my $borrowers_log = C4::Context->preference("BorrowersLog");
+ if ( $borrowers_log && $patron->cardnumber ne $new_borrower->{cardnumber} )
+ {
+ logaction(
+ "MEMBERS",
+ "MODIFY",
+ $data{'borrowernumber'},
+ to_json(
+ {
+ cardnumber_replaced => {
+ previous_cardnumber => $patron->cardnumber,
+ new_cardnumber => $new_borrower->{cardnumber},
+ }
+ },
+ { utf8 => 1, pretty => 1 }
+ )
+ );
+ }
+
delete $new_borrower->{userid} if exists $new_borrower->{userid} and not $new_borrower->{userid};
my $execute_success = $patron->store if $patron->set($new_borrower);
Koha::NorwegianPatronDB::NLSync({ 'borrowernumber' => $data{'borrowernumber'} });
}
- logaction("MEMBERS", "MODIFY", $data{'borrowernumber'}, "UPDATE (executed w/ arg: $data{'borrowernumber'})") if C4::Context->preference("BorrowersLog");
+ logaction("MEMBERS", "MODIFY", $data{'borrowernumber'}, "UPDATE (executed w/ arg: $data{'borrowernumber'})") if $borrowers_log;
}
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;
-
- # 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} ||= Koha::Patron::Categories->find( $data{categorycode} )->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} );
- }
- }
-
- my $patron_category = $schema->resultset('Category')->find( $data{'categorycode'} );
- $data{'privacy'} =
- $patron_category->default_privacy() eq 'default' ? 1
- : $patron_category->default_privacy() eq 'never' ? 2
- : $patron_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);
return $sth->fetchall_arrayref( {} );
}
-
-=head2 GetMemberAccountRecords
-
- ($total, $acctlines, $count) = &GetMemberAccountRecords($borrowernumber);
-
-Looks up accounting data for the patron with the given borrowernumber.
-
-C<&GetMemberAccountRecords> returns a three-element array. C<$acctlines> is a
-reference-to-array, where each element is a reference-to-hash; the
-keys are the fields of the C<accountlines> table in the Koha database.
-C<$count> is the number of elements in C<$acctlines>. C<$total> is the
-total amount outstanding for all of the account lines.
-
-=cut
-
-sub GetMemberAccountRecords {
- my ($borrowernumber) = @_;
- my $dbh = C4::Context->dbh;
- my @acctlines;
- my $numlines = 0;
- my $strsth = qq(
- SELECT *
- FROM accountlines
- WHERE borrowernumber=?);
- $strsth.=" ORDER BY accountlines_id desc";
- my $sth= $dbh->prepare( $strsth );
- $sth->execute( $borrowernumber );
-
- my $total = 0;
- while ( my $data = $sth->fetchrow_hashref ) {
- if ( $data->{itemnumber} ) {
- my $biblio = GetBiblioFromItemNumber( $data->{itemnumber} );
- $data->{biblionumber} = $biblio->{biblionumber};
- $data->{title} = $biblio->{title};
- }
- $acctlines[$numlines] = $data;
- $numlines++;
- $total += sprintf "%.0f", 1000*$data->{amountoutstanding}; # convert float to integer to avoid round-off errors
- }
- $total /= 1000;
- return ( $total, \@acctlines,$numlines);
-}
-
-=head2 GetMemberAccountBalance
-
- ($total_balance, $non_issue_balance, $other_charges) = &GetMemberAccountBalance($borrowernumber);
-
-Calculates amount immediately owing by the patron - non-issue charges.
-Based on GetMemberAccountRecords.
-Charges exempt from non-issue are:
-* Res (reserves)
-* Rent (rental) if RentalsInNoissuesCharge syspref is set to false
-* Manual invoices if ManInvInNoissuesCharge syspref is set to false
-
-=cut
-
-sub GetMemberAccountBalance {
- my ($borrowernumber) = @_;
-
- my $ACCOUNT_TYPE_LENGTH = 5; # this is plain ridiculous...
-
- my @not_fines;
- push @not_fines, 'Res' unless C4::Context->preference('HoldsInNoissuesCharge');
- push @not_fines, 'Rent' unless C4::Context->preference('RentalsInNoissuesCharge');
- unless ( C4::Context->preference('ManInvInNoissuesCharge') ) {
- my $dbh = C4::Context->dbh;
- my $man_inv_types = $dbh->selectcol_arrayref(qq{SELECT authorised_value FROM authorised_values WHERE category = 'MANUAL_INV'});
- push @not_fines, map substr($_, 0, $ACCOUNT_TYPE_LENGTH), @$man_inv_types;
- }
- my %not_fine = map {$_ => 1} @not_fines;
-
- my ($total, $acctlines) = GetMemberAccountRecords($borrowernumber);
- my $other_charges = 0;
- foreach (@$acctlines) {
- $other_charges += $_->{amountoutstanding} if $not_fine{ substr($_->{accounttype}, 0, $ACCOUNT_TYPE_LENGTH) };
- }
-
- return ( $total, $total - $other_charges, $other_charges);
-}
-
-=head2 GetBorNotifyAcctRecord
-
- ($total, $acctlines, $count) = &GetBorNotifyAcctRecord($params,$notifyid);
-
-Looks up accounting data for the patron with the given borrowernumber per file number.
-
-C<&GetBorNotifyAcctRecord> returns a three-element array. C<$acctlines> is a
-reference-to-array, where each element is a reference-to-hash; the
-keys are the fields of the C<accountlines> table in the Koha database.
-C<$count> is the number of elements in C<$acctlines>. C<$total> is the
-total amount outstanding for all of the account lines.
-
-=cut
-
-sub GetBorNotifyAcctRecord {
- my ( $borrowernumber, $notifyid ) = @_;
- my $dbh = C4::Context->dbh;
- my @acctlines;
- my $numlines = 0;
- my $sth = $dbh->prepare(
- "SELECT *
- FROM accountlines
- WHERE borrowernumber=?
- AND notify_id=?
- AND amountoutstanding != '0'
- ORDER BY notify_id,accounttype
- ");
-
- $sth->execute( $borrowernumber, $notifyid );
- my $total = 0;
- while ( my $data = $sth->fetchrow_hashref ) {
- if ( $data->{itemnumber} ) {
- my $biblio = GetBiblioFromItemNumber( $data->{itemnumber} );
- $data->{biblionumber} = $biblio->{biblionumber};
- $data->{title} = $biblio->{title};
- }
- $acctlines[$numlines] = $data;
- $numlines++;
- $total += int(100 * $data->{'amountoutstanding'});
- }
- $total /= 100;
- return ( $total, \@acctlines, $numlines );
-}
-
sub checkcardnumber {
my ( $cardnumber, $borrowernumber ) = @_;
=cut
sub get_cardnumber_length {
- my ( $min, $max ) = ( 0, 16 ); # borrowers.cardnumber is a nullable varchar(16)
+ my $borrower = Koha::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/;
if ( my $cardnumber_length = C4::Context->preference('CardnumberLength') ) {
# Is integer and length match
}
}
- my $borrower = Koha::Schema->resultset('Borrower');
- my $field_size = $borrower->result_source->column_info('cardnumber')->{size};
- $min = $field_size if $min > $field_size;
+ $min = $max if $min > $max;
return ( $min, $max );
}
-=head2 GetFirstValidEmailAddress
-
- $email = GetFirstValidEmailAddress($borrowernumber);
-
-Return the first valid email address for a borrower, given the borrowernumber. For now, the order
-is defined as email, emailpro, B_email. Returns the empty string if the borrower has no email
-addresses.
-
-=cut
-
-sub GetFirstValidEmailAddress {
- my $borrowernumber = shift;
-
- my $borrower = Koha::Patrons->find( $borrowernumber );
-
- return $borrower->first_valid_email_address();
-}
-
-=head2 GetNoticeEmailAddress
-
- $email = GetNoticeEmailAddress($borrowernumber);
-
-Return the email address of borrower used for notices, given the borrowernumber.
-Returns the empty string if no email address.
-
-=cut
-
-sub GetNoticeEmailAddress {
- my $borrowernumber = shift;
-
- my $which_address = C4::Context->preference("AutoEmailPrimaryAddress");
- # if syspref is set to 'first valid' (value == OFF), look up email address
- if ( $which_address eq 'OFF' ) {
- return GetFirstValidEmailAddress($borrowernumber);
- }
- # specified email address field
- my $dbh = C4::Context->dbh;
- my $sth = $dbh->prepare( qq{
- SELECT $which_address AS primaryemail
- FROM borrowers
- WHERE borrowernumber=?
- } );
- $sth->execute($borrowernumber);
- my $data = $sth->fetchrow_hashref;
- return $data->{'primaryemail'} || '';
-}
-
=head2 GetBorrowersToExpunge
$borrowers = &GetBorrowersToExpunge(
my $dbh = C4::Context->dbh;
my $query = q|
- SELECT borrowers.borrowernumber,
- MAX(old_issues.timestamp) AS latestissue,
- MAX(issues.timestamp) AS currentissue
- FROM borrowers
- JOIN categories USING (categorycode)
- LEFT JOIN (
- SELECT guarantorid
- FROM borrowers
- WHERE guarantorid IS NOT NULL
- AND guarantorid <> 0
- ) as tmp ON borrowers.borrowernumber=tmp.guarantorid
- LEFT JOIN old_issues USING (borrowernumber)
- LEFT JOIN issues USING (borrowernumber)|;
+ SELECT *
+ FROM (
+ SELECT borrowers.borrowernumber,
+ MAX(old_issues.timestamp) AS latestissue,
+ MAX(issues.timestamp) AS currentissue
+ FROM borrowers
+ JOIN categories USING (categorycode)
+ LEFT JOIN (
+ SELECT guarantorid
+ FROM borrowers
+ WHERE guarantorid IS NOT NULL
+ AND guarantorid <> 0
+ ) as tmp ON borrowers.borrowernumber=tmp.guarantorid
+ LEFT JOIN old_issues USING (borrowernumber)
+ LEFT JOIN issues USING (borrowernumber)|;
if ( $filterpatronlist ){
$query .= q| LEFT JOIN patron_list_patrons USING (borrowernumber)|;
}
$query .= q| WHERE category_type <> 'S'
AND tmp.guarantorid IS NULL
- |;
+ |;
my @query_params;
if ( $filterbranch && $filterbranch ne "" ) {
$query.= " AND borrowers.branchcode = ? ";
$query.=" AND patron_list_id = ? ";
push( @query_params, $filterpatronlist );
}
- $query.=" GROUP BY borrowers.borrowernumber HAVING currentissue IS NULL ";
+ $query .= " GROUP BY borrowers.borrowernumber";
+ $query .= q|
+ ) xxx WHERE currentissue IS NULL|;
if ( $filterdate ) {
$query.=" AND ( latestissue < ? OR latestissue IS NULL ) ";
push @query_params,$filterdate;
}
+
warn $query if $debug;
my $sth = $dbh->prepare($query);
<<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) };
+ 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';
- 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;
+ # 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,
};
}
- }
- # Sort on timestamp then on issuedate (useful for tests and could be if modified in a batch
- @issues = sort {
- my $s = $b->{timestamp} <=> $a->{timestamp};
- $s == 0 ?
- $b->{issuedate} <=> $a->{issuedate} : $s;
- } @issues;
-
- my ($letter_code, %repeat);
- if ( $quickslip ) {
- $letter_code = 'ISSUEQSLIP';
%repeat = (
- 'checkedout' => [ map {
- 'biblio' => $_,
- 'items' => $_,
- 'biblioitems' => $_,
- 'issues' => $_,
- }, grep { $_->{'now'} } @issues ],
+ checkedout => \@checkouts, # Historical syntax
+ );
+ %loops = (
+ issues => [ map { $_->{issues}{itemnumber} } @checkouts ], # TT syntax
);
}
else {
+ 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'};
+ { opac_news => $_ }
+ } @$news;
$letter_code = 'ISSUESLIP';
- %repeat = (
- 'checkedout' => [ map {
- 'biblio' => $_,
- 'items' => $_,
- 'biblioitems' => $_,
- 'issues' => $_,
- }, grep { !$_->{'overdue'} } @issues ],
-
- 'overdue' => [ map {
- 'biblio' => $_,
- 'items' => $_,
- 'biblioitems' => $_,
- 'issues' => $_,
- }, grep { $_->{'overdue'} } @issues ],
-
- 'news' => [ map {
- $_->{'timestamp'} = $_->{'newdate'};
- { opac_news => $_ }
- } @{ GetNewsToDisplay("slip",$branch) } ],
+ %repeat = (
+ checkedout => \@checkouts,
+ overdue => \@overdues,
+ news => \@news,
+ );
+ %loops = (
+ issues => [ map { $_->{issues}{itemnumber} } @checkouts ],
+ overdues => [ map { $_->{issues}{itemnumber} } @overdues ],
+ opac_news => [ map { $_->{opac_news}{idnew} } @news ],
);
}
'borrowers' => $borrowernumber,
},
repeat => \%repeat,
+ loops => \%loops,
);
}
sub AddMember_Auto {
my ( %borrower ) = @_;
- $borrower{'cardnumber'} ||= fixup_cardnumber();
-
- $borrower{'borrowernumber'} = AddMember(%borrower);
+ my $patron = Koha::Patron->new(\%borrower)->store;
- return ( %borrower );
+ return %{ $patron->unblessed };
}
=head2 AddMember_Opac
my ( %borrower ) = @_;
$borrower{'categorycode'} //= C4::Context->preference('PatronSelfRegistrationDefaultCategory');
- if (not defined $borrower{'password'}){
+ my $password = $borrower{password};
+ if (not defined $password){
my $sr = new String::Random;
$sr->{'A'} = [ 'A'..'Z', 'a'..'z' ];
- my $password = $sr->randpattern("AAAAAAAAAA");
+ $password = $sr->randpattern("AAAAAAAAAA");
$borrower{'password'} = $password;
}
%borrower = AddMember_Auto(%borrower);
- return ( $borrower{'borrowernumber'}, $borrower{'password'} );
+ return ( $borrower{'borrowernumber'}, $password );
}
=head2 DeleteExpiredOpacRegistrations
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