Attachment #53660 for bug #16966

View | Details | Raw Unified | Return to bug 16966
Collapse All | Expand All




        &GetBranchItemRule
		&GetBiblioIssues
		&GetOpenIssue
		&AnonymiseIssueHistory
        &CheckIfIssuedToPatron
        &IsItemIssued
        GetTopIssues

    return $sth->execute($itemnumber);
}

=head2 AnonymiseIssueHistory

  ($rows,$err_history_not_deleted) = AnonymiseIssueHistory($date,$borrowernumber)

This function write NULL instead of C<$borrowernumber> given on input arg into the table issues.
if C<$borrowernumber> is not set, it will delete the issue history for all borrower older than C<$date>.

If c<$borrowernumber> is set, it will delete issue history for only that borrower, regardless of their opac privacy
setting (force delete).

return the number of affected rows and a value that evaluates to true if an error occurred deleting the history.

=cut

sub AnonymiseIssueHistory {
    my $date           = shift;
    my $borrowernumber = shift;
    my $dbh            = C4::Context->dbh;
    my $query          = "
        UPDATE old_issues
        SET    borrowernumber = ?
        WHERE  returndate < ?
          AND borrowernumber IS NOT NULL
    ";

    # The default of 0 does not work due to foreign key constraints
    # The anonymisation should not fail quietly if AnonymousPatron is not a valid entry
    # Set it to undef (NULL)
    my $anonymouspatron = C4::Context->preference('AnonymousPatron') || undef;
    my @bind_params = ($anonymouspatron, $date);
    if (defined $borrowernumber) {
       $query .= " AND borrowernumber = ?";
       push @bind_params, $borrowernumber;
    } else {
       $query .= " AND (SELECT privacy FROM borrowers WHERE borrowers.borrowernumber=old_issues.borrowernumber) <> 0";
    }
    my $sth = $dbh->prepare($query);
    $sth->execute(@bind_params);
    my $anonymisation_err = $dbh->err;
    my $rows_affected = $sth->rows;  ### doublecheck row count return function
    return ($rows_affected, $anonymisation_err);
}

=head2 SendCirculationAlert

Send out a C<check-in> or C<checkout> alert using the messaging system.





        &GetBorrowersToExpunge
        &GetBorrowersWhoHaveNeverBorrowed
        &GetBorrowersWithIssuesHistoryOlderThan

        &GetExpiryDate
        &GetUpcomingMembershipExpires

    return \@results;
}

=head2 GetBorrowersWithIssuesHistoryOlderThan

  $results = &GetBorrowersWithIssuesHistoryOlderThan($date)

this function get all borrowers who has an issue history older than I<$date> given on input arg.

I<$result> is a ref to an array which all elements are a hashref.
This hashref is containt the number of time this borrowers has borrowed before I<$date> and the borrowernumber.

=cut

sub GetBorrowersWithIssuesHistoryOlderThan {
    my $dbh  = C4::Context->dbh;
    my $date = shift ||POSIX::strftime("%Y-%m-%d",localtime());
    my $filterbranch = shift || 
                        ((C4::Context->preference('IndependentBranches')
                             && C4::Context->userenv 
                             && !C4::Context->IsSuperLibrarian()
                             && C4::Context->userenv->{branch})
                         ? C4::Context->userenv->{branch}
                         : "");  
    my $query = "
       SELECT count(borrowernumber) as n,borrowernumber
       FROM old_issues
       WHERE returndate < ?
         AND borrowernumber IS NOT NULL 
    "; 
    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(@query_params);
    my @results;

    while ( my $data = $sth->fetchrow_hashref ) {
        push @results, $data;
    }
    return \@results;
}

=head2 IssueSlip

  IssueSlip($branchcode, $borrowernumber, $quickslip)




package Koha::Patrons;

# Copyright 2014 ByWater Solutions
# Copyright 2016 Koha Development Team
#
# This file is part of Koha.
#

use Carp;

use Koha::Database;
use Koha::DateUtils;

