This is a script I made quite a while ago and it's all dirty (as anyone can tell, lol). I was wondering if anyone would mind taking a look through it to see if you know ways to improve the code or overall functionality of the script.

Put simply, this is a chatterbox script similar to the one here. This has emoticons :) :( and things like that, it has actions with /me and has urls like we use on here.

Any suggestions or comments would be much appreciated! Thanks!

#!/usr/bin/perl -w # # Chatterbox version 2.0 # use strict; use warnings; use POSIX; use CGI qw(:standard start_table end_table); use CGI::Carp qw(fatalsToBrowser); use lib ""; use DB_File; use Text::Wrap; $Text::Wrap::columns = 15; my %chat; my %chatorder; ########################################### # Configuration section ########################################### # Change the below line to how many characters a word can be before it +'s split up $Text::Wrap::columns = 15; # swear words my @words = ("bad words go here"); # saved name list my @list = ("Sulfericacid", "sulfericacid", "Sulfy", "Sulfer", "sulfy +", "sulfer", "admin", "Admin", "webmaster", "Webmaster", "administrat +or", "Administrator"); my $url = "/cgi-bin/scripts/chat/v2/chat.pl"; ## Change the above line to the full URL of the chat script my $imagedir = "/scripts/chat/v2/images"; # location of image + directory (emoticons) ## Change the above line to the full URL of the /images/ folder for th +e chat script my $ip = "66.47.159.11"; ## Change to the administrator IP address my $chathelp = "scripts/chat/v2/chathelp.html"; my $log = "cgi-bin/scripts/chat/v2/log.pl"; ## Change the two above lines to point to the chathelp.html and log.pl + files my $pagead = "www.mypage.com"; ########################################## # Please do not edit below this line ########################################## my $redirect = param('location'); my $chat = "chat.db"; # location of database my $file = "count.txt"; # location of count file my $banned = "banned.txt"; # location of banned IP list 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=\"w +indow.location.reload()\"></form>');</script></noscript></noscript>"; my $name = param('name'); my $message = param('message'); my $cnt; ## Get the user information if (param) { if ($name ne "") { if (grep { $name eq $_ } @list and $ENV{REMOTE_ADDR} ne "$ip" ) { print "<font color=red>You are not authorized to post as the Adminis +trator</font>"; exit; } if ($message ne "") { 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 $message =~ s/\[(http:\/\/.+)\|(.+)\]/<a href="$1" target="new">$2<\/a +>/gi; $message =~ s/\[(ftp:\/\/.+)\]/<a href="$1">$1<\/a>/gi; $message =~ s/\[(https:\/\/.+)\]/<a href="$1">$1<\/a>/gi; my $info = join ( '~~', $name, $message, $ENV{REMOTE_ADDR}); $chat{$cnt} = $info; print "<SCRIPT LANGUAGE=\"JAVASCRIPT\">"; print "document.location.href=\"$redirect\";"; print "</SCRIPT>"; } else { print "<SCRIPT LANGUAGE=\"JAVASCRIPT\">"; print "document.location.href=\"$redirect\";"; print "</SCRIPT>"; } } else { print "<SCRIPT LANGUAGE=\"JAVASCRIPT\">"; print "document.location.href=\"$redirect\";"; print "</SCRIPT>"; } } # Start printing everything out my $cnt = 0; foreach (keys %chat) { $cnt++; } print qq[(<a href="$chathelp" target="new">chat help</a>) ]; print "(<a href=\"$log\" target=\"new\">chat logs</a>)"; print start_table; print Tr(td({-height=>'5', width=>'700', bgcolor=>'#BBCCEE'},"<font si +ze=2><b>ChatterBox version 1.73</b></font>\n" )); print Tr(td({-height=>'5', width=>'700', bgcolor=>'#BBCCEE'},"\n")); for (grep defined($_), (keys %chat)[-10..-1]) { my ( $name, $message, $userip) = split /~~/, $chat{$_}; $name =~ s/$_/****/g for @words; # say goodbye to swear words $name = wrap('', '', $name); $message =~ s/$_/****/g for @words; # say goodbye to swear words next if ($message =~ /\[http:\/\/|https:\/\/\ftp:\/\/\|.+\]/); $message = wrap('', '', $message); $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 emotic +on $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 emoti +con $message =~ s#\*devil\*#<img src="$imagedir/devil.gif">#g;# devil emot +icon $message =~ s#\*love\*#<img src="$imagedir/love.gif"\>#g; # love emot +icon $message =~ s#\*sleep\*#<img src="$imagedir/sleep.gif">#g;# sleep emot +icon $message =~ s#\*conf\*#<img src="$imagedir/confused.gif">#g;# sleep em +oticon if ($message =~ m/(^\/me)/) { $name = "<i>$name"; $message =~ s/$1//; $message = "$message<\i>"; if (grep { $name eq "<i>$_" } @list) { print Tr(td({-width=>'700'},"<font size=2 color=red>$name</font><f +ont size=2> $message</font>\n")), } else { print Tr(td({-width=>'700'},"<font size=2 color=blue>$name</font>< +font size=2> $message</font>\n")), }} else { if (grep { $name eq $_ } @list) { print Tr(td({-width=>'700'},"<font size=2 color=red>&lt;$name&gt;< +/font><font size=2> $message</font>\n")), } else { print Tr(td({-width=>'700'},"<font size=2 color=blue>&lt;$name&gt; +</font><font size=2> $message</font>\n")), } } } print Tr(td({-height=>'5', width=>'700', bgcolor=>'#BBCCEE'},"")); print Tr(td({-height=>'5', width=>'700', bgcolor=>'#BBCCEE'},"<font si +ze=2><p align=right><b>$pagead</b></font>\n" )); print "</table>"; my $location = join("", "http://", $ENV{'SERVER_NAME'}, $ENV{'REQUEST_ +URI'}); open(BANNED, "<$banned") or die "Cannot open $banned because: $!"; while(<BANNED>) { chomp; if ($_ eq $ENV{REMOTE_ADDR}) { print <<"ALL"; <table width="20"> <td>Your IP has been banned, you are not allowed to use this scri +pt.</td> </table> ALL exit; } } close(BANNED); print <<"ALL"; <table width="20" border="0"><form method="POST" action="$url"> <tr><td>Name:</td><td><input type="text" name="name" value="$name" siz +e="15"></td></tr> <tr><td>Message:</td><td><input type="text" name="message" size="15" m +axlength="100"></td></tr> <tr><td><input type="submit" name="submit" value="send"><input type="h +idden" name="location" value="$location"></form></td><td> <form><input type=button value="Refresh" onClick="window.location.relo +ad()"></form></td></tr> </form></table> <hr> ALL


"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

In reply to Making this script cleaner and better by sulfericacid

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":



  • 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:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.