CGI/Perl Guide | Learning Center | Forums | Advertise | Login
Site Search: in

  Main Index MAIN
INDEX 		Search Posts SEARCH
POSTS 		Who's Online WHO'S
ONLINE 		Log in LOG
IN

Home: Need a Custom or Prewritten Perl Program?: Throw Down The Gauntlet:
Script Modifications Need

 


Lesia
Deleted

Mar 3, 2000, 3:09 PM

Post #1 of 4 (4059 views)
Script Modifications Need Can't Post
Hi, I have a chat script that needs to be modified. The modifications would be, reverse the page layout so that the user name and message boxes are at the bottom of the page, take out pull down menu, and make it so user ip's don't show in the chat rooms. I'm on a very limited budget at the moment because of a computer meltdown, that about killed my pocketbook. If you can help please let me know,
Thank You,
Lesia


Cretep
User

Mar 3, 2000, 6:26 PM

Post #2 of 4 (4059 views)
Re: Script Modifications Need [In reply to] Can't Post
Hi Lesia
I'm willing to help modify the script for free just email me at woodduck@bigpond.com with the script and a full list of modifications and the script either as an attachment or inside the email it's self.

Best regards

Peter Crouch


brian.hayes
User

Mar 3, 2000, 8:06 PM

Post #3 of 4 (4059 views)
Re: Script Modifications Need [In reply to] Can't Post
We are more than willing to help. If you would like to post the code here, we could get started on it. Also if you would prefer emailing it, just email it to one of the moderators listed in the forum.

Thanks

Brian Hayes


Lesia
Deleted

Mar 3, 2000, 8:48 PM

Post #4 of 4 (4059 views)
Re: Script Modifications Need [In reply to] Can't Post
Brian, I couldn't find the email addresses, so here's the script. My email address is tmhlmg@northcascades.net if anyone prefers I send it as an attatchment. The modifications needed are, reverse page layout so that the text and user name box is at the bottom of the page, take out the pull down menu, and make it so user's ip's don't show in the room.
Thanks,
Lesia

#!/usr/bin/perl

# Chat program (version 2.13)
#
# Copyright 1998 Michael Chavel (chavel@aquilo.net)
# You may use this program for PERSONAL, NON-PROFIT USE ONLY!
# The most recent version of this program and documentation can
# be found at http://www.aquilo.net


use 5.004;
use strict; # enforce declarations and quoting
use CGI qw(:standard); # import shortcuts
use Fcntl qw(:flock); # imports LOCK_EX, LOCK_SH, LOCK_NB

my (
$URL, $CHATFILE, $USERS, $MAXSAVE, $MAXDISPLAY, $MAXUSERS, $ACTIVETIME,
$SHOW_DATE, $SHOW_EMAIL, $CAPITALIZE, $HOURADJUST, $TZONE,
$TITLE, $WELCOME, $RETURN, $INFOCOLOR, $BGCOLOR, $FORMCOLOR,
$PUBLICCOLOR, $PRIVATECOLOR, $SENTPUBCOLOR, $SENTPVTCOLOR, $TEXTCOLOR,
$LINKCOLOR, $ALINKCOLOR, $VLINKCOLOR,
$msgcolor, # current message color
$from, $to, # current message from, to

$swap_image, # swap images

$timestamp, # time stamp to track active users
$date, # date and time (adjustable for different timezones)
$link, # email or URL of guest
$cur, # new entry in the guestbook
@entries, # holds all entries
$entry, # one particular entry
%times, # hash of users last access times
%hosts, # hash of users IP address or DNS name
@users, # all active users
$user, # current user
$remote_host, # IP address or DNS name of current user
$sorry, # string to inform user of an error
$line, $key, $value1, $value2, $beg, # misc variables
$taken, $display, $dsplycnt
);


### SITE DEFAULTS - CHANGE THESE AS NECESSARY ###############################

