foreach(@correctguesses) {
          splice(@their_guess,$_,1);
      }
      
      foreach(@getridofthese) {
          splice(@newpattern_to_match,$_,1);
      }
[download]

Have you tried it with a debugger. ptkdb is a very helpful one.
Hope it helps.

-----------------------------------
--the good, the bad and the physi--
-----------------------------------
[download]

here's my anotated code, with all the changes I've made.

#!/usr/bin/perl -w
  use strict;

  # Colors: [y]ellow [b]lue [g]reen [r]ed blac[k] [w]hite

  my $x;
  my @correctguesses;
  my @getridofthese;
  my $y;
  my $their_guess;
  my @their_guess;
  my $guess_count = 0;
  my $theyre_incorrect = 1;
  my $number_completly_right;
  my $number_correct_color;
  my @pattern_to_match;
  my @previous_guesses;
  my @numbers_to_colors = qw{y b g r k w};

  print "\nMastermind!!!\nColors are: [y]ellow [b]lue [g]reen [r]ed bl
+ac
  +[k] [w]hite\n";

  for($x=0;$x<=3;$x++) {
      $pattern_to_match[$x]=$numbers_to_colors[rand 5];
  }

  while ($guess_count <=9 && $theyre_incorrect) {
      my @newpattern_to_match = @pattern_to_match;
      $number_completly_right = 0;
      $number_correct_color = 0;
      $their_guess = <STDIN>;
      @correctguesses=();    ### THIS MUST BE CLEARED HERE !!!!
      chomp $their_guess;
      if ($their_guess eq "showme") {
          print @pattern_to_match;
          print "\n";
          next;
      }

      print "$number_correct_color\n";

      $previous_guesses[$guess_count]{"guess"} = $their_guess;
      $their_guess =~ /([ybgrkw])([ybgrkw])([ybgrkw])([ybgrkw])/;
      @their_guess = ($1,$2,$3,$4);

##### search for correct positons and colors !!!

      for ($x=0;$x<=3;$x++) {

          if ($their_guess[$x] eq $newpattern_to_match[$x]) {
              $number_completly_right++;
              @getridofthese = (@getridofthese, $x);                 #
+## you can say push @getridofthese, $x
              @correctguesses = (@correctguesses, $x);               #
+## see above
              next;                                                  #
+## there's nothing more after that, so no next is needed
          }
      }

      foreach(@correctguesses) {
          splice(@their_guess,$_,1);                                 #
+## Ok, kill that entrys, which allready fits the corect place & color
+ option
      }

      foreach(@getridofthese) {
          splice(@newpattern_to_match,$_,1);                         #
+## The same for @newpattern_to_match
      }

###### Now in @newpattern_to_match only those colors exists which ar n
+ot in the right position !!!

#### Check for right colors here
#### Here is the bug !!!!
#### What are you going to do here ?
#### in @their_guess are still ALL the letters which the user supplied
+i: makes $x going from 0..3
#### $y goes from 0..(theNumberofcorrectPositionsFound)
#### AHHH you maybe mean that one:

        my @notcorrectguesses = (0,1,2,3);
        for $y (@correctguesses) {
                splice(@notcorrectguesses,$_,1);
        }

### Now @notcorrectguesses contains only that indices which got no cor
+rect position&color


      for($x=0;$x<@their_guess;$x++) {
#         for($y=0;$y<@correctguesses;$y++) {
                for $y (@notcorrectguesses){
              if($their_guess[$x] eq $pattern_to_match[$y]) {
                  $number_correct_color++;
#                  splice(@newpattern_to_match,$y,1);
              }
          }
      }



      $previous_guesses[$guess_count]{"reply"} = "$number_completly_ri
+ght, $number_correct_color";

      print "\nMastermind!!!\nColors are: [y]ellow [b]lue [g]reen [r]e
+d
  +blac[k] [w]hite\n";
      for ($x=$guess_count;$x>=0;$x--) {
          print $x . " | " . $previous_guesses[$x]{"guess"} . " | " . 
+$previous_guesses[$x]{"reply"} . "\n";
      }

      $theyre_incorrect = 0 if ($number_completly_right == 4);
      $guess_count++;
  }
[download]

-----------------------------------
--the good, the bad and the physi--
-----------------------------------
[download]

Even though there are some other shorter versions, I have to show you my version here, cause I spend a few sleeping-hours on it ;^)
I use a package for the Color and Position stuff.

