22-й выпуск журнала Pragmatic Perl

Смелое утверждение. Про существование оператора // я в курсе. Мне в таком тоне общаться не интересно.

Ну во-первых, прошу прощения за прямолинейность. Я не пытался как-то задеть вас. Утверждение вполне заслуженное. Я повторюсь еще раз чтобы вы поняли что имеется ввиду: конструкия if($var) - это вычисляемое значение под bool, а в примере идет проверка на определенность. Конечно, тест на истинность неопределенности всегда дает ложный результат, и это логично, т.к. истинность неопределенного выражения невозможно установить впринципе.

Приведённые примеры «простоваты», жизнь бывает посложнее. Вобщем, я повторю один раз: приравнивание строкового нуля к «false» может приводить к проблемам в программе. Сам я не помню когда последний раз такую ошибку совершал, просто отмечаю этот момент.

Я думаю ваш пример немного неудачный, понятно что проверять «контент» переменной в этом случае неверно, т.к. требуется проверить собственно наличие «контента». Да, бывают случаи сложнее (вспомните хотя бы «0E0»), но и это не вызывает сложности.

Не откажешься посмотреть проектик на github? Буду рад конструктивной критике.

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

но наверное гляну если ссылку опубликуешь.

Надеюсь на это. Сам проект довольно большой и обладает огромным недостатком — слабостью документации. Но сил на неё надо много, а времени пока что не было. https://github.com/pef-secure/pef-front-psgi-dist

Обзорное «полотно»: https://github.com/pef-secure/pef-front-psgi-dist/blob/master/lib/PEF/Front/I...

Заодно, можно будет уже судить по моему уровню владения перлом.

Утверждение вполне заслуженное.

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

Надеюсь на это. Сам проект довольно большой и обладает огромным недостатком — слабостью документации. Но сил на неё надо много, а времени пока что не было. https://github.com/pef-secure/pef-front-psgi-dist

Глянул, но сильно не смотрел и не вникал в суть дела. Проверил по коду некоторые «ньюансы» и увидел что вы на perl программируете достойно. Я ошибся по поводу ваших знании perl'а, прошу принять мои извинения.

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

1. PEF::Front::Config

