Koha/BackgroundJob.pm

   1 package Koha::BackgroundJob;
   2
   3 # This file is part of Koha.
   4 #
   5 # Koha is free software; you can redistribute it and/or modify it
   6 # under the terms of the GNU General Public License as published by
   7 # the Free Software Foundation; either version 3 of the License, or
   8 # (at your option) any later version.
   9 #
  10 # Koha is distributed in the hope that it will be useful, but
  11 # WITHOUT ANY WARRANTY; without even the implied warranty of
  12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  13 # GNU General Public License for more details.
  14 #
  15 # You should have received a copy of the GNU General Public License
  16 # along with Koha; if not, see <http://www.gnu.org/licenses>.
  17
  18 use Modern::Perl;
  19 use JSON qw( decode_json encode_json );
  20 use Encode qw( encode_utf8 );
  21 use Carp qw( croak );
  22 use Net::Stomp;
  23 use Try::Tiny qw( catch try );
  24
  25 use C4::Context;
  26 use Koha::DateUtils qw( dt_from_string );
  27 use Koha::Exceptions;
  28
  29 use base qw( Koha::Object );
  30
  31 =head1 NAME
  32
  33 Koha::BackgroundJob - Koha BackgroundJob Object class
  34
  35 This is a base class for BackgroundJob, some methods must be subclassed.
  36
  37 Example of usage:
  38
  39 Producer:
  40 my $job_id = Koha::BackgroundJob->enqueue(
  41     {
  42         job_type => $job_type,
  43         job_size => $job_size,
  44         job_args => $job_args
  45     }
  46 );
  47
  48 Consumer:
  49 Koha::BackgrounJobs->find($job_id)->process;
  50 See also C<misc/background_jobs_worker.pl> for a full example
  51
  52 =head1 API
  53
  54 =head2 Class methods
  55
  56 =head3 connect
  57
  58 Connect to the message broker using default guest/guest credential
  59
  60 =cut
  61
  62 sub connect {
  63     my ( $self );
  64     my $hostname = 'localhost';
  65     my $port = '61613';
  66     my $config = C4::Context->config('message_broker');
  67     my $credentials = {
  68         login => 'guest',
  69         passcode => 'guest',
  70     };
  71     if ($config){
  72         $hostname = $config->{hostname} if $config->{hostname};
  73         $port = $config->{port} if $config->{port};
  74         $credentials->{login} = $config->{username} if $config->{username};
  75         $credentials->{passcode} = $config->{password} if $config->{password};
  76         $credentials->{host} = $config->{vhost} if $config->{vhost};
  77     }
  78     my $stomp = Net::Stomp->new( { hostname => $hostname, port => $port } );
  79     $stomp->connect( $credentials );
  80     return $stomp;
  81 }
  82
  83 =head3 enqueue
  84
  85 Enqueue a new job. It will insert a new row in the DB table and notify the broker that a new job has been enqueued.
  86
  87 C<job_size> is the size of the job
  88 C<job_args> is the arguments of the job. It's a structure that will be JSON encoded.
  89
  90 Return the job_id of the newly created job.
  91
  92 =cut
  93
  94 sub enqueue {
  95     my ( $self, $params ) = @_;
  96
  97     my $job_type = $self->job_type;
  98     my $job_size = $params->{job_size};
  99     my $job_args = $params->{job_args};
 100
 101     my $borrowernumber = (C4::Context->userenv) ? C4::Context->userenv->{number} : undef;
 102     my $json_args = encode_json $job_args;
 103
 104     $self->set(
 105         {
 106             status         => 'new',
 107             type           => $job_type,
 108             size           => $job_size,
 109             data           => $json_args,
 110             enqueued_on    => dt_from_string,
 111             borrowernumber => $borrowernumber,
 112         }
 113     )->store;
 114
 115     $job_args->{job_id} = $self->id;
 116
 117     my $conn;
 118     try {
 119         $conn = $self->connect;
 120     } catch {
 121         warn "Cannot connect to broker " . $_;
 122     };
 123     return unless $conn;
 124
 125     $json_args = encode_json $job_args;
 126     try {
 127         # This namespace is wrong, it must be a vhost instead.
 128         # But to do so it needs to be created on the server => much more work when a new Koha instance is created.
 129         # Also, here we just want the Koha instance's name, but it's not in the config...
 130         # Picking a random id (memcached_namespace) from the config
 131         my $namespace = C4::Context->config('memcached_namespace');
 132         $conn->send_with_receipt( { destination => sprintf("/queue/%s-%s", $namespace, $job_type), body => $json_args } )
 133           or Koha::Exceptions::Exception->throw('Job has not been enqueued');
 134     } catch {
 135         $self->status('failed')->store;
 136         if ( ref($_) eq 'Koha::Exceptions::Exception' ) {
 137             $_->rethrow;
 138         } else {
 139             warn sprintf "The job has not been sent to the message broker: (%s)", $_;
 140         }
 141     };
 142
 143     return $self->id;
 144 }
 145
 146 =head3 process
 147
 148 Process the job!
 149
 150 =cut
 151
 152 sub process {
 153     my ( $self, $args ) = @_;
 154
 155     return {} if ref($self) ne 'Koha::BackgroundJob';
 156
 157     my $derived_class = $self->_derived_class;
 158
 159     $args ||= {};
 160
 161     return $derived_class->process( $args );
 162 }
 163
 164 =head3 job_type
 165
 166 Return the job type of the job. Must be a string.
 167
 168 =cut
 169
 170 sub job_type { croak "This method must be subclassed" }
 171
 172 =head3 messages
 173
 174 Messages let during the processing of the job.
 175
 176 =cut
 177
 178 sub messages {
 179     my ( $self ) = @_;
 180
 181     my @messages;
 182     my $data_dump = decode_json encode_utf8 $self->data;
 183     if ( exists $data_dump->{messages} ) {
 184         @messages = @{ $data_dump->{messages} };
 185     }
 186
 187     return \@messages;
 188 }
 189
 190 =head3 report
 191
 192 Report of the job.
 193
 194 =cut
 195
 196 sub report {
 197     my ( $self ) = @_;
 198
 199     my $data_dump = decode_json encode_utf8 $self->data;
 200     return $data_dump->{report} || {};
 201 }
 202
 203 =head3 additional_report
 204
 205 Build additional variables for the job detail view.
 206
 207 =cut
 208
 209 sub additional_report {
 210     my ( $self ) = @_;
 211
 212     return {} if ref($self) ne 'Koha::BackgroundJob';
 213
 214     my $derived_class = $self->_derived_class;
 215
 216     return $derived_class->additional_report;
 217 }
 218
 219 =head3 cancel
 220
 221 Cancel a job.
 222
 223 =cut
 224
 225 sub cancel {
 226     my ( $self ) = @_;
 227     $self->status('cancelled')->store;
 228 }
 229
 230 =head2 Internal methods
 231
 232 =head3 _derived_class
 233
 234 =cut
 235
 236 sub _derived_class {
 237     my ( $self ) = @_;
 238     my $job_type = $self->type;
 239
 240     my $class = $self->type_to_class_mapping->{$job_type};
 241
 242     Koha::Exception->throw($job_type . ' is not a valid job_type')
 243         unless $class;
 244
 245     eval "require $class";
 246     return $class->_new_from_dbic( $self->_result );
 247 }
 248
 249 =head3 type_to_class_mapping
 250
 251 =cut
 252
 253 sub type_to_class_mapping {
 254     return {
 255         batch_authority_record_deletion     => 'Koha::BackgroundJob::BatchDeleteAuthority',
 256         batch_authority_record_modification => 'Koha::BackgroundJob::BatchUpdateAuthority',
 257         batch_biblio_record_deletion        => 'Koha::BackgroundJob::BatchDeleteBiblio',
 258         batch_biblio_record_modification    => 'Koha::BackgroundJob::BatchUpdateBiblio',
 259         batch_item_record_deletion          => 'Koha::BackgroundJob::BatchDeleteItem',
 260         batch_item_record_modification      => 'Koha::BackgroundJob::BatchUpdateItem',
 261         batch_hold_cancel                   => 'Koha::BackgroundJob::BatchCancelHold',
 262     };
 263 }
 264
 265 =head3 _type
 266
 267 =cut
 268
 269 sub _type {
 270     return 'BackgroundJob';
 271 }
 272
 273 1;