Нашли или выдавили из себя код, который нельзя назвать нормальным, на который без улыбки не взглянешь? Не торопитесь его удалять или рефакторить, — запостите его на говнокод.ру, посмеёмся вместе!
−125
while (my $t = $tix->RT::SearchBuilder::Next) { # BLOODY HACK
my $when = $t->ResolvedObj->Unix - $t->CreatedObj->Unix;
next unless $when > 0; # Doubly bloody hack
my $max = (60*60*24*2) / 1800;
my $x = int($when / 1800);
$counts[$x > $max ? $max : $x]++;
}Нашел в коде RTx Statistics - расширения для CRM Request Tracker: http://wiki.bestpractical.com/view/RT3StatisticsPackage
del,
19 Мая 2010
−122
sub PrintToFile {
my ($filename, @file) = @_;
@file = sort {$a <=> $b} @file;
open BK, ">backup.txt";
foreach $line(@file) {
print BK "$line";
}
close BK;
rename "backup.txt", "$filename";
unlink "backup.txt";
}
А вот так мы записываем в файл. И нас не интересует многопоточность или проверка имени файла (в вызывающей функции тоже нет). А не записать ли нам ../index.html?
Прошу не кидаться калом. Первый раз вижу перл. Может быть так и надо? Волшебник-интерприатор все поправит, и не даст сучиться ужасному?
ps взято с разломанного недображелателем хостинга, для того, чтобы "поправить все как следует".
da4ever,
09 Мая 2010
−119
sub getMessages{
local($mop,$pg,$all)=@_;
if(!&db_query("select insurance_faq_main.id,date_format(insurance_faq_main.date,'%d.%m.%Y'),insurance_faq_main.name,insurance_faq_main.email,insurance_faq_main.www,insurance_faq_main.city,insurance_faq_main.message,insurance_faq_main.ip,answer from insurance_faq_main, insurance_faq_ans where insurance_faq_ans.idm=insurance_faq_main.id order by id desc limit ".$pg*$mop.",$mop")) {$body .= $db_message; return -1}
$id;
@date;
@name;
@email;
@www;
@city;
@msg;
@ip;
@answer;
for(local $i=0;defined($rows->[$i]);$i++)
{
$id[$i]=$rows->[$i]->[0];
$date[$i]=$rows->[$i]->[1];
$name[$i]=$rows->[$i]->[2];
$email[$i]=$rows->[$i]->[3];
$www[$i]=$rows->[$i]->[4];
$city[$i]=$rows->[$i]->[5];
$msg[$i]=$rows->[$i]->[6];
$ip[$i]=$rows->[$i]->[7];
$answer[$i]=$rows->[$i]->[8];
}
return $i;
}Мужской способ возвращать результаты из функции
Suor,
26 Апреля 2010
−110.6
# АРТ
return -1 if
!$project_id ||
length $name > 32 || !(length $name) ||
length $password > 32 || !(length $password) || #########->*
length $repassword > 32 || !(length $repassword) ||
$name =~ /[^\w\d]+/ig ||
$password =~ /[^\w\d]+/ig ||
$repassword =~ /[^\w\d]+/ig;Вдохновение, хули ...
klem4,
24 Марта 2010
−155.2
%words = map { $_ => $hash{$_} } grep { !proper($_) } keys %words;
Фильтрация хэша - удаление элементов, чьи ключи не удовлетворяют некому условию.
Конечно же использование православного for для Perl-истов ниже собственного достоинства.... :X
Balza,
25 Февраля 2010
−104.3
# (S) (рекурсивного вызова) Генерирует контент слота рекурсивного дерева (с плюсиками). Возвращает ('RecursiveSlot'=>$textbuf) или ()
sub PlusTreeSlot {
# (P) Путь к шаблону контентной ячейки
# (P) ghm
# (P) pid
# (P) treename
# (P) Уровень
# (P) функция
# (P) $ret
return () if !exists($_[1]->{$_[2]}); # Не вкладываем ничего в слот если там ничего нет
my $textbuf;
foreach (@{$_[1]->{$_[2]}}){
my $ret=&{$_[5]}($_,$_[4],ref($_[6])?dclone($_[6]):$_[6]) if $_[5];
$textbuf.=${tmpl_prepare($_[0],{
PlusTreeSlot($_[0],$_[1],$_->{'id'},$_[3],($_[4]+1),$_[5],$ret),
%{$_},
'trname'=>$_[3],
})};
};
return ('RecursiveSlot'=>$textbuf);
};
А вам тоже нравятся безымянные параметры?
А писать код без пробелов?
Кроме того, эта функция, вызывая себя рекурсивно, каждый раз заново открывает, читает, парсит и закрывает один и тот же файл шаблона.
ichesnokov,
25 Февраля 2010
−251.4
my $sec;
my $min;
my $hour;
my $mday;
my $mon;
my $year;
my $wday;
my $yday;
my $isdst;
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =localtime(time);
$year=$year+1900;
$mon=$mon+1;
if ($mon<10)
{
$mon='0'.$mon;
}
if ($sec<10)
{
$sec='0'.$sec;
}
if ($min<10)
{
$min='0'.$min;
}
if ($hour<10)
{
$hour='0'.$hour;
}
if ($mday<10)
{
$mday='0'.$mday;
}двузначные цифры в дате
Bracus,
25 Февраля 2010
−111.2
# куски кода выдернуты
# смотрите внимательно на SQL
#--- INSERT ------
my $comment_id = $ej->{dbh}->insert('blog.comments', (
'id::primary' => '',
'post_id::numeric' => $param_id,
'user_id::numeric' => $ej->{user}{id},
'text' => $newmess,
'time::numeric' => $ej->{time},
'rating_ball::numeric' => $rating_ball
));
my $_rating_ball = 0 + $ej->Query ('SELECT SUM(rating_ball) FROM blog.comments WHERE post_id = '.$param_id)->FetchRow;
$ej->Query(
'UPDATE blog.posts SET update_time = '.$ej->{time}.', rating_ball = '.$_rating_ball.', '.
'comments_ptr = CONCAT('.Q(pack('L', $comment_id)).', comments_ptr) WHERE id = '.$param_id
);
#--- DELETE ---
$ej->Query('DELETE FROM blog.comments WHERE id = '.$comment_id);
my $comments_ptr = pack('L*', $ej->Query('SELECT id FROM blog.comments WHERE post_id = '.$post_id.' ORDER BY time DESC')->FetchCol);
my $_rating_ball = 0 + $ej->Query ('SELECT SUM(rating_ball) FROM blog.comments WHERE post_id = '.$post_id)->FetchRow;
$ej->Query('UPDATE blog.posts SET comments_ptr = '.Q($comments_ptr).', rating_ball = '.$_rating_ball.' WHERE id = '.$post_id);
#--- SELECT ----
my %q = $ej->Query('SELECT user_id, topic_id, name, text, SUBSTRING(comments_ptr, '.(1+($page-1)*40).',40) AS ptr, round(length(comments_ptr) / 4) AS cnt, create_time, pics_ptr, rating_ball FROM blog.posts WHERE id = '.$param_id)->FetchHash;
my @id = (); my @user_id = (); my @text = (); my @time = ();
if ($q{ptr} ne '') {
my $r = $ej->Query('SELECT id, user_id, text, time FROM blog.comments WHERE id IN ('.join(',',unpack('L*', $q{ptr})).') ORDER BY time DESC');
@id = $r->FetchCol;
@user_id = $r->FetchCol(1);
@text = $r->FetchCol(2);
@time = $r->FetchCol(3);
}
# потом еще вывод через Ж
это работает на mySQL/PERL.
да зачем нам реляционная база, мы сами можем манипулировать отношениями.
comments_ptr это BLOB, c упакованным в него массивом int32 id'шников из comments.id
хотя и есть comments.post_id <=> posts.id
просто праздник какой-то!
bmp20,
07 Февраля 2010
−257.7
sub count {scalar(@{[@_]})}Из себя выдавил)
RolCom,
23 Января 2010
−113.6
sub append {
my $appendstring = @_[0];
$returnstring = "$returnstring$appendstring";
}Из плагина к nagios'у, который проверяет состояние интерфейсов на cisco-девайсах. http://svn.opsview.org/opsview/trunk/opsview-core/nagios-plugins/check_snmp_cisco_ifstatus .
aag,
20 Января 2010
Follow us!