1. Perl / Говнокод #4044

    −118

    1. 1
    /^([a-zA-Z0-9]+)([-_.]?[a-zA-Z0-9]+)*@([a-zA-Z0-9]+[-_.]?)*[a-zA-Z0-9]+(?:\.[a-zA-Z]{2,6})$/

    kubynek, 20 Августа 2010

    Комментарии (75)
  2. Perl / Говнокод #4040

    −156

    1. 1
    print reverse 1..10

    kubynek, 20 Августа 2010

    Комментарии (46)
  3. Perl / Говнокод #3972

    −117

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

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

    mrtaryk, 13 Августа 2010

    Комментарии (16)
  4. Perl / Говнокод #3966

    −115

    1. 01
    2. 02
    3. 03
    4. 04
    5. 05
    6. 06
    7. 07
    8. 08
    9. 09
    10. 10
    11. 11
    12. 12
    13. 13
    14. 14
    15. 15
    16. 16
    17. 17
    18. 18
    19. 19
    20. 20
    21. 21
    22. 22
    23. 23
    24. 24
    25. 25
    26. 26
    27. 27
    28. 28
    29. 29
    30. 30
    31. 31
    32. 32
    33. 33
    34. 34
    35. 35
    36. 36
    37. 37
    38. 38
    39. 39
    40. 40
    41. 41
    42. 42
    43. 43
    44. 44
    45. 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)
  5. Perl / Говнокод #3963

    −121

    1. 01
    2. 02
    3. 03
    4. 04
    5. 05
    6. 06
    7. 07
    8. 08
    9. 09
    10. 10
    11. 11
    12. 12
    13. 13
    14. 14
    15. 15
    16. 16
    17. 17
    18. 18
    19. 19
    20. 20
    21. 21
    22. 22
    23. 23
    24. 24
    25. 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)
  6. Perl / Говнокод #3941

    −125

    1. 1
    2. 2
    3. 3
    4. 4
    $new_customer = 1 if ($new_customer);
        $new_customer = 0 unless ($new_customer);
    
    # запись из весьма не малого инет-магазина.... на perl'е....

    vat, 11 Августа 2010

    Комментарии (3)
  7. Perl / Говнокод #3896

    −126

    1. 01
    2. 02
    3. 03
    4. 04
    5. 05
    6. 06
    7. 07
    8. 08
    9. 09
    10. 10
    11. 11
    12. 12
    13. 13
    14. 14
    15. 15
    16. 16
    17. 17
    18. 18
    19. 19
    20. 20
    21. 21
    22. 22
    23. 23
    24. 24
    25. 25
    26. 26
    27. 27
    28. 28
    29. 29
    30. 30
    31. 31
    32. 32
    33. 33
    34. 34
    35. 35
    36. 36
    37. 37
    38. 38
    39. 39
    40. 40
    41. 41
    42. 42
    43. 43
    44. 44
    45. 45
    46. 46
    47. 47
    48. 48
    49. 49
    50. 50
    51. 51
    52. 52
    53. 53
    54. 54
    55. 55
    56. 56
    57. 57
    58. 58
    59. 59
    60. 60
    61. 61
    62. 62
    63. 63
    64. 64
    65. 65
    66. 66
    67. 67
    68. 68
    69. 69
    70. 70
    71. 71
    72. 72
    73. 73
    74. 74
    75. 75
    76. 76
    77. 77
    78. 78
    79. 79
    80. 80
    81. 81
    82. 82
    83. 83
    84. 84
    85. 85
    86. 86
    87. 87
    88. 88
    89. 89
    90. 90
    91. 91
    92. 92
    93. 93
    94. 94
    95. 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)
  8. Perl / Говнокод #3895

    −123

    1. 01
    2. 02
    3. 03
    4. 04
    5. 05
    6. 06
    7. 07
    8. 08
    9. 09
    10. 10
    11. 11
    12. 12
    13. 13
    14. 14
    15. 15
    16. 16
    17. 17
    18. 18
    19. 19
    20. 20
    21. 21
    22. 22
    23. 23
    24. 24
    25. 25
    26. 26
    27. 27
    28. 28
    29. 29
    30. 30
    31. 31
    32. 32
    33. 33
    34. 34
    35. 35
    36. 36
    37. 37
    38. 38
    39. 39
    40. 40
    41. 41
    42. 42
    43. 43
    44. 44
    45. 45
    46. 46
    47. 47
    48. 48
    49. 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)
  9. Perl / Говнокод #3726

    −121

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

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

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

    Комментарии (26)
  10. Perl / Говнокод #3356

    −123

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

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

    Floppy Formator, 31 Мая 2010

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