X-Git-Url: http://koha-dev.rot13.org:8081/gitweb/?a=blobdiff_plain;f=C4%2FMembers.pm;h=8d3df660def2669be0e1b15f5028baf7501c97ab;hb=58138e93d709b953f00cc126318d2cc4a9e102f4;hp=81e83ace836d7250a4c042adea6db8feb05731e7;hpb=e196f19e2d7d6825e71306f45bcda0f3903a7a7f;p=srvgit diff --git a/C4/Members.pm b/C4/Members.pm index 81e83ace83..8d3df660de 100644 --- a/C4/Members.pm +++ b/C4/Members.pm @@ -23,8 +23,8 @@ package C4::Members; use strict; #use warnings; FIXME - Bug 2505 use C4::Context; -use C4::Dates qw(format_date_in_iso format_date); use String::Random qw( random_string ); +use Scalar::Util qw( looks_like_number ); use Date::Calc qw/Today Add_Delta_YM check_date Date_to_Days/; use C4::Log; # logaction use C4::Overdues; @@ -37,19 +37,22 @@ use C4::NewsChannels; #get slip news use DateTime; use Koha::Database; use Koha::DateUtils; -use Koha::Borrower::Debarments qw(IsDebarred); +use Koha::Patron::Debarments qw(IsDebarred); use Text::Unaccent qw( unac_string ); use Koha::AuthUtils qw(hash_password); use Koha::Database; -use Module::Load; -if ( C4::Context->preference('NorwegianPatronDBEnable') && C4::Context->preference('NorwegianPatronDBEnable') == 1 ) { - load Koha::NorwegianPatronDB, qw( NLUpdateHashedPIN NLEncryptPIN NLSync ); +use Koha::Holds; +use Koha::List::Patron; + +our (@ISA,@EXPORT,@EXPORT_OK,$debug); + +use Module::Load::Conditional qw( can_load ); +if ( ! can_load( modules => { 'Koha::NorwegianPatronDB' => undef } ) ) { + $debug && warn "Unable to load Koha::NorwegianPatronDB"; } -our ($VERSION,@ISA,@EXPORT,@EXPORT_OK,$debug); BEGIN { - $VERSION = 3.07.00.049; $debug = $ENV{DEBUG} || 0; require Exporter; @ISA = qw(Exporter); @@ -60,27 +63,17 @@ BEGIN { &GetMemberRelatives &GetMember - &GetGuarantees - &GetMemberIssuesAndFines &GetPendingIssues &GetAllIssues - &getzipnamecity - &getidcity - &GetFirstValidEmailAddress &GetNoticeEmailAddress &GetAge - &GetCities &GetSortDetails &GetTitles - &GetPatronImage - &PutPatronImage - &RmPatronImage - &GetHideLostItemsPreference &IsMemberBlocked @@ -97,23 +90,19 @@ BEGIN { &GetBorrowersWithIssuesHistoryOlderThan &GetExpiryDate - - &AddMessage - &DeleteMessage - &GetMessages - &GetMessagesCount + &GetUpcomingMembershipExpires &IssueSlip GetBorrowersWithEmail HasOverdues + GetOverduesForPatron ); #Modify data push @EXPORT, qw( &ModMember &changepassword - &ModPrivacy ); #Delete data @@ -135,8 +124,6 @@ BEGIN { &checkuserpassword &Check_Userid &Generate_Userid - &fixEthnicity - ðnicitycategories &fixup_cardnumber &checkcardnumber ); @@ -242,16 +229,6 @@ sub GetMemberDetails { $borrower->{'flags'} = $flags; $borrower->{'authflags'} = $accessflagshash; - # For the purposes of making templates easier, we'll define a - # 'showname' which is the alternate form the user's first name if - # 'other name' is defined. - if ($borrower->{category_type} eq 'I') { - $borrower->{'showname'} = $borrower->{'othernames'}; - $borrower->{'showname'} .= " $borrower->{'firstname'}" if $borrower->{'firstname'}; - } else { - $borrower->{'showname'} = $borrower->{'firstname'}; - } - # Handle setting the true behavior for BlockExpiredPatronOpacActions $borrower->{'BlockExpiredPatronOpacActions'} = C4::Context->preference('BlockExpiredPatronOpacActions') @@ -351,6 +328,28 @@ sub patronflags { $flaginfo{'amount'} = sprintf "%.02f", $balance; $flags{'CREDITS'} = \%flaginfo; } + + # Check the debt of the guarntees of this patron + my $no_issues_charge_guarantees = C4::Context->preference("NoIssuesChargeGuarantees"); + $no_issues_charge_guarantees = undef unless looks_like_number( $no_issues_charge_guarantees ); + if ( defined $no_issues_charge_guarantees ) { + my $p = Koha::Patrons->find( $patroninformation->{borrowernumber} ); + 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; + } + + if ( $guarantees_non_issues_charges > $no_issues_charge_guarantees ) { + my %flaginfo; + $flaginfo{'message'} = sprintf 'patron guarantees owe %.02f', $guarantees_non_issues_charges; + $flaginfo{'amount'} = $guarantees_non_issues_charges; + $flaginfo{'noissues'} = 1 unless C4::Context->preference("allowfineoverride"); + $flags{'CHARGES_GUARANTEES'} = \%flaginfo; + } + } + if ( $patroninformation->{'gonenoaddress'} && $patroninformation->{'gonenoaddress'} == 1 ) { @@ -458,7 +457,7 @@ sub GetMember { } $debug && warn $select, " ",values %information; my $sth = $dbh->prepare("$select"); - $sth->execute(map{$information{$_}} keys %information); + $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 @@ -469,71 +468,23 @@ sub GetMember { return; } -=head2 GetMemberRelatives - - @borrowernumbers = GetMemberRelatives($borrowernumber); - - C returns a borrowersnumber's list of guarantor/guarantees of the member given in parameter - -=cut - -sub GetMemberRelatives { - my $borrowernumber = shift; - my $dbh = C4::Context->dbh; - my @glist; - - # Getting guarantor - my $query = "SELECT guarantorid FROM borrowers WHERE borrowernumber=?"; - my $sth = $dbh->prepare($query); - $sth->execute($borrowernumber); - my $data = $sth->fetchrow_arrayref(); - push @glist, $data->[0] if $data->[0]; - my $guarantor = $data->[0] ? $data->[0] : undef; - - # Getting guarantees - $query = "SELECT borrowernumber FROM borrowers WHERE guarantorid=?"; - $sth = $dbh->prepare($query); - $sth->execute($borrowernumber); - while ($data = $sth->fetchrow_arrayref()) { - push @glist, $data->[0]; - } - - # Getting sibling guarantees - if ($guarantor) { - $query = "SELECT borrowernumber FROM borrowers WHERE guarantorid=?"; - $sth = $dbh->prepare($query); - $sth->execute($guarantor); - while ($data = $sth->fetchrow_arrayref()) { - push @glist, $data->[0] if ($data->[0] != $borrowernumber); - } - } - - return @glist; -} - =head2 IsMemberBlocked my ($block_status, $count) = IsMemberBlocked( $borrowernumber ); -Returns whether a patron has overdue items that may result -in a block or whether the patron has active fine days -that would block circulation privileges. +Returns whether a patron is restricted or has overdue items that may result +in a block of circulation privileges. C<$block_status> can have the following values: -1 if the patron has outstanding fine days or a manual debarment, in which case +1 if the patron is currently restricted, in which case C<$count> is the expiration date (9999-12-31 for indefinite) -1 if the patron has overdue items, in which case C<$count> is the number of them 0 if the patron has no overdue items or outstanding fine days, in which case C<$count> is 0 -Outstanding fine days are checked before current overdue items -are. - -FIXME: this needs to be split into two functions; a potential block -based on the number of current overdue items could be orthogonal -to a block based on whether the patron has any fine days accrued. +Existing active restrictions are checked before current overdue items. =cut @@ -541,7 +492,7 @@ sub IsMemberBlocked { my $borrowernumber = shift; my $dbh = C4::Context->dbh; - my $blockeddate = Koha::Borrower::Debarments::IsDebarred($borrowernumber); + my $blockeddate = Koha::Patron::Debarments::IsDebarred($borrowernumber); return ( 1, $blockeddate ) if $blockeddate; @@ -657,11 +608,12 @@ sub ModMember { } else { if ( C4::Context->preference('NorwegianPatronDBEnable') && C4::Context->preference('NorwegianPatronDBEnable') == 1 ) { # Update the hashed PIN in borrower_sync.hashed_pin, before Koha hashes it - NLUpdateHashedPIN( $data{'borrowernumber'}, $data{password} ); + Koha::NorwegianPatronDB::NLUpdateHashedPIN( $data{'borrowernumber'}, $data{password} ); } $data{password} = hash_password($data{password}); } } + my $old_categorycode = GetBorrowerCategorycode( $data{borrowernumber} ); # get only the columns of a borrower @@ -670,23 +622,25 @@ sub ModMember { my $new_borrower = { map { join(' ', @columns) =~ /$_/ ? ( $_ => $data{$_} ) : () } keys(%data) }; delete $new_borrower->{flags}; + $new_borrower->{dateofbirth} ||= undef if exists $new_borrower->{dateofbirth}; + $new_borrower->{dateenrolled} ||= undef if exists $new_borrower->{dateenrolled}; + $new_borrower->{dateexpiry} ||= undef if exists $new_borrower->{dateexpiry}; + $new_borrower->{debarred} ||= undef if exists $new_borrower->{debarred}; + $new_borrower->{sms_provider_id} ||= undef if exists $new_borrower->{sms_provider_id}; + my $rs = $schema->resultset('Borrower')->search({ borrowernumber => $new_borrower->{borrowernumber}, }); + + delete $new_borrower->{userid} if exists $new_borrower->{userid} and not $new_borrower->{userid}; + my $execute_success = $rs->update($new_borrower); if ($execute_success ne '0E0') { # only proceed if the update was a success - # 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 ( exists $borrowercategory->{'category_type'} && $borrowercategory->{'category_type'} eq ('A' || 'S') ) { - # is adult check guarantees; - UpdateGuarantees(%data); - } - # If the patron changes to a category with enrollment fee, we add a fee if ( $data{categorycode} and $data{categorycode} ne $old_categorycode ) { - AddEnrolmentFeeIfNeeded( $data{categorycode}, $data{borrowernumber} ); + if ( C4::Context->preference('FeeOnChangePatronCategory') ) { + AddEnrolmentFeeIfNeeded( $data{categorycode}, $data{borrowernumber} ); + } } # If NorwegianPatronDBEnable is enabled, we set syncstatus to something that a @@ -705,7 +659,7 @@ sub ModMember { # Set the value of 'sync' $borrowersync->update( { 'sync' => $data{'sync'} } ); # Try to do the live sync - NLSync({ 'borrowernumber' => $data{'borrowernumber'} }); + Koha::NorwegianPatronDB::NLSync({ 'borrowernumber' => $data{'borrowernumber'} }); } logaction("MEMBERS", "MODIFY", $data{'borrowernumber'}, "UPDATE (executed w/ arg: $data{'borrowernumber'})") if C4::Context->preference("BorrowersLog"); @@ -741,12 +695,12 @@ sub AddMember { # add expiration date if it isn't already there unless ( $data{'dateexpiry'} ) { - $data{'dateexpiry'} = GetExpiryDate( $data{'categorycode'}, C4::Dates->new()->output("iso") ); + $data{'dateexpiry'} = GetExpiryDate( $data{'categorycode'}, output_pref( { dt => dt_from_string, dateonly => 1, dateformat => 'iso' } ) ); } # add enrollment date if it isn't already there unless ( $data{'dateenrolled'} ) { - $data{'dateenrolled'} = C4::Dates->new()->output("iso"); + $data{'dateenrolled'} = output_pref( { dt => dt_from_string, dateonly => 1, dateformat => 'iso' } ); } my $patron_category = $schema->resultset('Category')->find( $data{'categorycode'} ); @@ -755,16 +709,24 @@ sub AddMember { : $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'}) : '!'; - $data{'dateofbirth'} = undef if( not $data{'dateofbirth'} ); + + # 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'} ); # get only the columns of Borrower my @columns = $schema->source('Borrower')->columns; my $new_member = { map { join(' ',@columns) =~ /$_/ ? ( $_ => $data{$_} ) : () } keys(%data) } ; + $new_member->{checkprevcheckout} ||= 'inherit'; delete $new_member->{borrowernumber}; my $rs = $schema->resultset('Borrower'); @@ -778,7 +740,7 @@ sub AddMember { 'synctype' => 'norwegianpatrondb', 'sync' => 1, 'syncstatus' => 'new', - 'hashed_pin' => NLEncryptPIN( $plain_text_password ), + 'hashed_pin' => Koha::NorwegianPatronDB::NLEncryptPIN( $plain_text_password ), }); } @@ -952,61 +914,6 @@ sub fixup_cardnumber { return $cardnumber; # just here as a fallback/reminder } -=head2 GetGuarantees - - ($num_children, $children_arrayref) = &GetGuarantees($parent_borrno); - $child0_cardno = $children_arrayref->[0]{"cardnumber"}; - $child0_borrno = $children_arrayref->[0]{"borrowernumber"}; - -C<&GetGuarantees> takes a borrower number (e.g., that of a patron -with children) and looks up the borrowers who are guaranteed by that -borrower (i.e., the patron's children). - -C<&GetGuarantees> returns two values: an integer giving the number of -borrowers guaranteed by C<$parent_borrno>, and a reference to an array -of references to hash, which gives the actual results. - -=cut - -#' -sub GetGuarantees { - my ($borrowernumber) = @_; - my $dbh = C4::Context->dbh; - my $sth = - $dbh->prepare( -"select cardnumber,borrowernumber, firstname, surname from borrowers where guarantorid=?" - ); - $sth->execute($borrowernumber); - - my @dat; - my $data = $sth->fetchall_arrayref({}); - return ( scalar(@$data), $data ); -} - -=head2 UpdateGuarantees - - &UpdateGuarantees($parent_borrno); - - -C<&UpdateGuarantees> borrower data for an adult and updates all the guarantees -with the modified information - -=cut - -#' -sub UpdateGuarantees { - my %data = shift; - my $dbh = C4::Context->dbh; - my ( $count, $guarantees ) = GetGuarantees( $data{'borrowernumber'} ); - foreach my $guarantee (@$guarantees){ - my $guaquery = qq|UPDATE borrowers - SET address=?,fax=?,B_city=?,mobile=?,city=?,phone=? - WHERE borrowernumber=? - |; - my $sth = $dbh->prepare($guaquery); - $sth->execute($data{'address'},$data{'fax'},$data{'B_city'},$data{'mobile'},$data{'city'},$data{'phone'},$guarantee->{'borrowernumber'}); - } -} =head2 GetPendingIssues my $issues = &GetPendingIssues(@borrowernumber); @@ -1020,7 +927,6 @@ The keys include C fields except marc and marcxml. =cut -#' sub GetPendingIssues { my @borrowernumbers = @_; @@ -1170,7 +1076,7 @@ sub GetMemberAccountRecords { SELECT * FROM accountlines WHERE borrowernumber=?); - $strsth.=" ORDER BY date desc,timestamp DESC"; + $strsth.=" ORDER BY accountlines_id desc"; my $sth= $dbh->prepare( $strsth ); $sth->execute( $borrowernumber ); @@ -1183,7 +1089,7 @@ sub GetMemberAccountRecords { } $acctlines[$numlines] = $data; $numlines++; - $total += int(1000 * $data->{'amountoutstanding'}); # convert float to integer to avoid round-off errors + $total += sprintf "%.0f", 1000*$data->{amountoutstanding}; # convert float to integer to avoid round-off errors } $total /= 1000; return ( $total, \@acctlines,$numlines); @@ -1365,40 +1271,6 @@ sub get_cardnumber_length { return ( $min, $max ); } -=head2 getzipnamecity (OUEST-PROVENCE) - -take all info from table city for the fields city and zip -check for the name and the zip code of the city selected - -=cut - -sub getzipnamecity { - my ($cityid) = @_; - my $dbh = C4::Context->dbh; - my $sth = - $dbh->prepare( - "select city_name,city_state,city_zipcode,city_country from cities where cityid=? "); - $sth->execute($cityid); - my @data = $sth->fetchrow; - return $data[0], $data[1], $data[2], $data[3]; -} - - -=head2 getdcity (OUEST-PROVENCE) - -recover cityid with city_name condition - -=cut - -sub getidcity { - my ($city_name) = @_; - my $dbh = C4::Context->dbh; - my $sth = $dbh->prepare("select cityid from cities where city_name=? "); - $sth->execute($city_name); - my $data = $sth->fetchrow; - return $data; -} - =head2 GetFirstValidEmailAddress $email = GetFirstValidEmailAddress($borrowernumber); @@ -1483,6 +1355,53 @@ sub GetExpiryDate { } } +=head2 GetUpcomingMembershipExpires + + my $expires = GetUpcomingMembershipExpires({ + branch => $branch, before => $before, after => $after, + }); + + $branch is an optional branch code. + $before/$after is an optional number of days before/after the date that + is set by the preference MembershipExpiryDaysNotice. + If the pref would be 14, before 2 and after 3, you will get all expires + from 12 to 17 days. + +=cut + +sub GetUpcomingMembershipExpires { + my ( $params ) = @_; + my $before = $params->{before} || 0; + my $after = $params->{after} || 0; + my $branch = $params->{branch}; + + my $dbh = C4::Context->dbh; + my $days = C4::Context->preference("MembershipExpiryDaysNotice") || 0; + my $date1 = dt_from_string->add( days => $days - $before ); + my $date2 = dt_from_string->add( days => $days + $after ); + $date1= output_pref({ dt => $date1, dateformat => 'iso', dateonly => 1 }); + $date2= output_pref({ dt => $date2, dateformat => 'iso', dateonly => 1 }); + + my $query = q| + SELECT borrowers.*, categories.description, + branches.branchname, branches.branchemail FROM borrowers + LEFT JOIN branches USING (branchcode) + LEFT JOIN categories USING (categorycode) + |; + if( $branch ) { + $query.= 'WHERE branchcode=? AND dateexpiry BETWEEN ? AND ?'; + } else { + $query.= 'WHERE dateexpiry BETWEEN ? AND ?'; + } + + my $sth = $dbh->prepare( $query ); + my @pars = $branch? ( $branch ): (); + push @pars, $date1, $date2; + $sth->execute( @pars ); + my $results = $sth->fetchall_arrayref( {} ); + return $results; +} + =head2 GetborCatFromCatType ($codes_arrayref, $labels_hashref) = &GetborCatFromCatType(); @@ -1611,54 +1530,6 @@ sub GetBorrowercategoryList { return $data; } # sub getborrowercategory -=head2 ethnicitycategories - - ($codes_arrayref, $labels_hashref) = ðnicitycategories(); - -Looks up the different ethnic types in the database. Returns two -elements: a reference-to-array, which lists the ethnicity codes, and a -reference-to-hash, which maps the ethnicity codes to ethnicity -descriptions. - -=cut - -#' - -sub ethnicitycategories { - my $dbh = C4::Context->dbh; - my $sth = $dbh->prepare("Select code,name from ethnicity order by name"); - $sth->execute; - my %labels; - my @codes; - while ( my $data = $sth->fetchrow_hashref ) { - push @codes, $data->{'code'}; - $labels{ $data->{'code'} } = $data->{'name'}; - } - return ( \@codes, \%labels ); -} - -=head2 fixEthnicity - - $ethn_name = &fixEthnicity($ethn_code); - -Takes an ethnicity code (e.g., "european" or "pi") and returns the -corresponding descriptive name from the C table in the -Koha database ("European" or "Pacific Islander"). - -=cut - -#' - -sub fixEthnicity { - my $ethnicity = shift; - return unless $ethnicity; - my $dbh = C4::Context->dbh; - my $sth = $dbh->prepare("Select name from ethnicity where code = ?"); - $sth->execute($ethnicity); - my $data = $sth->fetchrow_hashref; - return $data->{'name'}; -} # sub fixEthnicity - =head2 GetAge $dateofbirth,$date = &GetAge($date); @@ -1729,35 +1600,6 @@ sub SetAge{ return $borrower; } # sub SetAge -=head2 GetCities - - $cityarrayref = GetCities(); - - Returns an array_ref of the entries in the cities table - If there are entries in the table an empty row is returned - This is currently only used to populate a popup in memberentry - -=cut - -sub GetCities { - - my $dbh = C4::Context->dbh; - my $city_arr = $dbh->selectall_arrayref( - q|SELECT cityid,city_zipcode,city_name,city_state,city_country FROM cities ORDER BY city_name|, - { Slice => {} }); - if ( @{$city_arr} ) { - unshift @{$city_arr}, { - city_zipcode => q{}, - city_name => q{}, - cityid => q{}, - city_state => q{}, - city_country => q{}, - }; - } - - return $city_arr; -} - =head2 GetSortDetails (OUEST-PROVENCE) ($lib) = &GetSortDetails($category,$sortvalue); @@ -1820,23 +1662,55 @@ sub DelMember { my $borrowernumber = shift; #warn "in delmember with $borrowernumber"; return unless $borrowernumber; # borrowernumber is mandatory. + # Delete Patron's holds + my @holds = Koha::Holds->search({ borrowernumber => $borrowernumber }); + $_->delete for @holds; - my $query = qq|DELETE - FROM reserves - WHERE borrowernumber=?|; - my $sth = $dbh->prepare($query); - $sth->execute($borrowernumber); - $query = " + my $query = " DELETE FROM borrowers WHERE borrowernumber = ? "; - $sth = $dbh->prepare($query); + my $sth = $dbh->prepare($query); $sth->execute($borrowernumber); logaction("MEMBERS", "DELETE", $borrowernumber, "") if C4::Context->preference("BorrowersLog"); return $sth->rows; } +=head2 HandleDelBorrower + + HandleDelBorrower($borrower); + +When a member is deleted (DelMember in Members.pm), you should call me first. +This routine deletes/moves lists and entries for the deleted member/borrower. +Lists owned by the borrower are deleted, but entries from the borrower to +other lists are kept. + +=cut + +sub HandleDelBorrower { + my ($borrower)= @_; + my $query; + my $dbh = C4::Context->dbh; + + #Delete all lists and all shares of this borrower + #Consistent with the approach Koha uses on deleting individual lists + #Note that entries in virtualshelfcontents added by this borrower to + #lists of others will be handled by a table constraint: the borrower + #is set to NULL in those entries. + $query="DELETE FROM virtualshelves WHERE owner=?"; + $dbh->do($query,undef,($borrower)); + + #NOTE: + #We could handle the above deletes via a constraint too. + #But a new BZ report 11889 has been opened to discuss another approach. + #Instead of deleting we could also disown lists (based on a pref). + #In that way we could save shared and public lists. + #The current table constraints support that idea now. + #This pref should then govern the results of other routines/methods such as + #Koha::Virtualshelf->new->delete too. +} + =head2 ExtendMemberSubscriptionTo (OUEST-PROVENCE) $date = ExtendMemberSubscriptionTo($borrowerid, $date); @@ -1852,8 +1726,9 @@ sub ExtendMemberSubscriptionTo { my $borrower = GetMember('borrowernumber'=>$borrowerid); unless ($date){ $date = (C4::Context->preference('BorrowerRenewalPeriodBase') eq 'dateexpiry') ? - C4::Dates->new($borrower->{'dateexpiry'}, 'iso')->output("iso") : - C4::Dates->new()->output("iso"); + eval { output_pref( { dt => dt_from_string( $borrower->{'dateexpiry'} ), dateonly => 1, dateformat => 'iso' } ); } + : + output_pref( { dt => dt_from_string, dateonly => 1, dateformat => 'iso' } ); $date = GetExpiryDate( $borrower->{'categorycode'}, $date ); } my $sth = $dbh->do(<dbh; - my $query = 'SELECT mimetype, imagefile FROM patronimage WHERE borrowernumber = ?'; - my $sth = $dbh->prepare($query); - $sth->execute($borrowernumber); - 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 (borrowernumber, mimetype, imagefile) VALUES ( ( SELECT borrowernumber from borrowers WHERE cardnumber = ? ),?,?) 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($borrowernumber); - -Removes the image for the patron with the supplied borrowernumber. - -=cut - -sub RmPatronImage { - my ($borrowernumber) = @_; - warn "Borrowernumber passed to GetPatronImage is $borrowernumber" if $debug; - my $dbh = C4::Context->dbh; - my $query = "DELETE FROM patronimage WHERE borrowernumber = ?;"; - my $sth = $dbh->prepare($query); - $sth->execute($borrowernumber); - my $dberror = $sth->errstr; - warn "Database error!" if $sth->errstr; - return $dberror; -} - =head2 GetHideLostItemsPreference $hidelostitemspref = &GetHideLostItemsPreference($borrowernumber); @@ -1971,9 +1786,10 @@ sub GetHideLostItemsPreference { =head2 GetBorrowersToExpunge $borrowers = &GetBorrowersToExpunge( - not_borrowered_since => $not_borrowered_since, + not_borrowed_since => $not_borrowed_since, expired_before => $expired_before, category_code => $category_code, + patron_list_id => $patron_list_id, branchcode => $branchcode ); @@ -1982,18 +1798,19 @@ sub GetHideLostItemsPreference { =cut sub GetBorrowersToExpunge { - my $params = shift; - my $filterdate = $params->{'not_borrowered_since'}; - my $filterexpiry = $params->{'expired_before'}; - my $filtercategory = $params->{'category_code'}; - my $filterbranch = $params->{'branchcode'} || + my $params = shift; + my $filterdate = $params->{'not_borrowed_since'}; + my $filterexpiry = $params->{'expired_before'}; + my $filtercategory = $params->{'category_code'}; + my $filterbranch = $params->{'branchcode'} || ((C4::Context->preference('IndependentBranches') && C4::Context->userenv && !C4::Context->IsSuperLibrarian() && C4::Context->userenv->{branch}) ? C4::Context->userenv->{branch} : ""); + my $filterpatronlist = $params->{'patron_list_id'}; my $dbh = C4::Context->dbh; my $query = q| @@ -2009,11 +1826,13 @@ sub GetBorrowersToExpunge { AND guarantorid <> 0 ) as tmp ON borrowers.borrowernumber=tmp.guarantorid LEFT JOIN old_issues USING (borrowernumber) - LEFT JOIN issues USING (borrowernumber) - WHERE category_type <> 'S' + 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 = ? "; @@ -2027,6 +1846,10 @@ sub GetBorrowersToExpunge { $query .= " AND categorycode = ? "; push( @query_params, $filtercategory ); } + if ( $filterpatronlist ){ + $query.=" AND patron_list_id = ? "; + push( @query_params, $filterpatronlist ); + } $query.=" GROUP BY borrowers.borrowernumber HAVING currentissue IS NULL "; if ( $filterdate ) { $query.=" AND ( latestissue < ? OR latestissue IS NULL ) "; @@ -2037,10 +1860,10 @@ sub GetBorrowersToExpunge { my $sth = $dbh->prepare($query); if (scalar(@query_params)>0){ $sth->execute(@query_params); - } + } else { $sth->execute; - } + } my @results; while ( my $data = $sth->fetchrow_hashref ) { @@ -2167,152 +1990,6 @@ sub GetBorrowersNamesAndLatestIssue { return $results; } -=head2 ModPrivacy - - my $success = ModPrivacy( $borrowernumber, $privacy ); - -Update the privacy of a patron. - -return : -true on success, false on failure - -=cut - -sub ModPrivacy { - my $borrowernumber = shift; - my $privacy = shift; - return unless defined $borrowernumber; - return unless $borrowernumber =~ /^\d+$/; - - return ModMember( borrowernumber => $borrowernumber, - privacy => $privacy ); -} - -=head2 AddMessage - - AddMessage( $borrowernumber, $message_type, $message, $branchcode ); - -Adds a message to the messages table for the given borrower. - -Returns: - True on success - False on failure - -=cut - -sub AddMessage { - my ( $borrowernumber, $message_type, $message, $branchcode ) = @_; - - my $dbh = C4::Context->dbh; - - if ( ! ( $borrowernumber && $message_type && $message && $branchcode ) ) { - return; - } - - my $query = "INSERT INTO messages ( borrowernumber, branchcode, message_type, message ) VALUES ( ?, ?, ?, ? )"; - my $sth = $dbh->prepare($query); - $sth->execute( $borrowernumber, $branchcode, $message_type, $message ); - logaction("MEMBERS", "ADDCIRCMESSAGE", $borrowernumber, $message) if C4::Context->preference("BorrowersLog"); - return 1; -} - -=head2 GetMessages - - GetMessages( $borrowernumber, $type ); - -$type is message type, B for borrower, or L for Librarian. -Empty type returns all messages of any type. - -Returns all messages for the given borrowernumber - -=cut - -sub GetMessages { - my ( $borrowernumber, $type, $branchcode ) = @_; - - if ( ! $type ) { - $type = '%'; - } - - my $dbh = C4::Context->dbh; - - my $query = "SELECT - branches.branchname, - messages.*, - message_date, - messages.branchcode LIKE '$branchcode' AS can_delete - FROM messages, branches - WHERE borrowernumber = ? - AND message_type LIKE ? - AND messages.branchcode = branches.branchcode - ORDER BY message_date DESC"; - my $sth = $dbh->prepare($query); - $sth->execute( $borrowernumber, $type ) ; - my @results; - - while ( my $data = $sth->fetchrow_hashref ) { - my $d = C4::Dates->new( $data->{message_date}, 'iso' ); - $data->{message_date_formatted} = $d->output; - push @results, $data; - } - return \@results; - -} - -=head2 GetMessages - - GetMessagesCount( $borrowernumber, $type ); - -$type is message type, B for borrower, or L for Librarian. -Empty type returns all messages of any type. - -Returns the number of messages for the given borrowernumber - -=cut - -sub GetMessagesCount { - my ( $borrowernumber, $type, $branchcode ) = @_; - - if ( ! $type ) { - $type = '%'; - } - - my $dbh = C4::Context->dbh; - - my $query = "SELECT COUNT(*) as MsgCount FROM messages WHERE borrowernumber = ? AND message_type LIKE ?"; - my $sth = $dbh->prepare($query); - $sth->execute( $borrowernumber, $type ) ; - my @results; - - my $data = $sth->fetchrow_hashref; - my $count = $data->{'MsgCount'}; - - return $count; -} - - - -=head2 DeleteMessage - - DeleteMessage( $message_id ); - -=cut - -sub DeleteMessage { - my ( $message_id ) = @_; - - my $dbh = C4::Context->dbh; - my $query = "SELECT * FROM messages WHERE message_id = ?"; - my $sth = $dbh->prepare($query); - $sth->execute( $message_id ); - my $message = $sth->fetchrow_hashref(); - - $query = "DELETE FROM messages WHERE message_id = ?"; - $sth = $dbh->prepare($query); - $sth->execute( $message_id ); - logaction("MEMBERS", "DELCIRCMESSAGE", $message->{'borrowernumber'}, $message->{'message'}) if C4::Context->preference("BorrowersLog"); -} - =head2 IssueSlip IssueSlip($branchcode, $borrowernumber, $quickslip) @@ -2462,21 +2139,26 @@ sub GetBorrowersWithEmail { return @result; } +=head2 AddMember_Opac + +=cut + sub AddMember_Opac { my ( %borrower ) = @_; - $borrower{'categorycode'} = C4::Context->preference('PatronSelfRegistrationDefaultCategory'); - - my $sr = new String::Random; - $sr->{'A'} = [ 'A'..'Z', 'a'..'z' ]; - my $password = $sr->randpattern("AAAAAAAAAA"); - $borrower{'password'} = $password; + $borrower{'categorycode'} //= C4::Context->preference('PatronSelfRegistrationDefaultCategory'); + if (not defined $borrower{'password'}){ + my $sr = new String::Random; + $sr->{'A'} = [ 'A'..'Z', 'a'..'z' ]; + my $password = $sr->randpattern("AAAAAAAAAA"); + $borrower{'password'} = $password; + } - $borrower{'cardnumber'} = fixup_cardnumber(); + $borrower{'cardnumber'} = fixup_cardnumber( $borrower{'cardnumber'} ); my $borrowernumber = AddMember(%borrower); - return ( $borrowernumber, $password ); + return ( $borrowernumber, $borrower{'password'} ); } =head2 AddEnrolmentFeeIfNeeded @@ -2508,6 +2190,10 @@ sub AddEnrolmentFeeIfNeeded { } } +=head2 HasOverdues + +=cut + sub HasOverdues { my ( $borrowernumber ) = @_; @@ -2519,6 +2205,72 @@ sub HasOverdues { return $count; } +=head2 DeleteExpiredOpacRegistrations + + Delete accounts that haven't been upgraded from the 'temporary' category + Returns the number of removed patrons + +=cut + +sub DeleteExpiredOpacRegistrations { + + my $delay = C4::Context->preference('PatronSelfRegistrationExpireTemporaryAccountsDelay'); + my $category_code = C4::Context->preference('PatronSelfRegistrationDefaultCategory'); + + return 0 if not $category_code or not defined $delay or $delay eq q||; + + my $query = qq| +SELECT borrowernumber +FROM borrowers +WHERE categorycode = ? AND DATEDIFF( NOW(), dateenrolled ) > ? |; + + my $dbh = C4::Context->dbh; + my $sth = $dbh->prepare($query); + $sth->execute( $category_code, $delay ); + my $cnt=0; + while ( my ($borrowernumber) = $sth->fetchrow_array() ) { + DelMember($borrowernumber); + $cnt++; + } + return $cnt; +} + +=head2 DeleteUnverifiedOpacRegistrations + + Delete all unverified self registrations in borrower_modifications, + older than the specified number of days. + +=cut + +sub DeleteUnverifiedOpacRegistrations { + my ( $days ) = @_; + my $dbh = C4::Context->dbh; + my $sql=qq| +DELETE FROM borrower_modifications +WHERE borrowernumber = 0 AND DATEDIFF( NOW(), timestamp ) > ?|; + my $cnt=$dbh->do($sql, undef, ($days) ); + 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;