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

    +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
    #! /usr/bin/perl
    
    use strict;
    use warnings;
    
    my %h1 = (one => 1, two => 2);
    my %h2 = (three =>3 , four => 4);
    
    sub h_uno { \%h1 }
    
    sub h_multi {
        my %all = (%h1, %h2);
    
        \%all;
    }
    
    while (my ($k, $v) = each %{h_uno()}) {
        print "k=$k, v=$v\n";
    }
    
    # следующий цикл не завершится никогда
    #while (my ($k, $v) = each %{h_multi()}) {
    #    print "k=$k, $v=$v\n";
    #}

    Один из традиционных подколов собеседований на Perl вакансию.

    https://www.linux.org.ru/forum/job/14518840

    Elvenfighter, 09 Октября 2018

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

    −1

    1. 1
    SADASD

    kezzyhko, 13 Июля 2018

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

    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
    23. 23
    24. 24
    25. 25
    26. 26
    27. 27
    28. 28
    29. 29
    #!/usr/bin/env perl
    
    use strict;
    use warnings;
    use utf8;
    use diagnostics;
    
    use LWP;
    use LWP::UserAgent;
    use HTTP::Request;
    use HTTP::Response;
    use JSON;
    use HTML::TreeBuilder;
    use HTML::FormatText;
    
    my $ua = LWP::UserAgent->new();
    $ua->agent('advice/0.9');
    
    my $uri = 'http://fucking-great-advice.ru/api/random';
    
    my $request = HTTP::Request->new('GET', $uri);
    my $response = $ua->request($request);
    my $content = from_json($response->content(), {utf8 => 1});
    
    binmode(STDOUT, ':utf8');
    my $tree = HTML::TreeBuilder->new->parse_content($content->{'text'});
    
    my $formatter = HTML::FormatText->new(leftmargin => 0, rightmargin => 50);
    print $formatter->format($tree);

    Пользуйтесь на здоровье

    Elvenfighter, 14 Февраля 2018

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

    +3

    1. 1
    print for <>

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

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

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

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

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

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

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

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