Конфиг наверное лучше переложить под PON и на загрузке приложения eval'нуть его в хэш. Тогда, простым перебором key/value под map или в цикле вы через eval можете генерировать нужные sub'ы в нужном пакете с определением дефолтных значении в другом хэше (как раз оператор // тут поможет). «+» за список @std_params, но cfg_ можно было и не писать в принципе, а отдать под рантайм: $s = «cfg_$v».

2. PEF::Front::Validator::make_value_parser :

$ret = qq~do {
  my \$tmpl = '[% $exp %]';
  my \$out;
  \$tt->process_simple(\\\$tmpl, \$stash, \\\$out) or \$logger->({level => \"error\", message => 'error: $exp - ' . \$tt->error});\n
  \$out;
}~;

3. Вы используете GD::SecurityImage для капчи и полагаю что достаточно «поигрались» и подобрали для себя ряд параметров при котором получается достойная капча. Можете опубликовать свои параметры (включая шрифты, размеры и т.д.) ?

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

Я понимаю. Но в этом примере корень этих возможных проблем в программисте, а не в ЯП. Пример «не очень».

Как раз сам способ конфигурирования, что я применил, считаю очень удачным. Есть довольно прозрачное слияние параметров, что конфигурирует пользователь с параметрами, предусматриваемыми фреймворком и параметрами, что пользователь сам пожелает. Например в конфиге:

our @EXPORT = qw/product_items_path/;
sub product_images_path () { cfg_www_static_dir() .'/product_images' }

Здесь cfg_www_static_dir() — вычисленный фреймворком или предоставленный пользователем параметр. В каком-то локальном модуле требуется получить не-фреймворка параметр, который зависит от параметра фреймворка:

use PEF::Front::Config;
...
 my $image = product_images_path() . '/' . $image_name;

Сделать подобное через хеш конфигурации мне представляется довольно спорным решением. Здесь на стороне функций автоматическая проверка, что если параметра нет, то не будет тихого undef, а будет громкий die. Подобного способа нигде не встречал, так что считаю своим изобретением, может быть не очень простым в осознании :)

Про функции генерации кода — их сложно написать красиво, но почистить стоит, это да.

GD::SecurityImage — свои параметры оптимальными не считаю. Это, вобщем, тема для отдельного холивара. Просто после пары часов мучений решил «и так сойдёт» :) Недавно снова пересматривал результат и не доволен, надо будет снова поиграть с параметрами. Кстати, чтобы буквы «прыгали», им надо установить допустимые углы наклона, я использовал «0E0» для этого. Всё равно там проблема с центровкой и вылетанием букв за границы изображения.

our @EXPORT = qw/product_items_path/;

опечатка. должно быть

our @EXPORT = qw/product_images_path/;

Сделать подобное через хеш конфигурации мне представляется довольно спорным решением. Здесь на стороне функций автоматическая проверка, что если параметра нет, то не будет тихого undef, а будет громкий die.

diff --git a/Boot.pm b/Boot.pm
new file mode 100644
index 0000000..b01b7cf
--- /dev/null
+++ b/Boot.pm
@@ -0,0 +1,32 @@
+package Boot;
+
+# Boot code here
+
+package My::Config;
+use strict;
+
+*My::config = \( our $cfg = {
+	std_value  => '17',
+	std_string => 'def_string',
+    }
+);
+
+(eval "\*cfg_$_ = sub{\"$cfg->{$_}\"};", $@ && die "$@") for keys %$cfg;
+
+my ($h, $fh);
+open $fh, 'conf.pl' || die "Can't open conf.pl: $!\n";
+
+$h = eval join '', <$fh>;
+$@ && die "error in config: $@";
+
+close $fh;
+
+unshift @INC, @{$h->{include}};
+
+(
+    (eval "\*cfg_$_ = sub{\"$h->{$_}\"}", $@ && die "$@"), $cfg->{$_} = $h->{$_} 
+)for keys %$h;
+
+$cfg->{$_} // die "ERROR: undefined param detected: $_\ncan't continue\n" for keys %$cfg;
+
+1;
diff --git a/Include/TestLoad.pm b/Include/TestLoad.pm
new file mode 100644
index 0000000..d60f2ed
--- /dev/null
+++ b/Include/TestLoad.pm
@@ -0,0 +1,5 @@
+package TestLoad;
+
+print "Loading TestLoad:: ...\n";
+
+1;
diff --git a/conf.pl b/conf.pl
new file mode 100644
index 0000000..95f6ae1
--- /dev/null
+++ b/conf.pl
@@ -0,0 +1,15 @@
+sub call_perl_rocks{
+    `notify-send "PERL5 ROCKS!!"`;
+    1337
+};
+
+my $axiom = pack 'H*', '504850205355434B532121';
+
+{
+    include 	=> 	[qw{./Include}],
+    bind 	=>	[qw/127.0.0.1 18080/],
+    any_value1 	=> 	(eval "use constant{M_PI => 3.14159265359};1;" ? cfg_std_value . cfg_std_string : die "$@"),
+    axiom	=> 	(eval 'my $tmp = `find /boot/ -name grub.cfg`; chomp $tmp; $cfg->{"grub.cfg"} = $tmp;' ? $axiom : die $@),
+    pi		=> 	M_PI(),
+    const_1337 	=>	call_perl_rocks(),
+}
diff --git a/test.pl b/test.pl
new file mode 100644
index 0000000..8cb395e
--- /dev/null
+++ b/test.pl
@@ -0,0 +1,15 @@
+#!perl
+
+BEGIN{
+    $\ .= "\x0A";
+}
+
+use Boot;
+use Data::Dumper;
+use TestLoad;
+use strict;
+
+$Data::Dumper::Terse = 1;
+print "Dumping config:\n", Dumper $My::config;
+
+print "what about user-defined axiom?\n - ", My::Config::cfg_axiom();

Вот вариант адаптированный под ваш случай. Накидал на коленке, поэтому возможно что-то упустил из виду. Из существенного - добавил определение sub под значение из конфигов.

Как вам такой вариант?

GD::SecurityImage — свои параметры оптимальными не считаю.
Это, вобщем, тема для отдельного холивара. Просто после пары часов мучений решил «и так сойдёт» :) Недавно снова пересматривал результат и не доволен, надо будет снова поиграть с параметрами. Кстати, чтобы буквы «прыгали», им надо установить допустимые углы наклона, я использовал «0E0» для этого. Всё равно там проблема с центровкой и вылетанием букв за границы изображения.

Вот я «игрался» когда-то, вдруг мои наработки помогут вам сэкономить немного времени.

#!/usr/bin/morbo

use Mojolicious::Lite;
use GD::SecurityImage;
use MIME::Base64;
use Crypt::CBC;

my $pass = '10x#laf~WfU$ax`V2s%83meA';

$|=1;

my @fontlist = map {chomp; $_} `ls font`;

my ($pm, $i) = (10000, );

my $font_list = {
    $pm+1, '8-PM____.TTF',
    $pm+2, 'MATRIX.ttf',
    $pm+3, 'Merchant Copy.ttf',
};

