From c3220411e21961f8f326eb5bb9985f169e5515a2 Mon Sep 17 00:00:00 2001 From: Nick Clemens Date: Wed, 15 Feb 2017 16:34:04 +0000 Subject: [PATCH] Bug 17168: Add a command line script for updating patron category based on status This patch adds a new script update_patrons_category.pl which allows for updating patron categories in a batch upon meeting provided criteria. This script additionally can replace j2a.pl. To test: 1 - perl update_patrons_category.pl -h 2 - Ensure help text makes sense and covers all options 3 - Test converting patrons supplying only fromcat and tocat perl update_patrons_category.pl -f PT -t J -v --confirm perl update_patrons_category.pl -f J -t PT -v --confirm 4 - All patrons should have been switched to and from Juveniles 5 - Try without --confirm switch perl update_patrons_category.pl -f PT -t J -v 6 - Should list all patrons but not update 7 - Set the age for juvenile patrons to be outside the range provided in categories (or set the upper age limit for juveniles to '2') 8 - Test with verbosity and with without --confirm perl update_patrons_category.pl -f J -a -t PT -v perl update_patrons_category.pl -f J -a -t PT -v --confirm 9 - Repeat above and verify linked/unlinked guarantors are removed in above scenario 10 - Test various fine and registration limits 11 - Test matching on specific fields i.e. --field surname=acosta 12 - Sign off Sponsored by: Round Rock Public Library (https://www.roundrocktexas.gov/departments/library/) Signed-off-by: Jesse Maseto --- Koha/Patrons.pm | 88 +++++++++++ misc/cronjobs/update_patrons_category.pl | 259 +++++++++++++++++++++++++++++++ t/db_dependent/Patrons.t | 96 +++++++++++- 3 files changed, 442 insertions(+), 1 deletion(-) create mode 100644 misc/cronjobs/update_patrons_category.pl diff --git a/Koha/Patrons.pm b/Koha/Patrons.pm index dedf4c4a65..3a083fe685 100644 --- a/Koha/Patrons.pm +++ b/Koha/Patrons.pm @@ -29,6 +29,8 @@ use Koha::ArticleRequests; use Koha::ArticleRequest::Status; use Koha::Patron; use Koha::Exceptions::Patron; +use Koha::Patron::Categories; +use Date::Calc qw( Today Add_Delta_YMD ); use base qw(Koha::Objects); @@ -236,6 +238,92 @@ sub delete { return $patrons_deleted; } +=head3 search_patrons_to_update + + my $patrons = Koha::Patrons->search_patrons_to_anonymise( { + from => $from_category, + fine_max => $fine_max, + fine_min => $fin_min, + au => $au, + ao => $ao, + }); + +This method returns all patron who should be updated form one category to another meeting criteria: + +from - original category +fine_min - with fines totaling at least this amount +fine_max - with fines above this amount +au - under the age limit for 'from' +ao - over the agelimit for 'from' + +=cut + +sub search_patrons_to_update { + my ( $self, $params ) = @_; + my %query; + my $search_params = $params->{search_params};; + + my $cat_from = Koha::Patron::Categories->find($params->{from}); + $search_params->{categorycode}=$params->{from}; + if ($params->{ao} || $params->{au}){ + my ($y,$m,$d) = Today(); + if( $cat_from->dateofbirthrequired && $params->{au} ) { + my ($dy,$dm,$dd) =Add_Delta_YMD($y,$m,$d,-$cat_from->dateofbirthrequired,0,0); + $search_params->{dateofbirth}{'>'} = $dy."-".sprintf("%02d",$dm)."-".sprintf("%02d",$dd); + } + if( $cat_from->upperagelimit && $params->{ao} ) { + my ($dy,$dm,$dd) =Add_Delta_YMD($y,$m,$d,-$cat_from->upperagelimit,0,0); + $search_params->{dateofbirth}{'<'} = $dy."-".sprintf("%02d",$dm)."-".sprintf("%02d",$dd); + } + } + if ($params->{fine_min} || $params->{fine_max}) { + $query{join} = ["accountlines"]; + $query{select} = ["borrowernumber", { sum => 'amountoutstanding', -as => 'total_fines'} ]; + $query{as} = [qw/borrowernumber total_fines/]; + $query{group_by} = ["borrowernumber"]; + $query{having}{total_fines}{'<='}=$params->{fine_max} if defined $params->{fine_max}; + $query{having}{total_fines}{'>='}=$params->{fine_min} if defined $params->{fine_min}; + } + return Koha::Patrons->search($search_params,\%query); +} + +=head3 update_category + + Koha::Patrons->search->update_category( { + to => $to, + }); + +Update supplied patrons from one category to another and take care of guarantor info. +To make sure all the conditions are met, the caller has the responsibility to +call search_patrons_to_update to filter the Koha::Patrons set + +=cut + +sub update_category { + my ( $self, $params ) = @_; + my $to = $params->{to}; + + my $to_cat = Koha::Patron::Categories->find($to); + return unless $to_cat; + + my $counter = 0; + my $remove_guarantor = ( $to_cat->category_type ne 'C' || $to_cat->category_type ne 'P' ) ? 1 : 0; + while( my $patron = $self->next ) { + $counter++; + if ( $remove_guarantor && ($patron->category->category_type eq 'C' || $patron->category->category_type eq 'P') ) { + $patron->guarantorid(0); + $patron->contactname(''); + $patron->contactfirstname(''); + $patron->contacttitle(''); + $patron->relationship(''); + } + $patron->categorycode($to); + $patron->store(); + } + return $counter; +>>>>>>> Bug 17168: Add a command line script for updating patron category based on status +} + =head3 _type =cut diff --git a/misc/cronjobs/update_patrons_category.pl b/misc/cronjobs/update_patrons_category.pl new file mode 100644 index 0000000000..c49cb0cc7e --- /dev/null +++ b/misc/cronjobs/update_patrons_category.pl @@ -0,0 +1,259 @@ +#!/usr/bin/perl + +# This file is part of Koha. +# +# Koha is free software; you can redistribute it and/or modify it +# under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 3 of the License, or +# (at your option) any later version. +# +# Koha is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with Koha; if not, see . + +use Modern::Perl; + +BEGIN { + # find Koha's Perl modules + # test carefully before changing this + use FindBin; + eval { require "$FindBin::Bin/../kohalib.pl" }; +} + +use C4::Context; +use Getopt::Long; +use Pod::Usage; +use Koha::Logger; +use Koha::Patrons; +use Koha::Patron::Categories; +use Koha::DateUtils; +use Data::Dumper; + +=head1 NAME + +update_patrons_category.pl - Given a set of parameters update selected patrons from one catgeory to another. Options are cumulative. + +=head1 SYNOPSIS + +update_patrons_category.pl -f=categorycode -t=categorycode + [-b=branchcode] [-au] [-ao] [-fo=X] [-fu=X] + [-rb=date] [-ra=date] [-v] + [--field column=value ...] + +update_patrons_category.pl --help | --man + +Options: + --help brief help message + --man full documentation + -ao update if over maximum age for current category + -au update if under minimuum age current category + -fo=X update if fines over X amount + -fu=X update if fines under X amount + -rb=date update if registration date is before given date + -ra=date update if registration date is after a given date + --field name=value where is a column in the borrowers table, patrons will be updated if the field is equal to given + -v verbose mode + -confirm commit changes to db, no action will be taken unless this switch is included + -b only deal with patrons from this library/branch + -f change patron category from this category + -t change patron category to this category + +=head1 OPTIONS + +=over 8 + +=item B<--help> + +Print a brief help message and exits. + +=item B<--man> + +Prints the manual page and exits. + +=item B<-v> + +Verbose. Without this flag set, only fatal errors are reported. + +=item B<--confirm> + +Commit changes. Unless this flag set is, the script will report changes but not actually execute them on the database. + +=item B<-b> + +changes patrons for one specific branch. Use the value in the +branches.branchcode table. + +=item B<-f> + +*required* defines the category to update. Expects the code from categories.categorycode. + +=item B<-t> + +*required* defines the category patrons will be converted to. Expects the code from categories.categorycode. + +=item B<-ao> + +Update patron only if they are above the maximum age range specified for the 'from' category. + +=item B<-au> + +Update patron only if they are below the minimum age range specified for the 'from' category. + +=item B<-fo=X> + +Supply a number and only account with fines over this number will be updated. + +=item B<-fu=X> + +Supply a number and only account with fines under this number will be updated. + +=item B<-rb=date> + +Enter a date in ISO format YYYY-MM-DD and only patrons registered before this date wil be updated. + +=item B<-ra=date> + +Enter a date in ISO format YYYY-MM-DD and only patrons registered after this date wil be updated. + +=item B<--field column=value> + +Use this flag to specify a column in the borrowers table and update only patrons whose value in that column matches the value supplied (repeatable) + +e.g. +--field dateexpiry=2016-01-01 +will update all patrons who expired on that date, useful for schools etc. + +=back + +=head1 DESCRIPTION + +This script is designed to update patrons from one category to another. + +=head1 USAGE EXAMPLES + +C - Suggests that you read this help. :) + +C -b= -f= -t= --confirm - Processes a single branch, and updates the patron categories from fromcat to tocat. + +C -b= -f= -t= -a --confirm - Processes a single branch, and updates the patron categories from fromcat to tocat for patrons outside the age range of fromcat. + +C -f= -t= -v - Processes all branches, shows all messages, and reports the patrons who would be affected. Takes no action on the database. + +=cut + +# These variables are set by command line options. +# They are initially set to default values. + +my $help = 0; +my $man = 0; +my $verbose = 0; +my $doit = 0; +my $au; +my $ao; +my $min_dob; +my $max_dob; +my $remove_guarantors = 0; +my $fine_min; +my $fine_max; +my $fromcat; +my $tocat; +my $reg_bef; +my $reg_aft; +my $branch_lim; +my %fields; + +GetOptions( + 'help|?' => \$help, + 'man' => \$man, + 'v' => \$verbose, + 'confirm' => \$doit, + 'f=s' => \$fromcat, + 't=s' => \$tocat, + 'ao' => \$ao, + 'au' => \$au, + 'fo=s' => \$fine_min, + 'fu=s' => \$fine_max, + 'rb=s' => \$reg_bef, + 'ra=s' => \$reg_aft, + 'b=s' => \$branch_lim, + 'field=s' => \%fields +) or pod2usage(2); +pod2usage(1) if $help; +pod2usage( -verbose => 2 ) if $man; + +if ( not $fromcat && $tocat ) { #make sure we've specified the info we need. + print "Must supply category from and to (-f & -t) please specify -help for usage tips.\n"; + exit; +} + +($verbose && !$doit) and print "No actions will be taken (test mode)\n"; + +$verbose and print "Will update patrons from $fromcat to $tocat with conditions below (if any)\n"; + +my %params; + +if ( $reg_bef || $reg_aft ){ + my $date_bef; + my $date_aft; + if (defined $reg_bef) {eval { $date_bef = dt_from_string( $reg_bef, 'iso' ); };} + die "$reg_bef is not a valid date before, aborting! Use a date in format YYYY-MM-DD.$@" + if $@; + if (defined $reg_aft) {eval { $date_aft = dt_from_string( $reg_aft, 'iso' ); };} + die "$reg_bef is not a valid date after, aborting! Use a date in format YYYY-MM-DD.$@" + if $@; + $params{dateenrolled}{'<='}=$reg_bef if defined $date_bef; + $params{dateenrolled}{'>='}=$reg_aft if defined $date_aft; +} + +my $cat_from = Koha::Patron::Categories->find($fromcat); +my $cat_to = Koha::Patron::Categories->find($tocat); +die "Categories not found" unless $cat_from && $cat_to; + +$params{"me.categorycode"} = $fromcat; +$params{"me.branchcode"} = $branch_lim if $branch_lim; + +if ($verbose) { + print "Conditions:\n"; + print " Registered before $reg_bef\n" if $reg_bef; + print " Registered after $reg_aft\n" if $reg_aft; + print " Total fines more than $fine_min\n" if $fine_min; + print " Total fines less than $fine_max\n" if $fine_max; + print " Age below minimum for ".$cat_from->description."\n" if $au; + print " Age above maximum for ".$cat_from->description."\n" if $ao; + if (defined $branch_lim) { + print " Branchcode of patron is $branch_lim\n"; + } +} + +while (my ($key,$value) = each %fields ) { + $verbose and print " Borrower column $key is equal to $value\n"; + $params{"me.".$key} = $value; +} + +my $target_patrons = Koha::Patrons->search_patrons_to_update({ + from => $fromcat, + search_params => \%params, + au => $au, + ao => $ao, + fine_min => $fine_min, + fine_max => $fine_max, + }); +my $patrons_found = $target_patrons->count; +my $actually_updated = 0; +my $testdisplay = $doit ? "" : "WOULD HAVE "; +if ( $verbose ) { + while ( my $target_patron = $target_patrons->next() ){ + my $target = Koha::Patrons->find( $target_patron->borrowernumber ); + $verbose and print $testdisplay."Updated ".$target->firstname." ".$target->surname." from $fromcat to $tocat\n"; + } + $target_patrons->reset; +} +if ( $doit ) { + $actually_updated = $target_patrons->update_category({to=>$tocat}); +} + +$verbose and print "$patrons_found found, $actually_updated updated\n"; diff --git a/t/db_dependent/Patrons.t b/t/db_dependent/Patrons.t index f0d116a7bc..0e842c0464 100755 --- a/t/db_dependent/Patrons.t +++ b/t/db_dependent/Patrons.t @@ -17,7 +17,7 @@ use Modern::Perl; -use Test::More tests => 17; +use Test::More tests => 18; use Test::Warn; use C4::Context; @@ -104,5 +104,99 @@ foreach my $b ( $patrons->as_list() ) { is( $b->categorycode(), $categorycode, "Iteration returns a patron object" ); } +subtest "Update patron categories" => sub { + plan tests => 23; + $builder->schema->resultset( 'Issue' )->delete_all; + $builder->schema->resultset( 'Borrower' )->delete_all; + $builder->schema->resultset( 'Category' )->delete_all; + my $c_categorycode = $builder->build({ source => 'Category', value => { + category_type=>'C', + upperagelimit=>17, + dateofbirthrequired=>5, + } })->{categorycode}; + my $a_categorycode = $builder->build({ source => 'Category', value => {category_type=>'A'} })->{categorycode}; + my $p_categorycode = $builder->build({ source => 'Category', value => {category_type=>'P'} })->{categorycode}; + my $i_categorycode = $builder->build({ source => 'Category', value => {category_type=>'I'} })->{categorycode}; + my $branchcode1 = $builder->build({ source => 'Branch' })->{branchcode}; + my $branchcode2 = $builder->build({ source => 'Branch' })->{branchcode}; + my $adult1 = $builder->build({source => 'Borrower', value => { + categorycode=>$a_categorycode, + branchcode=>$branchcode1, + dateenrolled=>'2018-01-01', + sort1 =>'quack', + } + }); + my $adult2 = $builder->build({source => 'Borrower', value => { + categorycode=>$a_categorycode, + branchcode=>$branchcode2, + dateenrolled=>'2017-01-01', + } + }); + my $inst = $builder->build({source => 'Borrower', value => { + categorycode=>$i_categorycode, + branchcode=>$branchcode2, + } + }); + my $prof = $builder->build({source => 'Borrower', value => { + categorycode=>$p_categorycode, + branchcode=>$branchcode2, + guarantorid=>$inst->{borrowernumber}, + } + }); + my $child1 = $builder->build({source => 'Borrower', value => { + dateofbirth => dt_from_string->add(years=>-4), + categorycode=>$c_categorycode, + guarantorid=>$adult1->{borrowernumber}, + branchcode=>$branchcode1, + } + }); + my $child2 = $builder->build({source => 'Borrower', value => { + dateofbirth => dt_from_string->add(years=>-8), + categorycode=>$c_categorycode, + guarantorid=>$adult1->{borrowernumber}, + branchcode=>$branchcode1, + } + }); + my $child3 = $builder->build({source => 'Borrower', value => { + dateofbirth => dt_from_string->add(years=>-18), + categorycode=>$c_categorycode, + guarantorid=>$adult1->{borrowernumber}, + branchcode=>$branchcode1, + } + }); + $builder->build({source=>'Accountline',value => {amountoutstanding=>4.99,borrowernumber=>$adult1->{borrowernumber}}}); + $builder->build({source=>'Accountline',value => {amountoutstanding=>5.01,borrowernumber=>$adult2->{borrowernumber}}}); + + is( Koha::Patrons->search_patrons_to_update({from=>$c_categorycode})->count,3,'Three patrons in child category'); + is( Koha::Patrons->search_patrons_to_update({from=>$c_categorycode,au=>1})->count,1,'One under age patron in child category'); + is( Koha::Patrons->search_patrons_to_update({from=>$c_categorycode,au=>1})->next->borrowernumber,$child1->{borrowernumber},'Under age patron in child category is expected one'); + is( Koha::Patrons->search_patrons_to_update({from=>$c_categorycode,ao=>1})->count,1,'One over age patron in child category'); + is( Koha::Patrons->search_patrons_to_update({from=>$c_categorycode,ao=>1})->next->borrowernumber,$child3->{borrowernumber},'Over age patron in child category is expected one'); + is( Koha::Patrons->search_patrons_to_update({from=>$a_categorycode,search_params=>{branchcode=>$branchcode2}})->count,1,'One patron in branch 2'); + is( Koha::Patrons->search_patrons_to_update({from=>$a_categorycode,search_params=>{branchcode=>$branchcode2}})->next->borrowernumber,$adult2->{borrowernumber},'Adult patron in branch 2 is expected one'); + is( Koha::Patrons->search_patrons_to_update({from=>$a_categorycode,fine_min=>5})->count,1,'One patron with fines over $5'); + is( Koha::Patrons->search_patrons_to_update({from=>$a_categorycode,fine_min=>5})->next->borrowernumber,$adult2->{borrowernumber},'One patron with fines over $5 is expected one'); + is( Koha::Patrons->search_patrons_to_update({from=>$a_categorycode,fine_max=>5})->count,1,'One patron with fines under $5'); + is( Koha::Patrons->search_patrons_to_update({from=>$a_categorycode,fine_max=>5})->next->borrowernumber,$adult1->{borrowernumber},'One patron with fines under $5 is expected one'); + + is( Koha::Patrons->search_patrons_to_update({from=>$a_categorycode,search_params=>{dateenrolled=>{'<'=>'2018-01-01'}}})->count,1,'One adult patron enrolled before date'); + is( Koha::Patrons->search_patrons_to_update({from=>$a_categorycode,search_params=>{dateenrolled=>{'<'=>'2018-01-01'}}})->next->borrowernumber,$adult2->{borrowernumber},'One adult patron enrolled before date is expected one'); + is( Koha::Patrons->search_patrons_to_update({from=>$a_categorycode,search_params=>{dateenrolled=>{'>'=>'2017-01-01'}}})->count,1,'One adult patron enrolled after date'); + is( Koha::Patrons->search_patrons_to_update({from=>$a_categorycode,search_params=>{dateenrolled=>{'>'=>'2017-01-01'}}})->next->borrowernumber,$adult1->{borrowernumber},'One adult patron enrolled after date is expected one'); + is( Koha::Patrons->search_patrons_to_update({from=>$a_categorycode,search_params=>{'sort1'=>'quack'}})->count,1,'One adult patron has a quack'); + is( Koha::Patrons->search_patrons_to_update({from=>$a_categorycode,search_params=>{'sort1'=>'quack'}})->next->borrowernumber,$adult1->{borrowernumber},'One adult patron with a quack is expected one'); + + is( Koha::Patrons->find($adult1->{borrowernumber})->guarantees->count,3,'Guarantor has 3 guarantees'); + is( Koha::Patrons->search_patrons_to_update({from=>$c_categorycode,au=>1})->update_category({to=>$a_categorycode}),1,'One child patron updated to adult category'); + is( Koha::Patrons->find($adult1->{borrowernumber})->guarantees->count,2,'Guarantee was removed when made adult'); + + is( Koha::Patrons->find($inst->{borrowernumber})->guarantees->count,1,'Guarantor has 1 guarantees'); + is( Koha::Patrons->search_patrons_to_update({from=>$p_categorycode})->update_category({to=>$a_categorycode}),1,'One professional patron updated to adult category'); + is( Koha::Patrons->find($inst->{borrowernumber})->guarantees->count,0,'Guarantee was removed when made adult'); + +}; + + + $schema->storage->txn_rollback(); -- 2.11.0