Attachment #102759 for bug #25109

View | Details | Raw Unified | Return to bug 25109
Collapse All | Expand All

Lines 35-41 This class should be used in all scripts. It sets the interface and userenv appr Link Here

(-)a/Koha/Script.pm (+61 lines)
35		35
36	=cut	36	=cut
37		37
		38	use File::Basename;
		39	use Fcntl qw(:flock);
		40
38	use C4::Context;	41	use C4::Context;
		42	use Koha::Exceptions;
		43	use Koha::Exceptions::Exception;
39		44
40	sub import {	45	sub import {
41	my $class = shift;	46	my $class = shift;
Lines 67-72 sub import { Link Here
67	}	72	}
68	}	73	}
69		74
		75	=head2 new
		76
		77	Constructor
		78
		79	=cut
		80
		81	sub new {
		82	my ($class, $params) = @_;
		83	my $script = $params->{script};
		84	my $use_lock = $params->{use_lock};
		85
		86	Koha::Exceptions::MissingParameter->throw(
		87	"The 'script' parameter is mandatory. You should usually pass \$0"
		88	) unless $script;
		89
		90	my $self = {
		91	script => $script,
		92	};
		93
		94	if ($use_lock) {
		95	my $lock_dir = C4::Context->config('lock_dir')
		96	// C4::Context->temporary_directory();
		97
		98	my $lock_name = $params->{lock_name} // fileparse( $script );
		99	$self->{lock_file} = "$lock_dir/$lock_name";
		100	}
		101
		102	bless $self, $class;
		103	return $self;
		104	}
		105
		106	=head2 lock_exec
		107
		108	my $script = Koha::Script->new({ script => $0, use_lock => 1[, lock_name => 'my_script'] });
		109	try {
		110	$script->lock_exec;
		111	}
		112	catch {
		113	die "$_";
		114	};
		115	$script->lock_exec({ wait => 1 });
		116
		117	=cut
		118
		119	sub lock_exec {
		120	my ($self, $params) = @_;
		121
		122	my $lock_params = ($params->{wait}) ? LOCK_EX : LOCK_EX \| LOCK_NB;
		123
		124	open our $lock_handle, '>', $self->{lock_file}
		125	or Koha::Exceptions::Exception->throw("Unable to open the lock file ".$self->{lock_file}.": $!");
		126	$self->{lock_handle} = $lock_handle;
		127	flock( $lock_handle, $lock_params )
		128	or Koha::Exceptions::Exception->throw("Unable to acquire the lock");
		129	}
		130
70	=head1 AUTHOR	131	=head1 AUTHOR
71		132
72	Martin Renvoize <martin.renvoize@ptfs-europe.com>	133	Martin Renvoize <martin.renvoize@ptfs-europe.com>

Lines 17-26 Link Here

(-)a/t/Koha/Script.t (-1 / +19 lines)
17		17
18	use Modern::Perl;	18	use Modern::Perl;
19		19
20	use Test::More tests => 3;	20	use Test::More tests => 4;
21		21
22	BEGIN { use_ok('Koha::Script') }	22	BEGIN { use_ok('Koha::Script') }
23		23
		24	use File::Basename;
		25
24	use C4::Context;	26	use C4::Context;
25		27
26	my $userenv = C4::Context->userenv;	28	my $userenv = C4::Context->userenv;
Lines 44-47 is_deeply( Link Here
44	my $interface = C4::Context->interface;	46	my $interface = C4::Context->interface;
45	is( $interface, 'commandline', "Context interface set correctly with no flags" );	47	is( $interface, 'commandline', "Context interface set correctly with no flags" );
46		48
		49	subtest 'lock_exec() tests' => sub {
		50	plan tests => 1;
		51
		52	# Launch the sleep script
		53	my $pid = fork();
		54	if ( $pid == 0 ) {
		55	system( dirname(__FILE__) . '/sleep.pl' );
		56	exit;
		57	}
		58
		59	my $command = dirname(__FILE__) . '/sleep.pl';
		60	my $result = `$command 2>&1`;
		61
		62	is( $result, 'Unable to acquire the lock', 'Exception found' );
		63	};
		64
47	1;	65	1;




#!/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;

Return to bug 25109

Line 0 Link Here

(-)a/t/Koha/sleep.pl (-1 / +19 lines)
0	-	1	#!/usr/bin/perl
		2
		3	use Modern::Perl;
		4
		5	use Koha::Script;
		6	use Fcntl qw(:flock);
		7	use Try::Tiny;
		8
		9	# # Lock execution
		10	my $script = Koha::Script->new({ script => $0, use_lock => 1 });
		11
		12	$script->lock_exec;
		13
		14	# Sleep for a while, we need to force the concurrent access to the
		15	# lock file
		16	sleep 2;
		17
		18	# Normal exit
		19	1;