Attachment #102906 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 (+97 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	=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 our $lock_handle, '>', $self->{lock_file}
139	or Koha::Exceptions::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::Exceptions::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('lock_dir')
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
70	=head1 AUTHOR	167	=head1 AUTHOR
71		168
72	Martin Renvoize <martin.renvoize@ptfs-europe.com>	169	Martin Renvoize <martin.renvoize@ptfs-europe.com>

Lines 17-26 Link Here

(-)a/t/Koha/Script.t (-1 / +26 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	use Test::Exception;
21		22
22	BEGIN { use_ok('Koha::Script') }	23	BEGIN { use_ok('Koha::Script') }
23		24
		25	use File::Basename;
		26
24	use C4::Context;	27	use C4::Context;
25		28
26	my $userenv = C4::Context->userenv;	29	my $userenv = C4::Context->userenv;
Lines 44-47 is_deeply( Link Here
44	my $interface = C4::Context->interface;	47	my $interface = C4::Context->interface;
45	is( $interface, 'commandline', "Context interface set correctly with no flags" );	48	is( $interface, 'commandline', "Context interface set correctly with no flags" );
46		49
		50	subtest 'lock_exec() tests' => sub {
		51	plan tests => 2;
		52
		53	# Launch the sleep script
		54	my $pid = fork();
		55	if ( $pid == 0 ) {
		56	system( dirname(__FILE__) . '/sleep.pl 2>&1' );
		57	exit;
		58	}
		59
		60	sleep 1; # Make sure we start after the fork
		61	my $command = dirname(__FILE__) . '/sleep.pl';
		62	my $result = `$command 2>&1`;
		63
		64	like( $result, qr{Unable to acquire the lock.*}, 'Exception found' );
		65
		66	throws_ok
		67	{ Koha::Script->new({ lock_name => 'blah' }); }
		68	'Koha::Exceptions::MissingParameter',
		69	'Not passing the "script" parameter makes it raise an exception';
		70	};
		71
47	1;	72	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 => 'sleep.pl' });

$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 => 'sleep.pl' });
		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;