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

    −150

    1. 1
    print $string =~ /([http|ftp|https]+:\/\/[\w\/\.\?\&\=]+)/;

    Типичный индусский регэксп (в данном случае ищет УРЛ в строчке)

    guest, 25 Июля 2009

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

  2. Perl / Говнокод #1413

    −147

    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
    if (!@ARGV){
    die ("Usage: palindrom.pl word\n");
}
$text = $ARGV[0];
if (length($text) < 4){
    die ("Error: Word must be not less than 4 leters\n");
}
if ($text =~ m/(.)(.). ?\2\1/){
    print "Result: Match\n";
}
else{
    print "Result: Not match\n";
}

    Код как-бэ проверяет является ли слово палиндромом.
    На самом деле проверяются только первые два символа с начала и конца. То есть строка "alla123h5vj3galla" является палиндромом.

    guest, 23 Июля 2009

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

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

    −237.4

    1. 1
    print "Content-type: text/plane \n\n";

    текст/самолёт

    Собсно, тут даже Перл ни при чем, просто улыбнуло...

    guest, 23 Июля 2009

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

  4. Perl / Говнокод #1329

    −82.1

    1. 1
    2. 2
    3. 3
    4. 4
    5. 5
    # заменяем в разделитель на запятую в поле "Количество"
$row[4] =~ s/\./,/;
	
# лишние нули красим цветом фона
$row[4] =~ s/,000/<font color=#ffffff>.000<\/font>/;

    Обработка суммы платежа при выводе пользователю в личном кабинете (web-страница)

    guest, 06 Июля 2009

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

  5. Perl / Говнокод #1175

    −207.6

    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
    58. 58
    59. 59
    60. 60
    61. 61
    62. 62
    63. 63
    64. 64
    65. 65
    66. 66
    67. 67
    68. 68
    69. 69
    70. 70
    71. 71
    72. 72
    73. 73
    74. 74
    75. 75
    76. 76
    77. 77
    78. 78
    79. 79
    80. 80
    81. 81
    82. 82
    #sub load_midi_positions_random {
##
## Вот понапишут такого кода, а потом системные администраторы виноваты что сервер тормозит ;-) ....
## У Вас есть  враги ? Подарите им этот уникальный код !
##.
#
#    my $dbh = get_pg_connect();
#    my $sql = "SELECT count(id) FROM midi_data where name<>'Unsorted'";
#    my $sth = $dbh->prepare($sql) or die $DBI::errstr;
#    $sth->execute or die $DBI::errstr;
#    my $i=$sth->fetchrow();
#    $sth->finish or die $DBI::errstr;
#....
#my    $PIC_COUNT=$i;
#my    $pic1 = int (rand($i));
#my    $pic2 = int (rand($i));
#my $count=0;
#    while ($pic1 == $pic2 && $count < 20){
#        $pic2 = int (rand($PIC_COUNT));
#        $count++;
#    }
#    my $pic3 = int (rand($PIC_COUNT));
#    $count = 0;
#    while (($pic1 == $pic3 || $pic2 == $pic3 || $pic2 == $pic1) && $count < 20){
#        $pic3 = int (rand($PIC_COUNT));
#        $count++;
#    }
#    my $pic4 = int (rand($PIC_COUNT));
#    $count = 0;
#    while (($pic1 == $pic2 || $pic1 == $pic3 || $pic1 == $pic4  || $pic2 == $pic3 || $pic2 == $pic4  || $pic3 == $pic4) && $count < 20){
#        $pic4 = int (rand($PIC_COUNT));
#        $count++;
#    }
#    my $pic5 = int (rand($PIC_COUNT));
#    $count = 0;
#    while (($pic1 == $pic2 || $pic1 == $pic3 || $pic1 == $pic4  || $pic2 == $pic3 || $pic2 == $pic4  || $pic3 == $pic4 || $pic1 == $pic5 || $pic2 == $pic5
#    || $pic3 == $pic5 || $pic4 == $pic5) && $count < 20){
#        $pic5 = int (rand($PIC_COUNT));
#        $count++;
#    }
#    my $pic6 = int (rand($PIC_COUNT));
#    $count = 0;
#    while (($pic1 == $pic2 || $pic1 == $pic3 || $pic1 == $pic4  || $pic2 == $pic3 || $pic2 == $pic4  || $pic3 == $pic4 || $pic1 == $pic5 || $pic2 == $pic5
#    || $pic3 == $pic5 || $pic4 == $pic5
#    || $pic1 == $pic6 || $pic2 == $pic6 || $pic3 == $pic6 || $pic4 == $pic6 || $pic5 == $pic6  ) && $count < 20){
#        $pic6 = int (rand($PIC_COUNT));
#        $count++;
#    }
#    my $pic7 = int (rand($PIC_COUNT));
#    $count = 0;
#    while (($pic1 == $pic2 || $pic1 == $pic3 || $pic1 == $pic4  || $pic2 == $pic3 || $pic2 == $pic4  || $pic3 == $pic4 || $pic1 == $pic5 || $pic2 == $pic5
#    || $pic3 == $pic5 || $pic4 == $pic5
#    || $pic1 == $pic6 || $pic2 == $pic6 || $pic3 == $pic6 || $pic4 == $pic6 || $pic5 == $pic6..
#    || $pic1 == $pic7 || $pic2 == $pic7 || $pic3 == $pic7 || $pic4 == $pic7 || $pic5 == $pic7  || $pic6 == $pic7) && $count < 20
#
#    ){
#        $pic6 = int (rand($PIC_COUNT));
#        $count++;
#    }
#
#    $sql = "SELECT * FROM midi_data where name<>'Unsorted' order by id";
#    $sth = $dbh->prepare($sql) or die $DBI::errstr;
#    $sth->execute or die $DBI::errstr;
#    my @result;
#    while(my @row = $sth->fetchrow){
#        my $tmp = split_midi_position(@row);
#    	$tmp->{POSITION_NAME}=~ s/(\d{4})//;
#	$tmp->{POSITION_YEAR}=$1;
#        push @result, $tmp;....
#    }
#my @new=();
#$new[0]=$result[$pic1];
#$new[1]=$result[$pic2];
#$new[2]=$result[$pic3];
#$new[3]=$result[$pic4];
#$new[4]=$result[$pic5];
#$new[5]=$result[$pic6];
#$new[6]=$result[$pic7];
#$sth->finish or die $DBI::errstr;
#    return @new;
#}
###

    Таблица midi_data > 15000 записей.
    Этот код вызывался несколько раз в секунду...

    guest, 10 Июня 2009

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

  6. Perl / Говнокод #1167

    −150

    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
    use LWP::Simple;
