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

    −1

    1. 1
    SADASD

    kezzyhko, 13 Июля 2018

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

  2. 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)

  3. Perl / Говнокод #23358

    +3

    1. 1
    print for <>

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

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

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

  4. 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)

  5. 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)

  6. 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)

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

  8. 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)

  9. 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)

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

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