Сабж - если файл разросся до слишком больших размеров требуется удалить первую
(соответственно самую старую) запись (строку).
Вопрос- можно ли это сделать не переписывая данные в массив или во временный файл??

нет

Вот пример... Массив не нужен, но временная переменная нужна

Код

#!/usr/bin/perl use strict; use warnings; my $counter=0; my $buf=''; open FD,"<testfile" or die; while (<FD>){     # переписав условие можно удалять сколько угодно строк от начала файла.     $buf.=$_ if $counter++;  }  close FD;  open FD, ">testfile" or die; print FD $buf;

А вообще это нужно изначально продумывать, ещё перед тем как файл разросся. Например держать в файле только последние 200 строк, всё остальные писать в архив. Допустим добавляется 201 строка, то первая выдёргивется и пишется в архив. Тогда можно и массивом воспользоваться. Кстати а строки какой длины? Может стоит подумать над тем что бы заюзать DBM?

Почему-то не работает (после первой записи 4 байт данные в файл не добавляются)
Строка запроса
http://www.host-n-one.com/cgi-bin/form.cgi?b=%ff%ff%ff%f0

Код

#!/usr/bin/perl $counter=0; $buf=''; $size=0; #Get data -------- if ($ENV{'REQUEST_METHOD'} eq "POST")     {       read(STDIN, $bufer, $ENV{'CONTENT_LENGTH'});     } else     {       $bufer=$ENV{'QUERY_STRING'};     }     @pairs = split(/&/, $bufer); foreach $pair (@pairs) {    ($name, $value) = split(/=/, $pair);    $value =~ tr/+/ /;    $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;    $VOTE{$name} = $value; } $path="$ENV{'DOCUMENT_ROOT'}"; $filename=$path."/output/test.txt";       #See if file already exists -------- $test=0;  if (-e("$filename")){ $size= -s $filename; } else { $test=1;  }  #If exists check it for duplicates -------- if ($test==0) { open (NAMEFILE, "$filename");  while(<NAMEFILE>) {  if (/$value/) { $test=0; break; } } close (NAMEFILE); }   #If no duplicates found -------- if ($test==1)  { #If file is too large delete first 4 bytes -------- if ($size>=12)  {  open (NAMEFILE, "$filename");  sysread(NAMEFILE, &buf, $size-4, 4);  close (NAMEFILE); open (NAMEFILE, ">$filename");  flock (NAMEFILE, 2); syswrite (NAMEFILE, $buf, $size-4, 0); close (NAMEFILE); $size-=4; } #Add new record -------- open (NAMEFILE, ">>$filename");  flock (NAMEFILE, 2); print NAMEFILE $value; close (NAMEFILE); $size+=4; }

А можно узнать что ты пытаешься сделать? Кроме того, почему не пользуешься модулем CGI? Пример который я писал годится для строк, а тебе, похоже, нужно побайтово работать, тогда используй seek что бы задать позицию с которой нужно читать. Вобщем опиши задачу, тогда будет легче написать пример.

Да собственно нужен такой массив каждый элемент в котором это четырехбайтовое число.
Массив хранится в файле и при достижении некоторого числа элементов, скажем 1000, самая старая (первая) запись просто стирается, а новая добавляется в конец этого массива.
Ну еще желательно проверять перед записью наличие элемента с таким значением в массиве-если имеется, то ничего не записываем и выходим.

Странно, но проверка вроде-бы работает, несмотря на то что строки файла собственно и не строки, а четырехбайтные числа....
Передаем число на сервер -> http://www.host-n-one.com/cgi-bin/form.cgi...rd=%ff%12%21%ff

Код

$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; #$value=0xff1221ff; #проверяем может такое уже есть.... open (NAMEFILE, "$filename");  while(<NAMEFILE>) {  if (/$value/) { $bTest=0; break; } } close (NAMEFILE);

А вот убрать первую запись (если число элементов > n) из файла не получается

Я в Perl совсем зеленый , не знаю что в нем является строкой - m-байтная двоичная последовательность это строка? Или строка должна иметь какой-то символ ограничитель?
Какая минимальная длина строки? Максимальная? Может ли строка содержать любые символы от 00 до FF или нет?