$CHATFILE = 'chatfile'; # name of chat file
$USERS = 'chatusers'; # file storing active user info
$RETURN = 'http://www.aquilo.net/projects'; # refer visitors back to this URL
$MAXUSERS = 20; # max number of users
$MAXSAVE = 100; # how many messages to save to disk
$MAXDISPLAY= 25; # max number of messages to display
$ACTIVETIME = 5*60; # time a user stays active (in seconds)
$SHOW_DATE = 0; # show date/time of messages
$SHOW_EMAIL = 0; # enable email link at users name
$CAPITALIZE = 0; # capitalize names
$TITLE = "CHAT"; # page title
$WELCOME = "CHAT"; # <H1>$WELCOME</H1>
$INFOCOLOR = 'red'; # color of welcome and other text
$BGCOLOR = 'black'; # overall background color
$FORMCOLOR = 'black'; # bgcolor for form, if table is used
$TEXTCOLOR = 'red'; # text color
$LINKCOLOR = 'red'; # link color
$ALINKCOLOR = 'red'; # active link color
$VLINKCOLOR = 'red'; # visited link color
$PUBLICCOLOR = 'red'; # color for PUBLIC messages
$PRIVATECOLOR = 'yellow'; # color for PRIVATE messages
$SENTPUBCOLOR = 'red'; # color for SENT PUBLIC messages
$SENTPVTCOLOR = 'silver'; # color for SENT PRIVATE messages
$HOURADJUST = 0; # add this to local hour
$TZONE = 'EST'; # to display this time zone
# # automatically adjusts for
# # daylight savings (EST -> EDT, etc)
#############################################################################


$timestamp = time(); # get time stamp
$sorry = 0; # no error yet

print <<End_of_Text; # start HTML
Content-type: text/html

<HTML>
<HEAD>
<TITLE> $TITLE</TITLE>
</HEAD>
<BODY BGCOLOR="$BGCOLOR"
TEXT="$TEXTCOLOR"
LINK="$LINKCOLOR"
ALINK="$ALINKCOLOR"
VLINK="$VLINKCOLOR"
>
<A NAME="TOP"></A>
<FONT COLOR="$INFOCOLOR">
<CENTER>
<H1>$WELCOME</H1></CENTER>
<CENTER>
<b>Earliest Comments at <A HREF="#BOTTOM">Bottom</a> of Page</b>
</CENTER>
</FONT>

End_of_Text

if (-e $USERS) { # update users
open(UHANDLE, "+< $USERS") &#0124; &#0124; bail("cannot open $USERS: $!");
} else {
open(UHANDLE, "+> $USERS") &#0124; &#0124; bail("cannot open $USERS: $!");
}
flock(UHANDLE, LOCK_EX) &#0124; &#0124; bail("cannot flock $USERS: $!");
while (!eof(UHANDLE) && (%times < $MAXUSERS) ) {
chomp($line = <UHANDLE> );
($key, $value1, $value2) = split(/:/, $line);
if ($timestamp-$value1 < $ACTIVETIME) { # check if still active
$times{$key} = $value1;
$hosts{$key} = $value2;
};
};

$remote_host = $ENV{'REMOTE_HOST'};
$cur = CGI->new(); # current request
$URL = $cur->script_name(); # URL of this script

$user = $cur->param("name"); # get user name
$user =~ tr/ \n\r\t\f/ /s; # remove consequtive spaces
chop($user) if ($user =~ m/ $/); # remove any trailing junk
$user = substr($user, 1) if ($user =~ m/^ /); # remove any leading junk
$user =~ s/(\w+)/\u$1/g if ($CAPITALIZE); # capatalize (if enabled)
$cur->param("name", $user);

foreach (keys %times) { # check active user names
$taken=$_ if (m/^$user$/i);
};
if (length($taken)) { # is name already active
###
# one method of verifying users is to check the previous $user value
# saved in a hidden field in the HTML form. If they don't match
# this person is trying to use someone else's name
if (lc($user) ne $cur->param("save")) {
###
# another way to verify users is to check the remote users ip address.
# if it is not the same as before assume this is a different person
# and prompt for a different user name
# if (!($remote_host =~ m/$hosts{$taken}/i)) {
#
$sorry ="The name $taken is already active. "
.'Please choose another name.';
};
# otherwise, assume this is the same active user
###
} elsif (length($user)) { # new user
$times{$user} = $timestamp;
$hosts{$user} = $remote_host;
};

seek(UHANDLE, 0, 0) &#0124; &#0124; bail("cannot rewind $USERS: !");
foreach (keys %times) {
print UHANDLE "$_:$times{$_}:$hosts{$_}\n"; # save updated user info
push (@users, $_); # record active user names
}

truncate(UHANDLE, tell(UHANDLE)) &#0124; &#0124; bail("cannot truncate $USERS: $!");
close(UHANDLE) &#0124; &#0124; bail("cannot close $USERS: $!");


#### TD MODIFY ROUTINE 3/3/2000 ####

