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

    −165

    1. 1
    if ( $method{'out_format'} && $method{'out_format'} eq lc(q{json}) ) {

    Yo dawg, we heard that you like lowercase, so we put some lowercase into your lowercase

    Elvenfighter, 18 Июля 2013

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

    −172

    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
    sub company_stuff_add_array_elems
    {
            my $list = shift;
    
            my $count = 0;
    
            foreach ( @$list )
            {
                    $count += $_;
            }
    
            return $count;
    }

    List::Util::sum
    http://perldoc.perl.org/List/Util.html

    kainwinterheart, 07 Июня 2013

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

    −160

    1. 1
    unless( eval{ $p -> role() -> is_company() } or eval{ $p -> channel_status() } or ( $p -> id() eq 11902 ) )

    kainwinterheart, 05 Июня 2013

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

    −103

    1. 1
    2. 2
    3. 3
    4. 4
    5. 5
    6. 6
    7. 7
    8. 8
    9. 9
    sub exdef {
        my ($hash, $key) = @_;
    
        if (exists $hash->{$key} && defined $hash->{$key}) {
            return 1;
        }
    
        return 0;
    }

    No comments.

    BTW.
    http://perldoc.perl.org/functions/exists.html
    http://perldoc.perl.org/functions/defined.html

    Elvenfighter, 08 Мая 2013

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

    −116

    1. 1
    sprintf "%d-%02d-%02d", map { $$_[5]+1900, $$_[4]+1, $$_[3]+1 } [localtime];

    Даты. Perl. Классика.

    http://perldoc.perl.org/POSIX.html#strftime

    Elvenfighter, 01 Апреля 2013

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

    −84

    1. 1
    use constant MAX_INT => 4294967295;

    Code hard.

    P.S. perl -MPOSIX -we 'print INT_MAX'

    Elvenfighter, 17 Марта 2013

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

    −115

    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
    #!/usr/bin/perl -w
    
    use strict;
    
    my $enchant_num=1;
    my $tries_num=0;
    
    print "Please, enter safe enchant lvl:\n";
    my $safe_enchant_num=<STDIN>; chomp $safe_enchant_num;
    print "Please enter maximum enchant lvl:\n";
    
    my $max_enchant_num=<STDIN>; chomp $max_enchant_num;
    
    if($max_enchant_num=~/\d/)
    {
    	if($max_enchant_num>$safe_enchant_num)
    	{
    		while($enchant_num<=$max_enchant_num)
    		{
    			if($enchant_num<=$safe_enchant_num)
    			{
    				while($enchant_num<=$safe_enchant_num)
    				{
    					print "Succesfully enchanted for +" . $enchant_num++ . "\r";
    				}
    			}
    			else
    			{
    				if(rand(100)<=66)
    				{
    					print "Succesfully enchanted for +" . $enchant_num++ . "\r";
    				}
    				else
    				{
    					print "Enchant failed for +" . $enchant_num++ . "\r";
    					$enchant_num=1;
    					$tries_num++;
    				}
    			}
    		}
    	}
    }
    else
    {
    	print "\nInput is incorrect\n";
    }
    print "\nEnchanted for $max_enchant_num with: $tries_num fails.";

    Комментарии излишни

    mish, 25 Января 2013

    Комментарии (14)
  8. Perl / Говнокод #12382

    −103

    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
    # save all blocks to %blocks. Replace first block with <block blockname />
    	sub _parse_block {
    		my $tag = $_[1];
    		
    		last unless $_[0]=~s#($tag->[0]block +([^ /]*?) *$tag->[1])((.*?)$tag->[0]/?block$tag->[1])#
    				my($opentag,$source,$bname,$bcode, $retval) = ($1,$3, $2, $4, '');
    				if( $bcode =~m|$tag->[0]block +[^ /]*? *$tag->[1]|){
    					_parse_block($source, $tag);
    					$retval =  $opentag.$source;
    				}else{
    					$retval = "$tag->[0]block $bname /$tag->[1]" unless exists $blocks{$bname};
    					
    					$bcode=~s%$tag->[0](:? |/)*parent(:? |/)*$tag->[1]%$blocks{$bname}%g;
    					
    					$blocks{$bname} = $bcode; 
    				}
    				$retval;
    		#seg;
    	}
    	
    	foreach my $tag( @{$self->{tag_symbols}} ){
    		_parse_block($code,$tag) while(1);
    	}
    
    	
    	
    	#if <blockmode> turned on, delete all data that not in blocks until </blockmode> or end of code
    	
    	foreach my $tag( @{$self->{tag_symbols}} ){
    		$code=~s%$tag->[0] *blocks?(?:mode?)? *$tag->[1](.*?)(?:(?:$tag->[0] *\/ *blocks?(?:mode?)? *$tag->[1])|(';#end of code))%
    			$_ = $1; my $end_of_code = $2;
    			my $retval;
    			$retval .= $1 while( m/($tag->[0]block +[^ ]*? *\/.*?$tag->[1])/g ); 
    			
    			$retval.$end_of_code;
    		%esg;
    		#
    	}
    	
    	
    	# replace <block blockname /> with a code block
    	foreach my $tag( @{$self->{tag_symbols}} ){
    		while($code=~s|$tag->[0]block +([A-zА-я0-9_-]*?) */.*?$tag->[1]|$blocks{$1}|eg){};
    	};

    Кусок шаблонизатора. Парсинг вложенных тегов регулярками.

    nyaknyan, 02 Января 2013

    Комментарии (32)
  9. Perl / Говнокод #12381

    −119

    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
    sub merge_data_struct { # to, from, bless coderefs as
    	for(keys %{$_[1]}){
    		if(ref($_[1]->{$_}) eq 'HASH'){
    			merge_data_struct($_[0]->{$_},$_[1]->{$_},$_[2]) 
    		}
    		elsif(ref($_[1]->{$_}) eq 'CODE')
    		{
    			warn "Merge datastruct conflict at $_[2] - key $_" if $_[0]->{$_};
    			$_[0]->{$_} = $_[1]->{$_};
    			bless ($_[0]->{$_},$_[2]) if($_[2]);
    		}
    		else
    		{
    			$_[0]->{$_} = $_[1]->{$_};
    		}
    	}
    }

    $_[]{}

    nyaknyan, 02 Января 2013

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

    −88

    1. 1
    2. 2
    3. 3
    % if ($ARGS{standalone_bhv}) {} else {
    %# Что-то делаем
    % }

    Mason. Автор явно знает толк..

    Elvenfighter, 24 Декабря 2012

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