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

    −109.3

    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
    83. 83
    84. 84
    85. 85
    86. 86
    $in{item_name}=CGI::unescape($in{item_name});
    $in{item_number}=CGI::unescape($in{item_number});
    
    #убиваем пробелы сначала, с конца и двойные
    ###
    if($in{item_name}=~/^[\s]+([\s\S]+)/) {
      $in{item_name}=$1;
    }
    if($in{item_name}=~/([\s\S]+)[\s]+$/) {
      $in{item_name}=$1;
    }
    
    $in{item_name}=~s/[\s]{2,}/ /g;
      
    if($in{item_number}=~/^[\s]+([\s\S]+)/) {
      $in{item_number}=$1;
    }
    if($in{item_number}=~/([\s\S]+)[\s]+$/) {
      $in{item_number}=$1;
    }
    
    $in{item_number}=~s/[\s]{2,}/ /g;
    ####
    
    my @select_parent=db_select_list ['title','id'],"catalog_section","parent_id=0";
    
    
    
    ###########
    my $only_this_category_text;
    my $checked_only;
    if($in{action} eq 'filter' and !$in{only_this_cat}) { $checked_only=''; } else {$checked_only="checked"; }
    
    #############################
    my $selected_list_item;
    my $only_this_cat_string;
    my @selected_only;
    my $selected_parent;
    #die $in{only_this_cat_s};
    
    
    for(@select_parent)
    {my $name="index_sel_$$_{id}";
     if($in{action} eq 'filter' and ($in{only_this_cat_s} eq $$_{id})) {$selected_only[$$_{id}]='selected'; } else { $selected_only[$$_{id}]=''; }
     if(!$in{only_this_cat_s})
     { if(!$in{action} and ($in{s} eq $$_{id})) {$selected_only[$$_{id}]='selected'; } else { $selected_only[$$_{id}]=''; }
     }else{ if($in{only_this_cat_s} eq $$_{id}){ $selected_only[$$_{id}]='selected';}}
    }
    
    
    ############################
    
    
    if($in{s}) {
    
    #максимальная вложенность =3 - сформируем строку для чекбокса по-простому
      my %ha=db_select_row ['id','title','parent_id'],"catalog_section","id=$in{s}";
     if(%ha){$selected_only[$ha{parent_id}]='selected';}
    	my %parent=db_select_row ['title','parent_id'],"catalog_section","id=$ha{parent_id}";
      my %parent2=db_select_row ['title','parent_id'],"catalog_section","id=$parent{parent_id}";	
    	my $only_title=$ha{title};
    	
    	$only_title= "$parent{title} — $only_title" if %parent;
    	$only_title= "$parent2{title} — $only_title" if %parent2;
      $only_this_cat_string=""; 
    	if(%parent || %parent2) {#%ha
          $only_this_category_text=qq~
    			<span>
    			<input type="checkbox" name="only_this_cat" id="only_this_cat" $checked_only onchange="checkSelect();">
    			<label for="only_this_cat">Искать только в разделе &laquo;$only_title&raquo;</label>
    			</span>~;
    			    	
    	}
    	}
    	
    	
    $selected_list_item=qq~<select name="only_this_cat_s" id="only_this_cat_s"> <OPTION VALUE='none'>Все разделы</OPTION>~;
    										for(@select_parent)
    										{
    $selected_list_item.=qq~<OPTION VALUE='$$_{id}' $selected_only[$$_{id}]~;
    $selected_list_item.=qq~><label for="only_this_cat_s">$$_{title}</label>
                            </OPTION>~;
    										
    										}
    $selected_list_item.=qq~</select></td>~;
    $only_this_cat_string="Раздел каталога";

    Оригинальное форматирование сохранено

    nolka4, 17 Августа 2009

    Комментарии (4)
  2. Perl / Говнокод #1530

    −117.2

    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
    my $cache_sql="SELECT `content`, `insertTime` FROM _cache WHERE `confid`='$$conf{confid}'";
    ...
        $cache_sql.=" AND `location`=".$self->{dbh}->quote($url);
    ...
        $cache_sql.=" AND `cgiparams`=".$self->{dbh}->quote($cgi_hash);
    ...
        $cache_sql.=" AND `callparams`=".$self->{dbh}->quote($callp_hash);
    ...
        $cache_sql.=" AND `userid`=".int($$params{userid});
    ...
        $cache_sql.=" AND `groupid`=".int($$params{groupid});
    
       my $replace_sql=$cache_sql;
       $replace_sql=~s/SELECT.*?FROM\s+_cache\s+WHERE/REPLACE INTO _cache SET/s;

    perl+sql

    poltora, 11 Августа 2009

    Комментарии (1)
  3. Perl / Говнокод #1529

    −101

    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
    my $iref=$self->{ditems}->_get_item({itemid=>$weather_itemid, set=>'Weather', fields=>['MinT', 'MaxT', 'Precip', 'Cloud', 'twater'], prefix=>$$p{prefix}});
        if ($$iref{$$p{prefix}.'MinT'}<0 && $$iref{$$p{prefix}.'MaxT'}<=0) {
            my $tmp=$$iref{$$p{prefix}.'MaxT'};
            $$iref{$$p{prefix}.'MaxT'}=$$iref{$$p{prefix}.'MinT'};
            $$iref{$$p{prefix}.'MaxT'}=$tmp;
        };
        #warn $$iref{$$p{prefix}.'MinT'} if !$$iref{$$p{prefix}.'MinT'}>0;
        $$iref{$$p{prefix}.'T'}=int( ($$iref{$$p{prefix}.'MinT'}+$$iref{$$p{prefix}.'MaxT'})/2 );
        $$iref{$$p{prefix}.'T'}='+'.$$iref{$$p{prefix}.'T'} if $$iref{$$p{prefix}.'T'}>0;
        #$$iref{$$p{prefix}.'T'}=~s/\-/\&\#150\;/gs;
        $$iref{$$p{prefix}.'MinT'}='+'.$$iref{$$p{prefix}.'MinT'} if ($$iref{$$p{prefix}.'MinT'}>0);
        $$iref{$$p{prefix}.'MaxT'}='+'.$$iref{$$p{prefix}.'MaxT'} if ($$iref{$$p{prefix}.'MaxT'}>0);
        $$iref{$$p{prefix}.'twater'}='+'.$$iref{$$p{prefix}.'twater'} if ($$iref{$$p{prefix}.'twater'}>0);
        
        $$iref{$$p{prefix}.'time'}=$$p{daystart}+$$p{hour}*3600;

    poltora, 11 Августа 2009

    Комментарии (1)
  4. Perl / Говнокод #1519

    −55.2

    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
    #!/etc/Tivoli/bin/perl
    ##############################################################
    #  Name: Default.cgi
    #
    #  Description: Generates translated Default HTML page
    #               according to browser's language
    #  TMF 4.1
    #  Licensed Materials- Property of IBM
    #  (C) Copyright IBM Corp. 2000. All Rights Reserved
    #
    #  US Government Users Restricted Rights- Use, duplication,
    #  or disclosure restricted by GSA ADP Schedule Contract with
    #  IBM Corp.
    ##############################################################
    
    # wupddefhtml will bind all messages contained in default page
    # accordingly ( LANG is set to the browser's locale )
    
    $defaultPage=`wupddefhtml -out`;
    
    # all links in the default page are absolute or relative to root
    # so we need to fix them because we have changed location
    
    $defaultPage =~ s|href=|href=../|g;
    $defaultPage =~ s|//|/|g;
    
    print("HTTP/1.0 200 OK
    Contents-Type: text/html
    
    ");
    
    print "$defaultPage";

    строка print("HTTP/1.0 200 OK
    явно говорит о глубоких знаниях протокола :))
    (C) Copyright IBM Corp. - ИТ лидер - что еще сказать

    pdp_dp, 11 Августа 2009

    Комментарии (10)
  5. Perl / Говнокод #1417

    −150

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

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

    guest, 25 Июля 2009

    Комментарии (2)
  6. 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 ([email protected]){
        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)
  7. Perl / Говнокод #1412

    −237.4

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

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

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

    guest, 23 Июля 2009

    Комментарии (2)
  8. 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)
  9. 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)
  10. 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)