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

(-)a/misc/cronjobs/longoverdue.pl (-44 / +68 lines)
Lines 39-44 use C4::Circulation qw/LostItem/; Link Here
39
use Getopt::Long;
39
use Getopt::Long;
40
use C4::Log;
40
use C4::Log;
41
use Pod::Usage;
41
use Pod::Usage;
42
use Koha::Borrowers;
42
43
43
my  $lost;  #  key=lost value,  value=num days.
44
my  $lost;  #  key=lost value,  value=num days.
44
my ($charge, $verbose, $confirm, $quiet);
45
my ($charge, $verbose, $confirm, $quiet);
Lines 48-84 my $borrower_category = []; Link Here
48
my $skip_borrower_category = [];
49
my $skip_borrower_category = [];
49
my $help=0;
50
my $help=0;
50
my $man=0;
51
my $man=0;
52
my $list_categories = 0;
51
53
52
GetOptions(
54
GetOptions(
53
    'lost=s%'         => \$lost,
55
    'lost=s%'         => \$lost,
54
    'c|charge=s'      => \$charge,
56
    'c|charge=s'      => \$charge,
55
    'confirm'         => \$confirm,
57
    'confirm'         => \$confirm,
56
    'verbose'         => \$verbose,
58
    'v|verbose'         => \$verbose,
57
    'quiet'           => \$quiet,
59
    'quiet'           => \$quiet,
58
    'maxdays=s'       => \$endrange,
60
    'maxdays=s'       => \$endrange,
59
    'mark-returned'   => \$mark_returned,
61
    'mark-returned'   => \$mark_returned,
60
    'help'            => \$help,
62
    'h|help'            => \$help,
61
    'man|manual'      => \$man,
63
    'man|manual'      => \$man,
62
    'category=s'      => $borrower_category,
64
    'category=s'      => $borrower_category,
63
    'skip-category=s' => $skip_borrower_category
65
    'skip-category=s' => $skip_borrower_category,
66
    'list-categories' => \$list_categories,
64
);
67
);
65
68
66
if ( $man ) {
69
if ( $man ) {
67
    pod2usage( -verbose => 2 );
70
    pod2usage( -verbose => 2 
68
    exit;
71
               -exitval => 0
72
            );
69
}
73
}
70
74
71
if ( $help ) {
75
if ( $help ) {
72
    pod2usage(1);
76
    pod2usage( -verbose => 1,
73
    exit;
77
               -exitval => 0
78
            );
79
}
80
81
if ( scalar @$borrower_category && scalar @$skip_borrower_category) {
82
    pod2usage( -verbose => 1, 
83
               -message => "The options --category and --skip-category are muually exclusive.\n"
84
                           . "Use one or the other.", 
85
               -exitval => 1
86
            );
87
}
88
89
if ( $list_categories ) {
90
    my @categories = sort map { uc $_->[0] } @{ C4::Context->dbh->selectall_arrayref(q|SELECT categorycode FROM categories|) };
91
    print "\nBorrowrer Categories: " . join( " ", @categories ) . "\n\n"; 
92
    exit 0;
74
}
93
}
75
94
76
=head1 SYNOPSIS
95
=head1 SYNOPSIS
77
96
78
   longoverdue.pl [ --help | -h | --man ]
97
   longoverdue.pl [ --help | -h | --man | --list-categories ]
79
   longoverdue.pl --lost | -l DAYS=LOST_CODE [ --charge | -c CHARGE_CODE ] [ --verbose | -v ] [ --quiet ]
98
   longoverdue.pl --lost | -l DAYS=LOST_CODE [ --charge | -c CHARGE_CODE ] [ --verbose | -v ] [ --quiet ]
80
                  [ --maxdays MAX_DAYS ] [ --mark-returned ] [ --category BORROWER_CATEGOERY ] ...
99
                  [ --maxdays MAX_DAYS ] [ --mark-returned ] [ --category BORROWER_CATEGORY ] ...