Строка - это все что в кавычках двойных или одинаковых, число может использоваться тоже как строка, все зависит от контекста. Perl сам определяет строка здесь или число.
Никаких ограничителей у строки нет, только - размер оперативной памяти.
Минимальная длина строки - длина пустой строки = 0.

Цитата

Может ли строка содержать любые символы от 00 до FF или нет?

да, строка может содержать все что угодно, на то она и строка.



Это сообщение отредактировал(а) sharq - 19.11.2005, 00:08

Файл открывай как для чтения, так и для записи. Читай блоками байтов, а не строками. Вот тебе пример c коментариями.
Только в данном случае параметр получаем из командной строки, это я сделал для более легкого тестирования.

Код

#!/usr/bin/perl -w use strict; # Имя файла, с которым будем работать my $file = "test.txt"; # Получаем рараметр из командной строки chomp(my $param = shift); # Флаг, по нему будем определять есть ли такая строка в файле my $flag = 0; # Максимальное кол-во блоков, т.е. записей в файле my $max_block = 5; # Длана блока в байтах my $block_length = 4; my @bytes = (); my $buff; # Отарываем файл для чтения и записи open(F, "+< $file") or die "Can't open file: $!\n"; # Следующая строка нужна только для винды, но под # никсами она ничего не делает потому указываем её # в любом случае для переносимости binmode F; # Можно было этого и не делать, переходим в начало файла seek(F, 0, 0); # Читаем файл блоками по $block_length байт while ( read( F, $buff, $block_length ) ) {         # Распаковуем полученные байты в строку и         # сравниваем её с полученной из командной строки         if ( unpack("a$block_length",$buff) eq $param ) {              # Если оказались здесь, значит такая запись есть в файле              # устанавливаем флаг и завершаем цикл, как я понял делать              # в этом случае ничего не нужно              $flag = 1;              last;         }         # Сохраняем в массив полученный блок         push(@bytes, $buff); } # Проверяем был ли установлен флаг, если нет то: unless ( $flag ) {       # переходим в начало файла если текущая позиция / $block_length больше $max_block       if ((tell() / $block_length) >= $max_block ) {            seek(F,0,0);  # Переходим в начало            # Удаляем первый элемент            shift @bytes;            # Добавляем новый в конец, перед этим упакуем его            push(@bytes, pack("a$block_length", $param));            # Перезаписываем файл            print F $_ while ($_ = shift @bytes);       } else {             # Упакуем строку и добавим в файл             print F pack("a$block_length", "$param");       } } close(F);

Только +< не создаёт файла, потому тебе нужно будет создать, пустой, файл самому. Затем настрой первые 3 переменные. Из командной строки передавай параметр:
C:\>perl test.pl ffff
C:\>perl test.pl xxxx
C:\>perl test.pl aaaa
И так далее.
В файле будет сохранено максимум $max_block блоков, если если блоков больше или равно, то первая запись будет удалена, а новая запись будет добавлена в конец.
Если переданный параметр уже есть, то он не будет сохранён повторно.
Я не блокировал файл, но в конечной программе это нужно будет сделать.

Не знаю это то, что тебе нужно или нет. Вобщем пробуй. Если что-то будет не ясно, пиши.

Это сообщение отредактировал(а) korob2001 - 19.11.2005, 02:41

По порядку. Строкой, при чтении из файла по крайней мере, считается последовательность символов ограниченная символом перевода строки (\n). Далее, то что ты хочешь хранить в этом файле? Я так понимаю что это двоичные данные?
А насколько критично их писать не на одной строке? Добавляй перевод строки и все будет работать. А еще лучше хранить это в dbm файле. Доступ будет проще и быстрее. И используй модуль CGI, он тебе сильно жизнь облегчит. Да и массив тебе ничем не мешает, скорее наоборот

Код

