Bug 15429 - sub _parseletter should not change referenced values
[koha.git] / misc / cronjobs / j2a.pl
blob4000b6a49c562870ee05ace45d40e8e318fd96b3
1 #!/usr/bin/perl
3 # 2011 Liz Rea - Northeast Kansas Library System <lrea@nekls.org>
5 # This file is part of Koha.
7 # Koha is free software; you can redistribute it and/or modify it
8 # under the terms of the GNU General Public License as published by
9 # the Free Software Foundation; either version 3 of the License, or
10 # (at your option) any later version.
12 # Koha is distributed in the hope that it will be useful, but
13 # WITHOUT ANY WARRANTY; without even the implied warranty of
14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 # GNU General Public License for more details.
17 # You should have received a copy of the GNU General Public License
18 # along with Koha; if not, see <http://www.gnu.org/licenses>.
20 use strict;
21 use warnings;
23 BEGIN {
24 # find Koha's Perl modules
25 # test carefully before changing this
26 use FindBin;
27 eval { require "$FindBin::Bin/../kohalib.pl" };
31 use C4::Context;
32 use C4::Members;
33 use Getopt::Long;
34 use Pod::Usage;
35 use C4::Log;
37 =head1 NAME
39 juv2adult.pl - convert juvenile/child patrons from juvenile patron category and category code to corresponding adult patron category and category code when they reach the upper age limit defined in the Patron Categories.
41 =head1 SYNOPSIS
43 juv2adult.pl [ -b=<branchcode> -f=<categorycode> -t=<categorycode> ]
45 Options:
46 --help brief help message
47 --man full documentation
48 -v verbose mode
49 -n take no action, display only
50 -b <branchname> only deal with patrons from this library/branch
51 -f <categorycode> change patron category from this category
52 -t <categorycode> change patron category to this category
53 =head1 OPTIONS
55 =over 8
57 =item B<--help>
59 Print a brief help message and exits.
61 =item B<--man>
63 Prints the manual page and exits.
65 =item B<-v>
67 Verbose. Without this flag set, only fatal errors are reported.
69 =item B<-n>
71 No Action. With this flag set, script will report changes but not actually execute them on the database.
73 =item B<-b>
75 changes patrons for one specific branch. Use the value in the
76 branches.branchcode table.
78 =item B<-f>
80 *required* defines the juvenile category to update. Expects the code from categories.categorycode.
82 =item B<-t>
84 *required* defines the category juvenile patrons will be converted to. Expects the code from categories.categorycode.
86 =back
88 =head1 DESCRIPTION
90 This script is designed to update patrons from juvenile to adult patron types, remove the guarantor, and update their category codes appropriately when they reach the upper age limit defined in the Patron Categories.
92 =head1 USAGE EXAMPLES
94 C<juv2adult.pl> - Suggests that you read this help. :)
96 C<juv2adult.pl> -b=<branchcode> -f=<categorycode> -t=<categorycode> - Processes a single branch, and updates the patron categories from fromcat to tocat.
98 C<juv2adult.pl> -f=<categorycode> -t=<categorycode> -v -n - Processes all branches, shows all messages, and reports the patrons who would be affected. Takes no action on the database.
99 =cut
101 # These variables are set by command line options.
102 # They are initially set to default values.
105 my $help = 0;
106 my $man = 0;
107 my $verbose = 0;
108 my $noaction = 0;
109 my $mybranch;
110 my $fromcat;
111 my $tocat;
113 GetOptions(
114 'help|?' => \$help,
115 'man' => \$man,
116 'v' => \$verbose,
117 'n' => \$noaction,
118 'f=s' => \$fromcat,
119 't=s' => \$tocat,
120 'b=s' => \$mybranch,
121 ) or pod2usage(2);
122 pod2usage(1) if $help;
123 pod2usage( -verbose => 2 ) if $man;
125 if(not $fromcat && $tocat) { #make sure we've specified the info we need.
126 print "please specify -help for usage tips.\n";
127 exit;
130 cronlogaction();
132 my $dbh=C4::Context->dbh;
133 my @branches = C4::Branch::GetBranches();
134 #get today's date, format it and subtract upperagelimit
135 my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
136 $year +=1900;
137 $mon +=1; if ($mon < 10) {$mon = "0".$mon;}
138 if ($mday < 10) {$mday = "0".$mday;}
139 # get the upperagelimit from the category to be transitioned from
140 my $query=qq|SELECT upperagelimit from categories where categorycode =?|;
141 my $sth=$dbh->prepare( $query );
142 $sth->execute( $fromcat )
143 or die "Couldn't execute statement: " . $sth->errstr;
144 my $agelimit = $sth->fetchrow_array();
145 if ( not $agelimit ) {
147 die "No patron category $fromcat. Please try again. \n";
149 $query=qq|SELECT categorycode from categories where categorycode=?|;
150 $sth=$dbh->prepare( $query );
151 $sth->execute( $tocat )
152 or die "Couldn't execute statement: " . $sth->errstr;
153 my $tocatage = $sth->fetchrow_array();
154 if ( not $tocatage ){
155 die "No patron category $tocat. Please try again. \n";
157 $sth->finish( );
158 $year -=$agelimit;
160 $verbose and print "The age limit for category $fromcat is $agelimit\n";
162 my $itsyourbirthday = "$year-$mon-$mday";
165 if ( not $noaction) {
166 if ( $mybranch ) { #yep, we received a specific branch to work on.
167 $verbose and print "Looking for patrons of $mybranch to update from $fromcat to $tocat that were born before $itsyourbirthday\n";
168 my $query=qq|UPDATE borrowers
169 SET guarantorid ='0',
170 categorycode =?
171 WHERE dateofbirth<=?
172 AND dateofbirth!='0000-00-00'
173 AND branchcode=?
174 AND categorycode IN (select categorycode from categories where category_type='C' and categorycode=?)|;
175 my $sth=$dbh->prepare($query);
176 my $res = $sth->execute( $tocat, $itsyourbirthday, $mybranch, $fromcat ) or die "can't execute";
177 if ($res eq '0E0') { print "No patrons updated\n";
178 } else { print "Updated $res patrons\n"; }
179 } else { # branch was not supplied, processing all branches
180 $verbose and print "Looking in all branches for patrons to update from $fromcat to $tocat that were born before $itsyourbirthday\n";
181 foreach my $branchcode (@branches) {
182 my $query=qq|UPDATE borrowers
183 SET guarantorid ='0',
184 categorycode =?
185 WHERE dateofbirth<=?
186 AND dateofbirth!='0000-00-00'
187 AND categorycode IN (select categorycode from categories where category_type='C' and categorycode=?)|;
188 my $sth=$dbh->prepare($query);
189 my $res = $sth->execute( $tocat, $itsyourbirthday, $fromcat ) or die "can't execute";
190 if ($res eq '0E0') { print "No patrons updated\n";
191 } else { print "Updated $res patrons\n"; }
194 } else {
195 my $birthday;
196 if ( $mybranch ) {
197 $verbose and print "Displaying patrons that would be updated from $fromcat to $tocat from $mybranch\n";
198 my $query=qq|SELECT firstname,
199 surname,
200 cardnumber,
201 dateofbirth
202 FROM borrowers
203 WHERE dateofbirth<=?
204 AND dateofbirth!='0000-00-00'
205 AND branchcode=?
206 AND categorycode IN (select categorycode from categories where category_type='C' and categorycode=?)|;
207 my $sth=$dbh->prepare( $query );
208 $sth->execute( $itsyourbirthday, $mybranch, $fromcat )
209 or die "Couldn't execute statement: " . $sth->errstr;
210 while ( my @res = $sth->fetchrow_array()) {
211 my $firstname = $res[0];
212 my $surname = $res[1];
213 my $barcode = $res[2];
214 $birthday = $res[3];
215 print "$firstname $surname $barcode $birthday\n";
217 } else {
218 $verbose and print "Displaying patrons that would be updated from $fromcat to $tocat.\n";
219 my $query=qq|SELECT firstname,
220 surname,
221 cardnumber,
222 dateofbirth
223 FROM borrowers
224 WHERE dateofbirth<=?
225 AND dateofbirth!='0000-00-00'
226 AND categorycode IN (select categorycode from categories where category_type='C' and categorycode=?)|;
227 my $sth=$dbh->prepare( $query );
228 $sth->execute( $itsyourbirthday, $fromcat )
229 or die "Couldn't execute statement: " . $sth->errstr;
230 while ( my @res = $sth->fetchrow_array()) {
231 my $firstname = $res[0];
232 my $surname = $res[1];
233 my $barcode = $res[2];
234 $birthday = $res[3];
235 print "$firstname $surname $barcode $birthday\n";
238 $sth->finish( );