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: Perl Programming Help: Beginner:
Big Script Problem

 


Lesia
Deleted

Mar 5, 2000, 7:14 PM

Post #1 of 3 (458 views)
Big Script Problem Can't Post
I have a problem with a chat script. It's only showing what you are posting and not what everyone else is posting or that there is even anyone else in the room. How do I fix that problem?
Thank You,
Lesia


Cure
User

Mar 5, 2000, 7:24 PM

Post #2 of 3 (458 views)
Re: Big Script Problem [In reply to] Can't Post
Hi

Can you post your code?

Cure


Lesia
Deleted

Mar 5, 2000, 7:42 PM

Post #3 of 3 (458 views)
Re: Big Script Problem [In reply to] Can't Post
Cure, here's the script.
Thanks,

#!/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 = 'convo'; # name of chat file
$USERS = 'convousers'; # file storing active user info
$RETURN = 'http://www.alterzone2.net/index.html'; # 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 = "Alterzone2"; # page title
$WELCOME = "Conversational Room"; # <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 = 'white'; # text color
$LINKCOLOR = 'blue'; # link color
$ALINKCOLOR = 'red'; # active link color
$VLINKCOLOR = 'red'; # visited link color
$PUBLICCOLOR = 'white'; # color for PUBLIC messages
$PRIVATECOLOR = 'white'; # color for PRIVATE messages
$SENTPUBCOLOR = 'white'; # color for SENT PUBLIC messages
$SENTPVTCOLOR = 'white'; # 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/:luv:/<img src="http:\/\/216.65.76.77\/icons\/luv.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;
$swap_image =~ s/:dizzy:/<img src="http:\/\/216.65.76.77\/icons\/dizzy.gif">/g;
$swap_image =~ s/:kma:/<img src="http:\/\/216.65.76.77\/icons\/kma.gif">/g;
$swap_image =~ s/:music:/<img src="http:\/\/216.65.76.77\/icons\/music.gif">/g;
$swap_image =~ s/:smoking:/<img src="http:\/\/216.65.76.77\/icons\/smoking.gif">/g;
$swap_image =~ s/:pms:/<img src="http:\/\/216.65.76.77\/icons\/pms.gif">/g;
$swap_image =~ s/:beer:/<img src="http:\/\/216.65.76.77\/icons\/beer.gif">/g;
$swap_image =~ s/:roses2:/<img src="http:\/\/216.65.76.77\/icons\/roses2.gif">/g;
$swap_image =~ s/:ly:/<img src="http:\/\/216.65.76.77\/icons\/ly.gif">/g;
$swap_image =~ s/:sleep:/<img src="http:\/\/216.65.76.77\/icons\/sleep.gif">/g;
$swap_image =~ s/:cum:/<img src="http:\/\/216.65.76.77\/icons\/cum.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 "</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> %s</B> %s</FONT>\n",
$link, $from, $to, $date);
} else {
$link =~ s/^http:\/\///;
printf ("<FONT COLOR=\"$msgcolor\"><B>
<a href=\"http:\/\/%s\">%s</a> %s</B> %s</FONT>\n",
$link, $from, $to, $date);
};
} else {
printf ("<FONT COLOR=\"$msgcolor\"><B>%s %s</B> %s</FONT>\n",
"$from", "$to", $date);
};
printf ("<BR><FONT COLOR=\"$msgcolor\">%s</FONT>\n",
$entry->param("message"));
print hr;
};
};
# modified code #
## easy find ##
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";

# end of modified code #

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