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

    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
    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
    51. 51
    52. 52
    #!/usr/bin/perl -w
    # ESXi host CPU/memory plugin for Munin by Niels Engelen
    # http://www.foonet.be
     
    use strict;
    use warnings;
    use VMware::VIRuntime;
    use VMware::VILib;
     
    $ENV{PERL_LWP_SSL_VERIFY_HOSTNAME} = 0;
     
    my $esxihost = basename($0);
    $esxihost =~ s/esxi\_cpu\_mem\_//;
    my $username = Opts::set_option ('username', $ENV{'username'});
    my $password = Opts::set_option ('password', $ENV{'password'});
    my $url = Opts::set_option ('url', "https://$esxihost/sdk/webService");
    my ($host_info);
     
    if ( exists $ARGV[0] and $ARGV[0] eq "config" ) {
      print "graph_title ESXi CPU/Memory ".$esxihost." \n";
      print "graph_args --base 1000 -r --lower-limit 0 --upper-limit 100 \n";
      print "graph_vlabel % \n";
      print "graph_category ESXi CPU/Memory\n";
      print "graph_scale no\n";
      print "mem.label MEM used\n";
      print "mem.draw AREA\n";
      print "cpu.label CPU used\n";
      exit 0;
    } else {
      Opts::parse();
      Opts::validate();
      Util::connect();
      $host_info = Vim::find_entity_view(view_type => 'HostSystem', properties => ['summary.hardware', 'summary.quickStats'], filter => {'summary.runtime.connectionState' => 'connected'});
      &get_host_mem_info($host_info);
      &get_host_cpu_info($host_info);
      Util::disconnect();
      exit 0;
    }
      
    sub get_host_mem_info {
            if ($host_info) {
            my $percentMemoryUsed = ($host_info->{'summary.quickStats'}->overallMemoryUsage * 1024 * 1024 / $host_info->{'summary.hardware'}->memorySize) * 100;
            printf "mem.value %.2f\n",$percentMemoryUsed;
        }
    }
      
    sub get_host_cpu_info {
        if ($host_info) {
            my $percentCpuUsed = ($host_info->{'summary.quickStats'}->overallCpuUsage / ($host_info->{'summary.hardware'}->cpuMhz * $host_info->{'summary.hardware'}->numCpuCores)) * 100;
            printf "cpu.value %.2f\n",$percentCpuUsed;
            }
    }

    munin, 22 Февраля 2017

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

    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
    sub deprecate_marks
    {
        my ($marks, $task) = @_;
        # дополнительное задание -- не уменьшаем оценку
        $_->{days_late} < 0 ? $_->{days_late} = 0 : undef for @$marks;
        $task->{half_life} or return ($marks->[0] || {})->{points};
        my ($dep_points, $prev_points) = (0, 0);
        for my $m (reverse @$marks)
        {
            # Раньше вычиталось dep_points, что приводило к необоснованному завышению оценки.
            # Чтобы не менять старые данные, исправляем ошибку только для новых заданий.
            my $p = $task->{after_marks_fix} > 0 ? $prev_points : $dep_points;
            my $diff = max($m->{points} - $p, 0);
            $prev_points = $m->{points};
            my $dep_coeff = $task->{half_life} / ($m->{days_late} + $task->{half_life});
            $dep_points += $diff * max(($task->{deprecation_limit} || 10) / 100, $dep_coeff);
            $m->{dep_points} = sprintf '%.1f', $dep_points;
        }
        $dep_points;
    }

    Снижение баллов за задания по программированию

    askfail, 21 Сентября 2016

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

    +23

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

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

    Bobik, 02 Июня 2016

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

    +16

    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
    51. 51
    52. 52
    53. 53
    54. 54
    55. 55
    56. 56
    57. 57
    #!/usr/bin/perl -w
    
    use IO::Socket;
    
    @months = qw( Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec );
    
    $server_port = 1488;
    $server = IO::Socket::INET->new(
        LocalPort => $server_port,
        Type => SOCK_STREAM,
        Reuse => 1,
        Listen => 20
    )
    or die "Can\'t use port:$server_port";
    
    while($client_socket = $server->accept()) {
        while ($count = sysread($client_socket, $data, 1024)) {
            print "Принято ${count} байт: ${data}\n";
    
            if ($data eq '/time') {
                ($sec,$min,$hour) = localtime();
                if ($hour < 10) {
                    $hour = "0$hour";
                }
                if ($min < 10) {
                    $min = "0$min";
                }
                if ($sec < 10) {
                    $sec = "0$sec";
                }
                $client_socket->send("$hour:$min:$sec");
            } elsif ($data eq '/date') {
                ($sec,$min,$hour,$mday,$mon,$year) = localtime();
                $year += 1900;
                $client_socket->send("$mday $months[$mon] $year");
            } elsif ($data eq '/datetime') {
                ($sec,$min,$hour,$mday,$mon,$year) = localtime();
                $year += 1900;
                if ($hour < 10) {
                    $hour = "0$hour";
                }
                if ($min < 10) {
                    $min = "0$min";
                }
                if ($sec < 10) {
                    $sec = "0$sec";
                }
                $client_socket->send("$mday $months[$mon] $year $hour:$min:$sec");
            } else {
                $client_socket->send("nil");
            }
        }
    
        shutdown($client_socket, 1);
    }
    
    $server->close();

    Обнаружил сокет-сервер на перел

    ufufney, 16 Мая 2016

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

    +14

    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
    #!/usr/bin/perl -w
    
    use CGI::Carp qw(warningsToBrowser fatalsToBrowser);
    no warnings 'once';
    require "send_server_header.txt";
    send_server_header("html");
    
    $latest_release = "../programs/sasplanet/SASPlanet_121010.zip";		#ссыль на последний релиз
    
    
    print "<html><head>";
    print "<meta http-equiv=\"Content-type\" content=\"text/html; charset=UTF-8\" />";
    print "<meta http-equiv=\"Pragma\" content=\"no-cache\" />";
    print "<meta http-equiv=\"Cache-Control\" content=\"no-cache\" />";
    print "<meta http-equiv=\"Pragma-directive\" content=\"no-cache\" />";
    print "<meta http-equiv=\"Cache-Directive\" content=\"no-cache\" />";
    print "<meta name=\"robots\" content=\"noindex,follow\" />";
    print "<title>SAS.Планета - файловый архив</title>";
    print "<link href=\"stylesheet.css\" rel=\"stylesheet\" type=\"text/css\" />";
    print "<meta http-equiv=Refresh content=\"10; url=".$latest_release."\">";
    print "</head>";
    
    print "<h2>Последняя стабильная версия:</h2>";

    И ещё 60 строк, содержащих вызов print.

    inkanus-gray, 06 Мая 2016

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

    +15

    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
    #!/usr/bin/perl5.18
    
    $file = $ARGV[0];
    if (!$file) {
        print "Введите имя файла: ";
        $file = <STDIN>;
        chomp $file;
    }
    $direction = $ARGV[1];
    if (!$direction) {
        print "Введите направление: ";
        $direction = <STDIN>;
        chomp $direction;
    }
    if ($direction ne '866toKOI8' && $direction ne 'KOI8to866') {
        die "Invalid param";
    }
    
    open (IN_FILE, "<$file") or die "Cannot open file";
    open (OUT_FILE, ">out$file") or die "Cannot open file";
    $text = '';
    while (my $row = <IN_FILE>) {
        if ($direction eq '866toKOI8') {
            $row =~ tr/\x80\x81\x82\x83\x84\x85\xF0\x86\x87\x88\x89\x8A\x8B\x8C\x8D\x8E\x8F\x90\x91\x92\x93\x94\x95\x96\x97\x98\x99\x9A\x9B\x9C\x9D\x9E\x9F\xA0\xA1\xA2\xA3\xA4\xA5\xF1\xA6\xA7\xA8\xA9\xAA\xAB\xAC\xAD\xAE\xAF\xE0\xE1\xE2\xE3\xE4\xE5\xE6\xE7\xE8\xE9\xEA\xEB\xEC\xED\xEE\xEF/\xE1\xE2\xF7\xE7\xE4\xE5\xB3\xF6\xFA\xE9\xEA\xEB\xEC\xED\xEE\xEF\xF0\xF2\xF3\xF4\xF5\xE6\xE8\xE3\xFE\xFB\xFD\xFF\xF9\xF8\xFC\xE0\xF1\xC1\xC2\xD7\xC7\xC4\xC5\xA3\xD6\xDA\xC9\xCA\xCB\xCC\xCD\xCE\xCF\xD0\xD2\xD3\xD4\xD5\xC6\xC8\xC3\xDE\xDB\xDD\xDF\xD9\xD8\xDC\xC0\xD1/;
        } else {
            $row =~ tr/\xE1\xE2\xF7\xE7\xE4\xE5\xB3\xF6\xFA\xE9\xEA\xEB\xEC\xED\xEE\xEF\xF0\xF2\xF3\xF4\xF5\xE6\xE8\xE3\xFE\xFB\xFD\xFF\xF9\xF8\xFC\xE0\xF1\xC1\xC2\xD7\xC7\xC4\xC5\xA3\xD6\xDA\xC9\xCA\xCB\xCC\xCD\xCE\xCF\xD0\xD2\xD3\xD4\xD5\xC6\xC8\xC3\xDE\xDB\xDD\xDF\xD9\xD8\xDC\xC0\xD1/\x80\x81\x82\x83\x84\x85\xF0\x86\x87\x88\x89\x8A\x8B\x8C\x8D\x8E\x8F\x90\x91\x92\x93\x94\x95\x96\x97\x98\x99\x9A\x9B\x9C\x9D\x9E\x9F\xA0\xA1\xA2\xA3\xA4\xA5\xF1\xA6\xA7\xA8\xA9\xAA\xAB\xAC\xAD\xAE\xAF\xE0\xE1\xE2\xE3\xE4\xE5\xE6\xE7\xE8\xE9\xEA\xEB\xEC\xED\xEE\xEF/;
        }
        print OUT_FILE $row;
    }
    close (IN_FILE);
    close (OUT_FILE);

    Смена кодировки из cp866 в KOI8 и обратно. Шел 2016й год.....................

    ufufney, 04 Апреля 2016

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

    +15

    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
    package Whatever;
    
    use strict;
    use warnings;
    use Data::Dumper;
    
    use constant {
        PASSWORD            => 'password',
        PROFILE             => 'profile',
        ROOT_USER_DN        => 'bind-dn',
    };
    
    sub _export_data {
        my ($self, $data) = @_;
        # внутренняя логика не важна: просто напечатаем что получили
        print Dumper($data);
    }
    
    sub method {
       my ($self) = @_;
    
    # <govnokod location="here">
       $self->_export_data({
          map { __PACKAGE__->$_ => $self->{'_' . lc $_} } qw(PASSWORD PROFILE ROOT_USER_DN)
       });
    # </govnokod>
    }
    
    package main;
    
    # быстро создадим обьект (чтоб не копировать конструктор)
    my $obj = bless {
        _password     => 'foo',
        _profile      => 'bar/baz',
        _root_user_dn => 'cn=root,dc=example,dc=com'
    } => 'Whatever';
    
    $obj->method();

    Захотелось вы**нуться: експортнуть несколько значений внутри обьекта по константам с такими же названиями...

    Elvenfighter, 09 Марта 2016

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

    +771

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

    +101

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

    −37

    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)