Perl — Говнокод.ру

Perl / Говнокод #4995

−117

1
2
3
4
5
6
7
8
9

my $result = `zabbix_agent -t proc.num[,,,*.pl]`
...
#удаляем файлы форков
`rm /tmp/event_agent_fork_*`;
`rm /tmp/event_agent_main_*`;
...
`killall -9 event_agent.pl`;
sleep(5);
`/usr/local/blabla/bin/blabla.pl`;

LusterDroid, 20 Декабря 2010

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

Perl / Говнокод #4798

−120

01
02
03
04
05
06
07
08
09
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29

# Find out what mail program to use !! Terrible kludge !!
  $mailprogram = "/usr/bin/mail";
  if (! -x "$mailprogram") {
    if (-x "/bin/mail") {
      $mailprogram = "/bin/mail";
    } else {
      if (-x "/usr/sbin/sendmail") {
        $mailprogram = "/usr/sbin/sendmail";
      } else {
        if (-x "/usr/lib/sendmail") {
          $mailprogram = "/usr/lib/sendmail";
        } else {
          if (-x "/usr/bin/mutt") {
            $mailprogram = "/usr/bin/mutt";
          } else {
            if (-x "/usr/sbin/exim4") {
              $mailprogram = "/usr/sbin/exim4";
            } else {
              if (-x "/usr/bin/elm") {
                $mailprogram = "/usr/bin/elm";
              } else {
                print "Cannot find a mail program to use\n";
              }
            }
          }
        }
      }
    }
  }

В changelog автор честно признался, что не знал, как реализовать иначе.

Anderson, 01 Декабря 2010

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

Perl / Говнокод #4638

−116

1

map { push @{ $cgih->{add_result}->{errors} }, 'НЕ добавлено: ' . $_->{title} } @failed_comps;

Видимо теперь использовать for это уже не по-пацански!

antonfin, 15 Ноября 2010

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

Perl / Говнокод #4594

−121

01
02
03
04
05
06
07
08
09
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77

sub captcha {
	my $msg = $_[0];
	## make colors for validation image into hex again ##
	$rgb_foreground =~ s/\#//g;
	$rgb_shade =~ s/\#//g;
	$rgb_background =~ s/\#//g;
	$r_f = substr($rgb_foreground,0,2);
	$g_f = substr($rgb_foreground,2,2);
	$b_f = substr($rgb_foreground,4,2);
	$r_s = substr($rgb_shade,0,2);
	$g_s = substr($rgb_shade,2,2);
	$b_s = substr($rgb_shade,4,2);
	$r_b = substr($rgb_background,0,2);
	$g_b = substr($rgb_background,2,2);
	$b_b = substr($rgb_background,4,2);
// Тут я вырезал кусок никчемного кода
$ci{' '} = qq~
.......
.......
.......
.......
.......
.......
.......
.......
.......
.......
~;
$ci{'!'} = qq~
.......
...X...
...X...
...X...
...X...
...X...
.......
...X...
.......
.......
~;
$ci{'"'} = qq~
.......
..X.X..
..X.X..
..X.X..
.......
.......
.......
.......
.......
.......
~;
$ci{'#'} = qq~
.......
..X.X..
..X.X..
.XXXXX.
..X.X..
.XXXXX.
..X.X..
..X.X..
.......
.......
~;
$ci{'$'} = qq~
.......
...X...
..XXXX.
.X.X...
..XXX..
...X.X.
.XXXX..
...X...
.......
.......
~;
// Дальше идет вся таблица ASCII

Вот таким вот образом выводили каптчу в далеком 2009 году. Очень надежный метод :)

Arigato, 11 Ноября 2010

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

Perl / Говнокод #4592

−122

01
02
03
04
05
06
07
08
09
10

