1. 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)
  2. 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)
  3. 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)
  4. 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)
  5. Perl / Говнокод #10947

    −104

    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
    44. 44
    45. 45
    46. 46
    47. 47
    48. 48
    49. 49
    50. 50
    if ($key eq $default_key){
    		my $author = $default_author;
    		if ($release){
    			if (length $release <= $max_release){
    				if (length $description <= $max_description){			
    					if ($filename){
    						if (clearfn(\$filename) eq 1){
    							if (! -e "$files_dir/$filename"){
    								$release = clear($release);
    								$description = clear($description);
    								$description = bb($description);
    								open FILE, '>>db.txt' or die $!;
    								print FILE "$release\t$filename\t$description\t$author\t" . ftime() . "\n";
    								close FILE;
    								open FILE, ">$files_dir/$filename" or die "$!";
    								binmode FILE;
    								while (<$filehandle>){
    									print FILE;
    								}
    								close FILE;
    								$result = 'Файл успешно добавлен!';
    								rss();
    							}
    							else {
    								$result = 'Ошибка: Файл с таким именем уже загружен!';
    							}
    						}
    						else {
    							$result = 'Ошибка: Недопустимое расширение файла!';
    						}
    					}
    					else {
    						$result = 'Ошибка: Нет файла!';
    					}
    				}
    				else {
    					$result = "Ошибка: В описании должно быть не более $max_description символов!";
    				}
    			}
    			else {
    				$result = "Ошибка: В названии должно быть не более $max_release символов!";
    			}
    		}
    		else {
    			$result = 'Ошибка: Нет названия!';
    		}
    	}
    	else {
    		$result = 'Ошибка: ';
    	}

    Писал паскалеребенок

    nyaknyan, 14 Июня 2012

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

    −102

    1. 1
    2. 2
    3. 3
    4. 4
    5. 5
    6. 6
    7. 7
    8. 8
    9. 9
    ($sec,$min,$hour,$mday,$mon,$year) = localtime(time);
    if ($sec < 10) {$sec = "0$sec";}
    if ($min < 10) {$min = "0$min";}
    if ($hour < 10) {$hour = "0$hour";}
    if ($mday < 10) {$mday = "0$mday";}
    if ($mon < 10) {$mon = "0$mon";}
    $mon++;
    $year = 1900 + $year;
    print "[$mday-$mon-$year $hour:$min:$sec]\n";

    Добиваем нулями

    rohard, 24 Февраля 2011

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

    −103

    1. 1
    2. 2
    3. 3
    4. 4
    5. 5
    6. 6
    7. 7
    8. 8
    if (-e '/etc/passwd') {
        # assume Unix
        ...
    }
    else {
        # assume NT
        ...
    }

    так в круто-мегабаксовом ClearCase IBM программисты определяют в Перле запущен ли скрипт под Виндой или под *NIXком. наши админы долго смеялись, но по приколу сохранили этот кусок как было в оригинале.

    Dummy00001, 09 Ноября 2010

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

    −247

    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
    if($ENV{'mode'} eq "dialup"){
      if($ENV{'login'}=~/^P/){
        if($ENV{'bill'}){
          if($ENV{'passwd1'}){
            if($ENV{'passwd1'} eq $ENV{'passwd2'}){
    	  if($ENV{'email'}){
                my($rUser)=check_radius_user_new($ENV{'login'});
    	    my($sUser)=check_http_user_new($ENV{'login'});
    	   #my($Email)=Check_MailBox($ENV{'login'},$ENV{'email'});
        	    if(($rUser==0)and($sUser==0)and($Email==0)){
                  my($bUser)=check_billing_user($ENV{'bill'});
    	      if($bUser==0){
                    add_radius_user($ENV{'login'},$ENV{'passwd1'});
    	        add_http_user($ENV{'login'},$ENV{'passwd1'});
        	        add_billing($ENV{'login'},$ENV{'bill'});
    		Add_MailBox($ENV{'login'},$ENV{'email'},$ENV{'passwd1'});
            	$ENV{'message'}="User created";
                  }else{$ENV{'message'}="Error: Billing name is already exist";}
    	      if($Email!=0){$ENV{'message'}="Error: Email name or alias is already exist";}
                }else{$ENV{'message'}="Error: Sorry such login is already exist";}
    	  }else{$ENV{'message'}="Error: Enter e-mail";}
            }else{$ENV{'message'}="Error: Password mistake";}
          }else{$ENV{'message'}="Error: Enter password";}
        }else{$ENV{'message'}="Error: Enter billing name";}		
      }else{$ENV{'message'}="Error: Enter login";}
    }else{$ENV{'message'}="Error: ";}
    $ENV{'message'}=~s/ /\%20/g;

    Может это так и надо делать?

    Werdn, 30 Августа 2010

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

    −117

    1. 1
    2. 2
    if ( $src =~ /^(.+)$/ ) { $src = "$1"; }
    if ( $dst =~ /^(.+)$/ ) { $dst = "$1"; }

    Еще один вариант проверки на непустую строку.

    mrtaryk, 13 Августа 2010

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

    −251.4

    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
    my $sec;
    my $min;
    my $hour;
    my $mday;
    my $mon;
    my $year;
    my $wday;
    my $yday;
    my $isdst;
    
    ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =localtime(time);
    $year=$year+1900;
    $mon=$mon+1;
    if ($mon<10)
    {
    $mon='0'.$mon;
    }
    if ($sec<10)
    {
    $sec='0'.$sec;
    }
    if ($min<10)
    {
    $min='0'.$min;
    }
    if ($hour<10)
    {
    $hour='0'.$hour;
    }
    if ($mday<10)
    {
    $mday='0'.$mday;
    }

    двузначные цифры в дате

    Bracus, 25 Февраля 2010

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