Koha/BackgroundJob.pm

   1 package Koha::BackgroundJob;
   2
   3 use Modern::Perl;
   4 use JSON qw( encode_json decode_json );
   5 use Carp qw( croak );
   6 use Net::Stomp;
   7
   8 use C4::Context;
   9 use Koha::DateUtils qw( dt_from_string );
  10 use Koha::Exceptions;
  11 use Koha::BackgroundJob::BatchUpdateBiblio;
  12 use Koha::BackgroundJob::BatchUpdateAuthority;
  13
  14 use base qw( Koha::Object );
  15
  16 sub connect {
  17     my ( $self );
  18     my $stomp = Net::Stomp->new( { hostname => 'localhost', port => '61613' } );
  19     $stomp->connect( { login => 'guest', passcode => 'guest' } );
  20     return $stomp;
  21 }
  22
  23 sub enqueue {
  24     my ( $self, $params ) = @_;
  25
  26     my $job_type = $self->job_type;
  27     my $job_size = $params->{job_size};
  28     my $job_args = $params->{job_args};
  29
  30     my $borrowernumber = C4::Context->userenv->{number}; # FIXME Handle non GUI calls
  31     my $json_args = encode_json $job_args;
  32     my $job_id;
  33     $self->_result->result_source->schema->txn_do(
  34         sub {
  35             $self->set(
  36                 {
  37                     status         => 'new',
  38                     type           => $job_type,
  39                     size           => $job_size,
  40                     data           => $json_args,
  41                     enqueued_on    => dt_from_string,
  42                     borrowernumber => $borrowernumber,
  43                 }
  44             )->store;
  45
  46             $job_id = $self->id;
  47             $job_args->{job_id} = $job_id;
  48             $json_args = encode_json $job_args;
  49
  50             my $conn = $self->connect;
  51             # This namespace is wrong, it must be a vhost instead.
  52             # But to do so it needs to be created on the server => much more work when a new Koha instance is created.
  53             # Also, here we just want the Koha instance's name, but it's not in the config...
  54             # Picking a random id (memcached_namespace) from the config
  55             my $namespace = C4::Context->config('memcached_namespace');
  56             $conn->send_with_receipt( { destination => sprintf("%s-%s", $namespace, $job_type), body => $json_args } )
  57               or Koha::Exceptions::Exception->throw('Job has not been enqueued');
  58         }
  59     );
  60
  61     return $job_id;
  62 }
  63
  64 sub process {
  65     my ( $self, $args ) = @_;
  66
  67     my $job_type = $self->type;
  68     return $job_type eq 'batch_biblio_record_modification'
  69       ? Koha::BackgroundJob::BatchUpdateBiblio->process($args)
  70       : $job_type eq 'batch_authority_record_modification'
  71       ? Koha::BackgroundJob::BatchUpdateAuthority->process($args)
  72       : Koha::Exceptions::Exception->throw('->process called without valid job_type');
  73 }
  74
  75 sub job_type { croak "This method must be subclassed" }
  76
  77 sub messages {
  78     my ( $self ) = @_;
  79
  80     my @messages;
  81     my $data_dump = decode_json $self->data;
  82     if ( exists $data_dump->{messages} ) {
  83         @messages = @{ $data_dump->{messages} };
  84     }
  85
  86     return @messages;
  87 }
  88
  89 sub report {
  90     my ( $self ) = @_;
  91
  92     my $data_dump = decode_json $self->data;
  93     return $data_dump->{report};
  94 }
  95
  96 sub cancel {
  97     my ( $self ) = @_;
  98     $self->status('cancelled')->store;
  99 }
 100
 101 sub _type {
 102     return 'BackgroundJob';
 103 }
 104
 105 1;