sub generate_code {
	my ($arrey_pos,$code);
	my @arrey = ('a'..'q', 'C'..'O', '1'..'9', 'g'..'u', 'l'..'z', '9'..'1', 'H'..'W');

	for (my $i = 0; $i < $_[0]; $i++) {
		$arrey_pos = int(rand($#arrey));
		$code .= $arrey[$arrey_pos];
	}
	$code;
}

Генерация кода.

Arigato, 11 Ноября 2010

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

Perl / Говнокод #4591

−155

01
02
03
04
05
06
07
08
09
10
11
12
13
14
15
16
17
18
19
20

sub write_cookie {
	my %params = @_;

	if ($params{'-expires'} =~ /\+(\d+)m/) {
		my ($sec, $min, $hour, $mday, $mon, $year, $wday) = gmtime($date + $1 * 60);

		$year += 1900;
		my @mos = ("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec");
		my @dys = ("Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat");
		$mon  = $mos[$mon];
		$wday = $dys[$wday];

		$params{'-expires'} = sprintf("%s, %02i-%s-%04i %02i:%02i:%02i GMT", $wday, $mday, $mon, $year, $hour, $min, $sec);
	}

	$params{'-path'}    = " path=$params{'-path'};"       if $params{'-path'};
	$params{'-expires'} = " expires=$params{'-expires'};" if $params{'-expires'};

	"$params{'-name'}=$params{'-value'};$params{'-path'}$params{'-expires'}";
}

setcookie() Perl-вариант.

Arigato, 11 Ноября 2010

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

Perl / Говнокод #4589

−119

01
02
03
04
05
06
07
08
09
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47

sub mainMenu {
	if ($action eq "addtab" && $iamadmin) { require "$sourcedir/AdvancedTabs.pl"; &AddNewTab; }
	elsif ($action eq "edittab" && $iamadmin) { require "$sourcedir/AdvancedTabs.pl"; &EditTab; }
	elsif ($action ne "") {
		if ($action eq "search2") {
			$tmpaction = "search";
		} elsif ($action eq "favorites" || $action eq "shownotify" || $action eq "im" || $action eq "imdraft" || $action eq "imoutbox" || $action eq "imstorage" || $action eq "imsend" || $action eq "imsend2" || $action eq "imshow" || $action eq "profileCheck" || $action eq "myviewprofile" || $action eq "myprofile" || $action eq "myprofileContacts" || $action eq "myprofileOptions" || $action eq "myprofileBuddy" || $action eq "myprofileIM" || $action eq "myprofileAdmin" || $action eq "myusersrecentposts") {
			$tmpaction = "mycenter";
		} elsif ($action eq "messagepagetext" || $action eq "messagepagedrop" || $action eq "threadpagetext" || $action eq "threadpagedrop" || $action eq "post" || $action eq "notify" || $action eq "boardnotify" || $action eq "sendtopic" || $action eq "modify") {
			$tmpaction = "home";
		} elsif ($action eq "guestpm2") {
			$tmpaction = "guestpm";
		} else { $tmpaction = $action; }

	} else {
		$tmpaction = "home";
	}

	$tab{'home'} = qq~<span |><a href="$scripturl" title = "$img_txt{'103'}" style="padding: 3px 0 4px 0;">$tabfill$img_txt{'103'}$tabfill</a></span>~;
	$tab{'help'} = qq~<span |><a href="$scripturl?action=help" title = "$img_txt{'119'}" style="padding: 3px 0 4px 0; cursor:help;">$tabfill$img_txt{'119'}$tabfill</a></span>~;
	if ($maxsearchdisplay > -1) {
		$tab{'search'} = qq~<span |><a href="$scripturl?action=search" title = "$img_txt{'182'}" style="padding: 3px 0 4px 0;">$tabfill$img_txt{'182'}$tabfill</a></span>~;
	}
	if (!$ML_Allowed || ($ML_Allowed == 1 && !$iamguest) || ($ML_Allowed == 2 && $staff) || ($ML_Allowed == 3 && ($iamadmin || $iamgmod))) {
		$tab{'ml'} = qq~<span |><a href="$scripturl?action=ml" title = "$img_txt{'331'}" style="padding: 3px 0 4px 0;">$tabfill$img_txt{'331'}$tabfill</a></span>~;
	}
	if ($iamadmin) {
		$tab{'admin'} = qq~<span |><a href="$boardurl/AdminIndex.$yyaext" title = "$img_txt{'2'}" style="padding: 3px 0 4px 0;">$tabfill$img_txt{'2'}$tabfill</a></span>~;
	}
	if ($iamgmod) {
		if (-e "$vardir/gmodsettings.txt") { require "$vardir/gmodsettings.txt"; }
		if ($allow_gmod_admin) {
			$tab{'admin'} = qq~<span |><a href="$boardurl/AdminIndex.$yyaext" title = "$img_txt{'2'}" style="padding: 3px 0 4px 0;">$tabfill$img_txt{'2'}$tabfill</a></span>~;
		}
	}
	if ($sessionvalid == 0 && !$iamguest) {
		my $sesredir;
		unless (!$testenv || $action eq "revalidatesession" || $action eq "revalidatesession2") {
			$sesredir = $testenv;
			$sesredir =~ s/\=/\~/g;
			$sesredir =~ s/;/x3B/g;
			$sesredir = qq~;sesredir=$sesredir~;
		}
		$tab{'revalidatesession'} = qq~<span |><a href="$scripturl?action=revalidatesession$sesredir" title = "$img_txt{'34a'}" style="padding: 3px 0 4px 0;">$tabfill$img_txt{'34a'}$tabfill</a></span>~;
	}

// далее мало что меняется в стиле...

Формируем меню...

Arigato, 11 Ноября 2010

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

Perl / Говнокод #4572

−103

1
2
3
4
5
6
7
8

if (-e '/etc/passwd') {
    # assume Unix
    ...
}
else {
    # assume NT
    ...
}

так в круто-мегабаксовом ClearCase IBM программисты определяют в Перле запущен ли скрипт под Виндой или под *NIXком. наши админы долго смеялись, но по приколу сохранили этот кусок как было в оригинале.

Dummy00001, 09 Ноября 2010

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

Perl / Говнокод #4518

−123

01
02
03
04
05
06
07
08
09
10
11
12
13
14
15
16
17
18
19

@rem = '--*-Perl-*--
@echo off
if "%OS%" == "Windows_NT" goto WinNT
perl -x -S "%0" %1 %2 %3 %4 %5 %6 %7 %8 %9
goto endofperl
:WinNT
perl -x -S %0 %*
if NOT "%COMSPEC%" == "%SystemRoot%\system32\cmd.exe" goto endofperl
if %errorlevel% == 9009 echo You do not have Perl in your PATH.
if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
goto endofperl
@rem ';
#!perl
#line 15
    eval 'exec C:\TEMP\perl---please-run-the-install-script---\bin\perl.exe -S $0 ${1+"$@"}'
	if $running_under_some_shell;
#!/usr/bin/perl
# $Id: cpan,v 1.9 2006/11/01 21:49:31 comdog Exp $
use strict;

seonull, 03 Ноября 2010

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

Говнокод: по колено в коде.

Perl / Говнокод #4995

Perl / Говнокод #4798

Perl / Говнокод #4638

Perl / Говнокод #4632

Perl / Говнокод #4594

Perl / Говнокод #4592

Perl / Говнокод #4591

Perl / Говнокод #4589

Perl / Говнокод #4572

Perl / Говнокод #4518