use Koha::Patron;



=cut

=head3 search_patrons_to_anonymise

    my $patrons = Koha::Patrons->search_patrons_to_anonymise( $date );

This method returns all patrons who has an issue history older than a given date.

=cut

sub search_patrons_to_anonymise {
    my ( $class, $older_than_date ) = @_;
    $older_than_date = $older_than_date ? dt_from_string($older_than_date) : dt_from_string;
    my $library =
      ( C4::Context->preference('IndependentBranches') && C4::Context->userenv && !C4::Context->IsSuperLibrarian() && C4::Context->userenv->{branch} )
      ? C4::Context->userenv->{branch}
      : undef;

    my $dtf = Koha::Database->new->schema->storage->datetime_parser;
    my $rs = $class->search(
        {   returndate                  => { '<'   =>  $dtf->format_datetime($older_than_date), },
            'old_issues.borrowernumber' => { 'not' => undef },
            privacy                     => { '<>'  => 0 },                  # Keep forever
            ( $library ? ( 'old_issues.branchcode' => $library ) : () ),
        },
        {   join     => ["old_issues"],
            group_by => 'borrowernumber'
        }
    );
    return Koha::Patrons->_new_from_dbic($rs);
}

=head3 anonymise_issue_history

    Koha::Patrons->search->anonymise_issue_history( $older_than_date );

Anonymise issue history (old_issues) for all patrons older than the given date.
To make sure all the conditions are met, the caller has the responsability to
call search_patrons_to_anonymise to filter the Koha::Patrons set

=cut

sub anonymise_issue_history {
    my ( $self, $older_than_date ) = @_;

    return unless $older_than_date;
    $older_than_date = dt_from_string $older_than_date;

    # The default of 0 does not work due to foreign key constraints
    # The anonymisation should not fail quietly if AnonymousPatron is not a valid entry
    # Set it to undef (NULL)
    my $dtf = Koha::Database->new->schema->storage->datetime_parser;
    my $old_issues_to_anonymise = $self->search_related( 'old_issues', { returndate => { '<' => $dtf->format_datetime($older_than_date) } } );
    my $anonymous_patron = C4::Context->preference('AnonymousPatron') || undef;
    $old_issues_to_anonymise->update( { 'old_issues.borrowernumber' => $anonymous_patron } );
}

=head3 type

=cut

Lines 187-194 Link Here

(-)a/koha-tmpl/intranet-tmpl/prog/en/modules/tools/cleanborrowers.tt (-2 / +2 lines)
187	<h4>No patron records have been removed</h4>	187	<h4>No patron records have been removed</h4>
188	[% END %]	188	[% END %]
189	[% END %]	189	[% END %]
190	[% IF ( do_anonym ) %]	190	[% IF do_anonym %]
191	<h4>All checkouts older than [% last_issue_date \| $KohaDates %] have been anonymized</h4>	191	<h4>All checkouts ([% do_anonym %]) older than [% last_issue_date \| $KohaDates %] have been anonymized</h4>
192	[% ELSE %]	192	[% ELSE %]
193	<h4>No patron records have been anonymized</h4>	193	<h4>No patron records have been anonymized</h4>
194	[% END %]	194	[% END %]

