freq 铀疑性

[Mikhail Stakhanov]

Здравствуйте, All!

Прошу высказать замечания, так как скрипт писал вообще первый раз:

-----freq.pl-----
#!/usr/bin/perl -w

# Генератор freq для запросов фалов
# v0.1 от 29.03.2019г.
# Работает пока только с 1й зоной

use strict;
use warnings;
use Data::Dumper qw(Dumper);
use Scalar::Util qw(looks_like_number);
my $usage = << 'EOT';

Использование: freq.pl <node> <file>
Аргументы:
node = 2:5020/932 или 5050/932
file = имя запрашиваемого файла
EOT
# Нужно прописать переменную outbound
# для Windows \ пишется как \\
# для Linux /
my $outbound="d:\\fido\\spool\\out\\";

if ($#ARGV<1) { die $usage };

my $adr=$ARGV[0];
my $fname=lc($ARGV[1]);

my $temp_str=index($adr,":");
my $zone;
if ($temp_str!=-1) {
($zone,$adr)=split(":",$adr);
} else {
$zone="2";
}
print "Зона: $zone, ";

$temp_str=index($adr,"/");
my $net;
my $node;
if ($temp_str!=-1) {
($net,$node)=split("/",$adr,$temp_str);
} else {
print "ошибка в поле адреса, шаблон *:*/*";
}
print "Сеть: $net, ";
print "Нода: $node\n";

if (!looks_like_number($zone)) { die "Зона должна быть числом!\n"};
if (!looks_like_number($net)) { die "Сеть должна быть числом!\n"};
if (!looks_like_number($node)) { die "Нода должна быть числом!\n"};
my $adr_hex=sprintf("%x",$net);
if ($node<4096) {$adr_hex.="0"};
$adr_hex.=sprintf("%x",$node);
my $freq=$adr_hex.".req";

open(HANDLE,">$outbound"."$freq");
print HANDLE $fname;
close(HANDLE);
-----

Всего наилучшего, Mikhail

[Eugene Grosbein]

30 марта 2019, суббота, в 02:12 NOVT, Mikhail Stakhanov написал(а):

MS> Прошу высказать замечания, так как скрипт писал вообще первый раз:

MS> -----freq.pl-----
MS> #!/usr/bin/perl -w

use warnings ниже это полный эквивалент -w, так что -w избыточен.

MS> # Генератор freq для запросов фалов
MS> # v0.1 от 29.03.2019г.
MS> # Работает пока только с 1й зоной
MS> use strict;
MS> use warnings;
MS> use Data::Dumper qw(Dumper);
MS> use Scalar::Util qw(looks_like_number);
MS> my $usage = << 'EOT';
MS> Использование: freq.pl <node> <file>
MS> Аргументы:
MS> node = 2:5020/932 или 5050/932
MS> file = имя запрашиваемого файла
MS> EOT
MS> # Hужно прописать переменную outbound
MS> # для Windows \ пишется как \\
MS> # для Linux /
MS> my $outbound="d:\\fido\\spool\\out\\";

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

MS> if ($#ARGV<1) { die $usage };
MS> my $adr=$ARGV[0];
MS> my $fname=lc($ARGV[1]);
MS> my $temp_str=index($adr,":");
MS> my $zone;
MS> if ($temp_str!=-1) {
MS> ($zone,$adr)=split(":",$adr);
MS> } else {
MS> $zone="2";
MS> }
MS> print "Зона: $zone, ";
MS> $temp_str=index($adr,"/");
MS> my $net;
MS> my $node;
MS> if ($temp_str!=-1) {
MS> ($net,$node)=split("/",$adr,$temp_str);
MS> } else {
MS> print "ошибка в поле адреса, шаблон *:*/*";

Hефатальные сообщения об ошибках надо выдавать на STDERR,
то есть писать print STDERR "".

Hо тут у тебя это место наверняка должно быть фатальной ошибкой,
а то ты увидел некорректные данные, ругнулся и спокойно работаешь
дальше, как будто данные верные? Видимо, тут вообще нужен die
вместо print.

MS> }
MS> print "Сеть: $net, ";
MS> print "Hода: $node\n";

А почему в одной строке (нету \n у первого print) слово Hода
с заглавной буквы? И вообще это жаргонизм, пиши либо по-английски,
либо по-русски "узел".

MS> if (!looks_like_number($zone)) { die "Зона должна быть числом!\n"};
MS> if (!looks_like_number($net)) { die "Сеть должна быть числом!\n"};
MS> if (!looks_like_number($node)) { die "Hода должна быть числом!\n"};

Тебе не нужен looks_like_number, оно делает не то, что ты думаешь
(например, строку Infinity оно посчитает за "число").

То, что тебе надо, пишется гораздо короче в перле:

die "Зона должна быть числом!"

unless all { /^\d+$/ } ($zone, $net, $node);

То есть, выбрасывать исключение, если неверно, что для каждой переменной
списка выполняется условие в фигурных скобках, проверяющее,
что от начала ^ и до конца $ в переменной только цифры (\d обозначает цифру).

Выражение 'all' доступно в стандартном модуле, просто добавь use List::Util
'all';
Кроме простых переменных тут можно использовать любое выражение, разумеется.

MS> my $adr_hex=sprintf("%x",$net);
MS> if ($node<4096) {$adr_hex.="0"};

Эти две строчки короче пишутся так:
my $adr_hex=sprintf('%04x',$net);

Четверка перед x говорит, что результат должен быть строкой из четырех
символов и если бы после % не было нуля, то более короткие строки дополнялись
бы пробелом, так - нулём. Это стандатный формат printf и его вариаций,
ещё из языка C пришел.

MS> $adr_hex.=sprintf("%x",$node);
MS> my $freq=$adr_hex.".req";

Это тоже пишется одним выражением:
my $freq=sprintf("%x.req",$node);

В форматной строке могут быть и обычные символы.

MS> open(HANDLE,">> $outbound"."$freq");
MS> print HANDLE $fname;
MS> close(HANDLE);

Все файловые операции должны сопровождаться проверкой успешности,
даже print может завершиться неуспешно, если место закончилось,
и тогда надо выбрасывать исключение, а не делать вид, что всё отработало.

И в perl не нужно постоянно вручную склеивать строки, он прекрасно
подставляет более чем одну переменную внутрь двойных кавычек:

die "Системная ошибка $! при записи в $outbound.$freq"
unless open(HANDLE,">>$outbound.$freq") && print HANDLE $fname &&
close(HANDLE);
exit(0);

Eugene

[Eugene Grosbein]

30 марта 2019, суббота, в 02:12 NOVT, Mikhail Stakhanov написал(а):

MS> my $temp_str=index($adr,":");
MS> my $zone;
MS> if ($temp_str!=-1) {
MS> ($zone,$adr)=split(":",$adr);
MS> } else {
MS> $zone="2";
MS> }
MS> print "Зона: $zone, ";

Отдельно насчёт обработки строк - это изначально была основная задача Perl
и его языковые средства очень богаты, не надо бояться их использовать.
Весь процитированный громздкий блок сокращается до одной простой строки:

$adr =~ /^(.+?):(.+)/ and ($zone,$adr)=($1,$2) or $zone='2';

То есть проверяем, что $adr соответствует шаблону: после начала строки ^
идёт непустая группа символов, затем двоеточие, затем вторая непустая группа
символов. Если соответствует, то перезаписываем $zone первой группой,
а $addr второй, а иначе только пишем двойку в $zone.

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

MS> $temp_str=index($adr,"/");
MS> my $net;
MS> my $node;
MS> if ($temp_str!=-1) {
MS> ($net,$node)=split("/",$adr,$temp_str);
MS> } else {

MS> print "ошибка в поле адреса, шаблон *:*/*";
MS> }

То же самое тут, одной строкой:

$adr =~ m|^(.+?)/(.+)| and ($net,$node)=($1,$2) or die "ошибка ...";

Если в шаблоне есть прямой слеш, то Perl позволяет обрамлять шаблон
и другими символами, а не только слешами - тут использовал вертикальную черту |
Hо тогда нужна полная форма оператора "match", с буквой m в начале,
она необязательна только если обрамление слешами.

Eugene
--
Поэты - страшные люди. У них все святое.

[Mikhail Stakhanov]

Здравствуйте, Eugene!

Ответ на сообщение Eugene Grosbein (2:5006/1) к Mikhail Stakhanov,
написанное 30 мар 19 в 09:58:
Спасибо!
Кол-во строк сократилось:

#!/usr/bin/perl

# Генератор freq для запросов фалов

# v0.1b от 30.03.2019г.
# Работает пока только с одной зоной

use strict;
use warnings;

my $usage = << 'EOT';

Использование: freq.pl <node> <file>
Аргументы:

node = 2:5020/932 или 5050/932

file = имя запрашиваемого файла

EOT
# Нужно прописать переменную outbound

my $outbound="d:\\fido\\spool\\out\\";

> здесь он ругается на окончание \', как я понимаю это он воспринимает как
> ' внутри константы, как правильно написать ?

if ($#ARGV<1) { die $usage };

my $adr=$ARGV[0];
my $fname=lc($ARGV[1]);

my ($zone, $net, $node);
$adr =~ m|^(\d+?):(\d+)/(\d+)$| and ($zone,$net,$node)=($1,$2,$3) or
$adr =~ m|^(\d+?)/(\d+)$| and ($net,$node)=($1,$2) and $zone='2' or die
"Ошибка в формате адреса *:*/*";
print "Зона: $zone, Сеть: $net, Нода: $node\n";
> пока зону не использует, но все работает в такой конструкции а можно
> как-то писать and {} чтобы не писать and ... and ... ?

my $adr_hex=sprintf('%04x%04x',$net,$node);
my $freq=sprintf("%s.req",$adr_hex);

die "Системная ошибка $! при записи в $outbound$freq"
unless open(HANDLE,">>$outbound"."$freq") and print HANDLE $fname and
close(HANDLE);

exit(0);
----

Всего наилучшего, Mikhail

[Eugene Grosbein]

30 марта 2019, суббота, в 10:02 NOVT, Mikhail Stakhanov написал(а):


MS> my $outbound="d:\\fido\\spool\\out\\";

>> здесь он ругается на окончание \', как я понимаю это он воспринимает как
>> ' внутри константы, как правильно написать ?

Тут я ошибся, даже внутри одинарных кавычек Perl интерпретирует обратный слеш
как управляющий символ, так что его надо удваивать. Hо можно это дело
автоматизировать:

my $outbound='d:/fido/spool/out/';
# заменяем прямые слеши на обратные, если под Windows
$outbound =~ s|/|\\|g if $^O =~ /MSWin/;

MS> $adr =~ m|^(\d+?):(\d+)/(\d+)$| and ($zone,$net,$node)=($1,$2,$3) or
MS> $adr =~ m|^(\d+?)/(\d+)$| and ($net,$node)=($1,$2) and $zone='2' or
MS> die
MS> "Ошибка в формате адреса *:*/*";
MS> print "Зона: $zone, Сеть: $net, Hода: $node\n";

>> пока зону не использует, но все работает в такой конструкции а можно
>> как-то писать and {} чтобы не писать and ... and ... ?

Hе понял, что именно ты собираешься тут группировать скобками,
но в логических выражениях можно применять круглые собки, разумеется.

MS> my $adr_hex=sprintf('%04x%04x',$net,$node);
MS> my $freq=sprintf("%s.req",$adr_hex);

Вот уж чего никогда не стоит делать в Perl так это последний sprintf
для склеивания строк, вместо этого работает простой $freq="$adr_hex.req"

А если $adr_hex отдельно ненужен, то обе эти строки сворачиваются в одну:

my $freq=sprintf('%04x%04x.req',$net,$node);

Eugene
--
Господа Действительного Положения Вещей предохраняют себя от голода своим
богатством, от общественного мнения - тайной и анонимностью,
от частной критики - законами против клеветы и тем, что средства связи
находятся в их распоряжении. (Hорберт Винер)

[Mikhail Stakhanov]

Здравствуйте, Eugene!

Ответ на сообщение Eugene Grosbein (2:5006/1) к Mikhail Stakhanov,

написанное 01 апр 19 в 02:09:
EG> my $outbound='d:/fido/spool/out/';
EG> # заменяем прямые слеши на обратные, если под Windows
EG> $outbound =~ s|/|\\|g if $^O =~ /MSWin/;
Спасибо работает.

MS>> $adr =~ m|^(\d+?):(\d+)/(\d+)$| and ($zone,$net,$node)=($1,$2,$3)

MS>> or

MS>> $adr =~ m|^(\d+?)/(\d+)$| and ($net,$node)=($1,$2) and

MS>> $zone='2' or die "Ошибка в формате адреса *:*/*"; print "Зона:
MS>> $zone, Сеть: $net, Hода: $node\n";

>>> пока зону не использует, но все работает в такой конструкции а
>>> можно как-то писать and {} чтобы не писать and ... and ... ?

and ... and ... and ...

MS>> my $adr_hex=sprintf('%04x%04x',$net,$node);
MS>> my $freq=sprintf("%s.req",$adr_hex);

EG> Вот уж чего никогда не стоит делать в Perl так это последний sprintf
EG> для склеивания строк, вместо этого работает простой
EG> $freq="$adr_hex.req"
Поправил
EG> А если $adr_hex отдельно ненужен, то обе эти строки сворачиваются в
EG> одну:

EG> my $freq=sprintf('%04x%04x.req',$net,$node);
Исправил.
Осталось дописать проверку на созданный каталог, если зона отличается от
def_zone,
Если его нет, то создать его, и туда запихнуть req. И будет тогда все...

Всего наилучшего, Mikhail

[Brother Rabbit]

Hi, Mikhail!

31 мар 19 22:29, Mikhail Stakhanov -> Eugene Grosbein:

MS> Спасибо работает.

=== Import Windows Clipboard Start ===

sub getBSOname
{
my ( $addr, $out ) = @_;
$addr =~ /([\d]+)\:([\d]+)\/([\d]+)\.?([\d]*)/;
my ( $zone, $net, $node, $point ) = ( $1, $2, $3, $4 );

$bsoname = $out;
$bsoname .= ".".sprintf("%03x", $zone) if $zone != $defaultzone;
mkdir $bsoname unless -e $bsoname;

$bsoname .= "\\" if $bsoname =~ /\\/;
$bsoname .= "\/" if $bsoname =~ /\//;

$bsoname .= sprintf("%04x", $net) . sprintf("%04x", $node);
if ( defined ( $point ) && $point != 0 ) {
mkdir $bsoname unless -e $bsoname;
$bsoname .= "\\" if $bsoname =~ /\\/;
$bsoname .= "\/" if $bsoname =~ /\//;
$bsoname .= sprintf( "%08x", $point );
}
return $bsoname;
}

=== Import Windows Clipboard End ===

$freqfilename = getBSOname($address, '/home/fido/out/fidonet') . '.req';

Требуется глобальная переменная $defaultzone. Обычно берется из конфига или
указывается явно прямо в скрипте.

Have nice nights.
Brother Rabbit.

[Eugene Grosbein]

31 марта 2019, воскресенье, в 20:29 NOVT, Mikhail Stakhanov написал(а):

MS>>> $adr =~ m|^(\d+?):(\d+)/(\d+)$| and ($zone,$net,$node)=($1,$2,$3)
MS>>> or
MS>>> $adr =~ m|^(\d+?)/(\d+)$| and ($net,$node)=($1,$2) and
MS>>> $zone='2' or die "Ошибка в формате адреса *:*/*"; print "Зона:
MS>>> $zone, Сеть: $net, Hода: $node\n";
>>>> пока зону не использует, но все работает в такой конструкции а
>>>> можно как-то писать and {} чтобы не писать and ... and ... ?

MS> and ... and ... and ...

Это не просто перечисление операторов - это вычисление логического выражения,
причём если одно из двух или более условий, соединённых and, окажется ложным,
то второе даже не будет вычисляться. У каждого присвавания в Perl, как и в C
(но в отличие от Pascal), есть "результат": то значение, которое было
присвоено, и вот этот результат тоже оценивается как логическая истина
или ложь. Ложью в Perl считается неопределённое значение undef,
целочисленный ноль (0) и пустая строка, а всё остальное - истиной.

Так что, когда Perl исполняет эту строку:

$adr =~ m|^(\d+?)/(\d+)$| and ($net,$node)=($1,$2) and $zone='2';

он не просто выполняет подряд эти операторы, а именно оценивает
их логические значения: первый оператор =~ сам по себе логический,
проверка на соответствие шаблону и если он вернул истину,
то выполняется присваивание списку, а затем список конвертируется
в скалярный контекст - от него берётся длина - и эта длина
тут всегда 2, то есть не ложь, поэтому и третий оператор
тоже выполняется и результат его непустая строка '2' - тоже
не ложь, так что всё выражение целиком истина и альтернатива
после or не будет исполняться.

Формально говоря, есть возможность выполнить в логическом
выражении несколько операторов "подряд", не связывая их все
через and и не проверяя значение каждого, если использовать
оператор "запятая":

$adr =~ m|^(\d+?)/(\d+)$| and ( ($net,$node)=($1,$2), $zone='2' )
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ вот эта

Это всё ещё корректное логическое выражение и исполняться
оно будет почти так же, за тем исключением, что запятая
всегда исполняет все перечисленные операторы, игнорируя
их значания, кроме значения последнего - оно используется
как итоговое значение всей конструкции во внешних скобках.
В данном случае это будет '2', то есть истина.
Hо выглядит это хуже, чем исходный вариант.

Eugene

[Eugene Grosbein]

31 марта 2019, воскресенье, в 21:40 NOVT, Brother Rabbit написал(а):

BR> sub getBSOname
BR> {
BR> my ( $addr, $out ) = @_;
BR> $addr =~ /([\d]+)\:([\d]+)\/([\d]+)\.?([\d]*)/;
BR> my ( $zone, $net, $node, $point ) = ( $1, $2, $3, $4 );
BR> $bsoname = $out;
BR> $bsoname .= ".".sprintf("%03x", $zone) if $zone != $defaultzone;
BR> mkdir $bsoname unless -e $bsoname;
BR> $bsoname .= "\\" if $bsoname =~ /\\/;
BR> $bsoname .= "\/" if $bsoname =~ /\//;
BR> $bsoname .= sprintf("%04x", $net) . sprintf("%04x", $node);
BR> if ( defined ( $point ) && $point != 0 ) {
BR> mkdir $bsoname unless -e $bsoname;
BR> $bsoname .= "\\" if $bsoname =~ /\\/;
BR> $bsoname .= "\/" if $bsoname =~ /\//;
BR> $bsoname .= sprintf( "%08x", $point );
BR> }
BR> return $bsoname;
BR> }
BR> === Import Windows Clipboard End ===
BR> $freqfilename = getBSOname($address, '/home/fido/out/fidonet') . '.req';
BR> Требуется глобальная переменная $defaultzone. Обычно берется из конфига
BR> или
BR> указывается явно прямо в скрипте.

И абсолютно никаких проверок. Что будет, если передан некорректный формат
адреса, или формат корректный, но на месте создаваемого каталога
уже есть такое имя, только это обычный файл?

Я уж не говорю о странном склеивании sprintf("%04x", $net) . sprintf("%04x",
$node)
вместо одного простого вызова sprintf("%04x04x", $net, $node),
и четырехкратного поиска слешей в $bsoname вместо однократного.

Eugene
--
Устав от радостных пиров,
Hе зная страхов и желаний

[Brother Rabbit]

Hi, Eugene!

01 апр 19 15:30, Eugene Grosbein -> Brother Rabbit:

BR>> sub getBSOname
BR>> {
BR>> my ( $addr, $out ) = @_;
BR>> $addr =~ /([\d]+)\:([\d]+)\/([\d]+)\.?([\d]*)/;
BR>> my ( $zone, $net, $node, $point ) = ( $1, $2, $3, $4 );
BR>> $bsoname = $out;
BR>> $bsoname .= ".".sprintf("%03x", $zone) if $zone != $defaultzone;
BR>> mkdir $bsoname unless -e $bsoname;
BR>> $bsoname .= "\\" if $bsoname =~ /\\/;
BR>> $bsoname .= "\/" if $bsoname =~ /\//;
BR>> $bsoname .= sprintf("%04x", $net) . sprintf("%04x", $node);
BR>> if ( defined ( $point ) && $point != 0 ) {
BR>> mkdir $bsoname unless -e $bsoname;
BR>> $bsoname .= "\\" if $bsoname =~ /\\/;
BR>> $bsoname .= "\/" if $bsoname =~ /\//;
BR>> $bsoname .= sprintf( "%08x", $point );
BR>> }
BR>> return $bsoname;
BR>> }
BR>> === Import Windows Clipboard End ===
BR>> $freqfilename = getBSOname($address, '/home/fido/out/fidonet') . '.req';
BR>> Требуется глобальная переменная $defaultzone. Обычно берется из конфига

BR>> или указывается явно прямо в скрипте.

EG> И абсолютно никаких проверок.

Ну, почти.

EG> Что будет, если передан некорректный формат адреса,

Считается, что этого не может случиться, т.е. адрес передается заведомо
правильный (уже проверен на корректнось).

EG> или формат корректный, но на месте создаваемого каталога
EG> уже есть такое имя, только это обычный файл?

Да. Тут косяк. В BSO, кстати, это вполне может случиться.

EG> Я уж не говорю о странном склеивании sprintf("%04x", $net) .
EG> sprintf("%04x", $node) вместо одного простого вызова sprintf("%04x04x",
EG> $net, $node),

Спасибо. Я не знал, что так можно.

EG> и четырехкратного поиска слешей в $bsoname вместо однократного.

Согласен.
# считается, что аутбаунд уже проверен на корректность.
$slash = $1 if $out =~ /([\\\/])/;
# [...skipped...]
$bsoname .= $slash;