From 23d546e68be05236ef6927609cbbcf94be1f523a Mon Sep 17 00:00:00 2001 From: Tomas Cohen Arazi Date: Fri, 10 Apr 2020 19:37:31 -0300 Subject: [PATCH] Bug 25109: Add ->new and ->lock_exec to Koha::Script --- Koha/Script.pm | 61 +++++++++++++++++++++++++++++++++++++++++++++++++ t/Koha/Script.t | 20 +++++++++++++++- t/Koha/sleep.pl | 19 +++++++++++++++ 3 files changed, 99 insertions(+), 1 deletion(-) create mode 100755 t/Koha/sleep.pl diff --git a/Koha/Script.pm b/Koha/Script.pm index 2126d18506..9b8fff4823 100644 --- a/Koha/Script.pm +++ b/Koha/Script.pm @@ -35,7 +35,12 @@ This class should be used in all scripts. It sets the interface and userenv appr =cut +use File::Basename; +use Fcntl qw(:flock); + use C4::Context; +use Koha::Exceptions; +use Koha::Exceptions::Exception; sub import { my $class = shift; @@ -67,6 +72,62 @@ sub import { } } +=head2 new + +Constructor + +=cut + +sub new { + my ($class, $params) = @_; + my $script = $params->{script}; + my $use_lock = $params->{use_lock}; + + Koha::Exceptions::MissingParameter->throw( + "The 'script' parameter is mandatory. You should usually pass \$0" + ) unless $script; + + my $self = { + script => $script, + }; + + if ($use_lock) { + my $lock_dir = C4::Context->config('lock_dir') + // C4::Context->temporary_directory(); + + my $lock_name = $params->{lock_name} // fileparse( $script ); + $self->{lock_file} = "$lock_dir/$lock_name"; + } + + bless $self, $class; + return $self; +} + +=head2 lock_exec + + my $script = Koha::Script->new({ script => $0, use_lock => 1[, lock_name => 'my_script'] }); + try { + $script->lock_exec; + } + catch { + die "$_"; + }; + $script->lock_exec({ wait => 1 }); + +=cut + +sub lock_exec { + my ($self, $params) = @_; + + my $lock_params = ($params->{wait}) ? LOCK_EX : LOCK_EX | LOCK_NB; + + open our $lock_handle, '>', $self->{lock_file} + or Koha::Exceptions::Exception->throw("Unable to open the lock file ".$self->{lock_file}.": $!"); + $self->{lock_handle} = $lock_handle; + flock( $lock_handle, $lock_params ) + or Koha::Exceptions::Exception->throw("Unable to acquire the lock"); +} + =head1 AUTHOR Martin Renvoize diff --git a/t/Koha/Script.t b/t/Koha/Script.t index 778693b607..d177256d78 100644 --- a/t/Koha/Script.t +++ b/t/Koha/Script.t @@ -17,10 +17,12 @@ use Modern::Perl; -use Test::More tests => 3; +use Test::More tests => 4; BEGIN { use_ok('Koha::Script') } +use File::Basename; + use C4::Context; my $userenv = C4::Context->userenv; @@ -44,4 +46,20 @@ is_deeply( my $interface = C4::Context->interface; is( $interface, 'commandline', "Context interface set correctly with no flags" ); +subtest 'lock_exec() tests' => sub { + plan tests => 1; + + # Launch the sleep script + my $pid = fork(); + if ( $pid == 0 ) { + system( dirname(__FILE__) . '/sleep.pl' ); + exit; + } + + my $command = dirname(__FILE__) . '/sleep.pl'; + my $result = `$command 2>&1`; + + is( $result, 'Unable to acquire the lock', 'Exception found' ); +}; + 1; diff --git a/t/Koha/sleep.pl b/t/Koha/sleep.pl new file mode 100755 index 0000000000..01a3263db9 --- /dev/null +++ b/t/Koha/sleep.pl @@ -0,0 +1,19 @@ +#!/usr/bin/perl + +use Modern::Perl; + +use Koha::Script; +use Fcntl qw(:flock); +use Try::Tiny; + +# # Lock execution +my $script = Koha::Script->new({ script => $0, use_lock => 1 }); + +$script->lock_exec; + +# Sleep for a while, we need to force the concurrent access to the +# lock file +sleep 2; + +# Normal exit +1; -- 2.26.0