chat.pl


#!/usr/bin/perl -w

use strict;
use warnings;
use POSIX;
use CGI qw(:standard start_table end_table);

use lib "";

use DB_File;
use Text::Wrap;

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


my $chat = "chat.db";                 # location of database
my $file = "count.txt";                # location of count file
my $url = "http://sulfericacid.perlmonk.org/chat/chat1.pl";
my $imagedir = "http://sulfericacid.perlmonk.org/chat/images";          # location of image directory (emoticons)


tie %chat, "DB_File", "$chat", O_CREAT|O_RDWR, 0644, $DB_BTREE
	or die "Cannot open file 'chat': $!\n";
	
print header, start_html;



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



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



## Get the user information
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
$name =~ s/~/\&#126\;/g;     # database splitting
$message =~ s/</&lt\;/g;     # removing exploit
$message =~ s/~/\&#126\;/g;  # database splitting

    my $info = join ( '~~', $name, $message);

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


# Start printing everything out

my $cnt = 0;
foreach (keys %chat) {
$cnt++;
}
print qq[(<a href="chathelp.html" target="new">chat help</a>)   ];
print "(<a href=\"log.pl\" target=\"new\">chat logs</a>)";


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


for (grep defined($_), (keys %chat)[-10..-1]) { 

my ( $name, $message,) = split /~~/, $chat{$_};

$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#:p#<img src="$imagedir/tongue.gif"#g;  # tongue emoticon
$message =~ s#:P#<img src="$imagedir/tongue.gif">#g;  # tongue1 emoticon
$message =~ s#:o#<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>&lt;$name&gt;</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: "),
        td(
            textfield(
                -name => 'name',
                -size => 40
            )
        )
    ),
    Tr(
        td("Message: "),
        td(
            textfield(
                -name => 'message',
                -size => 100,
                -force=>1,
            )
        )
    ),

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


##</code><code>##

log.pl

#!/usr/bin/perl -w

use strict;
use warnings;
use POSIX;
use CGI qw/:standard/;


use DB_File;

my $add;
my %chat;
my $chat = "chat.db";


tie %chat, "DB_File", "$chat", O_CREAT|O_RDWR, 0644, $DB_BTREE
	or die "Cannot open file 'chat': $!\n";
	
print header, start_html;


print "<center><H2>CB History- last 100 things seen...</H2></center>";                                                

print "<table>";

for (grep defined($_), (keys %chat)[-100..-1]) {


my ( $name, $message, $time ) = split /~~/, $chat{$_};

    print "<tr><td>";
    print "<font color=blue>&lt;$name&gt;</font> $message";
    print "</td></tr>";
}
print "</table>";