Koha/Script.pm

   1 package Koha::Script;
   2
   3 # Copyright PTFS Europe 2019
   4 # Copyright 2019 Koha Development Team
   5 #
   6 # This file is part of Koha.
   7 #
   8 # Koha is free software; you can redistribute it and/or modify it
   9 # under the terms of the GNU General Public License as published by
  10 # the Free Software Foundation; either version 3 of the License, or
  11 # (at your option) any later version.
  12 #
  13 # Koha is distributed in the hope that it will be useful, but
  14 # WITHOUT ANY WARRANTY; without even the implied warranty of
  15 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  16 # GNU General Public License for more details.
  17 #
  18 # You should have received a copy of the GNU General Public License
  19 # along with Koha; if not, see <http://www.gnu.org/licenses>.
  20
  21 use Modern::Perl;
  22
  23 =head1 NAME
  24
  25 Koha::Script - Koha scripts base class
  26
  27 =head1 SYNOPSIS
  28
  29     use Koha::Script
  30     use Koha::Script -cron;
  31
  32 =head1 DESCRIPTION
  33
  34 This class should be used in all scripts. It sets the interface and userenv appropriately.
  35
  36 =cut
  37
  38 use File::Basename qw( fileparse );
  39 use Fcntl qw( LOCK_EX LOCK_NB );
  40
  41 use C4::Context;
  42 use Koha::Exceptions;
  43 use Koha::Exception;
  44
  45 sub import {
  46     my $class = shift;
  47     my @flags = @_;
  48
  49     C4::Context->_new_userenv(1);
  50     if ( ( $flags[0] || '' ) eq '-cron' ) {
  51
  52         # Set userenv
  53         C4::Context->_new_userenv(1);
  54         C4::Context->set_userenv(
  55             undef, undef, undef, 'CRON', 'CRON',
  56             undef, undef, undef, undef,  undef
  57         );
  58
  59         # Set interface
  60         C4::Context->interface('cron');
  61
  62     }
  63     else {
  64         # Set userenv
  65         C4::Context->set_userenv(
  66             undef, undef, undef, 'CLI', 'CLI',
  67             undef, undef, undef, undef,  undef
  68         );
  69
  70         # Set interface
  71         C4::Context->interface('commandline');
  72     }
  73 }
  74
  75 =head1 API
  76
  77 =head2 Class methods
  78
  79 =head3 new
  80
  81     my $script = Koha::Script->new(
  82         {
  83             script    => $0, # mandatory
  84           [ lock_name => 'my_script' ]
  85         }
  86     );
  87
  88 Create a new Koha::Script object. The I<script> parameter is mandatory,
  89 and will usually be passed I<$0> in the caller script. The I<lock_name>
  90 parameter is optional, and is used to generate the lock file if passed.
  91
  92 =cut
  93
  94 sub new {
  95     my ($class, $params) = @_;
  96     my $script   = $params->{script};
  97
  98     Koha::Exceptions::MissingParameter->throw(
  99         "The 'script' parameter is mandatory. You should usually pass \$0"
 100     ) unless $script;
 101
 102     my $self = { script => $script };
 103     $self->{lock_name} = $params->{lock_name}
 104         if exists $params->{lock_name} and $params->{lock_name};
 105
 106     bless $self, $class;
 107     return $self;
 108 }
 109
 110 =head3 lock_exec
 111
 112     # die if cannot get the lock
 113     try {
 114         $script->lock_exec;
 115     }
 116     catch {
 117         die "$_";
 118     };
 119
 120     # wait for the lock to be released
 121     $script->lock_exec({ wait => 1 });
 122
 123 This method sets an execution lock to prevent concurrent execution of the caller
 124 script. If passed the I<wait> parameter with a true value, it will make the caller
 125 wait until it can be granted the lock (flock's LOCK_NB behaviour). It will
 126 otherwise throw an exception immediately.
 127
 128 =cut
 129
 130 sub lock_exec {
 131     my ($self, $params) = @_;
 132
 133     $self->_initialize_locking
 134         unless $self->{lock_file};
 135
 136     my $lock_params = ($params->{wait}) ? LOCK_EX : LOCK_EX | LOCK_NB;
 137
 138     open my $lock_handle, '>', $self->{lock_file}
 139         or Koha::Exception->throw("Unable to open the lock file ".$self->{lock_file}.": $!");
 140     $self->{lock_handle} = $lock_handle;
 141     flock( $lock_handle, $lock_params )
 142         or Koha::Exception->throw("Unable to acquire the lock ".$self->{lock_file}.": $!");
 143 }
 144
 145 =head2 Internal methods
 146
 147 =head3 _initialize_locking
 148
 149     $self->_initialize_locking
 150
 151 This method initializes the locking configuration.
 152
 153 =cut
 154
 155 sub _initialize_locking {
 156     my ($self) = @_;
 157
 158     my $lock_dir = C4::Context->config('lockdir')
 159         // C4::Context->temporary_directory();
 160
 161     my $lock_name = $self->{lock_name} // fileparse( $self->{script} );
 162     $self->{lock_file} = "$lock_dir/$lock_name";
 163
 164     return $self;
 165 }
 166
 167 =head1 AUTHOR
 168
 169 Martin Renvoize <martin.renvoize@ptfs-europe.com>
 170
 171 =cut
 172
 173 1;