81
                  [ --skip-category BORROWER_CATEGOERY ] ... [ --commit ]
100
                  [ --skip-category BORROWER_CATEGOERY ] ... 
101
                  [ --commit ]
82
102
83
103
84
WARNING:  Flippant use of this script could set all or most of the items in your catalog to Lost and charge your
104
WARNING:  Flippant use of this script could set all or most of the items in your catalog to Lost and charge your
Lines 125-135 When an item is marked lost, remove it from the borrowers issued items. Link Here
125
145
126
=item B<--category>
146
=item B<--category>
127
147
128
Act on the listed borrower category code (borrowers.categorycode). Exclude all others. This may be specified multiple times to include multiple categories.
148
Act on the listed borrower category code (borrowers.categorycode). 
149
Exclude all others. This may be specified multiple times to include multiple categories.
150
May not be used with B<--skip-category>
129
151
130
=item B<--skip-category>
152
=item B<--skip-category>
131
153
132
Act on all available borrower category codes, except those listed.  This may be specified multiple times, to exclude multiple categories.
154
Act on all available borrower category codes, except those listed.  
155
This may be specified multiple times, to exclude multiple categories.
156
May not be used with B<--category>
157
158
=item B<--list-categories>
159
160
List borrower categories available for use by B<--category> or
161
B<--skip-category>, and exit.
133
162
134
=item B<--help | -h>
163
=item B<--help | -h>
135
164
Lines 141-149 Display entire manual and exit. Link Here
141
170
142
=back
171
=back
143
172
144
All 'category' options will be applied before any 'skip-category' options, meaning that the only categories available to skip
145
are those which have already been specified on the command line.
146
147
=cut
173
=cut
148
174
149
=head1 Description
175
=head1 Description
Lines 184-191 if ( ! defined($lost) ) { Link Here
184
        $lost->{$longoverdue_days} = $longoverdue_value;
210
        $lost->{$longoverdue_days} = $longoverdue_value;
185
    }
211
    }
186
    else {
212
    else {
187
        pod2usage(1);
213
        pod2usage( {
188
        die "ERROR: No --lost (-l) option defined";
214
                -exitval => 1,
215
                -msg => q|ERROR: No --lost (-l) option defined|,
216
        } );
189
    }
217
    }
