Форум программистов [Powered by Invision Power Board]

Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате

Форум программистов > Perl: Общие вопросы > open file

Автор: mastercz 13.4.2009, 12:31

Добрый день!
Сейчас под рукой нет линукс, проверить не могу, но в виндах сделал следующее.
написал две маленьких програмки.
1-ая.

Код


#!c:\Perl\bin
  open (test,">test");
  print test "QQQ";
  while(1)
   {
   }

и 2-ая.

Код


#!c:\Perl\bin


if(!open(test,">test"))
    {
        print "\n-->Ошибка доступа";
    }
else
    {
        print "\n-->Доступ есть";    
                              print test "aaa";
    }

Запускаю первую, потом запускаю вторую... и ... о чудо я пишу в файл "ааа".
В линуксе это также ? Как запретить совместный доступ к файлу на запись?
Заранее благодарю за ответ.

Автор: arto 13.4.2009, 13:27

perldoc -f flock

Автор: mastercz 14.4.2009, 03:46

Хм, чегото я не сображу чего я неправильно делаю.
С учетом flock
1-ый код

Код


#!/usr/bin/perl                             
use Fcntl ':flock';                         
open (FILE,">test");                        
if(!flock(FILE,LOCK_EX))                    
    {                                       
        print "\n--> No Lock\n"; exit();    
    }                                       
print FILE "ZZZ";                           
while(1)                                    
{                                           
    sleep(1);                               
}

2-ой код

Код


#!c:\Perl\bin
if(open (FILE,">test"))
    {
        print "\n->> Не работает блокировка.";
        print FILE "qqq";
    }
else
    {
        print "\n->> Работает блокировка.";    
    }

2-ой код приспокойно перезаписывает файл test, также я могу его удалить.
ОС ASPLinux Server IV;

Автор: arto 14.4.2009, 06:37

блокировку надо использовать в обеих скриптах

Автор: mastercz 14.4.2009, 16:17

Спасибо arto за подсказку. Вроди бы разобрался.
Посмотрите пожалуйста следующий куско кода, есть ли в нем слабые места :
Заранее благодарю за коментарий.

Код


        my $tmpfile;
                        my $Myflock="FALSE";
                        do{
                            do    
                              {
                                $tmpfile=qx/date +%j%H%M%S%N/; chop($tmpfile);
                                $tmpfile=substr($tmpfile,0,15)."\.ttt";
                              } while(-e $TempDir.$tmpfile);
                                
                            open(TMPFILE,">>".$TempDir.$tmpfile);
                            
                            if (flock(TMPFILE, 2|4))
                                {
                                    $Myflock="TRUE";
                                }
                            else
                                {
                                    close(TMPFILE);
                                    usleep(50000);
                                }
                        }while($Myflock eq "FALSE");
                        
                            print TMPFILE "qqq";
                        close(TMPFILE);
                #---> Тут работа с временным файлом.
                 unlink($TempDir.$tmpfile);

Автор: arto 14.4.2009, 19:37

1. вместо qx/date/ -- use POSIC qw( strftime )
2. вместо $tmpfile -- use File::Temp
3. usleep(50000) --> usleep (10000+int rand 40000)

Автор: mastercz 15.4.2009, 01:11

Подскажите пожалуйста, как средствами перл можно получить текущую метку времени до милисекунд;

Автор: arto 15.4.2009, 06:49

perldoc Time::HiRes