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

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

−117

1
2

if ( $src =~ /^(.+)$/ ) { $src = "$1"; }
if ( $dst =~ /^(.+)$/ ) { $dst = "$1"; }

Еще один вариант проверки на непустую строку.

mrtaryk, 13 Августа 2010

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

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

−115

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
45

#если делится на 3 без остатка, то приписываем 3 

if (!($sn%3)){$sn.="3";}

#если делится на 2 без остатка, то припысываем 2

elsif (!($sn%2)){$sn.="2";}

#если делится на 5 без остатка, то припысываем 5

elsif (!($sn%5)){$sn.="5";}

#втрой округ шифрования

#если делится на 7 без остатка, то приписываем 8 

if (!($sn%7)){$sn.="8";}

#если делится на 3 без остатка, то припысываем 2

elsif (!($sn%3)){$sn.="2";}

#если делится на 5 без остатка, то припысываем 3

elsif (!($sn%5)){$sn.="4";} 



my $len = length($sn);

if ($len ==6){$sn=~m/(\d)(\d)(\d)(\d)(\d)(\d)/;$itog=$6.$3.$1.$4.$5.$2;}

elsif ($len ==5){$sn=~m/(\d)(\d)(\d)(\d)(\d)/;$itog=$2.$1.$5.$4.$3;}

elsif ($len == 4){$sn=~m/(\d)(\d)(\d)(\d)/;$itog=$4.$1.$3.$2;}

elsif ($len == 3){$sn=~m/(\d)(\d)(\d)/;$itog=$2.$1.$3;}

elsif ($len == 2){$sn=~m/(\d)(\d)/;$itog=$2.$1;}

elsif ($len == 1){$itog=$sn;}

return $itog;

}

пример "крутого" кода с free-lance.ru

mahatharata, 13 Августа 2010

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

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

−121

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

sub save_info {
    beginTransaction();
     
    #-------    250 строк страшного кода, типа:    ---------
    .....
    goto ERROR if $error_code != 0;
    .....
    
    #-------    или
    if ( $res = save_item($data) ) {
        goto OK;
    }
    ............
       
    #-------    Но конец просто меня убил!!!    ---------  
    OK:
    commitTransaction();
    goto RET;

    ERROR:
    rollbackTransaction();

    RET:
    return $res;
}

Я около 3 лет пишу на perl. И догадывался, что есть perl-программисты, которые используют оператор goto LABEL.
Но я никогда не думал, что мне придется саппортить их код!!!

antonfin, 13 Августа 2010

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

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

−126

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
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95

...
$q = new CGI;

# дБООЩЕ УПФТХДОЙЛБ
$id 	= Trim ($q -> param ('id'));
$email1 = Trim ($q -> param ('email1'));
$email2 = Trim ($q -> param ('email2'));
$email3 = Trim ($q -> param ('email3'));
$tel1 	= Trim ($q -> param ('tel1'));
$tel2 	= Trim ($q -> param ('tel2'));
$fio 	= Trim ($q -> param ('fio'));
$prim 	= Trim ($q -> param ('prim'));
$login 	= Trim ($q -> param ('login'));
...
############################################################
############################################################
# жПТНБ ТЕДБЛФЙТПЧБОЙС УПФТХДОЙЛБ
sub Form_Edit_Employee {
&Top_M ("$name_prog :: тЕД. ID='$id'&&$bookcgi");

if ($act eq "edt") { &Exec_Edit_Employee (); }

my $sql = "SELECT fio, login, email, tel1, tel2, email2, email3, icq, prim FROM managers WHERE id='$id'";
my $res = $conn -> exec ($sql);

my $fio       = $res -> getvalue (0, 0);
my $login     = $res -> getvalue (0, 1);
my $email1    = $res -> getvalue (0, 2);
my $tel1      = $res -> getvalue (0, 3);
my $tel2      = $res -> getvalue (0, 4);
my $email2    = $res -> getvalue (0, 5);
my $email3    = $res -> getvalue (0, 6);
my $icq       = $res -> getvalue (0, 7);
my $prim      = $res -> getvalue (0, 8);

print "<form action='$bookcgi' method=post>
<input type=hidden name='id' value='$id'>
<input type=hidden name=go_back value='$go_back'>
<input type=hidden name=act value='edt'>
<table cellpadding=2 colpadding=2 width=100\%>
<tr bgcolor='$tabcolor7' align=center><td colspan=2>
<b><font color='white'>жПТНБ ТЕДБЛФЙТПЧБОЙС</font></b></td></tr>
<tr bgcolor='$tabcolor4'><td align='right'>ж.й.п.:</td><td>
<input name='fio' type=text size='60' value='$fio'></td></tr>
<tr bgcolor='$tabcolor4'><td align='right'>мПЗЙО:</td><td>
<input name='login' type=text size='60' value='$login'></td></tr>
<tr bgcolor='$tabcolor4'><td align='right'>E-Mail 1:</td><td>
<input name='email1' type=text size='60' value='$email1'></td></tr>
<tr bgcolor='$tabcolor4'><td align='right'>E-Mail 2:</td><td>
<input name='email2' type=text size='60' value='$email2'></td></tr>
<tr bgcolor='$tabcolor4'><td align='right'>E-Mail 3:</td><td>
<input name='email3' type=text size='60' value='$email3'></td></tr>
<tr bgcolor='$tabcolor4'><td align='right'>фЕМЕЖПО 1;</td><td>
<input name='tel1' type=text size='60' value='$tel1'></td></tr>
<tr bgcolor='$tabcolor4'><td align='right'>фЕМЕЖПО 2:</td><td>
<input name='tel2' type=text size='60' value='$tel2'></td></tr>
<tr bgcolor='$tabcolor4'><td align='right'>ICQ:</td><td>
<input name='icq' type=text size='60' value='$icq'></td></tr>
<tr bgcolor='$tabcolor4'><td align='right'>рТЙНЕЮБОЙЕ:</td><td>
<textarea name=prim cols=80 rows=6>$prim</textarea></td></tr>
<tr bgcolor='$tabcolor6'><td align='center' colspan=2>
<input type=submit value='йЪНЕОЙФШ'></td></tr>
</table></form>

[ <a href='JavaScript:history.go(-$go_back)'>$lang_histback</a> ]
[ <a href='$bookcgi'>$lang_startpage</a> ]\n";

&Bottom_M ();
exit;
}

