comment on

Another day has passed and much time was wasted trying to figure out why the following doesn't substitute the emoticons properly.

general:
This is a chatterbox with a username and message field, just like on PM. I want to add emoticons to the messages so things like :P and *tongue* will display an image. This is the only part giving me trouble and I can't for the life of me figure out why it won't catch on and add the emoticons.

Test prints were done with all the data. My test printout of the emoticons is as follows

:)
:(
:P
:O
*hug*
*flower*
;)
*evil*
*love*
*yawn*
*test*
*conf*
[download]

That's not what I expect to be in the emoticons list, that's the printout.

$face contains: *yawn*, :P, *conf*..
$name is the name: tongue, yawn..
$location is the full http://www url of the image

When the script is run, it prints out the face of each emoticon per message that it should be finding just to make sure it's looping over everything. It is. It refuses to make the s/// to the message though. Emoticons can happen ANYWHERE in the message.

Below is 90% of the complete code. Some of it is irrelevent but it may give you an idea of what the script is doing. Can anyone come up with an idea why I can swear filter but NOT emoticon filter?

if (param())
{
   my $username = param("name");
   my $message  = param("message");
   my $time     = localtime();
   my $ip       = $ENV{REMOTE_ADDR};


   ###
   # add their information to the db
   ###
   my $data = qq(INSERT INTO chat (username, ip, date, message) VALUES
+ (?,?,?,?));
   my $sth = $dbh->prepare($data);
   $sth->execute("$username","$ip","$time","$message") or die $dbh->er
+rstr;

   print "success!<p>";

}

#foreach (@a) { print "$_<br>"; }

####
# print chat
####

my $data = qq(SELECT id, username, ip, date, message FROM chat ORDER B
+Y id DESC LIMIT 10);

my $sth = $dbh->prepare($data);
$sth->execute() or die $dbh->errstr;

my ($id, $username, $ip, $date, $message);
$sth->bind_columns(\$id, \$username, \$ip, \$date, \$message);


######
# Because we need to reverse our SELECT we need to store it in @keep
######
my @keep;
my @keep_after_swear_words;
while ($sth->fetch)
{
  push(@keep, "$username<!!>$message<!!>$date<!!>$ip");
}

#######
# connecting to the DB again so we can filter swear words
#######
my $data = qq(SELECT id, word FROM swears);
my $sth = $dbh->prepare($data);
$sth->execute() or die $dbh->errstr;

my ($id, $badword);
$sth->bind_columns(\$id, \$badword);

foreach my $line (reverse @keep)
{
   my ($username, $message, $date, $ip) = split(/<!!>/, $line);
         #print "user: $username<br> message: $message<br> date: $date
+<br> ip: $ip<br><br>";
   while ($sth->fetch)
   {
      push (@badwords, $badword);
   }
     #print "message: $message<br>";
     #push(@keep_after_swear_words, "$username<!!>$message<!!>$date<!!
+>$ip");
}

foreach my $line (@keep)
{
  $line =~ s/\b$_\b/ **** /gi for @badwords;
}


####################
# connecting to the DB again so we can filter emoticons
####################
my $data = qq(SELECT id, name, location, face FROM emoticons);
my $sth = $dbh->prepare($data);
$sth->execute() or die $dbh->errstr;

my ($id, $name, $location, $face);
$sth->bind_columns(\$id, \$name, \$location, \$face);
while($sth->fetch)
{
  push (@emoticons, "$name<!!>$location<!!>$face");
}


foreach my $line (reverse @keep)
{
   my ($username, $message, $date, $ip) = split(/<!!>/, $line);

   foreach my $emoticon (@emoticons)
   {
      my ($name, $location, $face) = split(/<!!>/, $emoticon);
      if ($face)
      {
        $message =~ s/\b\Q$face\E\b/ <img src="\Q$location\E" alt="\Q$
+name\E"> /gi;
        print "<b>$face</b><br>";
      }
      #message =~ s/$face/ <img src="$location" alt="$name"> /gi;  
      # print "$emoticon<br>";
   }

   if ($message =~ m|^/me|i)
   {
      $message =~ s|^/me||i;
      print qq(<b><i><a href="#" TITLE="Message sent on $date by $ip">
+$username</a></i></b> <i>$message</i><br>);
   }
   else
   {
      print qq(<b><a href="#" TITLE="Message sent on $date by $ip">$us
+ername</a>:</b> $message<br>);
   }
}
[download]

2005-11-02 Retitled by planetscape, as per Monastery guidelines
Original title: 's/// with asterics and other chars'

In reply to s/// with asterisks and other chars by froglover

Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!

Titles consisting of a single word are discouraged, and in most cases are disallowed outright.

Read Where should I post X? if you're not absolutely sure you're posting in the right place.

Please read these before you post! —

Posts may use any of the Perl Monks Approved HTML tags:

a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr

You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)

	For:		Use:
	&		`&`
	<		`<`
	>		`>`
	[		`[`
	]		`]`

Link using PerlMonks shortcuts! What shortcuts can I use for linking?

See Writeup Formatting Tips and other pages linked from there for more info.