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

    −366

    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
    sub rotate {
    my ($filename, $max_entries) = @_;
    $max_entries //= 10; # TODO: make infinity available

    return if (! -f $filename);

    my ($name, $dir, $suffix) = fileparse($filename, qr/\.[^.]*$/);

    my %old_files = ();
    my $shift_max = 0; # maximum number of file that is going to be rotated
    my $glob = File::Spec->catfile($dir, $name . '.*' . $suffix);
    for my $file (glob qq/"$glob"/) {
        my ($number) = $file =~ /\.(\d+)\Q$suffix\E$/;

        $old_files{$number} = $file if (defined $number);
        $shift_max++ while (exists $old_files{$shift_max + 1});
    }

    $shift_max = $max_entries - 1 if ($shift_max >= $max_entries);
    # how many files to remove from the end
    my $to_remove = scalar(keys %old_files) - $max_entries;

    # rename and unlink
    for my $number (sort { $b <=> $a } keys %old_files) {
        my $file = $old_files{$number};

        if ($to_remove-- > 0) {
            print "## DEBUG: unlink $file\n";
            unlink($file)
                or croak('Cannot unlink ' . $file);
        } elsif ($number <= $shift_max) {
            my $new_name = File::Spec->catfile($dir, $name . '.' . ($number + 1) . $suffix);
            print "## DEBUG: rename $file -> $new_name\n";
            rename($file, $new_name)
                or croak('Cannot rename ' . $file . ' to ' . $new_name);
        }
    }

    my $new_name = File::Spec->catfile($dir, $name . '.1' . $suffix);
    print "## DEBUG: rename $filename -> $new_name\n";
    rename($filename, $new_name)
        or croak('Cannot rename ' . $filename . ' to ' . $new_name);
}

    Продолжаем парад велосипедов. Сделал ротацию бекап-архивов :-{

    Elvenfighter, 20 Ноября 2014

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

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

    −288

    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

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

  3. Perl / Говнокод #17073

    −161

    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

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

  4. Perl / Говнокод #16965

    −161

    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

    −165

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

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

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

    kainwinterheart, 08 Октября 2014

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

  6. Perl / Говнокод #16701

    −153

    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

    −161

    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

    −109

    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

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

  9. Perl / Говнокод #16565

    −159

    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 / Говнокод #16294

    −143

    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
    $minfts = $maxfts = undef;
$c=$l=$x=$z=0;
while (($id, @a) = $sth->fetchrow_array) {
    $l++;
    next unless defined($t{$a[1]});
    $c++;
    $s{$id} = [$r, $id, @a];
    $x++ if $s{$id}{rc} && !$s{$id}{rm};
    $z++ if $s{$id}{rm};
    $s{$id}{t} = $t{$s{$id}{tid}};
    $s{$id}{bonuses} = 0;
    push @{$sid{$s{$id}{sid}}}, $id;
    ### PATCH3 ###
    $sid2pid{$s{$id}{sid}} = $s{$id}{id2};
    ### END PATH3 ###
    $minfts = $s{$id}{sd} if !defined($minfts) || $s{$id}{sd}<$minfts;
    $maxfts = $s{$id}{ed} if !defined($maxfts) || ($maxfts && $s{$id}{ed}>$maxfts) || !$s{$id}{ed};
}
$sth->finish;
$l-=$c;

    Минимализм в название переменных

    ptaag, 09 Июля 2014

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