190
}
218
}
191
if ( ! defined($charge) ) {
219
if ( ! defined($charge) ) {
Lines 223-243 sub longoverdue_sth { Link Here
223
    return C4::Context->dbh->prepare($query);
251
    return C4::Context->dbh->prepare($query);
224
}
252
}
225
253
226
# The following two functions can and should replaced by a call to
254
sub check_user_categories {
227
# Koha::Database.
255
228
sub borrower_categories_sth {
256
    my $categories      = shift;
229
    my $query = "select distinct categorycode from categories";
257
    my $test_categories = shift;
230
    return C4::Context->dbh->prepare($query);
258
    my $category_label  = shift;
231
}
259
    my %good            = map { $_ => 1 } @$categories;
232
260
    my @bad_categories  = grep { ! $good{ uc $_ } } @$test_categories;
233
sub defined_borrower_categories {
261
234
    my $sth = borrower_categories_sth();
262
    if ( scalar @bad_categories ) {
235
    my @categories = ();
263
        my $error = "$category_label: category/categories '"
236
    $sth->execute();
264
                    . join( ' ',  @bad_categories )
237
    CATEGORY: while ( my $row = $sth->fetchrow_hashref ) {
265
                    . "' not in the available borrower cateogories: [ "
238
        push @categories, uc( $row->{categorycode} );
266
                    . join( ' ', @$categories )
267
                    . " ]";
268
        pod2usage(  '-verbose' => 1
269
                  , '-exitval' => 1
270
                  , '-message' => $error
271
                 ); 
239
    }
272
    }
240
    return @categories;
241
}
273
}
242
274
243
# returns a hash of borrower category codes to test for long-overdue-ness.
275
# returns a hash of borrower category codes to test for long-overdue-ness.
Lines 248-279 sub get_borrower_categories { Link Here
248
280
249
    return () unless ( scalar @$borrower_category || scalar @$skip_borrower_category );
281
    return () unless ( scalar @$borrower_category || scalar @$skip_borrower_category );
250
282
251
    my @categories = defined_borrower_categories();
283
    my $dbh = C4::Context->dbh;
284
    my @categories = map { uc $_->[0] } @{ $dbh->selectall_arrayref(q|SELECT categorycode FROM categories|) };
252
    if( @$borrower_category ) {
285
    if( @$borrower_category ) {
286
        check_user_categories( \@categories, $borrower_category, "--category" );
253
        my %borcat  = map { ( uc($_) => 1 ) } @$borrower_category;
287
        my %borcat  = map { ( uc($_) => 1 ) } @$borrower_category;
254
        @categories = grep { $borcat{$_} } @categories;
288
        @categories = grep { $borcat{$_} } @categories;
255
    }
289
    }
256
    if( @$skip_borrower_category ) {
290
    if( @$skip_borrower_category ) {
291
        check_user_categories( \@categories, $skip_borrower_category, "--skip-category" );
257
        my %skip_borcat  = map { ( uc($_) => 1 ) } @$skip_borrower_category;
292
        my %skip_borcat  = map { ( uc($_) => 1 ) } @$skip_borrower_category;
258
        @categories = grep { ! $skip_borcat{$_} } @categories;
293
        @categories = grep { ! $skip_borcat{$_} } @categories;
259
    }
294
    }
260
    return map { $_ => 1 } @categories;
295
    return map { $_ => 1 } @categories;
261
}
296
}
262
297
263
# TODO: category handling should be more user friendly:
264
#       * Warn if a category specified using --category or
265
#         --skip-category is not in the categories table
266
#       * Add --list-categories argument so that you don't
267
#         need to bring up the staff client or koha-mysql to
268
#         find the valid borrower categories.
269
270
my %category_to_process = get_borrower_categories( $borrower_category, $skip_borrower_category );
298
my %category_to_process = get_borrower_categories( $borrower_category, $skip_borrower_category );
271
my $filter_borrower_categories = ( scalar @$borrower_category || scalar @$skip_borrower_category );
299
my $filter_borrower_categories = ( scalar @$borrower_category || scalar @$skip_borrower_category );
272
300
273
#FIXME - Should add a 'system' user and get suitable userenv for it for logging, etc.
274
275
my $count;
301
my $count;
276
# my @ranges = map {
277
my @report;
302
my @report;
278
my $total = 0;
303
my $total = 0;
279
my $i = 0;
304
my $i = 0;
Lines 295-301 foreach my $startrange (sort keys %$lost) { Link Here
295
        $count=0;
320
        $count=0;
296
        ITEM: while (my $row=$sth_items->fetchrow_hashref) {
321
        ITEM: while (my $row=$sth_items->fetchrow_hashref) {
297
            if( $filter_borrower_categories ) {
322
            if( $filter_borrower_categories ) {
298
                my $category = uc Koha::Database->new()->schema->resultset('Borrower')->find( $row->{borrowernumber} )->get_column('categorycode');
323
                my $category = uc Koha::Borrowers->find( $row->{borrowernumber} )->categorycode();
299
                next ITEM unless ( $category_to_process{ $category } );
324
                next ITEM unless ( $category_to_process{ $category } );
300
            }
325
            }
301
            printf ("Due %s: item %5s from borrower %5s to lost: %s\n", $row->{date_due}, $row->{itemnumber}, $row->{borrowernumber}, $lostvalue) if($verbose);
326
            printf ("Due %s: item %5s from borrower %5s to lost: %s\n", $row->{date_due}, $row->{itemnumber}, $row->{borrowernumber}, $lostvalue) if($verbose);
302
- 

Return to bug 14292