Lines 30-36 BEGIN { Link Here

(-)a/misc/cronjobs/batch_anonymise.pl (-4 / +3 lines)
30	}	30	}
31		31
32	use C4::Context;	32	use C4::Context;
33	use C4::Circulation;	33	use Koha::Patrons;
34	use Date::Calc qw(	34	use Date::Calc qw(
35	Today	35	Today
36	Add_Delta_Days	36	Add_Delta_Days
Lines 74-81 my ($newyear,$newmonth,$newday) = Add_Delta_Days ($year,$month,$day,(-1)*$days); Link Here
74	my $formatdate = sprintf "%4d-%02d-%02d",$newyear,$newmonth,$newday;	74	my $formatdate = sprintf "%4d-%02d-%02d",$newyear,$newmonth,$newday;
75	$verbose and print "Checkouts before $formatdate will be anonymised.\n";	75	$verbose and print "Checkouts before $formatdate will be anonymised.\n";
76		76
77	my ($rows, $err_history_not_deleted) = AnonymiseIssueHistory($formatdate);	77	my $rows = Koha::Patrons->search_patrons_to_anonymise( $formatdate )->anonymise_issue_history( $formatdate );
78	carp "Anonymisation of reading history failed." if ($err_history_not_deleted);	78	$verbose and print int($rows) . " checkouts anonymised.\n";
79	$verbose and print "$rows checkouts anonymised.\n";
80		79
81	exit(0);	80	exit(0);





use C4::Auth;    # checkauth, getborrowernumber.
use C4::Context;
use C4::Circulation;
use C4::Members;
use C4::Output;
use Koha::Patrons;


    # delete all reading records for items returned
    # uses a hardcoded date ridiculously far in the future
    my $rows = Koha::Patrons->search({ borrowernumber => $borrowernumber })->anonymise_issue_history( '2999-12-12' );
    $template->param( 'deleted' => $rows );

    # confirm the user the deletion has been done
    if ( !$err_history_not_deleted ) {
        $template->param( 'deleted' => 1 );
    }
    else {
        $template->param( 'err_history_not_deleted' => 1 );
    }
}

# get borrower privacy ....




use C4::Auth;
use C4::Output;
use C4::Members;        # GetBorrowersWhoHavexxxBorrowed.
use C4::Circulation;    # AnonymiseIssueHistory.
use Koha::DateUtils qw( dt_from_string output_pref );
use Date::Calc qw/Today Add_Delta_YM/;
use Koha::Patrons;
use Koha::List::Patron;

my $cgi = new CGI;

    }
    _skip_borrowers_with_nonzero_balance($patrons_to_delete);

    my $patrons_to_anonymize = $checkboxes{issue}
        ? Koha::Patrons->search_patrons_to_anonymise( $last_issue_date )
        : undef;
    }

    $template->param(
        patrons_to_delete    => $patrons_to_delete,
        patrons_to_anonymize => $patrons_to_anonymize,
        patron_list_id          => $patron_list_id,
    );
}

    # Anonymising all members
    if ($do_anonym) {
        #FIXME: anonymisation errors are not handled
        my $rows = Koha::Patrons->search_patrons_to_anonymise( $last_issue_date )->anonymise_issue_history( $last_issue_date );
        $template->param(
            do_anonym   => $rows,
        );
    }

- 

Return to bug 16966

