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

    −7

    1. 1
    ((*+*)***)

    Это не новый смайлик, а один из способов задания анонимных функций в perl6. Как вы думаете, что это за функция?

    Bobik, 02 Июня 2016

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

    +745

    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

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

    +74

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

    −61

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

    −44

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

    −40

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

    −55

    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
    open (FILE, "< /etc/info_file");
    while (<FILE>) {
        $found++ if (/^\/usr\s+/);
    }
    close FILE;
    
    if ($found) {
        print "# Found /usr entry in /etc/info_file\n" if ($do_debug);
    } else {
        print "# Adding /home entry to /etc/info_file\n" if ($do_debug);
        open (FILE, ">> /etc/auto_master");
        print FILE "/usr    auto_usr   -noview";
        close FILE;
    }

    Энтерпрайз! Махровый и беспощадный.

    Elvenfighter, 10 Ноября 2014

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

    −61

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

    −61

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

    −65

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

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

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

    kainwinterheart, 08 Октября 2014

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