Database problems again

sulfericacid · Jul 4, 2003

Same person, same script, different problem

I asked on four different places and no one had any idea what was causing this behavior.

Problem: Plain text messages under 500 or so characters will feed through script properly (tested to 60 messages without problems). But once you provoke a substitution (using an emoticon) the script will freeze within 15 posts of the first time you used it. No matter how many times you use an emoticon, the script WILL freeze within 15 messages. By freeze I mean the database loses it's insertion order and tosses messages in whichever order it feels like.

I know the code below is quite long but since no one has any idea where the problem is I thought it'd be better if you could see the script. Still testable at [

http://sulfericacid.perlmonk.org/chat/chatgood.pl

].

Any suggestions on what could be the problem or what should be changed to better the script would be much appreciated. I've been stuck on this specific problem for over two weeks now.

Thank you!

#!/usr/bin/perl -w

open( STDERR, ">>/home/sulfericacid/public_html/error.log" )
or die "Cannot open error log, weird...an error opening an error log: $!";

use strict;
use warnings;
use POSIX;
use CGI qw

standard start_table end_table);

require SDBM_File;

my %chat;
my %chatorder;
my @words = ();

my $chat = "list.dbm"; # location of database
my $file = "count.txt"; # location of count file
my $url = "

http://sulfericacid.perlmonk.org/chat/chatgood.pl";

my $imagedir =
"

http://sulfericacid.perlmonk.org/chat/images"

; # location of image directory (emoticons)

use Tie::IxHash;
my $columns = 50;
use Text::Wrap qw( wrap $columns );

tie %chat, "Tie::IxHash";
tie %chatorder, "Tie::IxHash";

tie( %chat, 'SDBM_File', $chat, O_CREAT | O_RDWR, 0644 )
or die "Couldn’t tie SDBM file '$chat' $!; aborting";

if ( !tied %chat ) {
print "database unsuccessful $!.\n";
}

my $js = "<script langauge=\"Javascript\">
document.write('<form><input type=button value=\"Refresh\" onClick=\"window.location.reload()\"></form>');</script></noscript></noscript>";

#
# Time to keep accurate logs
#
my ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst ) =
localtime(time);

print header, start_html;

my $num;
foreach ( keys(%chat) ) {
$num++;
}
print "DB keys: $num";

my $name = param('name');
my $message = param('message');
my $cnt;

if (param) {
if ($name) {
if ($message) {

open( LOG, "$file" ); # open count log for ID
$cnt = <LOG>;
close(LOG);

$cnt++;
open( LOG, "> $file" );
print LOG $cnt;
close(LOG);

$name =~ s/</<\;/g; # removing exploit
$message =~ s/</<\;/g; # removing exploit

my $keeptime = join ( ':', $hour, $min, $sec );
my $info = join ( '::', $name, $message, $keeptime );

$chat{$cnt} = $info;
}
else {
print "Message was missing, data not sent.<br>";
}
}
else {
print "Name was missing, data not sent.<br>";
}
}

print "(<a href=\"log.pl\" target=\"new\">chat logs</a>)";

print "the local time is $hour:$min:$sec";

print start_table;
print Tr(
td(
{ -height => '5', width => '700', bgcolor => '#BBCCEE' },
"<font size=2><b>ChatterBox version 1.0</b> $hour:$min:$sec</font>"
)
);
print Tr( td( { -height => '5', width => '700', bgcolor => '#BBCCEE' }, "" ) );

my $add;

foreach ( reverse keys(%chat) ) {
$add++;

if ( $add <= 10 ) {

$chatorder{$_} = $chat{$_};

}
}

foreach ( reverse keys(%chatorder) ) {
my ( $name, $message, $time ) = split /::/, $chatorder{$_};

$name =~ s/$_/****/g for @words; # say goodbye to swear words
$message =~ s/$_/****/g for @words; # say goodbye to swear words

$message =~ s#:\)#<img src="$imagedir/smiley.gif">#g; # happy emoticon
$message =~ s#:\(#<img src="$imagedir/sad.gif">#g; # sad emoticon
$message =~ s#

#<img src="$imagedir/tongue.gif"#g; # tongue emoticon
$message =~ s#

#<img src="$imagedir/tongue.gif">#g; # tongue1 emoticon
$message =~ s#

#<img src="$imagedir/oh.gif">#g; # oh emoticon
$message =~ s#:O#<img src="$imagedir/oh.gif">#g; # oh1 emoticon
$message =~ s#\*hug\*#<img src="$imagedir/hug.gif">#g; # hug emoticon
$message =~
s#\*flower\*#<img src="$imagedir/flower.gif">#g; # flower emoticon
$message =~ s#\*wink\*#<img src="$imagedir/wink.gif">#g; # wink emoticon
$message =~ s#\*devil\*#<img src="$imagedir/devil.gif">#g; # devil emoticon
$message =~ s#\*love\*#<img src="$imagedir/love.gif"\>#g; # love emoticon
$message =~ s#\*sleep\*#<img src="$imagedir/sleep.gif">#g; # sleep emoticon
$message =~
s#\*conf\*#<img src="$imagedir/confused.gif">#g; # sleep emoticon

$message = wrap( '', '', $message );
print Tr(
td(
{ -width => '700' },
"<font color=blue><$name @ $time></font>$message"
)
),

}
print Tr( td( { -height => '5', width => '700', bgcolor => '#BBCCEE' }, "" ) );
print Tr(
td(
{ -height => '5', width => '700', bgcolor => '#BBCCEE' },
"<font size=2><p align=right><b>

http://sulfericacid.perlmonk.org</b></font>"

)
);