Lines 97-103 BEGIN { Link Here

(-)a/C4/Circulation.pm (-44 lines)
97	&GetBranchItemRule	97	&GetBranchItemRule
98	&GetBiblioIssues	98	&GetBiblioIssues
99	&GetOpenIssue	99	&GetOpenIssue
100	&AnonymiseIssueHistory
101	&CheckIfIssuedToPatron	100	&CheckIfIssuedToPatron
102	&IsItemIssued	101	&IsItemIssued
103	GetTopIssues	102	GetTopIssues
Lines 3444-3492 sub DeleteTransfer { Link Here
3444	return $sth->execute($itemnumber);	3443	return $sth->execute($itemnumber);
3445	}	3444	}
3446		3445
3447	=head2 AnonymiseIssueHistory
3448
3449	($rows,$err_history_not_deleted) = AnonymiseIssueHistory($date,$borrowernumber)
3450
3451	This function write NULL instead of C<$borrowernumber> given on input arg into the table issues.
3452	if C<$borrowernumber> is not set, it will delete the issue history for all borrower older than C<$date>.
3453
3454	If c<$borrowernumber> is set, it will delete issue history for only that borrower, regardless of their opac privacy
3455	setting (force delete).
3456
3457	return the number of affected rows and a value that evaluates to true if an error occurred deleting the history.
3458
3459	=cut
3460
3461	sub AnonymiseIssueHistory {
3462	my $date = shift;
3463	my $borrowernumber = shift;
3464	my $dbh = C4::Context->dbh;
3465	my $query = "
3466	UPDATE old_issues
3467	SET borrowernumber = ?
3468	WHERE returndate < ?
3469	AND borrowernumber IS NOT NULL
3470	";
3471
3472	# The default of 0 does not work due to foreign key constraints
3473	# The anonymisation should not fail quietly if AnonymousPatron is not a valid entry
3474	# Set it to undef (NULL)
3475	my $anonymouspatron = C4::Context->preference('AnonymousPatron') \|\| undef;
3476	my @bind_params = ($anonymouspatron, $date);
3477	if (defined $borrowernumber) {
3478	$query .= " AND borrowernumber = ?";
3479	push @bind_params, $borrowernumber;
3480	} else {
3481	$query .= " AND (SELECT privacy FROM borrowers WHERE borrowers.borrowernumber=old_issues.borrowernumber) <> 0";
3482	}
3483	my $sth = $dbh->prepare($query);
3484	$sth->execute(@bind_params);
3485	my $anonymisation_err = $dbh->err;
3486	my $rows_affected = $sth->rows; ### doublecheck row count return function
3487	return ($rows_affected, $anonymisation_err);
3488	}
3489
3490	=head2 SendCirculationAlert	3446	=head2 SendCirculationAlert
3491		3447
3492	Send out a C<check-in> or C<checkout> alert using the messaging system.	3448	Send out a C<check-in> or C<checkout> alert using the messaging system.

Lines 86-92 BEGIN { Link Here

(-)a/C4/Members.pm (-46 lines)
86		86
87	&GetBorrowersToExpunge	87	&GetBorrowersToExpunge
88	&GetBorrowersWhoHaveNeverBorrowed	88	&GetBorrowersWhoHaveNeverBorrowed
89	&GetBorrowersWithIssuesHistoryOlderThan
90		89
91	&GetExpiryDate	90	&GetExpiryDate
92	&GetUpcomingMembershipExpires	91	&GetUpcomingMembershipExpires
Lines 1815-1865 sub GetBorrowersWhoHaveNeverBorrowed { Link Here
1815	return \@results;	1814	return \@results;
1816	}	1815	}
1817		1816
1818	=head2 GetBorrowersWithIssuesHistoryOlderThan
1819
1820	$results = &GetBorrowersWithIssuesHistoryOlderThan($date)
1821
1822	this function get all borrowers who has an issue history older than I<$date> given on input arg.
1823
1824	I<$result> is a ref to an array which all elements are a hashref.
1825	This hashref is containt the number of time this borrowers has borrowed before I<$date> and the borrowernumber.
1826
1827	=cut
1828
1829	sub GetBorrowersWithIssuesHistoryOlderThan {
1830	my $dbh = C4::Context->dbh;
1831	my $date = shift \|\|POSIX::strftime("%Y-%m-%d",localtime());
1832	my $filterbranch = shift \|\|
1833	((C4::Context->preference('IndependentBranches')
1834	&& C4::Context->userenv
1835	&& !C4::Context->IsSuperLibrarian()
1836	&& C4::Context->userenv->{branch})
1837	? C4::Context->userenv->{branch}
1838	: "");
1839	my $query = "
1840	SELECT count(borrowernumber) as n,borrowernumber
1841	FROM old_issues
1842	WHERE returndate < ?
1843	AND borrowernumber IS NOT NULL
1844	";
1845	my @query_params;
1846	push @query_params, $date;
1847	if ($filterbranch){
1848	$query.=" AND branchcode = ?";
1849	push @query_params, $filterbranch;
1850	}
1851	$query.=" GROUP BY borrowernumber ";
1852	warn $query if $debug;
1853	my $sth = $dbh->prepare($query);
1854	$sth->execute(@query_params);
1855	my @results;
1856
1857	while ( my $data = $sth->fetchrow_hashref ) {
1858	push @results, $data;
1859	}
1860	return \@results;
1861	}
1862
1863	=head2 IssueSlip	1817	=head2 IssueSlip
1864		1818
1865	IssueSlip($branchcode, $borrowernumber, $quickslip)	1819	IssueSlip($branchcode, $borrowernumber, $quickslip)

