X-Git-Url: http://git.rot13.org/?a=blobdiff_plain;f=C4%2FMembers.pm;h=f5a360e803a2dec0fef3ab5612c9bb3268a0648d;hb=f33e65499b0d00637dc7627c6ead4f6849cc2a96;hp=4f3d692547a004736a4235fcb3fbd4fe4eeb4f0b;hpb=ee56e731abbb6c5110d18acb568dd65263833ffb;p=koha.git diff --git a/C4/Members.pm b/C4/Members.pm index 4f3d692547..f5a360e803 100644 --- a/C4/Members.pm +++ b/C4/Members.pm @@ -17,21 +17,99 @@ package C4::Members; # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place, # Suite 330, Boston, MA 02111-1307 USA -# $Id$ use strict; -require Exporter; use C4::Context; -use C4::Date; +use C4::Dates qw(format_date_in_iso); use Digest::MD5 qw(md5_base64); use Date::Calc qw/Today Add_Delta_YM/; use C4::Log; # logaction use C4::Overdues; use C4::Reserves; - -our ($VERSION,@ISA,@EXPORT,@EXPORT_OK); - -$VERSION = do { my @v = '$Revision$' =~ /\d+/g; shift(@v) . "." . join( "_", map { sprintf "%03d", $_ } @v ); }; +use C4::Accounts; +use C4::Biblio; + +our ($VERSION,@ISA,@EXPORT,@EXPORT_OK,$debug); + +BEGIN { + $VERSION = 3.02; + $debug = $ENV{DEBUG} || 0; + require Exporter; + @ISA = qw(Exporter); + #Get data + push @EXPORT, qw( + &SearchMember + &GetMemberDetails + &GetMember + + &GetGuarantees + + &GetMemberIssuesAndFines + &GetPendingIssues + &GetAllIssues + + &get_institutions + &getzipnamecity + &getidcity + + &GetAge + &GetCities + &GetRoadTypes + &GetRoadTypeDetails + &GetSortDetails + &GetTitles + + &GetPatronImage + &PutPatronImage + &RmPatronImage + + &GetMemberAccountRecords + &GetBorNotifyAcctRecord + + &GetborCatFromCatType + &GetBorrowercategory + &GetBorrowercategoryList + + &GetBorrowersWhoHaveNotBorrowedSince + &GetBorrowersWhoHaveNeverBorrowed + &GetBorrowersWithIssuesHistoryOlderThan + + &GetExpiryDate + + &IsMemberBlocked + ); + + #Modify data + push @EXPORT, qw( + &ModMember + &changepassword + ); + + #Delete data + push @EXPORT, qw( + &DelMember + ); + + #Insert data + push @EXPORT, qw( + &AddMember + &add_member_orgs + &MoveMemberToDeleted + &ExtendMemberSubscriptionTo + ); + + #Check data + push @EXPORT, qw( + &checkuniquemember + &checkuserpassword + &Check_Userid + &Generate_Userid + &fixEthnicity + ðnicitycategories + &fixup_cardnumber + &checkcardnumber + ); +} =head1 NAME @@ -49,79 +127,11 @@ This module contains routines for adding, modifying and deleting members/patrons =over 2 -=cut - -@ISA = qw(Exporter); - -#Get data -push @EXPORT, qw( - &SearchMember - &GetMemberDetails - &GetMember - - &GetGuarantees - - &GetMemberIssuesAndFines - &GetPendingIssues - &GetAllIssues - - &get_institutions - &getzipnamecity - &getidcity - - &GetAge - &GetCities - &GetRoadTypes - &GetRoadTypeDetails - &GetSortDetails - &GetTitles - - &GetMemberAccountRecords - &GetBorNotifyAcctRecord - - &GetborCatFromCatType - &GetBorrowercategory - - - &GetBorrowersWhoHaveNotBorrowedSince - &GetBorrowersWhoHaveNeverBorrowed - &GetBorrowersWithIssuesHistoryOlderThan - - &GetExpiryDate -); - -#Modify data -push @EXPORT, qw( - &ModMember - &changepassword -); - -#Delete data -push @EXPORT, qw( - &DelMember -); - -#Insert data -push @EXPORT, qw( - &AddMember - &add_member_orgs - &MoveMemberToDeleted - &ExtendMemberSubscriptionTo -); - -#Check data -push @EXPORT, qw( - &checkuniquemember - &checkuserpassword - &fixEthnicity - ðnicitycategories - &fixup_cardnumber - &checkcardnumber -); - =item SearchMember - ($count, $borrowers) = &SearchMember($searchstring, $type,$category_type); + ($count, $borrowers) = &SearchMember($searchstring, $type,$category_type,$filter,$showallbranches); + +=back Looks up patrons (borrowers) by name. @@ -136,6 +146,10 @@ C<$searchstring> is a space-separated list of search terms. Each term must match the beginning a borrower's surname, first name, or other name. +C<$filter> is assumed to be a list of elements to filter results on + +C<$showallbranches> is used in IndependantBranches Context to display all branches results. + C<&SearchMember> returns a two-element list. C<$borrowers> is a reference-to-array; each element is a reference-to-hash, whose keys are the fields of the C table in the Koha database. @@ -145,62 +159,92 @@ C<$count> is the number of elements in C<$borrowers>. #' #used by member enquiries from the intranet -#called by member.pl +#called by member.pl and circ/circulation.pl sub SearchMember { - my ($searchstring, $orderby, $type,$category_type ) = @_; + my ($searchstring, $orderby, $type,$category_type,$filter,$showallbranches ) = @_; my $dbh = C4::Context->dbh; my $query = ""; my $count; my @data; my @bind = (); + + # this is used by circulation everytime a new borrowers cardnumber is scanned + # so we can check an exact match first, if that works return, otherwise do the rest + $query = "SELECT * FROM borrowers + LEFT JOIN categories ON borrowers.categorycode=categories.categorycode + "; + my $sth = $dbh->prepare("$query WHERE cardnumber = ?"); + $sth->execute($searchstring); + my $data = $sth->fetchall_arrayref({}); + if (@$data){ + return ( scalar(@$data), $data ); + } + $sth->finish; if ( $type eq "simple" ) # simple search for one letter only { - $query = - "SELECT * FROM borrowers - LEFT JOIN categories ON borrowers.categorycode=categories.categorycode ". - ($category_type?" AND category_type = ".$dbh->quote($category_type):""). - " WHERE surname LIKE ? OR cardnumber like ? ORDER BY $orderby"; + $query .= ($category_type ? " AND category_type = ".$dbh->quote($category_type) : ""); + $query .= " WHERE (surname LIKE ? OR cardnumber like ?) "; + if (C4::Context->preference("IndependantBranches") && !$showallbranches){ + if (C4::Context->userenv && C4::Context->userenv->{flags}!=1 && C4::Context->userenv->{'branch'}){ + $query.=" AND borrowers.branchcode =".$dbh->quote(C4::Context->userenv->{'branch'}) unless (C4::Context->userenv->{'branch'} eq "insecure"); + } + } + $query.=" ORDER BY $orderby"; @bind = ("$searchstring%","$searchstring"); } else # advanced search looking in surname, firstname and othernames { @data = split( ' ', $searchstring ); $count = @data; - $query = "SELECT * FROM borrowers - LEFT JOIN categories ON borrowers.categorycode=categories.categorycode - WHERE ((surname LIKE ? OR surname LIKE ? - OR firstname LIKE ? OR firstname LIKE ? - OR othernames LIKE ? OR othernames LIKE ?) - ". - ($category_type?" AND category_type = ".$dbh->quote($category_type):""); + $query .= " WHERE "; + if (C4::Context->preference("IndependantBranches") && !$showallbranches){ + if (C4::Context->userenv && C4::Context->userenv->{flags}!=1 && C4::Context->userenv->{'branch'}){ + $query.=" borrowers.branchcode =".$dbh->quote(C4::Context->userenv->{'branch'})." AND " unless (C4::Context->userenv->{'branch'} eq "insecure"); + } + } + $query.="((surname LIKE ? OR surname LIKE ? + OR firstname LIKE ? OR firstname LIKE ? + OR othernames LIKE ? OR othernames LIKE ?) + " . + ($category_type?" AND category_type = ".$dbh->quote($category_type):""); @bind = ( "$data[0]%", "% $data[0]%", "$data[0]%", "% $data[0]%", "$data[0]%", "% $data[0]%" ); for ( my $i = 1 ; $i < $count ; $i++ ) { $query = $query . " AND (" . " surname LIKE ? OR surname LIKE ? - OR firstname LIKE ? OR firstname LIKE ? - OR othernames LIKE ? OR othernames LIKE ?)"; + OR firstname LIKE ? OR firstname LIKE ? + OR othernames LIKE ? OR othernames LIKE ?)"; push( @bind, "$data[$i]%", "% $data[$i]%", "$data[$i]%", "% $data[$i]%", "$data[$i]%", "% $data[$i]%" ); # FIXME - .= <preference('ExtendedPatronAttributes')) { + $query .= "OR borrowernumber IN ( +SELECT borrowernumber +FROM borrower_attributes +JOIN borrower_attribute_types USING (code) +WHERE staff_searchable = 1 +AND attribute like ? +)"; + push (@bind, $searchstring); + } + $query .= "order by $orderby"; # FIXME - .= <prepare($query); + $sth = $dbh->prepare($query); - # warn "Q $orderby : $query"; + $debug and print STDERR "Q $orderby : $query\n"; $sth->execute(@bind); my @results; - my $data = $sth->fetchall_arrayref({}); + $data = $sth->fetchall_arrayref({}); $sth->finish; return ( scalar(@$data), $data ); @@ -208,7 +252,7 @@ sub SearchMember { =head2 GetMemberDetails -($borrower, $flags) = &GetMemberDetails($borrowernumber, $cardnumber); +($borrower) = &GetMemberDetails($borrowernumber, $cardnumber); Looks up a patron and returns information about him or her. If C<$borrowernumber> is true (nonzero), C<&GetMemberDetails> looks @@ -224,81 +268,17 @@ about the patron. Its keys act as flags : # Patron's card was reported lost } -Each flag has a C key, giving a human-readable explanation of -the flag. If the state of a flag means that the patron should not be +If the state of a flag means that the patron should not be allowed to borrow any more books, then it will have a C key with a true value. -The possible flags are: - -=head3 CHARGES - -=over 4 - -=item Shows the patron's credit or debt, if any. - -=back - -=head3 GNA - -=over 4 - -=item (Gone, no address.) Set if the patron has left without giving a -forwarding address. - -=back - -=head3 LOST - -=over 4 - -=item Set if the patron's card has been reported as lost. - -=back - -=head3 DBARRED - -=over 4 - -=item Set if the patron has been debarred. - -=back - -=head3 NOTES - -=over 4 - -=item Any additional notes about the patron. - -=back - -=head3 ODUES - -=over 4 - -=item Set if the patron has overdue items. This flag has several keys: - -C<$flags-E{ODUES}{itemlist}> is a reference-to-array listing the -overdue items. Its elements are references-to-hash, each describing an -overdue item. The keys are selected fields from the issues, biblio, -biblioitems, and items tables of the Koha database. +See patronflags for more details. -C<$flags-E{ODUES}{itemlist}> is a string giving a text listing of -the overdue items, one per line. - -=back - -=head3 WAITING - -=over 4 - -=item Set if any items that the patron has reserved are available. - -C<$flags-E{WAITING}{itemlist}> is a reference-to-array listing the -available items. Each element is a reference-to-hash whose keys are -fields from the reserves table of the Koha database. - -=back +C<$borrower-E{authflags}> is a hash giving more detailed information +about the top-level permissions flags set for the borrower. For example, +if a user has the "editcatalogue" permission, +C<$borrower-E{authflags}-E{editcatalogue}> will exist and have +the value "1". =cut @@ -308,11 +288,11 @@ sub GetMemberDetails { my $query; my $sth; if ($borrowernumber) { - $sth = $dbh->prepare("select * from borrowers where borrowernumber=?"); + $sth = $dbh->prepare("select borrowers.*,category_type,categories.description from borrowers left join categories on borrowers.categorycode=categories.categorycode where borrowernumber=?"); $sth->execute($borrowernumber); } elsif ($cardnumber) { - $sth = $dbh->prepare("select * from borrowers where cardnumber=?"); + $sth = $dbh->prepare("select borrowers.*,category_type,categories.description from borrowers left join categories on borrowers.categorycode=categories.categorycode where cardnumber=?"); $sth->execute($cardnumber); } else { @@ -321,6 +301,7 @@ sub GetMemberDetails { my $borrower = $sth->fetchrow_hashref; my ($amount) = GetMemberAccountRecords( $borrowernumber); $borrower->{'amountoutstanding'} = $amount; + # FIXME - patronflags calls GetMemberAccountRecords... just have patronflags return $amount my $flags = patronflags( $borrower); my $accessflagshash; @@ -347,38 +328,67 @@ sub GetMemberDetails { =head2 patronflags - Not exported + $flags = &patronflags($patron); - NOTE!: If you change this function, be sure to update the POD for - &GetMemberDetails. + This function is not exported. - $flags = &patronflags($patron); + The following will be set where applicable: + $flags->{CHARGES}->{amount} Amount of debt + $flags->{CHARGES}->{noissues} Set if debt amount >$5.00 (or syspref noissuescharge) + $flags->{CHARGES}->{message} Message -- deprecated + + $flags->{CREDITS}->{amount} Amount of credit + $flags->{CREDITS}->{message} Message -- deprecated + + $flags->{ GNA } Patron has no valid address + $flags->{ GNA }->{noissues} Set for each GNA + $flags->{ GNA }->{message} "Borrower has no valid address" -- deprecated + + $flags->{ LOST } Patron's card reported lost + $flags->{ LOST }->{noissues} Set for each LOST + $flags->{ LOST }->{message} Message -- deprecated + + $flags->{DBARRED} Set if patron debarred, no access + $flags->{DBARRED}->{noissues} Set for each DBARRED + $flags->{DBARRED}->{message} Message -- deprecated + + $flags->{ NOTES } + $flags->{ NOTES }->{message} The note itself. NOT deprecated + + $flags->{ ODUES } Set if patron has overdue books. + $flags->{ ODUES }->{message} "Yes" -- deprecated + $flags->{ ODUES }->{itemlist} ref-to-array: list of overdue books + $flags->{ ODUES }->{itemlisttext} Text list of overdue items -- deprecated + + $flags->{WAITING} Set if any of patron's reserves are available + $flags->{WAITING}->{message} Message -- deprecated + $flags->{WAITING}->{itemlist} ref-to-array: list of available items + +=over 4 - $flags->{CHARGES} - {message} Message showing patron's credit or debt - {noissues} Set if patron owes >$5.00 - {GNA} Set if patron gone w/o address - {message} "Borrower has no valid address" - {noissues} Set. - {LOST} Set if patron's card reported lost - {message} Message to this effect - {noissues} Set. - {DBARRED} Set is patron is debarred - {message} Message to this effect - {noissues} Set. - {NOTES} Set if patron has notes - {message} Notes about patron - {ODUES} Set if patron has overdue books - {message} "Yes" - {itemlist} ref-to-array: list of overdue books - {itemlisttext} Text list of overdue items - {WAITING} Set if there are items available that the - patron reserved - {message} Message to this effect - {itemlist} ref-to-array: list of available items +C<$flags-E{ODUES}-E{itemlist}> is a reference-to-array listing the +overdue items. Its elements are references-to-hash, each describing an +overdue item. The keys are selected fields from the issues, biblio, +biblioitems, and items tables of the Koha database. + +C<$flags-E{ODUES}-E{itemlisttext}> is a string giving a text listing of +the overdue items, one per line. Deprecated. + +C<$flags-E{WAITING}-E{itemlist}> is a reference-to-array listing the +available items. Each element is a reference-to-hash whose keys are +fields from the reserves table of the Koha database. + +=back + +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. =cut +# TODO: use {anonymous => hashes} instead of a dozen %flaginfo +# FIXME rename this function. sub patronflags { my %flags; my ( $patroninformation) = @_; @@ -386,8 +396,9 @@ sub patronflags { my ($amount) = GetMemberAccountRecords( $patroninformation->{'borrowernumber'}); if ( $amount > 0 ) { my %flaginfo; - my $noissuescharge = C4::Context->preference("noissuescharge"); + my $noissuescharge = C4::Context->preference("noissuescharge") || 5; $flaginfo{'message'} = sprintf "Patron owes \$%.02f", $amount; + $flaginfo{'amount'} = sprintf "%.02f", $amount; if ( $amount > $noissuescharge ) { $flaginfo{'noissues'} = 1; } @@ -396,7 +407,8 @@ sub patronflags { elsif ( $amount < 0 ) { my %flaginfo; $flaginfo{'message'} = sprintf "Patron has credit of \$%.02f", -$amount; - $flags{'CHARGES'} = \%flaginfo; + $flaginfo{'amount'} = sprintf "%.02f", $amount; + $flags{'CREDITS'} = \%flaginfo; } if ( $patroninformation->{'gonenoaddress'} && $patroninformation->{'gonenoaddress'} == 1 ) @@ -424,11 +436,10 @@ sub patronflags { && $patroninformation->{'borrowernotes'} ) { my %flaginfo; - $flaginfo{'message'} = "$patroninformation->{'borrowernotes'}"; + $flaginfo{'message'} = $patroninformation->{'borrowernotes'}; $flags{'NOTES'} = \%flaginfo; } - my ( $odues, $itemsoverdue ) = - checkoverdues( $patroninformation->{'borrowernumber'}, $dbh ); + my ( $odues, $itemsoverdue ) = checkoverdues($patroninformation->{'borrowernumber'}); if ( $odues > 0 ) { my %flaginfo; $flaginfo{'message'} = "Yes"; @@ -437,11 +448,11 @@ sub patronflags { @$itemsoverdue ) { $flaginfo{'itemlisttext'} .= - "$_->{'date_due'} $_->{'barcode'} $_->{'title'} \n"; + "$_->{'date_due'} $_->{'barcode'} $_->{'title'} \n"; # newline is display layer } $flags{'ODUES'} = \%flaginfo; } - my @itemswaiting = GetReservesFromBorrowernumber( $patroninformation->{'borrowernumber'},'W' ); + my @itemswaiting = C4::Reserves::GetReservesFromBorrowernumber( $patroninformation->{'borrowernumber'},'W' ); my $nowaiting = scalar @itemswaiting; if ( $nowaiting > 0 ) { my %flaginfo; @@ -453,7 +464,7 @@ sub patronflags { } -=item GetMember +=head2 GetMember $borrower = &GetMember($information, $type); @@ -473,52 +484,40 @@ sub GetMember { my ( $information, $type ) = @_; my $dbh = C4::Context->dbh; my $sth; - if ($type eq 'cardnumber' || $type eq 'firstname'|| $type eq 'userid'|| $type eq 'borrowernumber'){ - $information = uc $information; - $sth = - $dbh->prepare( -"Select borrowers.*,categories.category_type,categories.description from borrowers left join categories on borrowers.categorycode=categories.categorycode where $type=?" - ); - $sth->execute($information); - } - else { - $sth = - $dbh->prepare( -"Select borrowers.*,categories.category_type, categories.description from borrowers left join categories on borrowers.categorycode=categories.categorycode where borrowernumber=?" - ); - $sth->execute($information); + my $select = " +SELECT borrowers.*, categories.category_type, categories.description +FROM borrowers +LEFT JOIN categories on borrowers.categorycode=categories.categorycode +"; + if (defined($type) and ( $type eq 'cardnumber' || $type eq 'firstname'|| $type eq 'userid'|| $type eq 'borrowernumber' ) ){ + $information = uc $information; + $sth = $dbh->prepare("$select WHERE $type=?"); + } else { + $sth = $dbh->prepare("$select WHERE borrowernumber=?"); } + $sth->execute($information); my $data = $sth->fetchrow_hashref; + ($data) and return ($data); - $sth->finish; - if ($data) { - return ($data); - } - elsif ($type eq 'cardnumber' ||$type eq 'firstname') { # try with firstname - my $sth = - $dbh->prepare( -"Select borrowers.*,categories.category_type,categories.description from borrowers left join categories on borrowers.categorycode=categories.categorycode where firstname like ?" - ); - $sth->execute($information); - my $data = $sth->fetchrow_hashref; - $sth->finish; - return ($data); - } - else { - return undef; + if (defined($type) and ($type eq 'cardnumber' || $type eq 'firstname')) { # otherwise, try with firstname + $sth = $dbh->prepare("$select WHERE firstname like ?"); + $sth->execute($information); + $data = $sth->fetchrow_hashref; + ($data) and return ($data); } + return undef; } -=item GetMemberIssuesAndFines +=head2 GetMemberIssuesAndFines - ($borrowed, $due, $fine) = &GetMemberIssuesAndFines($borrowernumber); + ($overdue_count, $issue_count, $total_fines) = &GetMemberIssuesAndFines($borrowernumber); Returns aggregate data about items borrowed by the patron with the given borrowernumber. -C<&GetMemberIssuesAndFines> returns a three-element array. C<$borrowed> is the -number of books the patron currently has borrowed. C<$due> is the -number of overdue items the patron currently has borrowed. C<$fine> is +C<&GetMemberIssuesAndFines> returns a three-element array. C<$overdue_count> is the +number of overdue items the patron currently has borrowed. C<$issue_count> is the +number of books the patron currently has borrowed. C<$total_fines> is the total fine currently due by the borrower. =cut @@ -527,105 +526,123 @@ the total fine currently due by the borrower. sub GetMemberIssuesAndFines { my ( $borrowernumber ) = @_; my $dbh = C4::Context->dbh; - my $query = - "Select count(*) from issues where borrowernumber='$borrowernumber' and - returndate is NULL"; + my $query = "SELECT COUNT(*) FROM issues WHERE borrowernumber = ?"; - # print $query; + $debug and warn $query."\n"; my $sth = $dbh->prepare($query); - $sth->execute; - my $data = $sth->fetchrow_hashref; + $sth->execute($borrowernumber); + my $issue_count = $sth->fetchrow_arrayref->[0]; $sth->finish; + $sth = $dbh->prepare( - "Select count(*) from issues where - borrowernumber='$borrowernumber' and date_due < now() and returndate is NULL" + "SELECT COUNT(*) FROM issues + WHERE borrowernumber = ? + AND date_due < now()" ); - $sth->execute; - my $data2 = $sth->fetchrow_hashref; + $sth->execute($borrowernumber); + my $overdue_count = $sth->fetchrow_arrayref->[0]; $sth->finish; - $sth = $dbh->prepare( - "Select sum(amountoutstanding) from accountlines where - borrowernumber='$borrowernumber'" - ); - $sth->execute; - my $data3 = $sth->fetchrow_hashref; + + $sth = $dbh->prepare("SELECT SUM(amountoutstanding) FROM accountlines WHERE borrowernumber = ?"); + $sth->execute($borrowernumber); + my $total_fines = $sth->fetchrow_arrayref->[0]; $sth->finish; - return ( $data2->{'count(*)'}, $data->{'count(*)'}, - $data3->{'sum(amountoutstanding)'} ); + return ($overdue_count, $issue_count, $total_fines); +} + +sub columns(;$) { + return @{C4::Context->dbh->selectcol_arrayref("SHOW columns from borrowers")}; } =head2 -=item ModMember +=head2 ModMember + +=over 4 + +my $success = ModMember(borrowernumber => $borrowernumber, [ field => value ]... ); - &ModMember($borrowernumber); +Modify borrower's data. All date fields should ALREADY be in ISO format. -Modify borrower's data +return : +true on success, or false on failure + +=back =cut -#' sub ModMember { my (%data) = @_; my $dbh = C4::Context->dbh; - $data{'dateofbirth'} = format_date_in_iso( $data{'dateofbirth'} ) if ($data{'dateofbirth'} ); - $data{'dateexpiry'} = format_date_in_iso( $data{'dateexpiry'} ) if ($data{'dateexpiry'} ); - $data{'dateenrolled'} = format_date_in_iso( $data{'dateenrolled'} ) if ($data{'dateenrolled'} ); -# warn Data::Dumper::Dumper(%data); - # warn "num user".$data{'borrowernumber'}; - my $qborrower=$dbh->prepare("SHOW columns from borrowers"); - $qborrower->execute; - my %hashborrowerfields; - while (my ($field)=$qborrower->fetchrow){ - $hashborrowerfields{$field}=1; - } - my $query; + my $iso_re = C4::Dates->new()->regexp('iso'); + foreach (qw(dateofbirth dateexpiry dateenrolled)) { + if (my $tempdate = $data{$_}) { # assignment, not comparison + ($tempdate =~ /$iso_re/) and next; # Congatulations, you sent a valid ISO date. + warn "ModMember given $_ not in ISO format ($tempdate)"; + my $tempdate2 = format_date_in_iso($tempdate); + if (!$tempdate2 or $tempdate2 eq '0000-00-00') { + warn "ModMember cannot convert '$tempdate' (from syspref to ISO)"; + next; + } + $data{$_} = $tempdate2; + } + } + if (!$data{'dateofbirth'}){ + delete $data{'dateofbirth'}; + } + my @columns = &columns; + my %hashborrowerfields = (map {$_=>1} @columns); + my $query = "UPDATE borrowers SET \n"; my $sth; - $data{'userid'} = '' if ( $data{'password'} eq '' ); my @parameters; - # test to know if u must update or not the borrower password - if ( $data{'password'} eq '****' ) { - delete $data{'password'}; - foreach (keys %data) - {push @parameters,"$_ = ".$dbh->quote($data{$_}) if ($_ ne "borrowernumber" and $hashborrowerfields{$_}) } ; - $query = "UPDATE borrowers SET ".join (",",@parameters) - ." WHERE borrowernumber=$data{'borrowernumber'}"; -# warn "$query"; - $sth = $dbh->prepare($query); - $sth->execute; + # 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 { + $data{password} = md5_base64($data{password}); + } } - else { - $data{'password'} = md5_base64( $data{'password'} ) if ( $data{'password'} ne '' ); - delete $data{'password'} if ($data{password} eq ""); - foreach (keys %data) - {push @parameters,"$_ = ".$dbh->quote($data{$_}) if ($_ ne "borrowernumber" and $hashborrowerfields{$_})} ; - - $query = "UPDATE borrowers SET ".join (",",@parameters)." WHERE borrowernumber=$data{'borrowernumber'}"; -# warn "$query"; - $sth = $dbh->prepare($query); - $sth->execute; + my @badkeys; + foreach (keys %data) { + next if ($_ eq 'borrowernumber' or $_ eq 'flags'); + if ($hashborrowerfields{$_}){ + $query .= " $_=?, "; + push @parameters,$data{$_}; + } else { + push @badkeys, $_; + delete $data{$_}; + } } + (@badkeys) and warn scalar(@badkeys) . " Illegal key(s) passed to ModMember: " . join(',',@badkeys); + $query =~ s/, $//; + $query .= " WHERE borrowernumber=?"; + push @parameters, $data{'borrowernumber'}; + $debug and print STDERR "$query (executed w/ arg: $data{'borrowernumber'})"; + $sth = $dbh->prepare($query); + my $execute_success = $sth->execute(@parameters); $sth->finish; # ok if its an adult (type) it may have borrowers that depend on it as a guarantor # so when we update information for an adult we should check for guarantees and update the relevant part # of their records, ie addresses and phone numbers my $borrowercategory= GetBorrowercategory( $data{'category_type'} ); - if ( $borrowercategory->{'category_type'} eq 'A' ) { + if ( exists $borrowercategory->{'category_type'} && $borrowercategory->{'category_type'} eq ('A' || 'S') ) { # is adult check guarantees; UpdateGuarantees(%data); - } - &logaction(C4::Context->userenv->{'number'},"MEMBERS","MODIFY",$data{'borrowernumber'},"") + logaction("MEMBERS", "MODIFY", $data{'borrowernumber'}, "$query (executed w/ arg: $data{'borrowernumber'})") if C4::Context->preference("BorrowersLog"); + + return $execute_success; } =head2 -=item AddMember +=head2 AddMember $borrowernumber = &AddMember(%borrower); @@ -638,130 +655,142 @@ Returns the borrowernumber sub AddMember { my (%data) = @_; my $dbh = C4::Context->dbh; - $data{'userid'} = '' unless $data{'password'}; + $data{'password'} = md5_base64( $data{'password'} ) if $data{'password'}; - $data{'dateofbirth'} = format_date_in_iso( $data{'dateofbirth'} ); - $data{'dateenrolled'} = format_date_in_iso( $data{'dateenrolled'} ); - $data{'dateexpiry'} = format_date_in_iso( $data{'dateexpiry'} ); + $data{'password'} = '!' if (not $data{'password'} and $data{'userid'}); + + # WE SHOULD NEVER PASS THIS SUBROUTINE ANYTHING OTHER THAN ISO DATES + # IF YOU UNCOMMENT THESE LINES YOU BETTER HAVE A DARN COMPELLING REASON +# $data{'dateofbirth'} = format_date_in_iso( $data{'dateofbirth'} ); +# $data{'dateenrolled'} = format_date_in_iso( $data{'dateenrolled'}); +# $data{'dateexpiry'} = format_date_in_iso( $data{'dateexpiry'} ); + # This query should be rewritten to use "?" at execute. + if (!$data{'dateofbirth'}){ + undef ($data{'dateofbirth'}); + } my $query = - "insert into borrowers set cardnumber=" - . $dbh->quote( $data{'cardnumber'} ) - . ",surname=" - . $dbh->quote( $data{'surname'} ) - . ",firstname=" - . $dbh->quote( $data{'firstname'} ) - . ",title=" - . $dbh->quote( $data{'title'} ) - . ",othernames=" - . $dbh->quote( $data{'othernames'} ) - . ",initials=" - . $dbh->quote( $data{'initials'} ) - . ",streetnumber=" - . $dbh->quote( $data{'streetnumber'} ) - . ",streettype=" - . $dbh->quote( $data{'streettype'} ) - . ",address=" - . $dbh->quote( $data{'address'} ) - . ",address2=" - . $dbh->quote( $data{'address2'} ) - . ",zipcode=" - . $dbh->quote( $data{'zipcode'} ) - . ",city=" - . $dbh->quote( $data{'city'} ) - . ",phone=" - . $dbh->quote( $data{'phone'} ) - . ",email=" - . $dbh->quote( $data{'email'} ) - . ",mobile=" - . $dbh->quote( $data{'mobile'} ) - . ",phonepro=" - . $dbh->quote( $data{'phonepro'} ) - . ",opacnote=" - . $dbh->quote( $data{'opacnote'} ) - . ",guarantorid=" - . $dbh->quote( $data{'guarantorid'} ) - . ",dateofbirth=" - . $dbh->quote( $data{'dateofbirth'} ) - . ",branchcode=" - . $dbh->quote( $data{'branchcode'} ) - . ",categorycode=" - . $dbh->quote( $data{'categorycode'} ) - . ",dateenrolled=" - . $dbh->quote( $data{'dateenrolled'} ) - . ",contactname=" - . $dbh->quote( $data{'contactname'} ) - . ",borrowernotes=" - . $dbh->quote( $data{'borrowernotes'} ) - . ",dateexpiry=" - . $dbh->quote( $data{'dateexpiry'} ) - . ",contactnote=" - . $dbh->quote( $data{'contactnote'} ) - . ",B_address=" - . $dbh->quote( $data{'B_address'} ) - . ",B_zipcode=" - . $dbh->quote( $data{'B_zipcode'} ) - . ",B_city=" - . $dbh->quote( $data{'B_city'} ) - . ",B_phone=" - . $dbh->quote( $data{'B_phone'} ) - . ",B_email=" - . $dbh->quote( $data{'B_email'}, ) - . ",password=" - . $dbh->quote( $data{'password'} ) - . ",userid=" - . $dbh->quote( $data{'userid'} ) - . ",sort1=" - . $dbh->quote( $data{'sort1'} ) - . ",sort2=" - . $dbh->quote( $data{'sort2'} ) - . ",contacttitle=" - . $dbh->quote( $data{'contacttitle'} ) - . ",emailpro=" - . $dbh->quote( $data{'emailpro'} ) - . ",contactfirstname=" - . $dbh->quote( $data{'contactfirstname'} ) . ",sex=" - . $dbh->quote( $data{'sex'} ) . ",fax=" - . $dbh->quote( $data{'fax'} ) - . ",relationship=" - . $dbh->quote( $data{'relationship'} ) - . ",B_streetnumber=" - . $dbh->quote( $data{'B_streetnumber'} ) - . ",B_streettype=" - . $dbh->quote( $data{'B_streettype'} ) - . ",gonenoaddress=" - . $dbh->quote( $data{'gonenoaddress'} ) - . ",lost=" - . $dbh->quote( $data{'lost'} ) - . ",debarred=" - . $dbh->quote( $data{'debarred'} ) - . ",ethnicity=" - . $dbh->quote( $data{'ethnicity'} ) - . ",ethnotes=" - . $dbh->quote( $data{'ethnotes'} ); - + "insert into borrowers set cardnumber=" . $dbh->quote( $data{'cardnumber'} ) + . ",surname=" . $dbh->quote( $data{'surname'} ) + . ",firstname=" . $dbh->quote( $data{'firstname'} ) + . ",title=" . $dbh->quote( $data{'title'} ) + . ",othernames=" . $dbh->quote( $data{'othernames'} ) + . ",initials=" . $dbh->quote( $data{'initials'} ) + . ",streetnumber=". $dbh->quote( $data{'streetnumber'} ) + . ",streettype=" . $dbh->quote( $data{'streettype'} ) + . ",address=" . $dbh->quote( $data{'address'} ) + . ",address2=" . $dbh->quote( $data{'address2'} ) + . ",zipcode=" . $dbh->quote( $data{'zipcode'} ) + . ",city=" . $dbh->quote( $data{'city'} ) + . ",phone=" . $dbh->quote( $data{'phone'} ) + . ",email=" . $dbh->quote( $data{'email'} ) + . ",mobile=" . $dbh->quote( $data{'mobile'} ) + . ",phonepro=" . $dbh->quote( $data{'phonepro'} ) + . ",opacnote=" . $dbh->quote( $data{'opacnote'} ) + . ",guarantorid=" . $dbh->quote( $data{'guarantorid'} ) + . ",dateofbirth=" . $dbh->quote( $data{'dateofbirth'} ) + . ",branchcode=" . $dbh->quote( $data{'branchcode'} ) + . ",categorycode=" . $dbh->quote( $data{'categorycode'} ) + . ",dateenrolled=" . $dbh->quote( $data{'dateenrolled'} ) + . ",contactname=" . $dbh->quote( $data{'contactname'} ) + . ",borrowernotes=" . $dbh->quote( $data{'borrowernotes'} ) + . ",dateexpiry=" . $dbh->quote( $data{'dateexpiry'} ) + . ",contactnote=" . $dbh->quote( $data{'contactnote'} ) + . ",B_address=" . $dbh->quote( $data{'B_address'} ) + . ",B_zipcode=" . $dbh->quote( $data{'B_zipcode'} ) + . ",B_city=" . $dbh->quote( $data{'B_city'} ) + . ",B_phone=" . $dbh->quote( $data{'B_phone'} ) + . ",B_email=" . $dbh->quote( $data{'B_email'} ) + . ",password=" . $dbh->quote( $data{'password'} ) + . ",userid=" . $dbh->quote( $data{'userid'} ) + . ",sort1=" . $dbh->quote( $data{'sort1'} ) + . ",sort2=" . $dbh->quote( $data{'sort2'} ) + . ",contacttitle=" . $dbh->quote( $data{'contacttitle'} ) + . ",emailpro=" . $dbh->quote( $data{'emailpro'} ) + . ",contactfirstname=" . $dbh->quote( $data{'contactfirstname'} ) + . ",sex=" . $dbh->quote( $data{'sex'} ) + . ",fax=" . $dbh->quote( $data{'fax'} ) + . ",relationship=" . $dbh->quote( $data{'relationship'} ) + . ",B_streetnumber=" . $dbh->quote( $data{'B_streetnumber'} ) + . ",B_streettype=" . $dbh->quote( $data{'B_streettype'} ) + . ",gonenoaddress=" . $dbh->quote( $data{'gonenoaddress'} ) + . ",lost=" . $dbh->quote( $data{'lost'} ) + . ",debarred=" . $dbh->quote( $data{'debarred'} ) + . ",ethnicity=" . $dbh->quote( $data{'ethnicity'} ) + . ",ethnotes=" . $dbh->quote( $data{'ethnotes'} ) + . ",altcontactsurname=" . $dbh->quote( $data{'altcontactsurname'} ) + . ",altcontactfirstname=" . $dbh->quote( $data{'altcontactfirstname'} ) + . ",altcontactaddress1=" . $dbh->quote( $data{'altcontactaddress1'} ) + . ",altcontactaddress2=" . $dbh->quote( $data{'altcontactaddress2'} ) + . ",altcontactaddress3=" . $dbh->quote( $data{'altcontactaddress3'} ) + . ",altcontactzipcode=" . $dbh->quote( $data{'altcontactzipcode'} ) + . ",altcontactphone=" . $dbh->quote( $data{'altcontactphone'} ) ; + $debug and print STDERR "AddMember SQL: ($query)\n"; my $sth = $dbh->prepare($query); - $sth->execute; + # print "Executing SQL: $query\n"; + $sth->execute(); $sth->finish; - $data{'borrowernumber'} = $dbh->{'mysql_insertid'}; + $data{'borrowernumber'} = $dbh->{'mysql_insertid'}; # unneeded w/ autoincrement ? + # mysql_insertid is probably bad. not necessarily accurate and mysql-specific at best. - &logaction(C4::Context->userenv->{'number'},"MEMBERS","CREATE",$data{'borrowernumber'},"") - if C4::Context->preference("BorrowersLog"); - + logaction("MEMBERS", "CREATE", $data{'borrowernumber'}, "") if C4::Context->preference("BorrowersLog"); + + # check for enrollment fee & add it if needed + $sth = $dbh->prepare("SELECT enrolmentfee FROM categories WHERE categorycode=?"); + $sth->execute($data{'categorycode'}); + my ($enrolmentfee) = $sth->fetchrow; + if ($enrolmentfee && $enrolmentfee > 0) { + # insert fee in patron debts + manualinvoice($data{'borrowernumber'}, '', '', 'A', $enrolmentfee); + } return $data{'borrowernumber'}; } +sub Check_Userid { + my ($uid,$member) = @_; + my $dbh = C4::Context->dbh; + # Make sure the userid chosen is unique and not theirs if non-empty. If it is not, + # Then we need to tell the user and have them create a new one. + my $sth = + $dbh->prepare( + "SELECT * FROM borrowers WHERE userid=? AND borrowernumber != ?"); + $sth->execute( $uid, $member ); + if ( ( $uid ne '' ) && ( my $row = $sth->fetchrow_hashref ) ) { + return 0; + } + else { + return 1; + } +} + +sub Generate_Userid { + my ($borrowernumber, $firstname, $surname) = @_; + my $newuid; + my $offset = 0; + do { + $firstname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g; + $surname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g; + $newuid = lc("$firstname.$surname"); + $newuid .= $offset unless $offset == 0; + $offset++; + + } while (!Check_Userid($newuid,$borrowernumber)); + + return $newuid; +} + sub changepassword { my ( $uid, $member, $digest ) = @_; my $dbh = C4::Context->dbh; #Make sure the userid chosen is unique and not theirs if non-empty. If it is not, #Then we need to tell the user and have them create a new one. + my $resultcode; my $sth = $dbh->prepare( - "select * from borrowers where userid=? and borrowernumber != ?"); + "SELECT * FROM borrowers WHERE userid=? AND borrowernumber != ?"); $sth->execute( $uid, $member ); - if ( ( $uid ne '' ) && ( $sth->fetchrow ) ) { - return 0; + if ( ( $uid ne '' ) && ( my $row = $sth->fetchrow_hashref ) ) { + $resultcode=0; } else { #Everything is good so we can update the information. @@ -769,16 +798,16 @@ sub changepassword { $dbh->prepare( "update borrowers set userid=?, password=? where borrowernumber=?"); $sth->execute( $uid, $digest, $member ); - return 1; + $resultcode=1; } - &logaction(C4::Context->userenv->{'number'},"MEMBERS","CHANGE PASS",$member,"") - if C4::Context->preference("BorrowersLog"); + logaction("MEMBERS", "CHANGE PASS", $member, "") if C4::Context->preference("BorrowersLog"); + return $resultcode; } -=item fixup_cardnumber +=head2 fixup_cardnumber Warning: The caller is responsible for locking the members table in write mode, to avoid database corruption. @@ -790,76 +819,65 @@ my @weightings = ( 8, 4, 6, 3, 5, 2, 1 ); sub fixup_cardnumber ($) { my ($cardnumber) = @_; - my $autonumber_members = C4::Context->boolean_preference('autoMemberNum'); - $autonumber_members = 0 unless defined $autonumber_members; + 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) { - if ($autonumber_members) { - my $dbh = C4::Context->dbh; - if ( C4::Context->preference('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)) from borrowers" - ); - $sth->execute; - - my $data = $sth->fetchrow_hashref; - $cardnumber = $data->{'max(substring(borrowers.cardnumber,2,7))'}; - $sth->finish; - 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 ) { + ($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; + } - # read weightings, left to right, 1 char at a time - my $temp1 = $weightings[$i]; + 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 ); + # 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; - } + # mult each char 1-7 by its corresponding weighting + $sum += $temp1 * $temp2; + } - my $rem = ( $sum % 11 ); - $rem = 'X' if $rem == 10; + my $rem = ( $sum % 11 ); + $rem = 'X' if $rem == 10; - $cardnumber = "V$cardnumber$rem"; - } - else { + return "V$cardnumber$rem"; + } else { # MODIFIED BY JF: mysql4.1 allows casting as an integer, which is probably # better. I'll leave the original in in case it needs to be changed for you - my $sth = - $dbh->prepare( - "select max(cast(cardnumber as signed)) from borrowers"); - - #my $sth=$dbh->prepare("select max(borrowers.cardnumber) from borrowers"); - - $sth->execute; - - my ($result) = $sth->fetchrow; - $sth->finish; - $cardnumber = $result + 1; - } + # my $sth=$dbh->prepare("select max(borrowers.cardnumber) from borrowers"); + my $sth = $dbh->prepare( + "select max(cast(cardnumber as signed)) from borrowers" + ); + $sth->execute; + my ($result) = $sth->fetchrow; + return $result + 1; } - return $cardnumber; + return $cardnumber; # just here as a fallback/reminder } =head2 GetGuarantees @@ -899,7 +917,7 @@ sub GetGuarantees { &UpdateGuarantees($parent_borrno); -C<&UpdateGuarantees> borrower data for an adulte and updates all the guarantees +C<&UpdateGuarantees> borrower data for an adult and updates all the guarantees with the modified information =cut @@ -916,10 +934,10 @@ sub UpdateGuarantees { # the array, which is probably better done as a foreach loop. # my $guaquery = qq|UPDATE borrowers - SET address='$data{'address'}',fax='$data{'fax'}', - B_city='$data{'B_city'}',mobile='$data{'mobile'}',city='$data{'city'}',phone='$data{'phone'}' - WHERE borrowernumber='$guarantees->[$i]->{'borrowernumber'}' - |; + SET address='$data{'address'}',fax='$data{'fax'}', + B_city='$data{'B_city'}',mobile='$data{'mobile'}',city='$data{'city'}',phone='$data{'phone'}' + WHERE borrowernumber='$guarantees->[$i]->{'borrowernumber'}' + |; my $sth3 = $dbh->prepare($guaquery); $sth3->execute; $sth3->finish; @@ -927,45 +945,60 @@ sub UpdateGuarantees { } =head2 GetPendingIssues - ($count, $issues) = &GetPendingIssues($borrowernumber); + my $issues = &GetPendingIssues($borrowernumber); Looks up what the patron with the given borrowernumber has borrowed. -C<&GetPendingIssues> returns a two-element array. C<$issues> is a -reference-to-array, where each element is a reference-to-hash; the -keys are the fields from the C, C, and C tables -in the Koha database. C<$count> is the number of elements in -C<$issues>. +C<&GetPendingIssues> returns a +reference-to-array where each element is a reference-to-hash; the +keys are the fields from the C, C, and C tables. +The keys include C fields except marc and marcxml. =cut #' sub GetPendingIssues { my ($borrowernumber) = @_; - my $dbh = C4::Context->dbh; - - my $sth = $dbh->prepare( - "SELECT * FROM issues - LEFT JOIN items ON issues.itemnumber=items.itemnumber - LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber - LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber + # must avoid biblioitems.* to prevent large marc and marcxml fields from killing performance + # FIXME: namespace collision: each table has "timestamp" fields. Which one is "timestamp" ? + # FIXME: circ/ciculation.pl tries to sort by timestamp! + # FIXME: C4::Print::printslip tries to sort by timestamp! + # FIXME: namespace collision: other collisions possible. + # FIXME: most of this data isn't really being used by callers. + my $sth = C4::Context->dbh->prepare( + "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, + issues.timestamp AS timestamp, + issues.renewals AS renewals, + 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 WHERE - borrowernumber=? - AND returndate IS NULL + borrowernumber=? ORDER BY issues.issuedate" ); $sth->execute($borrowernumber); my $data = $sth->fetchall_arrayref({}); - my $today = POSIX::strftime("%Y%m%d", localtime); - foreach( @$data ) { - my $datedue = $_->{'date_due'}; - $datedue =~ s/-//g; - if ( $datedue < $today ) { - $_->{'overdue'} = 1; - } + my $today = C4::Dates->new->output('iso'); + foreach (@$data) { + $_->{date_due} or next; + ($_->{date_due} lt $today) and $_->{overdue} = 1; } - $sth->finish; - return ( scalar(@$data), $data ); + return $data; } =head2 GetAllIssues @@ -997,18 +1030,27 @@ sub GetAllIssues { my $dbh = C4::Context->dbh; my $count = 0; my $query = -"Select *,items.timestamp AS itemstimestamp from issues,biblio,items,biblioitems - where borrowernumber=? and - items.biblioitemnumber=biblioitems.biblioitemnumber and - items.itemnumber=issues.itemnumber and - items.biblionumber=biblio.biblionumber order by $order"; + "SELECT *,issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp + 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=? + UNION ALL + SELECT *,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 + WHERE borrowernumber=? + order by $order"; if ( $limit != 0 ) { $query .= " limit $limit"; } #print $query; my $sth = $dbh->prepare($query); - $sth->execute($borrowernumber); + $sth->execute($borrowernumber, $borrowernumber); my @result; my $i = 0; while ( my $data = $sth->fetchrow_hashref ) { @@ -1021,11 +1063,15 @@ sub GetAllIssues { # large chunk of older issues data put into table oldissues # to speed up db calls for issuing items if ( C4::Context->preference("ReadingHistory") ) { - my $query2 = "SELECT * FROM oldissues,biblio,items,biblioitems + # FIXME oldissues (not to be confused with old_issues) is + # apparently specific to HLT. Not sure if the ReadingHistory + # syspref is still required, as old_issues by design + # is no longer checked with each loan. + my $query2 = "SELECT * FROM oldissues + LEFT JOIN items ON items.itemnumber=oldissues.itemnumber + LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber + LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber WHERE borrowernumber=? - AND items.biblioitemnumber=biblioitems.biblioitemnumber - AND items.itemnumber=oldissues.itemnumber - AND items.biblionumber=biblio.biblionumber ORDER BY $order"; if ( $limit != 0 ) { $limit = $limit - $count; @@ -1068,25 +1114,27 @@ sub GetMemberAccountRecords { my @acctlines; my $numlines = 0; my $strsth = qq( -SELECT * -FROM accountlines -WHERE borrowernumber=?); + SELECT * + FROM accountlines + WHERE borrowernumber=?); my @bind = ($borrowernumber); if ($date && $date ne ''){ - $strsth.=" -AND date < ? "; - push(@bind,$date); + $strsth.=" AND date < ? "; + push(@bind,$date); } - $strsth.=" -ORDER BY date desc,timestamp DESC"; + $strsth.=" ORDER BY date desc,timestamp DESC"; my $sth= $dbh->prepare( $strsth ); $sth->execute( @bind ); my $total = 0; while ( my $data = $sth->fetchrow_hashref ) { + my $biblio = GetBiblioFromItemNumber($data->{itemnumber}) if $data->{itemnumber}; + $data->{biblionumber} = $biblio->{biblionumber}; + $data->{title} = $biblio->{title}; $acctlines[$numlines] = $data; $numlines++; - $total += $data->{'amountoutstanding'}; + $total += int(1000 * $data->{'amountoutstanding'}); # convert float to integer to avoid round-off errors } + $total /= 1000; $sth->finish; return ( $total, \@acctlines,$numlines); } @@ -1112,91 +1160,86 @@ sub GetBorNotifyAcctRecord { my $dbh = C4::Context->dbh; my @acctlines; my $numlines = 0; - my $query = qq| SELECT * - FROM accountlines - WHERE borrowernumber=? - AND notify_id=? - AND (accounttype='FU' OR accounttype='N' OR accounttype='M'OR accounttype='A'OR accounttype='F'OR accounttype='L' OR accounttype='IP' OR accounttype='CH' OR accounttype='RE' OR accounttype='RL') - AND amountoutstanding != '0' - ORDER BY notify_id,accounttype - |; - my $sth = $dbh->prepare($query); + my $sth = $dbh->prepare( + "SELECT * + FROM accountlines + WHERE borrowernumber=? + AND notify_id=? + AND amountoutstanding != '0' + ORDER BY notify_id,accounttype + "); +# AND (accounttype='FU' OR accounttype='N' OR accounttype='M'OR accounttype='A'OR accounttype='F'OR accounttype='L' OR accounttype='IP' OR accounttype='CH' OR accounttype='RE' OR accounttype='RL') $sth->execute( $borrowernumber, $notifyid ); my $total = 0; while ( my $data = $sth->fetchrow_hashref ) { $acctlines[$numlines] = $data; $numlines++; - $total += $data->{'amountoutstanding'}; + $total += int(100 * $data->{'amountoutstanding'}); } + $total /= 100; $sth->finish; return ( $total, \@acctlines, $numlines ); } =head2 checkuniquemember (OUEST-PROVENCE) - $result = &checkuniquemember($collectivity,$surname,$categorycode,$firstname,$dateofbirth); + ($result,$categorycode) = &checkuniquemember($collectivity,$surname,$firstname,$dateofbirth); Checks that a member exists or not in the database. -C<&result> is 1 (=exist) or 0 (=does not exist) +C<&result> is nonzero (=exist) or 0 (=does not exist) +C<&categorycode> is from categorycode table C<&collectivity> is 1 (= we add a collectivity) or 0 (= we add a physical member) C<&surname> is the surname -C<&categorycode> is from categorycode table C<&firstname> is the firstname (only if collectivity=0) -C<&dateofbirth> is the date of birth (only if collectivity=0) +C<&dateofbirth> is the date of birth in ISO format (only if collectivity=0) =cut +# FIXME: This function is not legitimate. Multiple patrons might have the same first/last name and birthdate. +# This is especially true since first name is not even a required field. + sub checkuniquemember { my ( $collectivity, $surname, $firstname, $dateofbirth ) = @_; my $dbh = C4::Context->dbh; - my $request; - if ($collectivity) { - -# $request="select count(*) from borrowers where surname=? and categorycode=?"; - $request = - "select borrowernumber,categorycode from borrowers where surname=? "; - } - else { - -# $request="select count(*) from borrowers where surname=? and categorycode=? and firstname=? and dateofbirth=?"; - $request = -"select borrowernumber,categorycode from borrowers where surname=? and firstname=? and dateofbirth=?"; - } + my $request = ($collectivity) ? + "SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? " : + ($dateofbirth) ? + "SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? and firstname=? and dateofbirth=?" : + "SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? and firstname=?"; my $sth = $dbh->prepare($request); if ($collectivity) { $sth->execute( uc($surname) ); - } - else { + } elsif($dateofbirth){ $sth->execute( uc($surname), ucfirst($firstname), $dateofbirth ); + }else{ + $sth->execute( uc($surname), ucfirst($firstname)); } my @data = $sth->fetchrow; - if ( $data[0] ) { - $sth->finish; - return $data[0], $data[1]; + $sth->finish; + ( $data[0] ) and return $data[0], $data[1]; + return 0; +} - # +sub checkcardnumber { + my ($cardnumber,$borrowernumber) = @_; + my $dbh = C4::Context->dbh; + my $query = "SELECT * FROM borrowers WHERE cardnumber=?"; + $query .= " AND borrowernumber <> ?" if ($borrowernumber); + my $sth = $dbh->prepare($query); + if ($borrowernumber) { + $sth->execute($cardnumber,$borrowernumber); + } else { + $sth->execute($cardnumber); + } + if (my $data= $sth->fetchrow_hashref()){ + return 1; } else { - $sth->finish; return 0; } -} - -sub checkcardnumber { - my ($cardnumber) = @_; - my $dbh = C4::Context->dbh; - my $query = "SELECT * FROM borrowers WHERE cardnumber=?"; - my $sth = $dbh->prepare($query); - $sth->execute($cardnumber); - if (my $data= $sth->fetchrow_hashref()){ - return 1; - } - else { - return 0; - } - $sth->finish(); + $sth->finish(); } @@ -1238,21 +1281,24 @@ sub getidcity { =head2 GetExpiryDate $expirydate = GetExpiryDate($categorycode, $dateenrolled); -process expiry date given a date and a categorycode + +Calculate expiry date given a categorycode and starting date. Date argument must be in ISO format. +Return date is also in ISO format. =cut + sub GetExpiryDate { my ( $categorycode, $dateenrolled ) = @_; - my $dbh = C4::Context->dbh; - my $sth = - $dbh->prepare( - "select enrolmentperiod from categories where categorycode=?"); - $sth->execute($categorycode); - my ($enrolmentperiod) = $sth->fetchrow; - $enrolmentperiod = 12 unless ($enrolmentperiod); - my @date=split /-/,format_date_in_iso($dateenrolled); - @date=Add_Delta_YM($date[0],$date[1],$date[2],0,$enrolmentperiod); - return sprintf("%04d-%02d-%02d",$date[0],$date[1],$date[2]); + my $enrolmentperiod = 12; # reasonable default + if ($categorycode) { + my $dbh = C4::Context->dbh; + my $sth = $dbh->prepare("select enrolmentperiod from categories where categorycode=?"); + $sth->execute($categorycode); + $enrolmentperiod = $sth->fetchrow; + } + # die "GetExpiryDate: for enrollmentperiod $enrolmentperiod (category '$categorycode') starting $dateenrolled.\n"; + my @date = split /-/,$dateenrolled; + return sprintf("%04d-%02d-%02d", Add_Delta_YM(@date,0,$enrolmentperiod)); } =head2 checkuserpassword (OUEST-PROVENCE) @@ -1291,13 +1337,14 @@ to category descriptions. #' sub GetborCatFromCatType { my ( $category_type, $action ) = @_; + # FIXME - This API seems both limited and dangerous. my $dbh = C4::Context->dbh; - my $request = qq| SELECT categorycode,description - FROM categories - $action - ORDER BY categorycode|; + my $request = qq| SELECT categorycode,description + FROM categories + $action + ORDER BY categorycode|; my $sth = $dbh->prepare($request); - if ($action) { + if ($action) { $sth->execute($category_type); } else { @@ -1321,21 +1368,49 @@ sub GetborCatFromCatType { Given the borrower's category code, the function returns the corresponding data hashref for a comprehensive information display. + + $arrayref_hashref = &GetBorrowercategory; +If no category code provided, the function returns all the categories. =cut sub GetBorrowercategory { my ($catcode) = @_; + my $dbh = C4::Context->dbh; + if ($catcode){ + my $sth = + $dbh->prepare( + "SELECT description,dateofbirthrequired,upperagelimit,category_type + FROM categories + WHERE categorycode = ?" + ); + $sth->execute($catcode); + my $data = + $sth->fetchrow_hashref; + $sth->finish(); + return $data; + } + return; +} # sub getborrowercategory + +=head2 GetBorrowercategoryList + + $arrayref_hashref = &GetBorrowercategoryList; +If no category code provided, the function returns all the categories. + +=cut + +sub GetBorrowercategoryList { my $dbh = C4::Context->dbh; my $sth = - $dbh->prepare( -"SELECT description,dateofbirthrequired,upperagelimit,category_type - FROM categories - WHERE categorycode = ?" - ); - $sth->execute($catcode); + $dbh->prepare( + "SELECT * + FROM categories + ORDER BY description" + ); + $sth->execute; my $data = - $sth->fetchrow_hashref; + $sth->fetchall_arrayref({}); $sth->finish(); return $data; } # sub getborrowercategory @@ -1478,28 +1553,28 @@ sub GetCities { #my ($type_city) = @_; my $dbh = C4::Context->dbh; - my $query = qq|SELECT cityid,city_name - FROM cities - ORDER BY city_name|; + my $query = qq|SELECT cityid,city_zipcode,city_name + FROM cities + ORDER BY city_name|; my $sth = $dbh->prepare($query); #$sth->execute($type_city); $sth->execute(); my %city; my @id; - # insert empty value to create a empty choice in cgi popup - + push @id, " "; + $city{""} = ""; while ( my $data = $sth->fetchrow_hashref ) { - - push @id, $data->{'cityid'}; - $city{ $data->{'cityid'} } = $data->{'city_name'}; + push @id, $data->{'city_zipcode'}."|".$data->{'city_name'}; + $city{ $data->{'city_zipcode'}."|".$data->{'city_name'} } = $data->{'city_name'}; } #test to know if the table contain some records if no the function return nothing my $id = @id; $sth->finish; - if ( $id eq 0 ) { + if ( $id == 1 ) { + # all we have is the one blank row return (); } else { @@ -1523,41 +1598,42 @@ sub GetSortDetails { my ( $category, $sortvalue ) = @_; my $dbh = C4::Context->dbh; my $query = qq|SELECT lib - FROM authorised_values - WHERE category=? - AND authorised_value=? |; + FROM authorised_values + WHERE category=? + AND authorised_value=? |; my $sth = $dbh->prepare($query); $sth->execute( $category, $sortvalue ); my $lib = $sth->fetchrow; - return ($lib); + return ($lib) if ($lib); + return ($sortvalue) unless ($lib); } -=head2 DeleteBorrower +=head2 MoveMemberToDeleted - () = &DeleteBorrower($member); + $result = &MoveMemberToDeleted($borrowernumber); -delete all data fo borrowers and add record to deletedborrowers table -C<&$member>this is the borrowernumber +Copy the record from borrowers to deletedborrowers table. =cut +# FIXME: should do it in one SQL statement w/ subquery +# Otherwise, we should return the @data on success + sub MoveMemberToDeleted { - my ($member) = @_; + my ($member) = shift or return; my $dbh = C4::Context->dbh; - my $query; - $query = qq|SELECT * - FROM borrowers - WHERE borrowernumber=?|; + my $query = qq|SELECT * + FROM borrowers + WHERE borrowernumber=?|; my $sth = $dbh->prepare($query); $sth->execute($member); my @data = $sth->fetchrow_array; - $sth->finish; + (@data) or return; # if we got a bad borrowernumber, there's nothing to insert $sth = $dbh->prepare( "INSERT INTO deletedborrowers VALUES (" . ( "?," x ( scalar(@data) - 1 ) ) . "?)" ); $sth->execute(@data); - $sth->finish; } =head2 DelMember @@ -1572,12 +1648,12 @@ This function remove directly a borrower whitout writing it on deleteborrower. sub DelMember { my $dbh = C4::Context->dbh; my $borrowernumber = shift; - warn "in delmember with $borrowernumber"; + #warn "in delmember with $borrowernumber"; return unless $borrowernumber; # borrowernumber is mandatory. my $query = qq|DELETE - FROM reserves - WHERE borrowernumber=?|; + FROM reserves + WHERE borrowernumber=?|; my $sth = $dbh->prepare($query); $sth->execute($borrowernumber); $sth->finish; @@ -1589,23 +1665,25 @@ sub DelMember { $sth = $dbh->prepare($query); $sth->execute($borrowernumber); $sth->finish; - &logaction(C4::Context->userenv->{'number'},"MEMBERS","DELETE",$borrowernumber,"") - if C4::Context->preference("BorrowersLog"); + logaction("MEMBERS", "DELETE", $borrowernumber, "") if C4::Context->preference("BorrowersLog"); return $sth->rows; } =head2 ExtendMemberSubscriptionTo (OUEST-PROVENCE) -$date= ExtendMemberSubscriptionTo($borrowerid, $date); -Extending the subscription to a given date or to the expiry date calculated on local date. -returns date + $date = ExtendMemberSubscriptionTo($borrowerid, $date); + +Extending the subscription to a given date or to the expiry date calculated on ISO date. +Returns ISO date. + =cut sub ExtendMemberSubscriptionTo { my ( $borrowerid,$date) = @_; my $dbh = C4::Context->dbh; + my $borrower = GetMember($borrowerid,'borrowernumber'); unless ($date){ - $date=POSIX::strftime("%Y-%m-%d",localtime(time)); + $date=POSIX::strftime("%Y-%m-%d",localtime()); my $borrower = GetMember($borrowerid,'borrowernumber'); $date = GetExpiryDate( $borrower->{'categorycode'}, $date ); } @@ -1614,6 +1692,14 @@ UPDATE borrowers SET dateexpiry='$date' WHERE borrowernumber='$borrowerid' EOF + # add enrolmentfee if needed + $sth = $dbh->prepare("SELECT enrolmentfee FROM categories WHERE categorycode=?"); + $sth->execute($borrower->{'categorycode'}); + my ($enrolmentfee) = $sth->fetchrow; + if ($enrolmentfee && $enrolmentfee > 0) { + # insert fee in patron debts + manualinvoice($borrower->{'borrowernumber'}, '', '', 'A', $enrolmentfee); + } return $date if ($sth); return 0; } @@ -1626,7 +1712,6 @@ Looks up the different road type . Returns two elements: a reference-to-array, which lists the id_roadtype codes, and a reference-to-hash, which maps the road type of the road . - =cut sub GetRoadTypes { @@ -1673,10 +1758,74 @@ Looks up the different title . Returns array with all borrowers title sub GetTitles { my @borrowerTitle = split /,|\|/,C4::Context->preference('BorrowersTitles'); unshift( @borrowerTitle, "" ); - return ( \@borrowerTitle); + my $count=@borrowerTitle; + if ($count == 1){ + return (); } + else { + return ( \@borrowerTitle); + } +} + +=head2 GetPatronImage + + my ($imagedata, $dberror) = GetPatronImage($cardnumber); + +Returns the mimetype and binary image data of the image for the patron with the supplied cardnumber. + +=cut + +sub GetPatronImage { + my ($cardnumber) = @_; + warn "Cardnumber passed to GetPatronImage is $cardnumber" if $debug; + my $dbh = C4::Context->dbh; + my $query = 'SELECT mimetype, imagefile FROM patronimage WHERE cardnumber = ?'; + my $sth = $dbh->prepare($query); + $sth->execute($cardnumber); + my $imagedata = $sth->fetchrow_hashref; + warn "Database error!" if $sth->errstr; + return $imagedata, $sth->errstr; +} + +=head2 PutPatronImage + + PutPatronImage($cardnumber, $mimetype, $imgfile); + +Stores patron binary image data and mimetype in database. +NOTE: This function is good for updating images as well as inserting new images in the database. +=cut + +sub PutPatronImage { + my ($cardnumber, $mimetype, $imgfile) = @_; + warn "Parameters passed in: Cardnumber=$cardnumber, Mimetype=$mimetype, " . ($imgfile ? "Imagefile" : "No Imagefile") if $debug; + my $dbh = C4::Context->dbh; + my $query = "INSERT INTO patronimage (cardnumber, mimetype, imagefile) VALUES (?,?,?) ON DUPLICATE KEY UPDATE imagefile = ?;"; + my $sth = $dbh->prepare($query); + $sth->execute($cardnumber,$mimetype,$imgfile,$imgfile); + warn "Error returned inserting $cardnumber.$mimetype." if $sth->errstr; + return $sth->errstr; +} + +=head2 RmPatronImage + my ($dberror) = RmPatronImage($cardnumber); + +Removes the image for the patron with the supplied cardnumber. + +=cut + +sub RmPatronImage { + my ($cardnumber) = @_; + warn "Cardnumber passed to GetPatronImage is $cardnumber" if $debug; + my $dbh = C4::Context->dbh; + my $query = "DELETE FROM patronimage WHERE cardnumber = ?;"; + my $sth = $dbh->prepare($query); + $sth->execute($cardnumber); + my $dberror = $sth->errstr; + warn "Database error!" if $sth->errstr; + return $dberror; +} =head2 GetRoadTypeDetails (OUEST-PROVENCE) @@ -1706,24 +1855,50 @@ WHERE roadtypeid=?|; &GetBorrowersWhoHaveNotBorrowedSince($date) this function get all borrowers who haven't borrowed since the date given on input arg. - + =cut sub GetBorrowersWhoHaveNotBorrowedSince { - my $date = shift; - return unless $date; # date is mandatory. + my $filterdate = shift||POSIX::strftime("%Y-%m-%d",localtime()); + my $filterexpiry = shift; + my $filterbranch = shift || + ((C4::Context->preference('IndependantBranches') + && C4::Context->userenv + && C4::Context->userenv->{flags}!=1 + && C4::Context->userenv->{branch}) + ? C4::Context->userenv->{branch} + : ""); my $dbh = C4::Context->dbh; my $query = " - SELECT borrowers.borrowernumber,max(timestamp) + SELECT borrowers.borrowernumber,max(issues.timestamp) as latestissue FROM borrowers - LEFT JOIN issues ON borrowers.borrowernumber = issues.borrowernumber - WHERE issues.borrowernumber IS NOT NULL - GROUP BY borrowers.borrowernumber + JOIN categories USING (categorycode) + LEFT JOIN issues ON borrowers.borrowernumber = issues.borrowernumber + WHERE category_type <> 'S' "; + my @query_params; + if ($filterbranch && $filterbranch ne ""){ + $query.=" AND borrowers.branchcode= ?"; + push @query_params,$filterbranch; + } + if($filterexpiry){ + $query .= " AND dateexpiry < NOW() "; + } + $query.=" GROUP BY borrowers.borrowernumber"; + if ($filterdate){ + $query.=" HAVING latestissue prepare($query); - $sth->execute; + if (scalar(@query_params)>0){ + $sth->execute(@query_params); + } + else { + $sth->execute; + } + my @results; - while ( my $data = $sth->fetchrow_hashref ) { push @results, $data; } @@ -1741,15 +1916,35 @@ I<$result> is a ref to an array which all elements are a hasref. =cut sub GetBorrowersWhoHaveNeverBorrowed { + my $filterbranch = shift || + ((C4::Context->preference('IndependantBranches') + && C4::Context->userenv + && C4::Context->userenv->{flags}!=1 + && C4::Context->userenv->{branch}) + ? C4::Context->userenv->{branch} + : ""); my $dbh = C4::Context->dbh; my $query = " - SELECT borrowers.borrowernumber,max(timestamp) + SELECT borrowers.borrowernumber,max(timestamp) as latestissue FROM borrowers LEFT JOIN issues ON borrowers.borrowernumber = issues.borrowernumber WHERE issues.borrowernumber IS NULL "; + my @query_params; + if ($filterbranch && $filterbranch ne ""){ + $query.=" AND borrowers.branchcode= ?"; + push @query_params,$filterbranch; + } + warn $query if $debug; + my $sth = $dbh->prepare($query); - $sth->execute; + if (scalar(@query_params)>0){ + $sth->execute(@query_params); + } + else { + $sth->execute; + } + my @results; while ( my $data = $sth->fetchrow_hashref ) { push @results, $data; @@ -1770,17 +1965,30 @@ This hashref is containt the number of time this borrowers has borrowed before I sub GetBorrowersWithIssuesHistoryOlderThan { my $dbh = C4::Context->dbh; - my $date = shift; - return unless $date; # date is mandatory. + my $date = shift ||POSIX::strftime("%Y-%m-%d",localtime()); + my $filterbranch = shift || + ((C4::Context->preference('IndependantBranches') + && C4::Context->userenv + && C4::Context->userenv->{flags}!=1 + && C4::Context->userenv->{branch}) + ? C4::Context->userenv->{branch} + : ""); my $query = " SELECT count(borrowernumber) as n,borrowernumber - FROM issues + FROM old_issues WHERE returndate < ? AND borrowernumber IS NOT NULL - GROUP BY borrowernumber - "; + "; + my @query_params; + push @query_params, $date; + if ($filterbranch){ + $query.=" AND branchcode = ?"; + push @query_params, $filterbranch; + } + $query.=" GROUP BY borrowernumber "; + warn $query if $debug; my $sth = $dbh->prepare($query); - $sth->execute($date); + $sth->execute(@query_params); my @results; while ( my $data = $sth->fetchrow_hashref ) { @@ -1789,14 +1997,140 @@ sub GetBorrowersWithIssuesHistoryOlderThan { return \@results; } +=head2 GetBorrowersNamesAndLatestIssue + +$results = &GetBorrowersNamesAndLatestIssueList(@borrowernumbers) + +this function get borrowers Names and surnames and Issue information. + +I<@borrowernumbers> is an array which all elements are borrowernumbers. +This hashref is containt the number of time this borrowers has borrowed before I<$date> and the borrowernumber. + +=cut + +sub GetBorrowersNamesAndLatestIssue { + my $dbh = C4::Context->dbh; + my @borrowernumbers=@_; + my $query = " + SELECT surname,lastname, phone, email,max(timestamp) + FROM borrowers + LEFT JOIN issues ON borrowers.borrowernumber=issues.borrowernumber + GROUP BY borrowernumber + "; + my $sth = $dbh->prepare($query); + $sth->execute; + my $results = $sth->fetchall_arrayref({}); + return $results; +} + +=head2 DebarMember + +=over 4 + +my $success = DebarMember( $borrowernumber ); + +marks a Member as debarred, and therefore unable to checkout any more +items. + +return : +true on success, false on failure + +=back + +=cut + +sub DebarMember { + my $borrowernumber = shift; + + return unless defined $borrowernumber; + return unless $borrowernumber =~ /^\d+$/; + + return ModMember( borrowernumber => $borrowernumber, + debarred => 1 ); + +} + +=head2 IsMemberBlocked + +=over 4 + +my $blocked = IsMemberBlocked( $borrowernumber ); + +return the status, and the number of day or documents, depends his punishment + +return : +-1 if the user have overdue returns +1 if the user is punished X days +0 if the user is authorised to loan + +=back + +=cut + +sub IsMemberBlocked { + my $borrowernumber = shift; + my $dbh = C4::Context->dbh; + # if he have late issues + my $sth = $dbh->prepare( + "SELECT COUNT(*) as latedocs + FROM issues + WHERE borrowernumber = ? + AND date_due < now()" + ); + $sth->execute($borrowernumber); + my $latedocs = $sth->fetchrow_hashref->{'latedocs'}; + $sth->finish(); + + return (-1, $latedocs) if $latedocs > 0; + + # or if he must wait to loan + if(C4::Context->preference("item-level_itypes")){ + $sth = $dbh->prepare( + "SELECT + ADDDATE(returndate, finedays * DATEDIFF(returndate,date_due) ) AS blockingdate, + DATEDIFF(ADDDATE(returndate, finedays * DATEDIFF(returndate,date_due)),NOW()) AS blockedcount + FROM old_issues + LEFT JOIN items ON (items.itemnumber=old_issues.itemnumber) + LEFT JOIN issuingrules ON (issuingrules.itemtype=items.itype) + WHERE finedays IS NOT NULL + AND date_due < returndate + AND borrowernumber = ? + ORDER BY blockingdate DESC + LIMIT 1" + ); + }else{ + $sth = $dbh->prepare( + "SELECT + ADDDATE(returndate, finedays * DATEDIFF(returndate,date_due) ) AS blockingdate, + DATEDIFF(ADDDATE(returndate, finedays * DATEDIFF(returndate,date_due)),NOW()) AS blockedcount + FROM old_issues + LEFT JOIN items ON (items.itemnumber=old_issues.itemnumber) + LEFT JOIN biblioitems ON (biblioitems.biblioitemnumber=items.biblioitemnumber) + LEFT JOIN issuingrules ON (issuingrules.itemtype=biblioitems.itemtype) + WHERE finedays IS NOT NULL + AND date_due < returndate + AND borrowernumber = ? + ORDER BY blockingdate DESC + LIMIT 1" + ); + } + $sth->execute($borrowernumber); + my $row = $sth->fetchrow_hashref; + my $blockeddate = $row->{'blockeddate'}; + my $blockedcount = $row->{'blockedcount'}; + $sth->finish(); + + return (1, $blockedcount) if $blockedcount > 0; + + return 0 +} + END { } # module clean-up code here (global destructor) 1; __END__ -=back - =head1 AUTHOR Koha Team