- 1
SADASD
Нашли или выдавили из себя код, который нельзя назвать нормальным, на который без улыбки не взглянешь? Не торопитесь его удалять или рефакторить, — запостите его на говнокод.ру, посмеёмся вместе!
−1
SADASD
0
#!/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);
Пользуйтесь на здоровье
+3
print for <>
Базовая функциональность программы cat на perl. Кто короче?
(только возможности самого языка без exec и подобных, шеллы вне олимпиады)
0
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);
}
};
Кровавый ентерпрайз. Кусок кода мейд бай ХулетПакард
−227
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
−126
$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);
}
}
Из биллинга одного довольно крупного интернет-провайдера
Кто-то что-то хотел закомментить...
−161
my @arr = (1,2,3,4);
foreach (@arr)
{
threads->new(\&doSomething, $_)->join;
}
Цикл на 4...? Запуск потоков.
−366
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);
}
Продолжаем парад велосипедов. Сделал ротацию бекап-архивов :-{
−288
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.
−161
foreach my $i (0 .. (scalar @{ $PARAMS{Input} } - 1) )
{
@{ $PARAMS{Input} }[$i] = expand_filename(@{ $PARAMS{Input} }[$i]);
}
Такая то экспрессия