############################################################
############################################################
# тЕЪХМШФБФ ТЕДБЛФЙТПЧБОЙС УПФТХДОЙЛБ
sub Exec_Edit_Employee {
if ($fio eq "") {
print "<font color=red><b>хЛБЦЙФЕ ж.й.п.!</b></font>";
return;
}
[...]
my $sql = "UPDATE managers SET fio='$fio', login='$login', email='$email1',
tel1='$tel1', tel2='$tel2', email2='$email2', email3='$email3', icq='$icq',
prim='$prim', dt_modify='now()', idm_modify='$idm' WHERE id='$id'";
my $res = $conn -> exec ($sql);

my $oid = $res -> cmdTuples;

if ($oid eq 0) {
print "<font color=red><b>пЫЙВЛБ РТЙ ТЕДБЛФЙТПЧБОЙЙ УПФТХДОЙЛБ У ID='$id'.</b></font>";
} else {
print "<font color=green><b>дБООЩЕ ЙЪНЕОЕОЩ ХУРЕЫОП.</b></font>";
}

$go_back++;
}

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

kainwinterheart, 07 Августа 2010

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

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

−123

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
45
46
47
48
49

sub Blog_MakeRSS {
my @data = @_;
my $selflink = "http://$ENV{'SERVER_NAME'}:666$ENV{'SCRIPT_NAME'}?$ENV{'QUERY_STRING'}";
$selflink =~ s/&/&amp;/gi;

my $out = "<?xml version=\"1.0\" encoding=\"$charset\"?>

<rss version=\"2.0\" xmlns:atom=\"http://www.w3.org/2005/Atom\">

<channel>
<atom:link href=\"$selflink\" rel=\"self\" type=\"application/rss+xml\" />";

$data[0][6] =~ s/MSD/\+0300/i;

$out .= "<title>$rss_title</title>
<link>http://$ENV{'SERVER_NAME'}:666$ENV{'SCRIPT_NAME'}?$rss_link</link>
<description>$rss_descr</description>
<language>ru</language>
<copyright>$rss_copy</copyright>
<lastBuildDate>$data[0][6]</lastBuildDate>
<pubDate>$data[0][6]</pubDate>
<webMaster>$rss_email</webMaster>
<ttl>1</ttl>\n";

foreach (@data) {
my @row = @{ $_ };

if ($blog_owner ne "") { $row[7] = $blog_owner; }

my $link = "http://$ENV{'SERVER_NAME'}:666$ENV{'SCRIPT_NAME'}?blog=$row[7]&amp;post=$row[5]";
$row[0] =~ s/\%cut\%.+?$/ \[\.\.\.\]/gis;
$row[6] =~ s/MSD/\+0300/i;

$out .= "<item>
<title>$row[1]</title>
<description><![CDATA[ $row[0] ]]></description>
<guid isPermaLink=\"true\">$link</guid>
<link>$link</link>
<pubDate>$row[6]</pubDate>
</item>\n";

}

$out .= '</channel>
</rss>';

print "Content-type:application/rss+xml;charset=$charset\n\n";
print $out;
}

Был в несознанке, а XML::RSS плохо отзывался о кириллице...

kainwinterheart, 07 Августа 2010

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

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

−121

1

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

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

Мистер Хэнки, 17 Июля 2010

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

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

−123

1
2

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

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

Floppy Formator, 31 Мая 2010

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

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

−125

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

−122

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)

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