Нашли или выдавили из себя код, который нельзя назвать нормальным, на который без улыбки не взглянешь? Не торопитесь его удалять или рефакторить, — запостите его на говнокод.ру, посмеёмся вместе!
+1
#! /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
−1
SADASD
kezzyhko,
13 Июля 2018
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);Пользуйтесь на здоровье
Elvenfighter,
14 Февраля 2018
+3
print for <>
Базовая функциональность программы cat на perl. Кто короче?
(только возможности самого языка без exec и подобных, шеллы вне олимпиады)
Elvenfighter,
24 Сентября 2017
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);
}
};Кровавый ентерпрайз. Кусок кода мейд бай ХулетПакард
rjhdby,
09 Августа 2017
−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
Elvenfighter,
26 Июля 2015
−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);
}
}
Из биллинга одного довольно крупного интернет-провайдера
Кто-то что-то хотел закомментить...
begemot,
27 Апреля 2015
−161
my @arr = (1,2,3,4);
foreach (@arr)
{
threads->new(\&doSomething, $_)->join;
}Цикл на 4...? Запуск потоков.
BoBikeR,
20 Января 2015
−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);
}Продолжаем парад велосипедов. Сделал ротацию бекап-архивов :-{
Elvenfighter,
20 Ноября 2014
−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.
Elvenfighter,
14 Ноября 2014
Follow us!