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

    −61

    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
    BEGIN
    {
        my $gGls; # Hash reference for global variables, settings.
    
        # To get a handle to access the global hash.
        sub getgGls
        {
            return $gGls;
        }
    
        # "Fasten" the script name on $gGls->{ 'gScriptName' } instead of the perlish awkward $0.
        $gGls->{ 'gScriptName' } = $0;
        
        # ...

    синглтоны для перла. (плюс польская нотация.)

    на книги по паттернам надо заставлять цеплять наклейки: brain damage caused by use of the design patterns might be permanent!

    Dummy00001, 22 Октября 2013

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

    +92

    1. 1
    2. 2
    3. 3
    ЦЫТАТЫ ВЕЛИКЕХ ЛЮДЕЙ:
                 "ВЪИБУКА Я МИНУС ПАТАМУШТА У МИНЯ ГАРИТ ПУКАН И Я НИЧЕВО НИМАГУ ПАДЕЛАТЬ Я ЗАТРАЛИНАЯ ЛАЛКА СУКПЗДЦ((9"
                                             -ЛАЛКА НА САЙТЕ govnokod.ru

    PragramistOtBoga, 22 Октября 2013

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

    −62

    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
    С'шная либа: http://fossies.org/dox/imlib2-1.4.5/image_8c_source.html
    
    смотрим код сохраняющий картинку:
    
     1241 __imlib_SaveImage(ImlibImage * im, const char *file,
     1242                   ImlibProgressFunction progress, char progress_granularity,
     1243                   ImlibLoadError * er)
    ..........................................
    ..........................................
    
     1290         *er = IMLIB_LOAD_ERROR_UNKNOWN;
     1291         if (errno == EEXIST)
     1292            *er = IMLIB_LOAD_ERROR_FILE_DOES_NOT_EXIST;
     1293         else if (errno == EISDIR)
     1294            *er = IMLIB_LOAD_ERROR_FILE_IS_DIRECTORY;
     1295         else if (errno == EISDIR)
     1296            *er = IMLIB_LOAD_ERROR_FILE_IS_DIRECTORY;
     1297         else if (errno == EACCES)
     1298            *er = IMLIB_LOAD_ERROR_PERMISSION_DENIED_TO_WRITE;
     1299         else if (errno == ENAMETOOLONG)
     1300            *er = IMLIB_LOAD_ERROR_PATH_TOO_LONG;
     1301         else if (errno == ENOENT)
     1302            *er = IMLIB_LOAD_ERROR_PATH_COMPONENT_NON_EXISTANT;
     1303         else if (errno == ENOTDIR)
     1304            *er = IMLIB_LOAD_ERROR_PATH_COMPONENT_NOT_DIRECTORY;
     1305         else if (errno == EFAULT)
     1306            *er = IMLIB_LOAD_ERROR_PATH_POINTS_OUTSIDE_ADDRESS_SPACE;
     1307         else if (errno == ELOOP)
     1308            *er = IMLIB_LOAD_ERROR_TOO_MANY_SYMBOLIC_LINKS;
     1309         else if (errno == ENOMEM)
     1310            *er = IMLIB_LOAD_ERROR_OUT_OF_MEMORY;
     1311         else if (errno == EMFILE)
     1312            *er = IMLIB_LOAD_ERROR_OUT_OF_FILE_DESCRIPTORS;
     1313         else if (errno == ENOSPC)
     1314            *er = IMLIB_LOAD_ERROR_OUT_OF_DISK_SPACE;
     1315         else if (errno == EROFS)
     1316            *er = IMLIB_LOAD_ERROR_PERMISSION_DENIED_TO_WRITE;
    
    обращаем внимание на строки *er =
    в них записываются разные типы ошибок, обращаем внимаение на то, сколько типов используется
    
    теперь берем перловую обертку: Image::Imlib2 (http://search.cpan.org/~lbrocard/Image-Imlib2-2.03/lib/Image/Imlib2.pm)
    находим метод сохранения картинки, он в xs части lib/Image/Imlib2.xs
    
    void
    Imlib2_save(image, filename)
        Image::Imlib2   image
        char * filename
    
        PROTOTYPE: $$
    
            CODE:
        {
                    Imlib_Load_Error err;
    
            imlib_context_set_image(image);
            imlib_save_image_with_error_return(filename, &err);
    
                    if (err != IMLIB_LOAD_ERROR_NONE) {
                      Perl_croak(aTHX_ "Image::Imlib2 save error: Unknown error");
                    }
        }
    
    
    imlib_save_image_with_error_return вызывает в конечном итоге __imlib_SaveImage из C'шной либы
    обращаем внимание на то, как теперь подробно можно узнать о том, почему не удалось сохранить картинку
    
    пример вывода такого кода в случае ошибки:
    
    Image::Imlib2 save error: Unknown error at BL/Class/Image.pm line 608.
    
    до тех пор, пока есть такие гении, я не беспокоюсь о своем хлебе

    m0r1k, 18 Октября 2013

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

    −58

    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
    sub get_number_from_possible_b64
    {
            my $s = shift;
    
            my $rv = $s;
    
            if( $s =~ /^\d+$/ )
            {
                    $rv = int( $s );
    
            } elsif( $s =~ /=$/ )
            {
                    $rv = decode_base64( $rv );
            }
    
            return $rv;
    }

    Где-то есть что-то, что либо цифорка, либо строка, оканчивающаяся на знак равенства.

    kainwinterheart, 27 Августа 2013

    Комментарии (9)
  5. Perl / Говнокод #13665

    −67

    1. 1
    2. 2
    3. 3
    4. 4
    foreach my $ex (@excluded)
    {
            .....
    }

    О чем думал, когда имя переменной давал?

    Alexandris, 25 Августа 2013

    Комментарии (28)
  6. Perl / Говнокод #13648

    −67

    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
    use strict;
    use warnings;
     
    my $bottom = sub {
        my $test = shift // 'undef';
        print "bottom( $test )\n";
    };
     
    sub sub_bottom {
        my $test = shift // 'undef';
        print "sub_bottom( $test )\n";
    }
     
    sub fallthrough {
        &$bottom;
    }
     
    sub not_fallthrough {
        &$bottom();
    }
     
    sub not_fallthrough2 {
        sub_bottom;
    }
     
    fallthrough('Fallen1');
    not_fallthrough('Fallen2');
    not_fallthrough2('Fallen3');

    Долго пытался понять как до сабины доходят аргументы, хоть она вызывается без них. Обнаружил вот это. OH SHI~
    Вывод:

    bottom( Fallen1 )
    bottom( undef )
    sub_bottom( undef )

    http://ideone.com/QXT3HJ

    Elvenfighter, 23 Августа 2013

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

    −59

    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
    package Bool;
    
    use strict;
    use Carp qw/croak/;
    use Scalar::Util qw/blessed/;
    
    use base "Exporter";
    our @EXPORT = qw/true false/;
    
    use overload(
       'bool' => \&op_bool,
       '!'    => \&op_not,
       '=='   => \&op_equal,
       '!='   => \&op_not_equal,
       '""'   => \&op_to_string,
    );
    
    our $true  = !0;
    our $false = !!0;
    
    use constant true  => bless \$true;
    use constant false => bless \$false;
    
    sub import {
       my($package) = @_;
       $package->export_to_level(1, @_);
        
       &Internals::SvREADONLY(\!0,  0);
       &Internals::SvREADONLY(\!!0, 0);
       ${ \!0 }  = true;
       ${ \!!0 } = false;
       &Internals::SvREADONLY(\!0,  1);
       &Internals::SvREADONLY(\!!0, 1);
    }
    
    sub op_bool {
       my($self) = @_;
       return $$self;
    }
    
    sub op_not {
       my($self) = @_;
       $$self ? false : true;
    }
    
    sub op_equal {
       my($l, $r) = @_;
       typecheck($l, $r);
       return (($$l && $$r || !$$l && !$$r) ? true : false);
    }
    
    sub op_not_equal {
       my($l, $r) = @_;
       typecheck($l, $r);
       return (($$l && $$r || !$$l && !$$r) ? false : true);
    }
    
    sub op_to_string {
       my($self) = @_;
       return $self ? "true" : "false";
    }
    
    sub typecheck {
       map { blessed $_ eq __PACKAGE__ or croak "Bool: Type error" } @_;
       return;
    }
    
    1;

    true/false в perl.
    true == true -> true
    1 == 1 -> true
    "a" eq "b" -> false
    и т.п.
    true == 1 # Ошибка
    Пришлось долго искать как превратить !0 в true и !!0 в false, посмотрел в чужом модуле.

    an0nym, 22 Августа 2013

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

    +91

    1. 1
    2. 2
    3. 3
    4. 4
    5. 5
    6. 6
    7. 7
    8. 8
    9. 9
    my $list       = [];
    while ( my $r = $st->fetchrow_hashref ) {
         # ...
    
         my @desc_periods = sort { $b <=> $a } keys %{ $r->{bp_periods} };
         $num_p = ( $#desc_periods + 1 ) or 1;
     
         $list->{$num_p} = $r;
    }

    Суть ГК в строчке 6. Картина маслом: "Я у мамы хакир".

    Elvenfighter, 15 Августа 2013

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

    −39

    1. 1
    2. 2
    >> # HTML/4.01 says that line breaks are represented as "CR LF" pairs (i.e., `%0D%0A')
    >> $content =~ s/(?<!%0D)%0A/%0D%0A/g if defined($content);

    HTTP::Request::Common 6.04, строка 86
    http://cpansearch.perl.org/src/GAAS/HTTP-Message-6.04/lib/HTTP/Request/Common.pm

    Оно просто берёт и изменяет передаваемый контент. Любой. В том числе просто бинарные данные.

    kainwinterheart, 13 Августа 2013

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

    −19

    1. 1
    2. 2
    return { nocache => 1,
                     data => %{ &template_process() } -> { 'data' } };

    Конечно же template_process возвращает HashRef сам по себе.

    kainwinterheart, 13 Августа 2013

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