Perl_скрип выполнялся в единственной копии.

На форуме обсуждалась эта тема но мне кажется что многим пригодится.

Очень часто необходимо чтоб Perl_скрип выполнялся в единственной копии
в один момент времени, т.е. чтоб в одно и тоже время небыло запущенно 2
одинаковых скрипта.

Ниже перведена функция которая это обеспечивает.

#!/usr/bin/perl
use Fcntl qw(:DEFAULT :flock);
test_unique();

...
# Код программы
...

exit;

sub test_unique(){
my @a=split /\//,$0;
my $lockfile="/var/run/".$a[$#a]."\.lock";
    if (-e $lockfile){
        if (sysopen(FH, $lockfile, O_WRONLY) && flock(FH, LOCK_EX|LOCK_NB)){
        return 0;
        } else { print "Script $a[$#a] alredy started!!!\n"; exit(); }
    }
    sysopen(FH, $lockfile, O_WRONLY|O_CREAT) && flock(FH, LOCK_EX|LOCK_NB) ||
die $!;
    return 0;
}

• Реализация локов в Perl скриптах.,Димыч, 00:06 , 03-Июл-03
  • Реализация локов в Perl скриптах.,gara, 01:08 , 11-Июл-03
    • Реализация локов в Perl скриптах.,dm, 20:57 , 13-Сен-04
      • Реализация локов в Perl скриптах.,rWizard, 01:50 , 02-Окт-04

Это конечно здорово, но я обычно использую попроще:
в начале скрипта:

exit if -e /tmp/running
system('touch /tmp/running');
...
в конце скрипта:
system('rm -f /tmp/running');

При небольшом количестве запускаемых скриптов одновременно (например по таймеру, каждые пять минут, зато после запуска может уйти в глубокий и тяжёлый просчёт) очень даже работает.

>Это конечно здорово, но я обычно использую попроще:
>в начале скрипта:
>
>exit if -e /tmp/running
>system('touch /tmp/running');
>...
>в конце скрипта:
>system('rm -f /tmp/running');
тоже так делали раньше.
НЕКАТИТ, если скрипт вываливается посередине (малоли) то второй раз он не запускается. а с описанным выше способом при выпадении скрипта снимается лок и второй раз скрипт запускается без проблем.

>>exit if -e /tmp/running
>>system('touch /tmp/running');
>>в конце скрипта:
>>system('rm -f /tmp/running');
unlink($lockfile)
пусть сам перл удаляет :)

>тоже так делали раньше.
>НЕКАТИТ, если скрипт вываливается посередине (малоли) то второй раз он не запускается.
Вываливается скрипт же не просто так, бывают ситуации что и не стоит ему запускаться, дабы воизбежания :)

>>>exit if -e /tmp/running
>>>system('touch /tmp/running');
>>>в конце скрипта:
>>>system('rm -f /tmp/running');
>unlink($lockfile)
>пусть сам перл удаляет :)
>
тогду пусть и сам создает.
open(LOCK,">/tmp/running"); close LOCK;