Lines 21-27 use CGI qw ( -utf8 ); Link Here

(-)a/opac/opac-privacy.pl (-11 / +2 lines)
21		21
22	use C4::Auth; # checkauth, getborrowernumber.	22	use C4::Auth; # checkauth, getborrowernumber.
23	use C4::Context;	23	use C4::Context;
24	use C4::Circulation;
25	use C4::Members;	24	use C4::Members;
26	use C4::Output;	25	use C4::Output;
27	use Koha::Patrons;	26	use Koha::Patrons;
Lines 62-77 elsif ( $op eq "delete_record" ) { Link Here
62		61
63	# delete all reading records for items returned	62	# delete all reading records for items returned
64	# uses a hardcoded date ridiculously far in the future	63	# uses a hardcoded date ridiculously far in the future
65	my ( $rows, $err_history_not_deleted ) =	64	my $rows = Koha::Patrons->search({ borrowernumber => $borrowernumber })->anonymise_issue_history( '2999-12-12' );
66	AnonymiseIssueHistory( '2999-12-12', $borrowernumber );	65	$template->param( 'deleted' => $rows );
67
68	# confirm the user the deletion has been done
69	if ( !$err_history_not_deleted ) {
70	$template->param( 'deleted' => 1 );
71	}
72	else {
73	$template->param( 'err_history_not_deleted' => 1 );
74	}
75	}	66	}
76		67
77	# get borrower privacy ....	68	# get borrower privacy ....

Lines 38-46 use CGI qw ( -utf8 ); Link Here

(-)a/tools/cleanborrowers.pl (-9 / +7 lines)
38	use C4::Auth;	38	use C4::Auth;
39	use C4::Output;	39	use C4::Output;
40	use C4::Members; # GetBorrowersWhoHavexxxBorrowed.	40	use C4::Members; # GetBorrowersWhoHavexxxBorrowed.
41	use C4::Circulation; # AnonymiseIssueHistory.
42	use Koha::DateUtils qw( dt_from_string output_pref );	41	use Koha::DateUtils qw( dt_from_string output_pref );
43	use Date::Calc qw/Today Add_Delta_YM/;	42	use Date::Calc qw/Today Add_Delta_YM/;
		43	use Koha::Patrons;
