@ -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,98 @@ sub import {
}
}
= head1 API
= head2 Class methods
= head3 new
my $ script = Koha::Script - > new (
{
script = > $ 0 , # mandatory
[ lock_name = > 'my_script' ]
}
) ;
Create a new Koha:: Script object . The I <script> parameter is mandatory ,
and will usually be passed I <$0> in the caller script . The I <lock_name>
parameter is optional , and is used to generate the lock file if passed .
= cut
sub new {
my ( $ class , $ params ) = @ _ ;
my $ script = $ params - > { script } ;
Koha::Exceptions::MissingParameter - > throw (
"The 'script' parameter is mandatory. You should usually pass \$0"
) unless $ script ;
my $ self = { script = > $ script } ;
$ self - > { lock_name } = $ params - > { lock_name }
if exists $ params - > { lock_name } and $ params - > { lock_name } ;
bless $ self , $ class ;
return $ self ;
}
= head3 lock_exec
# die if cannot get the lock
try {
$ script - > lock_exec ;
}
catch {
die "$_" ;
} ;
# wait for the lock to be released
$ script - > lock_exec ( { wait = > 1 } ) ;
This method sets an execution lock to prevent concurrent execution of the caller
script . If passed the I <wait> parameter with a true value , it will make the caller
wait until it can be granted the lock ( flock ' s LOCK_NB behaviour ) . It will
otherwise throw an exception immediately .
= cut
sub lock_exec {
my ( $ self , $ params ) = @ _ ;
$ self - > _initialize_locking
unless $ self - > { lock_file } ;
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 " . $ self - > { lock_file } . ": $!" ) ;
}
= head2 Internal methods
= head3 _initialize_locking
$ self - > _initialize_locking
This method initializes the locking configuration .
= cut
sub _initialize_locking {
my ( $ self ) = @ _ ;
my $ lock_dir = C4::Context - > config ( 'lock_dir' )
// C4::Context - > temporary_directory ( ) ;
my $ lock_name = $ self - > { lock_name } // fileparse ( $ self - > { script } ) ;
$ self - > { lock_file } = "$lock_dir/$lock_name" ;
return $ self ;
}
= head1 AUTHOR
Martin Renvoize <martin.renvoize@ptfs-europe.com>