get '/captcha(:part)' => sub{
    my $self = shift;
    my $part = $self->param('part');
    my $font = $fontlist[rand(@fontlist) % @fontlist];

    my $image = GD::SecurityImage->new(
	#rnd_data => [0...9, 'A'...'Z', 'a'...'z'],
	rnd_data => [1...9, 'A'...'H', 'J'...'N','P'...'Z', 'a'...'h', 'j'...'n', 'p'...'z'],
	width    => 200,
	height   => 100,
	lines    => 1,
	scramble => 0,
	angle    => -7 + rand(14),
	ptsize	 => 25,
	frame    => 1,
	rndmax   => 7,
#	gd_font  => 'giant',
	bgcolor   => '#ddeeee',
#	bgcolor	 => '#000000',
	font	 => 'font/'.($font_list->{$part} || $font),
#	scolor    => '#ff0000',
    );

    $image->random();
    $image->create(qw/ttf rect/, '#001100', '#000000');
#    $image->create(qw/ttf rect/, '#ffffff', '#000000');
    $part && $part < $pm && $image->particle($part, 1);

    my ($img, $type, $str) = $image->out(force => 'png', compress => 9);

    $self->session('captcha_string' => encode_base64( Crypt::CBC->new( -key => $pass, -cipher => 'Blowfish')->encrypt($str) ));
    print "font: [$font] string: [$str]\n";

    $self->render_data($img, format => 'png');
};

get '/' => sub{
    my $self = shift;
    $self->render('test');
};

post '/test' => sub{
    my $self = shift;
    my $cap = Crypt::CBC->new( -key => $pass, -cipher => 'Blowfish')->decrypt( decode_base64( $self->session->{'captcha_string'} ) );
    my $test = !!(uc($cap) eq uc($self->param('capstr')));
    $self->render(text => 'Test result '.( $test ? 'SUCCESS' : 'FAIL' ));
};

app->start;

__DATA__
@@ test.html.ep
<html>
<body>
<br /><br />
<img src='captcha0' alt='captcha image' />
<img src='captcha1000' alt='captcha image' />
<img src='captcha2000' alt='captcha image' />
<img src='captcha4000' alt='captcha image' />
<img src='captcha8000' alt='captcha image' />
<img src='captcha10001' alt='captcha image' />
<img src='captcha10002' alt='captcha image' />
<img src='captcha10003' alt='captcha image' />
<br/>
<br/>
<form action="test" method="post">
<input type="text" name="capstr"/>
<input type="submit"></input>
</form>
</body>
</html>

там где лежит скрипт - создайте директорию font и в него накидайте ttf-файлы шрифтов. Я перебрал много шрифтов и много что поудалял из-за непригодности. В след. сообщении будет список файлов.

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

я нафлудил - а ты разбирайся :)

Как вам такой вариант?

Интересный вариант. Сходу, правда, не вижу особых преимуществ :) Но выглядит интересно, надо подумать. Я, пожалуй, накатаю статейку про свой метод, чтобы объяснить задачи что решались и как они решились. В моём варинте допустимо в параметрах, что передаёт пользователь, использовать параметры, что были «стандартно» вычислены фреймворком. В рамках прагматикперла, мне кажется, объёма объяснения и примеров хватит на статейку. Уж больно они там короткие, как правило :)

Вот я «игрался» когда-то, вдруг мои наработки помогут вам сэкономить немного времени.

да, я тоже фонты брал ttf, только не копировал, это непригодно для «фреймворка», т.е. надо какой-то «общий» вариант придумывать. можно, конечно, просто рецепт про фонты написать, как это в твоём варианте. я заметил, что относительно приличную капчу через GD::SecurityImage можно сделать, если дать много свободного места буквам, в моих случаях вёрстка этого не позволяла. В общем, в далёком туду у меня есть создание своей капчи.

Perl - это COBOL 21-го века. Огромные кучи говна, написаного на нем, еще долго будут кормить любителей в нем покопаться. Понаписали его, в свое время, действительно очень много и надо все это как-то поддерживать, пока потребность в этом коде не отпадет. Кстати, очень понятно, почему некоторые продолжают писать на нем. Перл надо вдолбить в мозг, чтобы можно было как-то его использовать. Это, неизбежно, влечет за собой утрату способности эффективно использовать любой другой язык.

Perl - это COBOL 21-го века. Огромные кучи говна, написаного на нем, еще долго будут кормить любителей в нем покопаться. Понаписали его, в свое время, действительно очень много и надо все это как-то поддерживать, пока потребность в этом коде не отпадет. Кстати, очень понятно, почему некоторые продолжают писать на нем. Перл надо вдолбить в мозг, чтобы можно было как-то его использовать. Это, неизбежно, влечет за собой утрату способности эффективно использовать любой другой язык.

Глупый ты. Ну а мнение болванов не интересуют.

eval «\*cfg_$_ = sub{\»$cfg->{$_}\«};», $@ && die «$@») for keys %$cfg

охренительно «мощный» язык, если без eval нe обойтись в таком простом случае. немудрено, что мало кто добровольно идет сопровождать это.

охренительно «мощный» язык, если без eval нe обойтись в таком простом случае. немудрено, что мало кто добровольно идет сопровождать это.

Обойтись конечно. Это я сделал через eval чтобы подчернуть возможность предварительного вычисления до собственно вычисления.

ЗЫЖ А если бы я сделать eval от eval, то этот болван наверное бы тут слюни пустил :)