#!/usr/local/bin/perl -w

use strict;
my $round = 0;
my $colors;
my @colors;
my @result=();
$"="\n";

my $mm = MM->new();

while ($round < 10) {
  my $result;
  while (length $colors != 4){
    print "Your 4 colors : ";
    $colors = <STDIN>;
    chomp $colors;
  }
  @colors = split //, $colors;

  $result = $mm->check_allright(@colors);

  push @result, "$colors --> $result";
  if ($result =~ /4:0/){
    print "Yeah, you got it after $round rounds!\n CONGRATULATIONS\n";
    exit;
  }
print "@result\n";
$colors='';
$round++;
}

package MM;

sub new {
  my $self = {};
  my $class = shift;
  bless $self, $class;
  my @numbers_to_colors = qw{y b g r k w};
  for my $i (0..3){
    $self->{ORIGINAL}->{$i}=$numbers_to_colors[int rand(6)]
  }
  return $self;
}

sub check_allright {
  my $self = shift;
  $self->{guess}->{0} = shift;
  $self->{guess}->{1} = shift;
  $self->{guess}->{2} = shift;
  $self->{guess}->{3} = shift;
  my $count;

  $self->{COLOR_GUESS}=();
  $self->{COLOR_ORIGINAL}=();

  for my $i (0..3){
    if ($self->{guess}->{$i} eq $self->{ORIGINAL}->{$i}) {
      $count++ ;
    } else {
      $self->{COLOR_GUESS}->{$self->{guess}->{$i}}++;
      $self->{COLOR_ORIGINAL}->{$self->{ORIGINAL}->{$i}}++;
    }
  }
  $count ||= 0;
  my $color= $self->check_color();
  return "$count:$color";
}


sub check_color {
        my $self = shift;
        my $count;

  map { $count += $self->{COLOR_GUESS}->{$_} < $self->{COLOR_ORIGINAL}
+->{$_} ? $self->{COLOR_GUESS}->{$_} : $self->{COLOR_ORIGINAL}->{$_} i
+f exists $self->{COLOR_GUESS}->{$_}} keys %{$self->{COLOR_ORIGINAL}};

  return $count || 0;

}

1;
[download]

And the good thing: It works *g*.

-----------------------------------
--the good, the bad and the physi--
-----------------------------------
[download]

If I may be so bold as to offer some advice, your lack of documentation (and certain comments you make) indicates that you did not flow-chart or otherwise plan out the parts of this code. You should know your algorithm works before you try to implement it. Try to avoid mixing the two, because your mind can lose track switching between the two contexts.

You probably just 'wanted to dive into the problem', but I assure you that coding and working out algorithms are two completely different things. Coding should be the process of implementing the algorithm.

'Logic errors' are usually a result of not having an algorithm worked out beforehand. You hope that you can wing it, and often you can. But if you can't you are often left with a lot of trouble.

In these cases you are usually better off chucking the code out and then doing it properly. Trying to debug it can take hours to spot the one subtle bug that is skewing the results.

On the up side, ++ for the warnings, strict and good variable names

#!/usr/bin/perl -w
use strict;


# Colors: [y]ellow [b]lue [g]reen [r]ed blac[k] [w]hite

my $x;
my @correctguesses;
my @getridofthese;
my $y;
my $their_guess;
my @their_guess;
my $guess_count = 0;
my $theyre_incorrect = 1;
my $number_completely_right;
my $number_correct_colour;
my @pattern_to_match;
my @previous_guesses;
my @numbers_to_colours = qw{y b g r k w};

print "\nMastermind!!!\nColors are: [y]ellow [b]lue [g]reen [r]ed blac
+[k] [w]hite\n";
print "Please guess four pegs\n\n";

#Choose our hidden pegs
foreach (0..3) {
        $pattern_to_match[$_]=$numbers_to_colours[rand 5];
}

my $pattern_to_match=join "", @pattern_to_match;

