Perl — Говнокод.ру

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

−161

1
2
3
4

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

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

Anus, 06 Ноября 2014

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

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

−161

01
02
03
04
05
06
07
08
09
10
11
12
13
14
15
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)

Perl / Говнокод #16825

−165

1

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

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

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

kainwinterheart, 08 Октября 2014

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

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

−153

01
02
03
04
05
06
07
08
09
10
11
12
13
14
15
16
17
18
19
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)

Perl / Говнокод #16668

−161

1
2
3
4
5
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)

Perl / Говнокод #16634

−109

01
02
03
04
05
06
07
08
09
10
11
12
13
14
15
16
17
18
19
20
21
22
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)

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

−159

1
2
3
4
5
6
7
8
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)

Perl / Говнокод #16294

−143

01
02
03
04
05
06
07
08
09
10
11
12
13
14
15
16
17
18
19
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)

Perl / Говнокод #15973

−149

1
2
3
4
5
6
7
8
9

my $query = "select * from client where <...>";
...
$params{'first_name'} = $v_client[6];
if (defined $v_client[11]) {
     $params{'address1'} = $v_client[11];
}
if (defined ($v_client[10])) {
  $params{'zip_code'} = $v_client[10];
}

No comments.

bormand, 13 Мая 2014

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

Perl / Говнокод #14557

−151

01
02
03
04
05
06
07
08
09
10

if( my $row = &dbselectrow( $sql ) )
        {
                if( $row -> { 'ofid' } == 9782 ) # moscow
                {
                        if( $row -> { 'jt' } =~ /Начальник /i )
                        {
                                &subscribe_to_management( $row -> { 'email' } );
                        }
                }
        }

Автоматическая подписка сотрудника руководящей должности на список рассылки для руководителей.

kainwinterheart, 13 Февраля 2014

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

Говнокод: по колено в коде.

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

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

Perl / Говнокод #16825

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

Perl / Говнокод #16668

Perl / Говнокод #16634

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

Perl / Говнокод #16294

Perl / Говнокод #15973

Perl / Говнокод #14557