- 1
/^([a-zA-Z0-9]+)([-_.]?[a-zA-Z0-9]+)*@([a-zA-Z0-9]+[-_.]?)*[a-zA-Z0-9]+(?:\.[a-zA-Z]{2,6})$/
Нашли или выдавили из себя код, который нельзя назвать нормальным, на который без улыбки не взглянешь? Не торопитесь его удалять или рефакторить, — запостите его на говнокод.ру, посмеёмся вместе!
−118
/^([a-zA-Z0-9]+)([-_.]?[a-zA-Z0-9]+)*@([a-zA-Z0-9]+[-_.]?)*[a-zA-Z0-9]+(?:\.[a-zA-Z]{2,6})$/
−156
print reverse 1..10
−117
if ( $src =~ /^(.+)$/ ) { $src = "$1"; }
if ( $dst =~ /^(.+)$/ ) { $dst = "$1"; }
Еще один вариант проверки на непустую строку.
−115
#если делится на 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
−121
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.
Но я никогда не думал, что мне придется саппортить их код!!!
−125
$new_customer = 1 if ($new_customer);
$new_customer = 0 unless ($new_customer);
# запись из весьма не малого инет-магазина.... на perl'е....
−126
...
$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++;
}
Какое-то время назад пришлось работать на одну хохляцкую конторку, так вот там такое было стандартом, и если писалось по другому - насяльнике был в паническом бешенстве. Кодировка оригинала сохранена...
−123
sub Blog_MakeRSS {
my @data = @_;
my $selflink = "http://$ENV{'SERVER_NAME'}:666$ENV{'SCRIPT_NAME'}?$ENV{'QUERY_STRING'}";
$selflink =~ s/&/&/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]&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 плохо отзывался о кириллице...
−121
@items = keys %{{ map { $_ => 1} @items }};
Удаление повторов из массива.
Вроде и не ГК, но, блин, такие вырвиглазные конструкции меня порой убивают... Мои глаза...
−123
my @orda = ();
my @whera = (); # Niggaz in da haus!
Найдено в коде метода, формирующего SQL-запрос для доступа к БД.