if ((!$sorry) && $cur->param("message") =~ m/\S/) { # new message
# check for image tags
if ($cur->param("message") =~ m/<\s*IMG\s*.*SRC\s*=/i) {
$sorry = 'Sorry, you can not include images in messages.';
} else {
if (length($user)) {
$cur->param("timestamp", $timestamp); # get timestamp
$cur->param("date", get_time($timestamp)); # get pretty date/time

################################################
$swap_image = $cur->param("message");
$swap_image =~ s/:angel:/<img src="http:\/\/216.65.76.77\/icons\/angel.gif">/g;
$swap_image =~ s/:bheart:/<img src="http:\/\/216.65.76.77\/icons\/bheart.gif">/g;
$swap_image =~ s/:blush:/<img src="http:\/\/216.65.76.77\/icons\/blush.gif">/g;
$swap_image =~ s/:coffee:/<img src="http:\/\/216.65.76.77\/icons\/coffee.gif">/g;
$swap_image =~ s/:cry:/<img src="http:\/\/216.65.76.77\/icons\/cry.gif">/g;
$swap_image =~ s/:cryingrose:/<img src="http:\/\/216.65.76.77\/icons\/cryingrose.gif">/g;
$swap_image =~ s/:cuffs:/<img src="http:\/\/216.65.76.77\/icons\/cuffs.gif">/g;
$swap_image =~ s/:devil:/<img src="http:\/\/216.65.76.77\/icons\/devil.gif">/g;
$swap_image =~ s/:eyes:/<img src="http:\/\/216.65.76.77\/icons\/eyes.gif">/g;
$swap_image =~ s/:frown:/<img src="http:\/\/216.65.76.77\/icons\/frown.gif">/g;
$swap_image =~ s/:heart:/<img src="http:\/\/216.65.76.77\/icons\/heart.gif">/g;
$swap_image =~ s/:hk:/<img src="http:\/\/216.65.76.77\/icons\/hk.gif">/g;
$swap_image =~ s/:hot:/<img src="http:\/\/216.65.76.77\/icons\/hot.gif">/g;
$swap_image =~ s/:kiss:/<img src="http:\/\/216.65.76.77\/icons\/kiss.gif">/g;
$swap_image =~ s/:licks:/<img src="http:\/\/216.65.76.77\/icons\/licks.gif">/g;
$swap_image =~ s/:phyt:/<img src="http:\/\/216.65.76.77\/icons\/phyt.gif">/g;
$swap_image =~ s/:poof:/<img src="http:\/\/216.65.76.77\/icons\/poof.gif">/g;
$swap_image =~ s/:roses:/<img src="http:\/\/216.65.76.77\/icons\/roses.gif">/g;
$swap_image =~ s/:slurp:/<img src="http:\/\/216.65.76.77\/icons\/slurp.gif">/g;
$swap_image =~ s/:smile:/<img src="http:\/\/216.65.76.77\/icons\/smile.gif">/g;
$swap_image =~ s/:wink:/<img src="http:\/\/216.65.76.77\/icons\/wink.gif">/g;

# print $cur->p("$swap_image");

$cur->param("message", $swap_image);

################################################

@entries = ($cur); # save message to array
} else {
$sorry ='You must enter a <b>name</b> to send a message!';
};
};
};


if (-e $CHATFILE) {
open(CHANDLE, "+< $CHATFILE") &#0124; &#0124; bail("cannot open $CHATFILE: $!");
} else {
open(CHANDLE, "+> $CHATFILE") &#0124; &#0124; bail("cannot open $CHATFILE: $!");
}
flock(CHANDLE, LOCK_EX) &#0124; &#0124; bail("cannot flock $CHATFILE: $!");
while (!eof(CHANDLE) && @entries < $MAXSAVE) {
$entry = CGI->new(\*CHANDLE);
push @entries, $entry;
}
seek(CHANDLE, 0, 0) &#0124; &#0124; bail("cannot rewind $CHATFILE: !");
foreach $entry (@entries) {
$entry->save(\*CHANDLE);
}
truncate(CHANDLE, tell(CHANDLE)) &#0124; &#0124; bail("cannot truncate $CHATFILE: $!");
close(CHANDLE) &#0124; &#0124; bail("cannot close $CHATFILE: $!");


