1. 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

    Комментарии (30)
  2. 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)
  3. 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)
  4. 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

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

    −19

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

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

    kainwinterheart, 13 Августа 2013

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

    −24

    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
    package Exception;
    
    sub new {
       my($package, $what) = @_;
       return bless { what => $what }, $package;
    }
    
    sub what {
       my($self) = @_;
       return $self->{what};
    }
    
    package main;
    
    sub try(&$) {
       my($code, $catch) = @_;
       unless(eval { $code->(); 1 }) {
          local $_ = $@;
          $catch->();
       }
    }
    
    sub catch(&) { $_[0] }
    
    sub throw($) { die $_[0] }
    
    try {
       throw new Exception("Ошибка");
    } catch {
       print $_->what;
    };

    Исключения в perl.

    an0nym, 08 Августа 2013

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

    −19

    1. 1
    2. 2
    3. 3
    4. 4
    5. 5
    6. 6
    7. 7
    8. 8
    use strict;
    use warnings;
     
    my ($i, $j) = (42, 13);
     
    my $max = [ $i => $j ]->[ $i <= $j ];
     
    print "max: $max\n";

    Вот-так вот: http://ideone.com/2Rd3Mr

    // Вроди где-то в PBP этот пример даже есть

    Elvenfighter, 31 Июля 2013

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

    −45

    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
    sub is_home_license
    {
            my $self = shift;
    
            my $rv = $self -> product() -> is_home_product();
    
            unless( $rv )
            {
    
                    unless( $self -> product() -> is_nl_product() )
                    {
    
                            if( ( int( $self -> licdata() -> { '1' } ) > 0 ) and ( int( $self -> licdata() -> { '1' } ) < 6 ) ) # 1 .. 5
                            {
                                    $rv = 1;
                            }
    
                            unless( $self -> licdata() -> { '1' } )
                            {
                                    if( $self -> licdata() -> { '8' } == 1 )
                                    {
                                            $rv = 1;
                                    }
                            }
    
                    }
            }
    
            return $rv;
    }

    kainwinterheart, 30 Июля 2013

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

    −49

    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
    sub is_demo_license
    {
            my $self = shift;
    
            my $rv = 0;
    
            if( ( $self -> dealer() -> id() == 116 )
                and
                ( $self -> comments() =~ /^DEMO\s+STID/ ) )
            {
                    $rv = 1;
            }
    
            return $rv;
    }

    kainwinterheart, 30 Июля 2013

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

    −63

    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
    # There is a note that I completely do not
    # understand how does it work and why.
    # I've manager to guess it via  trial and
    # error method. So be warned! :)
    sub magic
    {
            my ( $self, $others ) = @_;
    
            my $la = $self -> get_a();
            my $lb = $self -> get_b();
    
            my $x = ( ( reduce { ( ref( $a ) ? $a -> get_b() : $a ) + $b -> get_b() } @$others ) / scalar( @$others ) );
            my $y = ( $x ? ( $la / $x ) : ( $la ? log( $la ) : 0 ) );
    
            return ( $lb - ( $y ? log( $y ) : 0 ) );
    }

    Магическое число. По этому числу в порядке возрастания сортируются менеджеры. Тот, у кого значение наименьшее, получает новое задание.

    kainwinterheart, 18 Июля 2013

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