use HTML::FormatText;
use Fcntl ':flock';
use DB_File;

for ($num = 0 ; $num <= 1900; $num=$num+25){

$url = "http://btk-online.ru/phcode/?curPos1=&curPos="."$num";

print $url."\n";

my $file = "text_in.txt";
my $file_out = "text_out.txt";

$connect = get($url) ;

$text = HTML::FormatText->format_string($connect);

open(MYFILE, ">" .$file) or die "Can't create file: $!";

flock(MYFILE, LOCK_EX);

print MYFILE $text, "\n";

flock(MYFILE, LOCK_UN);

$tie = tie( my @lines, DB_File , $file , O_RDWR , 0666 , $DB_RECNO)
  or die "Cannot tie file $file: $!\n";

for ( $line_number = 140; $line_number <= 317 ; $line_number++){

print $line_number "\n";

unless ( $line_number < $tie->length){

die "Didn't find line $line_number in $file \n";

}

open (YFILE, ">>" .$file_out) or die "Can't create file $! \n";

flock (YFILE, LOCK_EX);

print YFILE "$lines[$line_number-1] \n";

flock (YFILE, LOCK_UN);

}

}

    Ребят ! Спасибо ! Едиственное быстро найденое средство перекинуть код с одной тачки на другую :)

    guest, 08 Июня 2009

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

  7. Perl / Говнокод #1161

    −260.4

    1. 1
    2. 2
    3. 3
    4. 4
    5. 5
    6. 6
    7. 7
    8. 8
    sub random {
	srand;
	RAND:
	my $rand = int(sprintf "%.f", 2 * rand() - 1) ^ int(sprintf "%.f", 2 * rand() - 1);
	goto RAND if $rand == 0;
	$rand = $rand > 0 ? 1 : 0;
	return $rand;
}

    шок и паника.

    guest, 07 Июня 2009

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

  8. Perl / Говнокод #1047

    −210.4

    1. 1
    2. 2
    3. 3
    4. 4
    5. 5
    6. 6
    7. 7
    sub trim_string
{
    my($sref) = $_[0];

    $$sref =~ s/^\s+//g;
    $$sref =~ s/\s+$//g;
}

    Написано владельцем одной известной говнокомпании, который утверждает, что программировать может каждый.

    guest, 15 Мая 2009

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

  9. Perl / Говнокод #939

    −149

    1. 1
    2. 2
    3. 3
    4. 4
    5. 5
    6. 6
    7. 7
    8. 8
    if (bstatus==0)
		{
			bstatus=0; 
		}
		else
		{	
			bstatus=0;
		}

    Вот так вот...

    guest, 24 Апреля 2009

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

  10. Perl / Говнокод #894

    −153

    1. 1
    2. 2
    3. 3
    4. 4
    5. 5
    6. 6
    7. 7
    8. 8
    sub get_user_xml {
    
    # много не существенного кода
    
    return $self->get_xml($self);

    return 0;
}

    Двойной

    guest, 17 Апреля 2009

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