push (@users, 'Everyone');
#print hr;
#print "<TABLE BGCOLOR=\"$FORMCOLOR\" # put a table around form, if you like
# BORDER =\"1\" CELLPADDING =\"10\"><TR><TD>\n";
print start_form; # HTML form
if ( length($user) && !$sorry ) { # save user name
print '<input type=hidden name="save" value="'.lc($user).'">',"\n";
} else { # save previous user name
print '<input type=hidden name="save" value="'
.$cur->param("save").'">',"\n";
};
print "<B>Name:</B> ", $cur->textfield( # sticky "name" field
-NAME => "name",
-SIZE => 30);
print " <B>To:</B> ",
$cur->popup_menu(-NAME => 'to', # "to" field
-VALUES => \@users,
-DEFAULT => 'Everyone',
-OVERRIDE => 1) # set to 0 to make sticky
, "\n";
if ($SHOW_EMAIL) {
print "<BR><B>Email or URL:</B>\n",
$cur->textfield( # sticky email/URL field
-NAME => "email",
-SIZE => 40), " (optional)<BR>\n";
};
print "<BR><B>Message:</B><BR>\n",
$cur->textfield( # message field
-NAME => "message",
-SIZE => 68,
-OVERRIDE => 1); # clears previous message
### if you prefer a textarea for messages
# $cur->textarea(
# -NAME => "message",
# -OVERRIDE => 1, # clears previous message from textarea
# -ROWS => 3,
# -COLUMNS => 68,
# -WRAP => "hard"), "<BR>\n";
###
print $cur->submit( -VALUE => "send / refresh"), " ";
#print $cur->reset( -VALUE => "clear"); # clear button, if you like
print end_form, "\n";
#print "</TD></TR></TABLE>\n";
print hr;

print "<CENTER><FONT SIZE=\"5\" COLOR=\"$PRIVATECOLOR\">
$sorry
</FONT></CENTER>\n<HR>" if ($sorry);

$dsplycnt=0;
while (@entries && ($dsplycnt < $MAXDISPLAY)) { # display messages
$entry = shift(@entries);
$link = $entry->param("email") if ($SHOW_EMAIL);
$from = $entry->param("name");
$from =~ s/(\w+)/\u$1/g if ($CAPITALIZE);
$to = $entry->param("to");
$to =~ s/\s+/ /g;
$to =~ s/(\w+)/\u$1/g if ($CAPITALIZE);
$date = $entry->param("date") if ($SHOW_DATE);
if ( length($user) && (lc($to) eq lc($user)) ) {
$msgcolor = $PRIVATECOLOR;
$display = 1 if (!$sorry);
} elsif (length($user) && (lc($from) eq lc($user))) {
if (lc($to) eq 'everyone') {
$msgcolor = $SENTPUBCOLOR;
$display = 1;
} else {
$msgcolor = $SENTPVTCOLOR;
$display = 1 if (!$sorry);
};
} elsif (lc($to) eq 'everyone') {
$msgcolor = $PUBLICCOLOR;
$display = 1;
};
if ($display) {
$display = 0;
$dsplycnt++;
if ($link) {
if ($link =~ m/@/) {
printf ("<FONT COLOR=\"$msgcolor\"><B>
<a href=\"mailto:%s\">%s</a> to %s</B> %s</FONT>\n",
$link, $from, $to, $date);
} else {
$link =~ s/^http:\/\///;
printf ("<FONT COLOR=\"$msgcolor\"><B>
<a href=\"http:\/\/%s\">%s</a> to %s</B> %s</FONT>\n",
$link, $from, $to, $date);
};
} else {
printf ("<FONT COLOR=\"$msgcolor\"><B>%s to %s</B> %s</FONT>\n",
"$from", "$to", $date);
};
printf ("<BR><FONT COLOR=\"$msgcolor\">%s</FONT>\n",
$entry->param("message"));
print hr;
};
};

print <<End_of_Text; # finish HTML
<FONT COLOR="$INFOCOLOR">
<CENTER>
<b>Latest Comments at <A NAME="BOTTOM" HREF="#TOP">Top</a> of Page</b>
</CENTER>
<p>
<CENTER>
<A HREF="$RETURN">Return to Home Page</a></b>
</CENTER>
</FONT>

</BODY>
</HTML>
End_of_Text


sub get_time {

my (
$sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$dst,
@months
);

@months = ("January","February","March","April","May","June","July",
"August","September","October","November","December");
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$dst)
= localtime(time()+$HOURADJUST*3600);
if ($hour < 10) {
$hour = '0'.$hour;
}
if ($min < 10) {
$min = '0'.$min;
}
if ($sec < 10) {
$sec = '0'.$sec;
}
$year += 1900; # Y2K OK!
$TZONE =~ tr/S/D/ if ($dst); # fix time zone string for daylight savings
return $timestamp = "$months[$mon] $mday, $year $hour:$min:$sec ($TZONE)";

}


sub bail { # print errors directly to browser
my $error = "@_";
print h1("Error:"), p($error), end_html;
die $error;
}

 
 


Search for (options) Powered by Gossamer Forum v.1.2.0

Web Applications & Managed Hosting Powered by Gossamer Threads
Visit our Mailing List Archives