Perl — Говнокод.ру

Perl / Говнокод #3726

−3

1

@items = keys %{{ map { $_ => 1} @items }};

Удаление повторов из массива.
Вроде и не ГК, но, блин, такие вырвиглазные конструкции меня порой убивают... Мои глаза...

Запостил: Мистер Хэнки, 17 Июля 2010

Комментарии (24)

Perl / Говнокод #3356

−3

1
2

my @orda = ();
my @whera = (); # Niggaz in da haus!

Найдено в коде метода, формирующего SQL-запрос для доступа к БД.

Запостил: Floppy Formator, 31 Мая 2010

Комментарии (10)

Perl / Говнокод #3264

−6

1
2
3
4
5
6
7

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

Комментарии (8)

Perl / Говнокод #3187

−3

01
02
03
04
05
06
07
08
09
10
11
12
13
14
15
16

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

Комментарии (7)

Perl / Говнокод #3109

+4

01
02
03
04
05
06
07
08
09
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29

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

Комментарии (5)

Perl / Говнокод #2862

+2.4

1
2
3
4
5
6
7
8
9

# АРТ
    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

Комментарии (10)

Perl / Говнокод #2668

+6.7

01
02
03
04
05
06
07
08
09
10
11
12
13
14
15
16
17
18
19
20
21
22

# (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

Комментарии (4)

Perl / Говнокод #2666

+5.6

01
02
03
04
05
06
07
08
09
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33

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

Комментарии (8)

Perl / Говнокод #2562

+3.8

01
02
03
04
05
06
07
08
09
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44

# куски кода выдернуты
#  смотрите внимательно на 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

Комментарии (1)

Perl / Говнокод #2476

+2.3

1

sub count {scalar(@{[@_]})}

Из себя выдавил)

Запостил: RolCom, 23 Января 2010

Комментарии (13)

Говнокод: по колено в коде.