print start_form( -action => $url ), table(
Tr(
td("Name: &quot

,
td(
textfield(
-name => 'name',
-size => 40
)
)
),
Tr(
td("Message: &quot

,
td(
textfield(
-name => 'message',
-size => 100,
-force => 1,
)
)
),

Tr( td(), td( submit('send'), $js ), ),
end_form(),
hr(),
);

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

fishiface · Jul 7, 2003

you are not forgotten - I've verified your symptoms but haven't had a spare second to try and debug the code yet (there's nothing obvious). Hopefully, tomorrow will be saner....

yours,

fish

"As soon as we started programming, we found to our surprise that it wasn't as easy to get programs right as we had thought. Debugging had to be discovered. I can remember the exact instant when I realized that a large part of my life from then on was going to be spent in finding mistakes in my own programs."
--Maurice Wilkes

PaulTEG · Jul 8, 2003

Sulf apologies, I was testing your words filter which doesn't seem to be implemented yet.

At a guess, you're using a different time key to store your comment on the database $keeptime

Try this

Code:

my ( $sec, $min, $hour, @rubbish ) =  localtime(time);
my $keeptime = sprintf(&quot;%0.2d&quot;, $hour).&quot;:&quot;.sprintf(&quot;%0.2d&quot;, $min).&quot;:&quot;.sprintf(&quot;%0.2d&quot;,$sec);

Your emoticon link would seem to be an observation of the fact at just the right (or wrong) time

HTH
--Paul

It's important in life to always strike a happy medium, so if you see someone with a crystal ball, and a smile on their face ...

PaulTEG · Jul 8, 2003

Nope,

I'd say after some more pricking about its to do with using the colon as a seperator for the time, (mebbe the reverse is doing something strange) try using minus symbols, and see how that goes

HTH
--Paul

It's important in life to always strike a happy medium, so if you see someone with a crystal ball, and a smile on their face ...

sulfericacid · Jul 8, 2003

I noticed that word fly across the chatroom, lol. The word filter is implemented it but since I posted the code here I thought it'd be nicer to remove those words so helpers wouldn't have to read all the cuss words. Somewhere in between editing the filter for here and saving it to my webspace, I guess I saved an unworded filter

I don't get what you meant by "Your emoticon link would seem to be an observation of the fact at just the right (or wrong) time". Or when you said use minus symbols somewhere.

Thanks for taking a look at it! *puts swear words back in so you can't abuse it anymore*

sulfericacid

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

PaulTEG · Jul 8, 2003

You looking at it now?

It's important in life to always strike a happy medium, so if you see someone with a crystal ball, and a smile on their face ...

PaulTEG · Jul 8, 2003

I meant use a different seperator for
user || message || keeptime
or else don't use colons for time
HH|MM|SS

--Paul

It's important in life to always strike a happy medium, so if you see someone with a crystal ball, and a smile on their face ...

sulfericacid · Jul 8, 2003

Yes, I am looking at it now and you probably already noticed the thing crashed because of the emoticons. I will try using a different deliminator, I'll probably use the pipe but I don't see how that would make much of a difference. I was thinking it was my DB itself but I'm well under the key/value size limitations.

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

PaulTEG · Jul 8, 2003

Start the database off afresh

It's important in life to always strike a happy medium, so if you see someone with a crystal ball, and a smile on their face ...

sulfericacid · Jul 8, 2003

I added the || as delimiter but it refuses to work at all. I'll put the colons back and refresh the DB.

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

sulfericacid · Jul 9, 2003

This is the newest version of the script, there's nothing different between this code and what I'm using on the site right now..

#!/usr/bin/perl -w

open( STDERR, ">>/home/sulfericacid/public_html/error.log" )
or die "Cannot open error log, weird...an error opening an error log: $!";

use strict;
use warnings;
use POSIX;
use CGI qw

standard start_table end_table);

use lib "";

use Tie::IxHash;

my $columns = 50;
use Text::Wrap qw( wrap $columns );

require SDBM_File;

my %chat;
my %chatorder;
my @words = ();

my $chat = "list.dbm"; # location of database
my $file = "count.txt"; # location of count file
my $url = "

http://sulfericacid.perlmonk.org/chat/chatgood.pl";

my $imagedir = "

http://sulfericacid.perlmonk.org/chat/images";

# location of image directory (emoticons)

tie %chat, "Tie::IxHash";
tie %chatorder, "Tie::IxHash";

tie (%chat, 'SDBM_File', $chat, O_CREAT | O_RDWR, 0644)
or die "Couldn’t tie SDBM file '$chat' $!; aborting";;

if ( !tied %chat ) {
print "database unsuccessful $!.\n";
}

my $js="<script langauge=\"Javascript\">
document.write('<form><input type=button value=\"Refresh\" onClick=\"window.location.reload()\"></form>');</script></noscript></noscript>";

#
# Time to keep accurate logs
#
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
localtime(time);

#my $eatery = cookie( -name=>'name',
# -value=>\$name,
# -expires=>'+1h');

#print header(-cookie=>$eatery), start_html;
print header, start_html;

my $num;
foreach (keys (%chat)) {
$num++;
}
print "DB keys: $num";

my $name = param('name');
my $message = param('message');
my $cnt;

if (param) {
if ($name) {
if ($message) {

open( LOG, "$file" ); # open count log for ID
$cnt = <LOG>;
close(LOG);

$cnt++;
open( LOG, "> $file" );
print LOG $cnt;
close(LOG);

$name =~ s/</&lt\;/g; # removing exploit
$message =~ s/</&lt\;/g; # removing exploit

my $keeptime = join ('~', $hour, $min, $sec);
my $info = join ( '~~', $name, $message, $keeptime );

$chat{$cnt} = $info;
}
else {
print "Message was missing, data not sent.<br>";
}
}
else {
print "Name was missing, data not sent.<br>";
}
}

print "(<a href=\"log.pl\" target=\"new\">chat logs</a>)";

print "the local time is $hour:$min:$sec";

print start_table;
print Tr(td({-height=>'5', width=>'700', bgcolor=>'#BBCCEE'},"<font size=2><b>ChatterBox version 1.0</b> $hour:$min:$sec</font>" ));
print Tr(td({-height=>'5', width=>'700', bgcolor=>'#BBCCEE'},"&quot

);

my $add;

foreach (reverse keys (%chat)) {
$add++;

if ($add <= 10) {

$chatorder{$_} = $chat{$_};

}
}

foreach (reverse keys (%chatorder)) {
my ( $name, $message, $time ) = split /~~/, $chatorder{$_};

$name =~ s/$_/****/g for @words; # say goodbye to swear words
$message =~ s/$_/****/g for @words; # say goodbye to swear words

$message =~ s#:\)#<img src="$imagedir/smiley.gif">#g; # happy emoticon
$message =~ s#:\(#<img src="$imagedir/sad.gif">#g; # sad emoticon
$message =~ s#

#<img src="$imagedir/tongue.gif"#g; # tongue emoticon
$message =~ s#

#<img src="$imagedir/tongue.gif">#g; # tongue1 emoticon
$message =~ s#

#<img src="$imagedir/oh.gif">#g; # oh emoticon
$message =~ s#:O#<img src="$imagedir/oh.gif">#g; # oh1 emoticon
$message =~ s#\*hug\*#<img src="$imagedir/hug.gif">#g; # hug emoticon
$message =~ s#\*flower\*#<img src="$imagedir/flower.gif">#g; # flower emoticon
$message =~ s#\*wink\*#<img src="$imagedir/wink.gif">#g; # wink emoticon
$message =~ s#\*devil\*#<img src="$imagedir/devil.gif">#g;# devil emoticon
$message =~ s#\*love\*#<img src="$imagedir/love.gif"\>#g; # love emoticon
$message =~ s#\*sleep\*#<img src="$imagedir/sleep.gif">#g;# sleep emoticon
$message =~ s#\*conf\*#<img src="$imagedir/confused.gif">#g;# sleep emoticon

$message = wrap('', '', $message);
print Tr(td({-width=>'700'},"<font color=blue><$name @ $time></font>$message&quot

),

}
print Tr(td({-height=>'5', width=>'700', bgcolor=>'#BBCCEE'},"&quot

);
print Tr(td({-height=>'5', width=>'700', bgcolor=>'#BBCCEE'},"<font size=2><p align=right><b>

http://sulfericacid.perlmonk.org</b></font>"

));

print start_form(-action=>$url), table(
Tr(
td("Name: &quot

,
td(
textfield(
-name => 'name',
-size => 40
)
)
),
Tr(
td("Message: &quot

,
td(
textfield(
-name => 'message',
-size => 100,
-force=>1,
)
)
),

Tr( td(),
td(submit('send'), $js),
),
end_form(),
hr(),
);

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

Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Database problems again

sulfericacid

Programmer

fishiface

IS-IT--Management

PaulTEG

Technical User

PaulTEG

Technical User

sulfericacid

Programmer

PaulTEG

Technical User

PaulTEG

Technical User

sulfericacid

Programmer

PaulTEG

Technical User

sulfericacid

Programmer

sulfericacid

Programmer

Similar threads

Part and Inventory Search

Sponsor