Problems with s///

sulfericacid has asked for the wisdom of the Perl Monks concerning the following question:

With the same problems I had yesterday, I decided to post a little more of the source code to give you a better idea of what everything looks like.

The code isn't pretty, I was told that some of the loops could have been merged into a single loop (and minor things like that).

The first problem I need help with is finding out why the WILD card filter system is leaving broken HTML tags. The script finds the WILD chards in the word, and applys a little HTML to it. The results are something like

adapis , adipsy , agasp , aed>lephs , alisp , aont color=red>lphos , a
+t color=red>lpist , apepsy , aphis , apont color=red>ios , aped>ont c
+olor=red>iose , apis , apish , apism , aped>odes , aped>oise , aposia
+ , appius , aed>ont color=red>ppose , apsis , aped>lor=red>ulse , apu
+s , asaph , nt color=red>ashpan , ast color=red>
[download]

From the printout above, you can see some font tags getting crammed in there. Someone mentioned yesterday that the problem might be the script is filtering out the HTML, too. For example, if an "o" is a wild, the "o" in "font" is also being s///. If this is the problem, I'm not sure how to apply the filtering.

Anyone have advice on what to do to get the wild filtering to work?

Full code:

if (param())
{
   my $letters   = param("letters");
   my $action    = param("select");
      $results   = param("results");
   my $selectbox = param("selectbox");

   print "Your letters were: <b>$letters</b><p>";

   ###########
   # any non a-z is a wild char
   ###########
   $blanks++ while $letters =~ s/[^a-z]//;
   $lhash{$_}++ for split //, $letters;

   ###########################
   # Open dictionary and begin checking word combos
   ###########################
   # dictionary opens, we get and find our words
   # words are placed in @solutions

   #############################
   # At this point, we have our word list
   #############################
   foreach my $found (@solutions)
   {
      my @chars = split(//, $found); # break word into chars
      my $score = 0;
      my $which_letter = $letters; # copy of letters to remove letters
+ found. this will aid in finding the wild chars
      my @wilds; # wild chars used
      my $find = $found; # $found after we apply font changes to wild 
+chars
   
      ##############
      # Break the word into characters and check which chars are wilds
      ##############
      foreach my $char (@chars)
      {
       
         if ($which_letter =~ m/$char/)
         {
            $which_letter =~ s/$char//;
         }
         else
         {
            push(@wilds, $char);
         }

     
      }

      #############
      # tear word apart and get point value
      #############
      my $found_word = $found;
      my $charlen = length $found;
      foreach(@wilds) { $found_word =~ s/$_//; } # removing the wilds
      my @found_word_letters = split(//, $found_word);

      foreach my $pt (@found_word_letters)
      {
         $score += $points{$pt};
      }

#####################################################
#
#
# WILD FILTERING HERE
#
#
#####################################################  
      foreach my $wild (@wilds)
      {
         $find =~ s/$wild/<font color=red>$wild<\/font>/;
      }

      ##################
      # Remove words that don't follow user's wishes
      ##################
      if ($action eq "starts")
      {
         if ($find =~ m/^$selectbox/)
         {
            push @{$scored{$score}}, $find;
            push @{$bylength{$charlen}}, $find;
         }
      }
      elsif ($action eq "ends")
      {
         if ($find =~ m/$selectbox$/)
         {
            push @{$scored{$score}}, $find;
            push @{$bylength{$charlen}}, $find;
         }
      }
      else
      { 
         push @{$scored{$score}}, $find;
         push @{$bylength{$charlen}}, $find;
      }

#push( @wild, $which_letter ) unless( $which_letter =~ tr/$char//d );

}
[download]

The second problem is that when wilds are found, it will only add font changes to the FIRST instance of the wild in the word. Meaning, if the same word has two wild characters that are the same (two wilds being S's, for example), only the first is affected. If they are different letters, then it works fine.

This second problem is really racking my brain.

ANY help at all with this mess would be much appreciated. I know this code is pretty scary.

"Age is nothing more than an inaccurate number bestowed upon us at birth as just another means for others to judge and classify us"

sulfericacid

Comment on Problems with s/// Select or Download Code

Replies are listed 'Best First'.
Re: Problems with s/// by idsfa (Vicar) on Jan 25, 2006 at 18:59 UTC
Replace `foreach my $wild (@wilds) { $find =~ s/$wild/<font color=red>$wild<\/font>/; }` [download] with `$find =~ s#([@wilds])#<font color=red>\1</font>#g;` [download] Updated: Sorry, I had to dash to a meeting and didn't have time to explain it. First, about your chomp issue. It is having problems because your `@solutions` all end in a newline. Since that is not one of your specified `letters`, it gets pushed into the `@wilds` list. Chomping the input or explicitly not adding newlines to the `@wilds` list are the correct solutions. (cute trick: `chomp @solutions;` will chomp each element in the list at once, potentially saving you another loop) Your version had two problems. It lacked the `g` at the end, which meant it only did the substitution for the first occurance of each wildcard found, and it didn't make all of the changes at once, so it could find wildcards inside of the text you were adding when it looped around for the next wildcard. So anyway, here's how that works: The substitution looks for any character in the list `[@wilds]` (the square brackets -- denoting a "character class" -- tell it to match any element). It then remembers what it matched (the parentheses around the brackets -- called capturing parentheses -- tell it to do that). It then replaces that with a string made up of the opening tag, the character it just matched (denoted by the `\1`) and the closing tag. The `g` modifier at the end tells it to repeat this match against the entire original string. Lastly, I used the fact that you do not have to use / as your delimiter to avoid having to escape the / in your closing tag (`s///` can also be written `s###` or `s~~~` or many many other ways). (No doubt someone else will be able to point out all of my misconceptions and mistakes in the above, but I'm here to learn, too ... check out perlre for more info) The intelligent reader will judge for himself. Without examining the facts fully and fairly, there is no way of knowing whether vox populi is really vox dei, or merely vox asinorum. — Cyrus H. Gordon	[reply] [d/l] [select]
Re^2: Problems with s/// by sulfericacid (Deacon) on Jan 25, 2006 at 19:56 UTC
Whoa there, idsfa! I made the said changes and it not only fixed the corrupted s///, but it also fixed it so duplicate letters as wilds are also working. I understand your code but I don't see how it's much different than my loop (just a tad shorter). So why does your code make everything work? What was my bug? Thanks much! "Age is nothing more than an inaccurate number bestowed upon us at birth as just another means for others to judge and classify us" sulfericacid	[reply]