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

(-)a/Koha/BackgroundJob.pm (+30 lines)
Lines 510-515 sub to_api_mapping { Link Here
510
    };
510
    };
511
}
511
}
512
512
513
=head3 purge
514
515
    Koha::BackgrounJob::purge(10, 1)
516
517
Purge all jobs older than 10 days. If called from the base class, jobs of
518
all types will be purges, otherwise only the jobs from the specific type.
519
520
=cut
521
522
sub purge {
523
    my ($self, $days, $doit) = @_;
524
    my $purge_all = ref($self) eq 'Koha::BackgroundJob';
525
    my $duration = DateTime::Duration->new( days => $days );
526
    my $ended_on = DateTime->now - $duration;
527
    $ended_on = $ended_on->ymd ." 23:59:59";
528
    my $query = {
529
        status   => 'finished',
530
        ended_on => { '<=', $ended_on },
531
    };
532
    $query->{type} = $self->job_type if ref($self) ne 'Koha::BackgroundJob';
533
    my $jobs = Koha::BackgroundJobs->search($query,
534
        { order_by => { -asc => 'enqueued_on' } } );
535
    my $result = [];
536
    while ( my $job = $jobs->next ) {
537
        push @$result, $job;
538
        $job->delete if $doit;
539
    }
540
    return $result;
541
}
542
513
=head3 _type
543
=head3 _type
514
544
515
=cut
545
=cut
(-)a/misc/cronjobs/background_jobs_purge.pl (-1 / +82 lines)
Line 0 Link Here
0
- 
1
#!/usr/bin/perl
2
3
# Copyright 2022 Tamil s.a.r.l.
4
#
5
# This file is part of Koha.
6
#
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.
11
#
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.
16
#
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>.
19
20
use Modern::Perl;
21
use Getopt::Long qw( GetOptions );
22
use Class::Load ':all';
23
use Koha::BackgroundJob;
24
use YAML;
25
26
use constant DEFAULT_DAYS => 30;
27
28
my $type_to_class = Koha::BackgroundJob::core_types_to_classes;
29
30
sub usage {
31
    my $types = join("\n", map { "  ► $_"; } sort keys %$type_to_class);
32
    print STDERR <<USAGE;
33
Usage: $0 [--confirm|-c] [--verbose|-v] type days [type days]...
34
Examples:
35
  $0 update_elastic_index 1 batch_item_record_deletion 0
36
  $0 all 1 --verbose --confirm
37
  $0 all 10 update_elastic_index 0 -v -c
38
  $0 all 0 --verbose
39
Without providing a number of days, it is defaulted to 30 days.
40
Available types of jobs:
41
$types;
42
USAGE
43
    exit;
44
}
45
46
my ($verbose, $confirm);
47
GetOptions(
48
    'confirm|c'   => \$confirm,
49
    'verbose|v' => \$verbose,
50
);
51
52
usage() unless @ARGV;
53
54
for my $class (values %$type_to_class) {
55
    load_class($class)
56
}
57
58
while (@ARGV) {
59
    my $type = shift @ARGV;
60
    my $class =
61
        $type =~ /^all$/i ? 'Koha::BackgroundJob' : $type_to_class->{$type};
62
    unless ($class) {
63
        say "Invalid job type: $type";
64
        exit;
65
    }
66
    my $days = @ARGV && $ARGV[0] =~ /^[0-9]+$/ ? shift @ARGV : DEFAULT_DAYS;
67
    $class = $class->new();
68
    my $jobs = $class->purge($days, $confirm);
69
    next unless $verbose;
70
    say "** TEST MODE **" unless $confirm;
71
    my $count = @$jobs;
72
    if ($count) {
73
        say "Purge $count jobs of type '$type' older than $days days\n",
74
            "ID       TYPE                                FINISHED\n",
75
            join("\n", map {
76
                sprintf("%-8d %-35s %s", $_->id, $_->type, $_->ended_on);
77
            } @$jobs);
78
    }
79
    else {
80
        say "No job to purge";
81
    }
82
}

Return to bug 31970