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

    +1

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

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

    +3

    1. 1
    print for <>

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

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

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

    0

    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
    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)
  4. Perl / Говнокод #18534

    −227

    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 этот пример даже есть

    #13520

    Elvenfighter, 26 Июля 2015

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

    −126

    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
    $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)
  6. Perl / Говнокод #17485

    −161

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

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

    BoBikeR, 20 Января 2015

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

    Комментарии (10)
  8. 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

    Комментарии (39)
  9. 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

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