#Main loop
while ($guess_count <=9 ) {

 #Set our default variables
        my @new_pattern_to_match = @pattern_to_match;
        my $new_pattern_to_match = join "", @pattern_to_match;
        $number_completely_right = 0;
        $number_correct_colour = 0;
        $their_guess = <STDIN>;
        chomp $their_guess;

 #Cheat.  Print out answer if they type 'showme'
        if ($their_guess eq "showme") {
                print @pattern_to_match;
                print "\n";
                next;
        }
 
 #Check for a proper input an complain if we don't get it.
 do{print "Incorrect guess.  Please enter four letters as described ab
+ove\n";
  next;
 } unless $their_guess=~ /^([ybgrkw])([ybgrkw])([ybgrkw])([ybgrkw])$/;

                
 #Push their guess onto the guess stack
        $previous_guesses[$guess_count]{guess} = $their_guess;

 #Check to see if any character of their guess occurs in the correct
 #answer string.  If it does, remove it from the answer string and
 #move onto the next character of their guess. 
        @their_guess = split //,$their_guess;
        foreach my $x (@their_guess) {
  my $z=index($new_pattern_to_match,$x);
  if (($z+1)) {
   substr $new_pattern_to_match,$z,1," ";
   $number_correct_colour++;
  }
 }
 
 #Now check for each character in it's right place.  If it is there, 
 #decrement the right colour, wrong place counter 
 do{$number_completely_right++;$number_correct_colour--;} if $pattern_
+to_match=~ /$their_guess[0].../;
 do{$number_completely_right++;$number_correct_colour--;} if $pattern_
+to_match=~ /.$their_guess[1]../;
        do{$number_completely_right++;$number_correct_colour--;} if $p
+attern_to_match=~ /..$their_guess[2]./;
        do{$number_completely_right++;$number_correct_colour--;} if $p
+attern_to_match=~ /...$their_guess[3]/; 

        $previous_guesses[$guess_count]{"reply"} = "$number_completely
+_right, $number_correct_colour";
        
        print "\nMastermind!!!\nColors are: [y]ellow [b]lue [g]reen [r
+]ed blac[k] [w]hite\n";
        for ($x=$guess_count;$x>=0;$x--) {
                print $x . " | " . $previous_guesses[$x]{"guess"} . " 
+| " . $previous_guesses[$x]{"reply"} . "\n";
        }
                
        do{print "Yay!  You win!\n\n\n";exit;} if ($number_completely_
+right == 4);
        $guess_count++;
}


print "You lost.\n\n\n";
[download]

____________________
Jeremy
I didn't believe in evil until I dated it.

Here is a somewhat shorter version to play with -- it differs in the ordering of the previous guesses (but you can change push() to unshift() to get the original behaviour):

#!/usr/bin/perl -w
use strict;

# Colors: [y]ellow [b]lue [g]reen [r]ed blac[k] [w]hite

my @colors  = qw/y b g r k w/;
my $pattern = join '', map{@colors[rand @colors]} 1..4;
my @guesses = ();

for my $count (1 .. 11) {
    print "Mastermind!\n";
    print "Colors:[y]ellow [b]lue [g]reen [r]ed blac[k] [w]hite\n";
    print @guesses;
    last if $count > 10;
    chomp(my $guess = <STDIN>);
    print "$pattern\n"  and redo if $guess eq 'showme';
    print "Bad Input\n" and redo unless $guess =~ /^[ybgrkw]{4}$/;
    my $tmp_pat = $pattern;
    my $right_color = grep { $tmp_pat =~ s/$_// } split //, $guess;
    my $right_place =()= "$pattern$guess"=~/(.)(?=...\1)/g;
    $right_color -= $right_place;
    push @guesses, "$count|$guess|$right_place,$right_color\n";
    if ($right_place == 4){
        print "You win!\n";
        exit;
    }
}
print "You lost! Pattern was: $pattern\n";
[download]

Update: chipmunk's shortened version of getting the right_place calculation (in his reply below) caused me wonder about other shortcuts for the same calculation -- here is one:

my $right_place =()= "$pattern$guess"=~/(.)(?=...\1)/g;
[download]

However, I think we're both crossing the line into obfuscation now rather than simplification. On the other hand, revisiting the code after a little break unveiled a large bug lurking in the code for counting the right colors that aren't in the right place --- the previous code was:

$right_color += $pattern =~ s/([$guess])/$1/g;
$right_color -= $right_place;
[download]

But that fails to do the right thing under some conditions. I've patched the code above (and thrown in the above shortcut too). But I rather dislike using the tmp variable and destroying it in the grep() call --- I'm sure there's a simpler/cleaner solution but it escapes me at the moment.

Here's a shorter way to count the guesses in the right place:

my $tmp = $solution ^ $guess;
my $right_place = $tmp =~ tr/\0//;
[download]

(In 5.6, I believe one can even skip the temporary variable.)