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

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

+1

01
02
03
04
05
06
07
08
09
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37

sub PARSE_MULTIPART {
	my    ($STREAM,$boundary,$HANDLE,$PROCESS) = @_;
	open my $DH,'>',do{\(my $null)}; # devnull
	local $_ = "--\r\n";
	local $/ = \8192;
	my ($BR,$BL) = map {qr{^ (.*?) \Q$_\E }sx,length} map {"\r\n--$_"} $boundary;
	/^/;
	while ( (length) < length($_.=<$STREAM>) and $PROCESS->($.,${$/}) ){
			(print $DH
				m{$BR}
				       ? $1
				       : substr($_,0,-$BL,'')
			)
			 &&
				$+[0]
		 ...
				m{^
					    \r\n Content-Disposition       :\ form-data
					                                   ;\ name     = (?:"([^"]*?)"|(\S+?))
					(                                  ;\ filename = (?:"([^"]*?)"|(\S+?)) )?
					(?: \r\n Content-Type              :\            (.+?)                 )?
					(?: \r\n Content-Transfer-Encoding :\            (.+?)                 )?
					    \r\n
					    \r\n
				}sx
			 &&
				($DH = $HANDLE->({
					      'name'     => length $1 ? $1 : $2      ,
					$3 ? ('filename' => length $4 ? $4 : $5) : (),
					$6 ? ('type'     =>             $6     ) : (),
					$7 ? ('encode'   =>             $7     ) : (),
				}))
			 ||
				m{^--};
		$+[0] and substr($_,0,$+[0],''),/^/,redo;
	};
};

http://oleg-bunin.livejournal.com/28302.html?thread=369550

SemaReal, 21 Октября 2017

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

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

+3

1

print for <>

Базовая функциональность программы cat на perl. Кто короче?
(только возможности самого языка без exec и подобных, шеллы вне олимпиады)

Elvenfighter, 24 Сентября 2017

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

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

0

01
02
03
04
05
06
07
08
09
10
11
12
13
14
15
16
17
18
19
20
21
22

if ( $MonitorMode eq \">=\" )
{
  if ( $NbrProcesses < $ProcNumber )
  {
    $Rule->Status(TRUE);
  }
}
elsif ( $MonitorMode eq \"<=\" )
{
  if ( $NbrProcesses > $ProcNumber )
  {
    $Rule->Status(TRUE);
  }
}
else
{
  if ( $NbrProcesses != $ProcNumber )
  {
    $Session->Value(\"PROCESSMODE\", \"\" );
    $Rule->Status(TRUE);
  }
};

Кровавый ентерпрайз. Кусок кода мейд бай ХулетПакард

rjhdby, 09 Августа 2017

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

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

−227

1
2
3
4
5
6
7
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 этот пример даже есть

#13520

Elvenfighter, 26 Июля 2015

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

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

−126

01
02
03
04
05
06
07
08
09
10
11
12
13
14
15
16
17
18
19
20

$utm = `$utmcalc_cmd $user $YEAR $MONTH` || "error";
if ($oldtarif_mar == 16 || $oldtarif_mar == 17 || $oldtarif_mar == 19 || $oldtarif_mar == 27 || $oldtarif_mar == 45) {
	if ($newtarif_mar == 16 || $newtarif_mar == 17 || $newtarif_mar == 19 || $newtarif_mar == 27 || $newtarif_mar == 45) {
		$money2 = (($oldtarif_abonplata/30)*$daystoeom) - (($newtarif_abonplata/30)*$daystoeom);
#		$nm1 = 0;
	} else {
		$money2 = (($oldtarif_abonplata/30)*$daystoeom) - (($newtarif_abonplata/30)*$daystoeom);
#		$nm1 = $utm;
	}
} elsif ($oldtarif_mar != 16 || $oldtarif_mar != 17 || $oldtarif_mar != 19 || $oldtarif_mar != 27 || $oldtarif_mar != 45) {
	if ($newtarif_mar == 16 || $newtarif_mar == 17 || $newtarif_mar == 19 || $newtarif_mar == 27 || $newtarif_mar == 45) {
#		$money2 = $oldtarif_abonplata - ($utm*$oldtarif_koef) - (($newtarif_abonplata/30)*$daystoeom);
		$money2 = (($oldtarif_abonplata/30)*$daystoeom) - (($newtarif_abonplata/30)*$daystoeom);
#		$nm1 = -$cur_nm;
	} else {
#		$money2 = $oldtarif_abonplata - ($utm*$oldtarif_koef) - (($newtarif_abonplata/30)*$daystoeom);
		$money2 = (($oldtarif_abonplata/30)*$daystoeom) - (($newtarif_abonplata/30)*$daystoeom);
#		$nm1 = -(($newtarif_lymit/30)*$DAY);
	}
}

Из биллинга одного довольно крупного интернет-провайдера
Кто-то что-то хотел закомментить...

begemot, 27 Апреля 2015

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

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

−161

1
2
3
4
5

my @arr = (1,2,3,4);
foreach (@arr) 
{
   threads->new(\&doSomething, $_)->join;
}

Цикл на 4...? Запуск потоков.

BoBikeR, 20 Января 2015

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

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

−366

01
02
03
04
05
06
07
08
09
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
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

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

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

−288

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

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

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

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

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

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

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

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

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

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

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

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

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