44	use Koha::List::Patron;	44	use Koha::List::Patron;
45		45
46	my $cgi = new CGI;	46	my $cgi = new CGI;
Lines 95-108 if ( $step == 2 ) { Link Here
95	}	95	}
96	_skip_borrowers_with_nonzero_balance($patrons_to_delete);	96	_skip_borrowers_with_nonzero_balance($patrons_to_delete);
97		97
98	my $members_to_anonymize;	98	my $patrons_to_anonymize = $checkboxes{issue}
99	if ( $checkboxes{issue} ) {	99	? Koha::Patrons->search_patrons_to_anonymise( $last_issue_date )
100	$members_to_anonymize = GetBorrowersWithIssuesHistoryOlderThan($last_issue_date);	100	: undef;
101	}
102		101
103	$template->param(	102	$template->param(
104	patrons_to_delete => $patrons_to_delete,	103	patrons_to_delete => $patrons_to_delete,
105	patrons_to_anonymize => $members_to_anonymize,	104	patrons_to_anonymize => $patrons_to_anonymize,
106	patron_list_id => $patron_list_id,	105	patron_list_id => $patron_list_id,
107	);	106	);
108	}	107	}
Lines 141-149 elsif ( $step == 3 ) { Link Here
141	# Anonymising all members	140	# Anonymising all members
142	if ($do_anonym) {	141	if ($do_anonym) {
143	#FIXME: anonymisation errors are not handled	142	#FIXME: anonymisation errors are not handled
144	($totalAno,my $anonymisation_error) = AnonymiseIssueHistory($last_issue_date);	143	my $rows = Koha::Patrons->search_patrons_to_anonymise( $last_issue_date )->anonymise_issue_history( $last_issue_date );
145	$template->param(	144	$template->param(
146	do_anonym => '1',	145	do_anonym => $rows,
147	);	146	);
148	}	147	}
149		148
150	-

Lines 1-6 Link Here

(-)a/Koha/Patrons.pm (-1 / +58 lines)
1	package Koha::Patrons;	1	package Koha::Patrons;
2		2
3	# Copyright ByWater Solutions 2014	3	# Copyright 2014 ByWater Solutions
		4	# Copyright 2016 Koha Development Team
4	#	5	#
5	# This file is part of Koha.	6	# This file is part of Koha.
6	#	7	#
Lines 22-27 use Modern::Perl; Link Here
22	use Carp;	23	use Carp;
23		24
24	use Koha::Database;	25	use Koha::Database;
		26	use Koha::DateUtils;
25		27
26	use Koha::Patron;	28	use Koha::Patron;
27		29
Lines 37-42 Koha::Patron - Koha Patron Object class Link Here
37		39
38	=cut	40	=cut
39		41
		42	=head3 search_patrons_to_anonymise
		43
		44	my $patrons = Koha::Patrons->search_patrons_to_anonymise( $date );
		45
		46	This method returns all patrons who has an issue history older than a given date.
		47
		48	=cut
		49
		50	sub search_patrons_to_anonymise {
		51	my ( $class, $older_than_date ) = @_;
		52	$older_than_date = $older_than_date ? dt_from_string($older_than_date) : dt_from_string;
		53	my $library =
		54	( C4::Context->preference('IndependentBranches') && C4::Context->userenv && !C4::Context->IsSuperLibrarian() && C4::Context->userenv->{branch} )
		55	? C4::Context->userenv->{branch}
		56	: undef;
		57
		58	my $dtf = Koha::Database->new->schema->storage->datetime_parser;
		59	my $rs = $class->search(
		60	{ returndate => { '<' => $dtf->format_datetime($older_than_date), },
		61	'old_issues.borrowernumber' => { 'not' => undef },
		62	privacy => { '<>' => 0 }, # Keep forever
		63	( $library ? ( 'old_issues.branchcode' => $library ) : () ),
		64	},
		65	{ join => ["old_issues"],
		66	group_by => 'borrowernumber'
		67	}
		68	);
		69	return Koha::Patrons->_new_from_dbic($rs);
		70	}
		71
		72	=head3 anonymise_issue_history
		73
		74	Koha::Patrons->search->anonymise_issue_history( $older_than_date );
		75
		76	Anonymise issue history (old_issues) for all patrons older than the given date.
		77	To make sure all the conditions are met, the caller has the responsability to
		78	call search_patrons_to_anonymise to filter the Koha::Patrons set
		79
		80	=cut
		81
		82	sub anonymise_issue_history {
		83	my ( $self, $older_than_date ) = @_;
		84
		85	return unless $older_than_date;
		86	$older_than_date = dt_from_string $older_than_date;
		87
		88	# The default of 0 does not work due to foreign key constraints
		89	# The anonymisation should not fail quietly if AnonymousPatron is not a valid entry
		90	# Set it to undef (NULL)
		91	my $dtf = Koha::Database->new->schema->storage->datetime_parser;
		92	my $old_issues_to_anonymise = $self->search_related( 'old_issues', { returndate => { '<' => $dtf->format_datetime($older_than_date) } } );
		93	my $anonymous_patron = C4::Context->preference('AnonymousPatron') \|\| undef;
		94	$old_issues_to_anonymise->update( { 'old_issues.borrowernumber' => $anonymous_patron } );
		95	}
		96
40	=head3 type	97	=head3 type
41		98
42	=cut	99	=cut