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

    −40

    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 serialize {
        my ($obj) = @_;
        my $result;
    
        my $ref = ref $obj;
        if ($ref eq 'HASH') {
            $result = sprintf '{ %s }', join(', ', map { qq/"$_": / . serialize($obj->{$_}) } keys %$obj);
        } elsif ($obj eq 'ARRAY') {
            $result = sprintf '[ %s ]', join(', ', map { serialize($_) } @$obj);
        } elsif (! $ref) {
            if (!defined $obj) {
                $result = 'null';
            } elsif ($obj =~ /^ -? (?:0|[1-9]\d*) (?:\.\d+)? (?:[eE][+-]?\d+)? $/x) {
                $result = $obj;
            } else {
                $obj =~ s/(["\\])/\\$1/g;
                $obj =~ s/\r/\\r/g;
                $obj =~ s/\n/\\n/g;
                $obj =~ s/\t/\\t/g;
                $result = qq/"$obj"/;
            }
        }
    
        return $result;
    }

    В продолжение #17106. Самопальная Самобытная сериализация в JSON.

    Elvenfighter, 14 Ноября 2014

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

    −55

    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
    open (FILE, "< /etc/info_file");
    while (<FILE>) {
        $found++ if (/^\/usr\s+/);
    }
    close FILE;
    
    if ($found) {
        print "# Found /usr entry in /etc/info_file\n" if ($do_debug);
    } else {
        print "# Adding /home entry to /etc/info_file\n" if ($do_debug);
        open (FILE, ">> /etc/auto_master");
        print FILE "/usr    auto_usr   -noview";
        close FILE;
    }

    Энтерпрайз! Махровый и беспощадный.

    Elvenfighter, 10 Ноября 2014

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

    −61

    1. 1
    2. 2
    3. 3
    4. 4
    foreach my $i (0 .. (scalar @{ $PARAMS{Input} } - 1) )
    {
    	@{ $PARAMS{Input} }[$i] = expand_filename(@{ $PARAMS{Input} }[$i]);
    }

    Такая то экспрессия

    Anus, 06 Ноября 2014

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

    −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
    15. 15
    16. 16
    sub check_license {
        my ($license) = @_;
    
        my $is_valid = 0;
        if (-f $license) {
            open(my $fh, '<', $license);
            my $content = do { local $/ = undef; <$fh> };
            close($fh);
            $content =~ s/\r\n/\n/g;
    
            $is_valid = $content =~ /^-{5}BEGIN LICENSE-{5}$/m;
            $is_valid = $content =~ /^-{5}END LICENSE-{5}$/m;
        }
    
        return $is_valid;
    }

    Ну ок.

    Elvenfighter, 29 Октября 2014

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

    −65

    1. 1
    our @hilight_critical_files = ( 'celebrities.txt', 'obscene.txt', 'lekarstva.txt' );

    Глобальная переменная, неверно написанное английское слово, захардкоженные значения, транслит, транслит вперемешку с английскими словами<s>, и вообще perl</s>.

    И всё это в одной короткой строке.

    kainwinterheart, 08 Октября 2014

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

    −53

    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
    eval {
            my $from = $class->get_env_sender($message);
    
            $smtp->mail($from)
                || croak("Email::Send::Gmail: error sending 'from' $from");
    
            my @to = $class->get_env_recipients($message);
    
            my @ok = $smtp->to( @to, { SkipBad => 1 } )
                || croak("Email::Send::Gmail: error sending 'to' @to");
    
            if ( @to != @ok ) {
                my %to;
                @to{@to} = (1) x @to;
                delete @to{@ok};
                @bad = keys %to;
            }
    
            croak("Email::Send::Gmail: no valid recipients") if @bad == @to;
        };

    Думаю понятно, какой это модуль с CPAN. Убило незнание приоритетов, в результате чего "|| croak" всегда возвращало в @ok число вместо результата выполнения $smtp->to

    NeoliteBSD, 16 Сентября 2014

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

    −61

    1. 1
    2. 2
    3. 3
    4. 4
    5. 5
    6. 6
    error_response("400 Bad request", "") unless (<> =~ /^GET\s+(.+?)\s+HTTP\/1\.1\r$/);                                                
    my $request_url = $1;                                                                                                               
    log_message "REQUEST $request_url";                                                                                                 
    get_bans() if ($request_url =~ /^\/bans\?auth=$authkey$/);                                                                          
    remove_ban($1) if ($request_url =~ /^\/bans\/(\d+\.\d+\.\d+\.\d+)\/remove\?auth=$authkey$/);                                        
    error_response("404 Not found", "");

    REST API через inetd (на этом серваке нету веб сервера, и ставить его влом). Новая жизнь старых технологий ;)

    bormand, 09 Сентября 2014

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

    +91

    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
    #!/usr/bin/perl
    use strict;
    sub ternary_switch {
    	my ($def,%exp) = @_;
    	my $result = $def;
    	for my $key (keys %exp) {
    		$result = '(' . $key . ')?(' . $exp{$key} . '):(' . $result . ')';
    	}
    	return $result;
    }
    my $def = ' (int)sum/0 /*assert*/ '; 
    my %exp = ( 
    	'quant==2' => ' round((sum)*pow(10.0,prec-1)*5.0)/pow(10.0,prec-1)/5.0 ',
    	'quant==5' => ' round((sum)*pow(10.0,prec-1)*2.0)/pow(10.0,prec-1)/2.0 ',
    	'quant==1' => ' round((sum)*pow(10.0,prec))/pow(10.0,prec) ',
    );
    my $result = ternary_switch($def,%exp);
    print $result . "\n";
    
    #define ROUND_QUANT(sum,prec,quant) (quant==5)?( round((sum)*pow(10.0,prec-1)*2.0)/pow(10.0,prec-1)/2.0 ):\
        ((quant==2)?( round((sum)*pow(10.0,prec-1)*5.0)/pow(10.0,prec-1)/5.0 ):\
        ((quant==1)?( round((sum)*pow(10.0,prec))/pow(10.0,prec) ):\
        ( (int)sum/0 /*assert*/ )))

    Округление с дробной точностью.
    Если бы я не прочитал на говнокоде что тернарники можно вкладывать, мне бы никогда это не пришло в голову

    overloop, 02 Сентября 2014

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

    −59

    1. 1
    2. 2
    3. 3
    4. 4
    5. 5
    6. 6
    7. 7
    8. 8
    9. 9
    my @args = (
    	one => 1,
    	two => 2,
    	three => 3,
    );
    
    croak(q/'hashes' only/) if (@args & 1);
    
    my $args = join ';', map { join '=', @args[$_, $_ + 1] } grep { !($_ & 1) } 0 .. $#args;

    Осилил, блин...

    Elvenfighter, 19 Августа 2014

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

    −53

    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
    sub is_consumer_registered {
        my ($type) = @_;
        my $out = qx(some-proprietary-tool --type $type);
        my $result = 0;
    
        my ($status) = $out =~ /$type\s+Status: ([^,]+),/;
        say '## DEBUG: status: ' . ($status // 'undef');
        if ($status && $status eq 'Component registered') {
            say '## DEBUG: result = 1';
            $result = 1;
        }
    
        return 0;
    }

    ... об опечатках. Даже оставил свой дебаг специально :)

    Elvenfighter, 18 Августа 2014

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