#!/usr/bin/perl #Crafted by Ku6ep :) use strict; use warnings; use CGI; my %Q = CGI::Vars(); my $LIMIT=10; # макс. кол-во элементов my @buf; my $file = 'data/outfile'; print CGI::header(); die "Don't get variable!\n" unless $Q{value}; # Умереть если не передана value if (-e $file){     open FR,"<$file" or die "Can't open file, $!";     while (<FR>) {         chomp;         push (@buf,$_);         if (/^$Q{value}/) {             print "Data exists!";             exit;          }     }     shift @buf if @buf >= $LIMIT; } push(@buf, $Q{value});  open FO,">$file" or die "Can't open file, $!"; print FO "$_\n" for @buf; # Добавляем перевод строки к каждой записи close FO; print "Data added...";

Проверь, может подойдет
P.S. Увидел ответы после того как написал Так что у тебя теперь есть из чего составить нужный тебе скрипт...

Вот, еще один вариант, так сказать "компиляция советов"

Код

#!/usr/bin/perl use strict; use warnings; use CGI; my %Q = CGI::Vars(); die "Don't get variable!\n" unless $Q{value}; # Умереть если не передана value my $LIMIT=10; # макс. кол-во элементов my $datalengh=4; # длина одной записи my (@buf, $buff); my $file = 'data/outfile_bin'; print CGI::header(); if (!-e $file) { # Создать файл если не было...     open FH, "> :raw",$file;     print FH pack("a$datalengh",$Q{value}); # ...записать в него данные...     close FH;     print "Data added...";     exit; #... и выйти } open FH, "+< :raw",$file or die "Can't open file, $!"; # :raw - вместо binmode :) while (read(FH,$buff,$datalengh)) {     if (unpack("a$datalengh",$buff) eq $Q{value}) {         print "Data exists!";         exit;     }     push (@buf,$buff); } shift @buf if @buf >= $LIMIT; push(@buf, pack("a$datalengh",$Q{value})); seek(FH,0,0); print FH for @buf; close FH; print "Data added...";

Ураааа! Работает Пасибо огромное всем за помощь!
Не уверен насчет flock(), говорят это срабатывает не во всех случаях,
еще не получилось открыть файл с ключом :raw - Unknown open mode!
а в остальном вот наваял по вашим советам

Код

#!/usr/bin/perl use strict; #use warnings; my $value = shift(@ARGV); # берет командную строку my $LIMIT=10; # макс. кол-во элементов my $datalengh=4; # длина одной записи my (@buf, $buff); my $file="test.txt"; my $flag = 0; if (!-e $file) { # Создать файл если не было...     open FH, ">$file";     binmode FH;     print FH pack("a$datalengh",$value);     # записать в него данные...     close (FH);     #print "Data added...";     exit(0);  } # Отkрываем файл для чтения и записи  open FH, "+<$file";        # Unknown open mode!!! if open FH, "+< :raw"; вместо binmode :)  flock (FH, 2);  binmode FH;  seek(FH, 0, 0); # Читаем файл блоками по $block_length байт  while (read(FH,$buff,$datalengh)) {     if (unpack("a$datalengh",$buff) eq $value) {         #print "Data exists!";         #exit;        $flag = 1;        last;     }     push (@buf,$buff);    # Сохраняем в массив полученный блок     } # Проверяем был ли установлен флаг, если нет то: unless ( $flag ) { shift @buf if @buf >= $LIMIT; push(@buf, pack("a$datalengh",$value)); seek(FH,0,0); print FH for @buf; } flock (FH, 0); close FH;

Вообще-то, было бы не плохо проверять файл не только на существование, но так же и на то, что он является двоичным.

Код

# Удаляем файл если он существует и не является двоичным unlink $file if ( (-e $file) and (!-B $file) ); unless ( -e $file ) {               # Файл не существует } else {               # Существует, а так же он двоичный }

Но это уже тонкости.

Еще выяснилось что паковать надо с флагом Н8, иначе данные сохраняются как строка символов. а не двоичное число
Для оптимизации поиска ввел дополнительную переменную, чтобы не распаковывать в цикле.

Код

my $bin_a=pack("H8",$value); ####################  while (read(FH,$buff,$datalengh)) {     if ($buff eq $bin_a) {        $flag = 1;        last;     }     push (@buf,$buff);     }

a - Строка байт, дополняемая нулями
H - Шестнадцатиричная строка, старший полубайт впереди.