From 23d546e68be05236ef6927609cbbcf94be1f523a Mon Sep 17 00:00:00 2001
From: Tomas Cohen Arazi <tomascohen@theke.io>
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 <martin.renvoize@ptfs-europe.com>
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