Нашли или выдавили из себя код, который нельзя назвать нормальным, на который без улыбки не взглянешь? Не торопитесь его удалять или рефакторить, — запостите его на говнокод.ру, посмеёмся вместе!
−102
($sec,$min,$hour,$mday,$mon,$year) = localtime(time);
if ($sec < 10) {$sec = "0$sec";}
if ($min < 10) {$min = "0$min";}
if ($hour < 10) {$hour = "0$hour";}
if ($mday < 10) {$mday = "0$mday";}
if ($mon < 10) {$mon = "0$mon";}
$mon++;
$year = 1900 + $year;
print "[$mday-$mon-$year $hour:$min:$sec]\n";Добиваем нулями
rohard,
24 Февраля 2011
−115
# Функция обновляет файл базы
# Пользоваться: cut_jnl($bc, $local_ip, $jnl_string_new);
sub cut_jnl
{
my ( $bc, $ip_old, $string_new ) = @_;
open (JNL, "<$bc->{const}{base_jnl}");
undef $\;
my @all_file = <JNL>;
close JNL;
chomp($string_new);
$string_new .= "\n" if ($string_new ne '');
grep { s/.*$ip_old;.*/$string_new/sg } @all_file;
open (JNL, ">$bc->{const}{base_jnl}");
grep { print JNL } @all_file;
close JNL;
$bc->{const}{info}->debug("Update jnl, update string: $ip_old on $string_new");
}no comments... особенно доставляют инструкции grep {}, это похлеще map {} будет.
SadKo,
22 Февраля 2011
−125
# Функция проверки валидность и сравнение ip адресов
# Пользоваться: dynamic_comparison_ip($bc, $s1, $s3, $s5, $s8)
sub dynamic_comparison_ip
{
my ( $bc, $s1, $s3, $s5, $s8 ) = @_;
my $ip_regext = qr/(?:[0-9]\.|[0-9]{2}\.|[0-2][0-9]{2}\.){3}(?:[0-9]|[0-9]{2}|[0-2][0-9]{2})/;
if ( ( $bc->{config_params}{HOST} eq $s1 ) or
( $bc->{config_params}{HOST} eq $s3 ) or
( $s1 eq $s3 ) or
( ($s5 =~ $ip_regext ) and ( $bc->{config_params}{HOST} eq $s5 or $s1 eq $s5 or $s3 eq $s5 ) ) or
( ($s8 =~ $ip_regext ) and ( $bc->{config_params}{HOST} eq $s8 or $s1 eq $s8 or $s3 eq $s8 ) ) or
( ($s5 =~ $ip_regext ) and ($s8 =~ $ip_regext ) and ( $s5 eq $s8 ) )
) {
$bc->{const}{warning}->debug("Warning!!!! String $_ not valid!!!");
return 1;
} else {
return 0;
}
}Предыдущие куски были мной отформатированы уже для лучшего понимания. А это - оригинал... Просто шедевр.
SadKo,
22 Февраля 2011
−123
sub initialize # Действия выполняемые непосредственно перед стартом цикла если мы ведём базу, что бы подгрузится из неё!!!!!
{
my $bc = shift;
if ( $bc->{const}{jnl} eq "1" )
{
$bc->{variable}{ip_addr} = run_shell_script("ip a", 'l');
open JNL, '<', $bc->{const}{base_jnl};
undef $\;
my @jnl_strings = <JNL>;
close JNL;
my $ip_regext = qr/(?:[0-9]\.|[0-9]{2}\.|[0-2][0-9]{2}\.){3}(?:[0-9]|[0-9]{2}|[0-2][0-9]{2})/;
map
{
chomp;
if (/^($ip_regext);(.*);($ip_regext);(.*);opt\[ip_v_2:(.*),(.*);int_2:(.*),(.*),(.*)\]$/)
{
my ( $s1, $s2, $s3, $s4, $s5, $s6, $s7, $s8, $s9 ) = ( "$1", "$2", "$3", "$4", "$5", "$6", "$7", "$8", "$9" );
if ( dynamic_comparison_ip($bc, $s1, $s3, $s5, $s8) == '1' )
{
cut_jnl($bc, $s1, '');
}
else
{
$bc->{variable}{base_virtual_ip}{$s1} = $s3;
$bc->{variable}{base_mask_v_ip}{$s1} = $s2;
$bc->{variable}{base_id}{$s1} = $s4;
$bc->{variable}{base_addit_v_ip}{$s1} = $s5;
$bc->{variable}{base_mask_v_ip_addit}{$s1} = $s6;
$bc->{variable}{base_addit_dev}{$s1} = $s7;
$bc->{variable}{base_addit_ip}{$s1} = $s8;
$bc->{variable}{base_mask_ip_addit}{$s1} = $s9;
$bc->{variable}{base_info_T}{$s1} = $bc->{variable}{no_info_T_max};
$bc->{variable}{base_delay}{$s1} = 0;
$bc->{const}{info}->debug("String $_ has been added in dynamic base");
push @{$bc->{variable}{base_load_conf}}, $s1; # Формируем базу загруженных из файла
$bc->{variable}{intrf_eth0} = Modules_SR::Ifconfig_all->new(
"$bc->{config_params}{HOST}",
"$bc->{variable}{base_mask_v_ip}{$s1}");
if ($bc->{variable}{base_addit_v_ip}{$s1})
{
$bc->{variable}{intrf_eth00} = Modules_SR::Ifconfig_all->new("
$bc->{config_params}{HOST}",
"$bc->{variable}{base_mask_v_ip_addit}{$s1}");
}
if ($bc->{variable}{base_addit_dev}{$s1})
{
$bc->{variable}{intrf_eth1} = Modules_SR::Ifconfig_all->new(
"$bc->{variable}{base_addit_dev}{$s1}",
"$bc->{variable}{base_mask_ip_addit}{$s1}");
}
check_stop_status($bc, "$s1");
}
}
else
{
$bc->{const}{info}->debug("String $_ hasn't been added in dynamic base");
$bc->{const}{warning}->debug("String $_ has incorrect format!!!");
}
} @jnl_strings;
}
} # end Действия выполняемые непосредственно перед стартом циклаВсё оттуда же. Инициализация объекта. Теперь делать через map {} стало, по-видимому, модно. Куча непонятно зачем нужных переменных и полей... FACEPALM...
SadKo,
22 Февраля 2011
−124
if ($bc->{variable}{status} eq "1" && $bc->{variable}{wait} eq "mmua" && # Действия при получении подтверждения старта
$bc->{const}{data} =~ /^MMUA\(mkd;$bc->{config_params}{VIRTUAL_IP};.*;$bc->{config_params}{HOST};$bc->{config_params}{TCM_ID};.*;.*\)$/)
{
# $bc->{const}{info}->debug("START ACCEPT");
$bc->{const}{console_out} = "1.Answer SR-Slave: ok\n";
my $res = check_virtual_ip($bc, "0", "0", "1", "$bc->{config_params}{VIRTUAL_IP}");
$bc->{const}{info}->debug("check_virtual_ip = $res");
unless ($res =~ /.*exist already and not local.*/)
{
EXECUTE_START($bc);
$bc->{const}{info}->debug("Start permit");
}
else
{
$bc->{const}{info}->debug("Start not recommend");
}
$bc->{const}{console_out} .= "2.Answer check_virtual_ip: " . $res;
open (RESPONSE, ">$bc->{const}{res_start}");
print RESPONSE $bc->{const}{console_out};
close RESPONSE;
}
elsif ($bc->{variable}{status} eq "1" && $bc->{variable}{wait} eq "mmua") # Действия при ожидании подтверждения от Сервера старта
{
# $bc->{const}{info}->debug("START ACCEPT WAIT");
if ( $bc->{variable}{var_T1} >= $bc->{variable}{T1} )
{
$bc->{const}{console_out} = "1.Answer SR-Slave: slave doesn't answer\n";
my $res = check_virtual_ip($bc, "0", "0", "1", "$bc->{config_params}{VIRTUAL_IP}");
$bc->{const}{info}->debug("check_virtual_ip = $res");
unless( $res =~ /.*exist already and not local.*/ )
{
EXECUTE_START($bc);
$bc->{const}{info}->debug("Start permit");
}
else
{
$bc->{const}{info}->debug("Start not recommend");
}
$bc->{const}{console_out} .= "2.Answer check_virtual_ip: " . $res;
open (RESPONSE, ">$bc->{const}{res_start}");
print RESPONSE $bc->{const}{console_out};
close RESPONSE;
}
else
{
++$bc->{variable}{var_T1};
}
### Возможно жопа здесь !!!!!
}
elsif (-e $bc->{const}{req_restart} or $bc->{variable}{before_start} eq '1') # Действия при обноружении рестарта ручного или при первом запуске
{
# $bc->{const}{info}->debug("FIRST START / RESTART");
unlink $bc->{const}{req_restart};
unlink $bc->{const}{req_restart_program};
unless($bc->{variable}{before_start})
{
$bc->{const}{info}->debug("Found restart.req");
}
else
{
$bc->{const}{info}->debug("Starting MASTER -> send MMU...");
}
send_mmu ($bc, "1", "mmua-for-restart");
$bc->{variable}{delay} = $bc->{variable}{delay_max};
$bc->{variable}{before_start} = 2 if ($bc->{variable}{before_start} eq '1'); # Не будем отправлять INFO, пока не прийдёт подтверждение MMUA
}Ещё несколько перлов из утилиты. Так записываем конечный автомат по функционированию протокола. Привёл только маленький кусочек из цепочки IF'ов.
SadKo,
22 Февраля 2011
−123
sub check_interface
{
my $int_input = shift;
my $all_intr_local = [];
$_ = qx[ip a];
s[\d{1,}:[ ]{1,}([^ ]{1,}):.*]<unshift(@$all_intr_local, $1)>ge;
if ( ! grep( { /^$config_params{$int_input}$/ } @$all_intr_local ))
{
$warning->debug("Error: interface $int_input can't found local!!!");
exit 1;
}
else
{
$info->debug("Load param $int_input = $config_params{$int_input}.");
}
}А вот так мы сканируем сетевые интерфейсы...
SadKo,
21 Февраля 2011
−124
sub check_dir
{
my ($param, $mode) = @_;
$mode ||= 'sr';
unless ( $mode eq 'sc')
{
my $full_path = $config_params{$param};
$full_path =~ /^(.+)\/(.+)$/;
my $put = $1;
while(1)
{
if (-l $full_path)
{
$info->debug("Load param $param = $full_path it is symlink. Readlink...");
$full_path = readlink $full_path;
}
elsif (-d $full_path or -d "$put/$full_path")
{
$info->debug("Load param $param = $full_path. It is directory and it is exists");
last;
}
else
{
$warning->debug("Not valid config. Error parsing param: $param");
exit 1;
}
}
}
else
{
my $full_path = $config_params_sc{$param};
$full_path =~ /^(.+)\/(.+)$/;
my $put = $1;
while(1)
{
if (-l $full_path)
{
$info_sc->debug("Load param $param = $full_path it is symlink. Readlink...");
$full_path = readlink $full_path;
}
elsif (-d $full_path or -d "$put/$full_path")
{
$info_sc->debug("Load param $param = $full_path. It is directory and it is exists");
last;
}
else
{
$warning_sc->debug("Not valid config. Error parsing param: $param");
exit 1;
}
}
}
}По крайней мере, этот код можно сократить вдвое... И подобное по всей утилите...
SadKo,
21 Февраля 2011
−119
sub dopprobelz # функция дополнения строки нулями вначале
{
my($str)=@_[0];
my($len)=@_[1]; my $delta=$len-length($str);
my $hwost='';
for (my($a)=0; $a<$delta; $a++) {$hwost=$hwost.'0';};
$str=$hwost.$str; return $str;
};
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)=localtime(time());
$RequestN=(1900+$year).dopprobelz($mon, 2);
$RequestN=$RequestN.dopprobelz($mday, 2).dopprobelz($hour, 2);
$RequestN=$RequestN.dopprobelz($min, 2).dopprobelz($sec, 2).dopprobelz($sec, 2);Дополняем время и дату ведущими нулями, где это требуется
Мистер Хэнки,
13 Февраля 2011
−123
my %tbl;
$tbl{'koi'}="БВЧЗДЕЦЪЙКЛМНОПРТУФХЖИГЮЫЭШЩЯЬАСбвчздецъйклмнопртуфхжигюыэшщяьас";
$tbl{'win'}="абвгдежзийклмнопрстуфхцчшщьыъэюяАБВГДЕЖЗИЙКЛМНОПРСТУФХЦЧШЩЬЫЪЭЮЯ";
...
if ($filename=~/^http:\/\//) {
my ($header, $page)=getpage($filename);
if ($page!~/\S/) {next;}
if ($header=~/Charset.*koi/i) {
eval("\$page=~tr/$tbl{'koi'}/$tbl{'win'}/");
}
open(OUT, ">$tmpfile");
print OUT $page;
close OUT;
open(NEWS, "$tmpfile");
} else {
open(NEWS, "$config::rubricsroot/$filename") || do {warn "Не могу открыть файл новостей: $!"; next;};
}
#5624 спровоцировал. Хотел запостить только перекодировку, но не смог удержаться, тут перлы в комплексе.
1) Свой велосипед для получения странички по http через IO::Socket (это отдельная большая песня, может спою потом).
2) Перекодировка из koi8r в cp1251, если нужно. Обратите внимание на элегантный eval.
3) Подстановка результата для дальнейшей построчной обработки через временный файл.
И не говорите мне о том, какой плохой язык PHP.
gegMOPO4,
11 Февраля 2011
−119
foreach $line (@data) {
@alldata = 0;
unshift @alldata;
@alldata = split(/\|/, $line);Инициализация массива.
da4ever,
06 Февраля 2011
Follow us!