[12623] in Perl-Users-Digest
Perl-Users Digest, Issue: 32 Volume: 9
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Wed Jul 7 00:17:31 1999
Date: Tue, 6 Jul 1999 21:06:55 -0700 (PDT)
From: Perl-Users Digest <Perl-Users-Request@ruby.OCE.ORST.EDU>
To: Perl-Users@ruby.OCE.ORST.EDU (Perl-Users Digest)
Perl-Users Digest Tue, 6 Jul 1999 Volume: 9 Number: 32
Today's topics:
Implimenting Chat Script...More info <kuzzero@nconnect.net>
Re: Implimenting Chat Script...More info (Abigail)
Re: Implimenting Chat Script...More info (William Herrera)
Re: INC not working properly (tom)
Re: Inserting @ in a string??? <gellyfish@gellyfish.com>
installing modules with perl win32 <thierry.metoudi@francemel.com>
Re: installing modules with perl win32 (elephant)
interpolating variables into string read from file <mathias@singapura.singnet.com.sg>
Re: interpolating variables into string read from file <uri@sysarch.com>
Re: interpolating variables into string read from file (elephant)
Re: Interpreting MS-ASCII - anyone have a filter? (Henry Churchyard)
Digest Administrivia (Last modified: 1 Jul 99) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: Sat, 3 Jul 1999 16:30:42 -0500
From: "John Curry" <kuzzero@nconnect.net>
Subject: Implimenting Chat Script...More info
Message-Id: <7llv3r$jq9@enews3.newsguy.com>
As I said earlier, I'm running a Sambar Server with Active State Perl 5.004
on a Win 98 op system, it generates a blank page with no tracable errors in
the logs,,, here's the script.
-----------------------------------script---------------------------------
#!d:\sambar41\perl\bin
## Define Variables
## Array Preferences
@room_names =
("Ar","Islands","Outlands","Sardar","Panther","Schendi","Bazi","Tahari","Wag
on");
@room_values =
("ar","islands","outlands","sardar","panther","schendi","bazi","tahari","wag
on");
## HTML Tag Preferences
$html_tag_font_begin = "<FONT FACE=\"arial\" SIZE=-1>";
$html_tag_font_end = "</FONT>";
## Message Preferences
$msg_bad_referrer = "Invalid call to this script.";
$msg_error_file_open = "An error occurred while opening the room file.";
$msg_error_file_create = "An error occurred while creating the room files.";
$msg_not_post = "Invalid call to this script.";
## Path Preferences
$path_to_chat_files = "d:\sambar41\docs\chat";
$path_to_templet_files = "d:\sambar41\docs\chat\templets";
## System Preferences
$sys_allow_html = "0"; # 0 = Yes; 1 = No;
$sys_allow_images = "0"; # 0 = Yes; 1 = No;
$sys_allow_java = "1"; # 0 = Yes; 1 = No;
$sys_allow_javascript = "1"; # 0 = Yes; 1 = No;
$sys_create_rooms = "1"; # 0 = Yes; 1 = No;
$sys_display_ip = "1"; # 0 = Yes; 1 = No;
$sys_log_rooms = "0"; # 0 = Yes; 1 = No;
$sys_num_of_posts = "30"; # Set to any number
## URLs
$url_of_referrer = d:\sambar41\docs\chat;
$url_to_images = d:\sambar41\docs\chat\icons;
$url_to_script = d:\sambar41\cgi-bin\chat.pl;
## Begin Program
$|=1;
if (($ENV{'REQUEST_METHOD'} eq "POST") && ($ENV{'HTTP_REFERER'} =~
/$url_of_referrer/)) {
&parsePostInput();
} else {
&printChatLogon();
}
@messages = ();
&cleanUser();
&readRoomFile();
&createDateStamp();
&cleanUserInput() unless $formdata{'user_body'} eq "";
&writeRoomFile() unless $formdata{'user_body'} eq "";
&createRooms();
&printChatPage();
&writeRoomLog() unless $formdata{'user_body'} eq "";
&exitProgram();
## Subroutines
sub cleanUser {
## Disallow JavaScript
$formdata{'user_email'} =~ s/javascript\://ig;
$formdata{'user_homepage'} =~ s/javascript\://ig;
$formdata{'user_homepage'} =~ s/http\:\/\///ig;
## Clean invalid chararcters from the room name
$formdata{'user_room'} =~ s/\|//g;
$formdata{'user_room'} =~ s/\\//g;
$formdata{'user_room'} =~ s/\=//g;
$formdata{'user_room'} =~ s/\+//g;
$formdata{'user_room'} =~ s/\)//g;
$formdata{'user_room'} =~ s/\(//g;
$formdata{'user_room'} =~ s/\*//g;
$formdata{'user_room'} =~ s/\&//g;
$formdata{'user_room'} =~ s/\^//g;
$formdata{'user_room'} =~ s/\%//g;
$formdata{'user_room'} =~ s/\$//g;
$formdata{'user_room'} =~ s/\#//g;
$formdata{'user_room'} =~ s/\@//g;
$formdata{'user_room'} =~ s/\!//g;
$formdata{'user_room'} =~ s/\`//g;
$formdata{'user_room'} =~ s/\~//g;
$formdata{'user_room'} =~ s/\;//g;
$formdata{'user_room'} =~ s/\://g;
$formdata{'user_room'} =~ s/\'//g;
$formdata{'user_room'} =~ s/\"//g;
$formdata{'user_room'} =~ s/\[//g;
$formdata{'user_room'} =~ s/\{//g;
$formdata{'user_room'} =~ s/\]//g;
$formdata{'user_room'} =~ s/\}//g;
$formdata{'user_room'} =~ s/\,//g;
$formdata{'user_room'} =~ s/\.//g;
$formdata{'user_room'} =~ s/\///g;
$formdata{'user_room'} =~ s/\<//g;
$formdata{'user_room'} =~ s/\>//g;
$formdata{'user_room'} =~ s/\?//g;
$formdata{'user_room'} =~ s/\s/\_/g;
if ($formdata{'user_room'} eq "") {
$formdata{'user_room'} = $room_values[0];
}
## Remove HTML from non-message fields
$formdata{'user_handle'} =~ s/<([^>]+)>//ig;
$formdata{'user_handle'} =~ s/<(IMG\s*SRC.*)>//ig;
$formdata{'user_email'} =~ s/<([^>]+)>//ig;
$formdata{'user_homepage'} =~ s/<([^>]+)>//ig;
}
sub cleanUserInput {
## Disallow JavaScript
$formdata{'user_body'} =~ s/<SCRIPT\w*\>//ig unless $sys_allow_javascript
eq "0";
$formdata{'user_body'} =~ s/<\/SCRIPT\>//ig unless $sys_allow_javascript eq
"0";
## Disallow Java Applets
$formdata{'user_body'} =~ s/<APPLET\w*\>//ig unless $sys_allow_java eq "0";
$formdata{'user_body'} =~ s/<\/APPLET\>//ig unless $sys_allow_java eq "0";
if ((length ($formdata{'user_body'}) > 50) && (($formdata{'user_body'}) !~
/\s/)){
$formdata{'user_body'} = "";
}
$formdata{'user_body'} =~ s/<([^>]+)>//ig unless $sys_allow_html eq "0";
$formdata{'user_body'} =~ s/<(IMG\s*SRC.*)>//ig unless $sys_allow_images eq
"0";
$formdata{'user_body'} =~ s/\n/<BR\>/g;
$formdata{'user_body'} =~ s/<BR\><BR\>/<P\>/ig;
}
sub createDateStamp {
my($year,$month,$day,$hour,$minute,$second);
$year = (localtime)[5] + 1900;
$month = (localtime)[4] + 1;
$day = (localtime)[3];
$hour = (localtime)[2];
$minute = (localtime)[1];
$second = (localtime)[0];
$month = "0$month" unless length($month) == 2;
$day = "0$day" unless length($day) == 2;
$hour = "0$hour" unless length($hour) == 2;
$minute = "0$minute" unless length($minute) == 2;
$second = "0$second" unless length($second) == 2;
$datestamp = "$month/$day/$year $hour:$minute:$second";
}
sub createRooms {
my($room,$value,$counter);
$room_list = "\t<TR>\n\t\t<TD
COLSPAN=2>\n\t\t\t$html_tag_font_begin<B>Room:</B>$html_tag_font_end\n";
if ($sys_create_rooms eq "0") {
$room_list .= "\t\t\t<INPUT TYPE=TEXT NAME=\"user_room\"
VALUE=\"$formdata{'user_room'}\" SIZE=10 MAXLENGTH=10>\n\t\t\t<INPUT
TYPE=SUBMIT VALUE=\" Talk \">\n\t\t\t<INPUT TYPE=SUBMIT VALUE=\" Listen
\">\n\t\t</TD>\n\t</TR>\n\t<TR>\n\t\t<TD
COLSPAN=2>\n\t\t\t$html_tag_font_begin<B>Public Rooms:</B> ";
foreach $room (@room_values) {
$room_list .= "\[ $room \]";
}
$room_list .= "$html_tag_font_end\n\t\t</TD>\n\t</TR>\n";
} else {
$counter = 0;
$room_list = "\t<TR>\n\t\t<TD
COLSPAN=2>\n\t\t\t$html_tag_font_begin<B>Room:</B>$html_tag_font_end\n\t\t\t
<SELECT NAME=\"user_room\">";
foreach $room (@room_names) {
$value = $room_values[$counter];
if ($value eq $formdata{'user_room'}) {
$room_list .= "<OPTION VALUE=\"$value\" SELECTED>$room";
} else {
$room_list .= "<OPTION VALUE=\"$value\">$room";
}
$counter++;
}
$room_list .= "</SELECT>\n\t\t\t<INPUT TYPE=SUBMIT VALUE=\" Talk
\">\n\t\t\t<INPUT TYPE=SUBMIT VALUE=\" Listen \">\n\t\t</TD>\n\t</TR>";
}
}
sub exitProgram {
exit(0);
}
sub parsePostInput {
$buffer = "";
read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
@pairs=split(/&/,$buffer);
foreach $pair (@pairs) {
@a = split(/=/,$pair);
$name=$a[0];
$value=$a[1];
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
$value =~ s/~!/ ~!/g;
$value =~ s/\+/ /g;
$value =~ s/\r//g;
push (@data,$name);
push (@data, $value);
}
%formdata=@data;
}
sub printChatLogon {
my($line,@chat_logon);
@chat_logon = &readFile("$path_to_chat_files/index.html");
print "Content-type: text/html\n\n";
print @chat_logon;
&exitProgram();
}
sub printChatPage {
my($line,@chat_page);
@chat_page = &readFile("$path_to_templet_files/chatpage.templet");
print "Content-type: text/html\n\n";
foreach $line (@chat_page) {
$line =~ s/\*\*USER_ROOM_SINGLE\*\*/$formdata{'user_room'}/;
$line =~ s/\*\*USER_HANDLE\*\*/$formdata{'user_handle'}/;
$line =~ s/\*\*USER_COLOR\*\*/$formdata{'user_color'}/;
$line =~ s/\*\*USER_EMAIL\*\*/$formdata{'user_email'}/;
$line =~ s/\*\*USER_HOMEPAGE\*\*/$formdata{'user_homepage'}/;
$line =~ s/\*\*MESSAGES\*\*/@messages/;
$line =~ s/\*\*USER_DATESTAMP\*\*/$datestamp/;
$line =~ s/\*\*USER_ROOM\*\*/$room_list/;
$line =~ s/\*\*USER_IMAGE\*\*/$formdata{'user_image'}/;
print $line;
}
}
sub printErrorPage {
my($message) = @_;
my($line,@error_page);
chomp($message);
open(ERRORPAGETEMP, "$path_to_templet_files/error.templet") ||
&exitProgram();
@error_page = <ERRORPAGETEMP>;
close(ERRORPAGETEMP);
print "Content-type: text/html\n\n";
foreach $line (@error_page) {
if ($line =~ m/\*\*ERROR_MESSAGE\*\*/) {
$line =~ s/\*\*ERROR_MESSAGE\*\*/$message/;
}
print @error_page;
}
}
sub readFile {
my($file_to_read) = @_;
my(@file_in);
open(FILE_IN, "$file_to_read") || &printErrorPage($msg_error_file_open);
@file_in = <FILE_IN>;
close(FILE_IN);
return @file_in;
}
sub readRoomFile {
if (-e "$path_to_chat_files/$formdata{'user_room'}.room") {
open(ROOMIN, "$path_to_chat_files/$formdata{'user_room'}.room") ||
&printErrorPage($msg_error_file_open);
@messages = <ROOMIN>;
close(ROOMIN);
}
}
sub writeRoomFile {
if ($sys_display_ip eq "0") {
$ip = " from $ENV{'REMOTE_HOST'}";
}
if ($formdata{'user_image'}) {
$user_icon = "<IMG SRC=\"$url_to_images/$formdata{'user_image'}\"
HEIGHT=55 WIDTH=42 BORDER=0>";
} else {
$user_icon = "";
}
if ($formdata{'user_email'}) {
$email_icon = "<A HREF=\"mailto:$formdata{'user_email'}\"><IMG
SRC=\"$url_to_images/email.gif\" HEIGHT=26 WIDTH=52 BORDER=0></A><BR>";
} else {
$email_icon = "";
}
if ($formdata{'user_homepage'}) {
$homepage_icon = "<A HREF=\"http://$formdata{'user_homepage'}\"
TARGET=_new><IMG SRC=\"$url_to_images/hp.gif\" HEIGHT=26 WIDTH=52
BORDER=0></A>";
} else {
$homepage_icon = "";
}
$temparray = "<TABLE BORDER=0 WIDTH=100\% CELLPADDING=2><TR><TD
BGCOLOR=\"\#$formdata{'user_color'}\" COLSPAN=3>$html_tag_font_begin<FONT
COLOR=\"\#FFFFFF\"><B>\ \;\ \;$formdata{'user_handle'}</B>$ip
\($datestamp\)\, says\:</FONT>$html_tag_font_end</TD></TR><TR><TD WIDTH=10\%
VALIGN=TOP ALIGN=CENTER>$url_to_image</TD><TD WIDTH=80\%
VALIGN=TOP><BLOCKQUOTE><TT>$formdata{'user_body'}</TT></BLOCKQUOTE></TD><TD
WIDTH=10\% VALIGN=TOP
ALIGN=CENTER>$email_icon$homepage_icon</TD></TR></TABLE>\n";
$templog = "<TABLE BORDER=0 WIDTH=100\% CELLPADDING=2><TR><TD
BGCOLOR=\"\#$formdata{'user_color'}\" COLSPAN=3>$html_tag_font_begin<FONT
COLOR=\"\#FFFFFF\"><B>\ \;\ \;$formdata{'user_handle'}</B> from
$ENV{'REMOTE_HOST'} \($datestamp\)\,
says\:</FONT>$html_tag_font_end</TD></TR><TR><TD WIDTH=10\% VALIGN=TOP
ALIGN=CENTER>$url_to_image</TD><TD WIDTH=80\%
VALIGN=TOP><BLOCKQUOTE><TT>$formdata{'user_body'}</TT></BLOCKQUOTE></TD><TD
WIDTH=10\% VALIGN=TOP
ALIGN=CENTER>$email_icon$homepage_icon</TD></TR></TABLE>\n";
unshift(@messages, $temparray);
splice(@messages, $sys_num_of_posts, 30);
if (-e "$path_to_chat_files/$formdata{'user_room'}.room") {
open(ROOMOUT, ">$path_to_chat_files/$formdata{'user_room'}.room") ||
&printErrorPage($msg_error_file_open);
flock(ROOMOUT, 2);
print ROOMOUT @messages;
flock(ROOMOUT, 8);
close(ROOMOUT);
} else {
if ($sys_create_rooms eq "0") {
open(ROOMOUT1, ">$path_to_chat_files/$formdata{'user_room'}.room") ||
&printErrorPage($msg_error_file_create);
flock(ROOMOUT1, 2);
print ROOMOUT1 @messages;
flock(ROOMOUT1, 8);
close(ROOMOUT1);
}
}
}
sub writeRoomLog {
if ($sys_log_rooms eq "0") {
if (-e "$path_to_chat_files/$formdata{'user_room'}.log") {
open(ROOMLOG, ">>$path_to_chat_files/$formdata{'user_room'}.log") ||
&exitProgram();
flock(ROOMLOG, 2);
print ROOMLOG $templog;
flock(ROOMLOG, 8);
close(ROOMLOG);
} else {
open(ROOMLOG1, ">$path_to_chat_files/$formdata{'user_room'}.log") ||
&exitProgram();
flock(ROOMLOG1, 2);
print ROOMLOG1 $templog;
flock(ROOMLOG1, 8);
close(ROOMLOG1);
}
}
}
----------------------------- end
script --------------------------------------
------------------------------
Date: 3 Jul 1999 18:51:05 -0500
From: abigail@delanet.com (Abigail)
Subject: Re: Implimenting Chat Script...More info
Message-Id: <slrn7nt8ej.31h.abigail@alexandra.delanet.com>
John Curry (kuzzero@nconnect.net) wrote on MMCXXXII September MCMXCIII in
<URL:news:7llv3r$jq9@enews3.newsguy.com>:
!! As I said earlier, I'm running a Sambar Server with Active State Perl 5.004
!! on a Win 98 op system, it generates a blank page with no tracable errors in
!! the logs,,, here's the script.
!!
!! -----------------------------------script---------------------------------
!! #!d:\sambar41\perl\bin
There's no -w!
There's no -T!
There's no "use strict;"!
There's no "use CGI;"!
!! ## Define Variables
!!
!! ## Array Preferences
!! @room_names =
!! ("Ar","Islands","Outlands","Sardar","Panther","Schendi","Bazi","Tahari","Wag
!! on");
!! @room_values =
!! ("ar","islands","outlands","sardar","panther","schendi","bazi","tahari","wag
!! on");
Ever heard of qw? Ever heard of lc?
my @room_values = map {lc} my @room_names =
qw /Ar Islands Outlands Sardar Panther Schendi Tahari Wagon/;
!! ## HTML Tag Preferences
!! $html_tag_font_begin = "<FONT FACE=\"arial\" SIZE=-1>";
!! $html_tag_font_end = "</FONT>";
Eeew. Font is evil! It was invented by the devil to kill the web.
And there's no need for all those backwacks. Use different quotes.
!! ## Message Preferences
!! $msg_bad_referrer = "Invalid call to this script.";
!! $msg_error_file_open = "An error occurred while opening the room file.";
!! $msg_error_file_create = "An error occurred while creating the room files.";
!! $msg_not_post = "Invalid call to this script.";
!!
!! ## Path Preferences
!! $path_to_chat_files = "d:\sambar41\docs\chat";
!! $path_to_templet_files = "d:\sambar41\docs\chat\templets";
Are you sure? Did you print out the values of $path_to_chat_files and
$path_to_templet_files? Perhaps you should.
!! ## System Preferences
!! $sys_allow_html = "0"; # 0 = Yes; 1 = No;
0 for yes, 1 for no? Isn't that confusing? And why quote the 0?
!! $sys_allow_images = "0"; # 0 = Yes; 1 = No;
!! $sys_allow_java = "1"; # 0 = Yes; 1 = No;
!! $sys_allow_javascript = "1"; # 0 = Yes; 1 = No;
!! $sys_create_rooms = "1"; # 0 = Yes; 1 = No;
!! $sys_display_ip = "1"; # 0 = Yes; 1 = No;
!! $sys_log_rooms = "0"; # 0 = Yes; 1 = No;
!! $sys_num_of_posts = "30"; # Set to any number
!!
!! ## URLs
!! $url_of_referrer = d:\sambar41\docs\chat;
!! $url_to_images = d:\sambar41\docs\chat\icons;
!! $url_to_script = d:\sambar41\cgi-bin\chat.pl;
No quotes here? Did you script even compile???
!! ## Begin Program
!!
!! $|=1;
!! if (($ENV{'REQUEST_METHOD'} eq "POST") && ($ENV{'HTTP_REFERER'} =~
!! /$url_of_referrer/)) {
!! &parsePostInput();
So.... this should only "work" from your local drive?
!! } else {
!! &printChatLogon();
!! }
!!
!! @messages = ();
!!
!! &cleanUser();
!! &readRoomFile();
!! &createDateStamp();
!! &cleanUserInput() unless $formdata{'user_body'} eq "";
!! &writeRoomFile() unless $formdata{'user_body'} eq "";
!! &createRooms();
!! &printChatPage();
!! &writeRoomLog() unless $formdata{'user_body'} eq "";
!! &exitProgram();
!!
!! ## Subroutines
!!
!! sub cleanUser {
!! ## Disallow JavaScript
!! $formdata{'user_email'} =~ s/javascript\://ig;
!! $formdata{'user_homepage'} =~ s/javascript\://ig;
!! $formdata{'user_homepage'} =~ s/http\:\/\///ig;
!!
!! ## Clean invalid chararcters from the room name
!! $formdata{'user_room'} =~ s/\|//g;
!! $formdata{'user_room'} =~ s/\\//g;
!! $formdata{'user_room'} =~ s/\=//g;
!! $formdata{'user_room'} =~ s/\+//g;
!! $formdata{'user_room'} =~ s/\)//g;
!! $formdata{'user_room'} =~ s/\(//g;
!! $formdata{'user_room'} =~ s/\*//g;
!! $formdata{'user_room'} =~ s/\&//g;
!! $formdata{'user_room'} =~ s/\^//g;
!! $formdata{'user_room'} =~ s/\%//g;
!! $formdata{'user_room'} =~ s/\$//g;
!! $formdata{'user_room'} =~ s/\#//g;
!! $formdata{'user_room'} =~ s/\@//g;
!! $formdata{'user_room'} =~ s/\!//g;
!! $formdata{'user_room'} =~ s/\`//g;
!! $formdata{'user_room'} =~ s/\~//g;
!! $formdata{'user_room'} =~ s/\;//g;
!! $formdata{'user_room'} =~ s/\://g;
!! $formdata{'user_room'} =~ s/\'//g;
!! $formdata{'user_room'} =~ s/\"//g;
!! $formdata{'user_room'} =~ s/\[//g;
!! $formdata{'user_room'} =~ s/\{//g;
!! $formdata{'user_room'} =~ s/\]//g;
!! $formdata{'user_room'} =~ s/\}//g;
!! $formdata{'user_room'} =~ s/\,//g;
!! $formdata{'user_room'} =~ s/\.//g;
!! $formdata{'user_room'} =~ s/\///g;
!! $formdata{'user_room'} =~ s/\<//g;
!! $formdata{'user_room'} =~ s/\>//g;
!! $formdata{'user_room'} =~ s/\?//g;
We could have done that in one line too.... s/[^\s\w]+//g;
!! $formdata{'user_room'} =~ s/\s/\_/g;
!!
!! if ($formdata{'user_room'} eq "") {
!! $formdata{'user_room'} = $room_values[0];
!! }
!!
!! ## Remove HTML from non-message fields
!! $formdata{'user_handle'} =~ s/<([^>]+)>//ig;
!! $formdata{'user_handle'} =~ s/<(IMG\s*SRC.*)>//ig;
So..... <IMG ALT = "Hahaha" SRC = "foobar"> is allowed?
!! $formdata{'user_email'} =~ s/<([^>]+)>//ig;
!! $formdata{'user_homepage'} =~ s/<([^>]+)>//ig;
That's extremely simplistic, and more likely to fail than accidently
be right.
!! }
!!
!! sub cleanUserInput {
!! ## Disallow JavaScript
!! $formdata{'user_body'} =~ s/<SCRIPT\w*\>//ig unless $sys_allow_javascript
!! eq "0";
!! $formdata{'user_body'} =~ s/<\/SCRIPT\>//ig unless $sys_allow_javascript eq
!! "0";
!!
!! ## Disallow Java Applets
!! $formdata{'user_body'} =~ s/<APPLET\w*\>//ig unless $sys_allow_java eq "0";
!! $formdata{'user_body'} =~ s/<\/APPLET\>//ig unless $sys_allow_java eq "0";
Why reinvent the wheel, poorly, over and over again? Why not use HTML::Parser?
!! if ((length ($formdata{'user_body'}) > 50) && (($formdata{'user_body'}) !~
!! /\s/)){
!! $formdata{'user_body'} = "";
!! }
!!
!! $formdata{'user_body'} =~ s/<([^>]+)>//ig unless $sys_allow_html eq "0";
!! $formdata{'user_body'} =~ s/<(IMG\s*SRC.*)>//ig unless $sys_allow_images eq
!! "0";
!! $formdata{'user_body'} =~ s/\n/<BR\>/g;
!! $formdata{'user_body'} =~ s/<BR\><BR\>/<P\>/ig;
!! }
!!
!! sub createDateStamp {
!! my($year,$month,$day,$hour,$minute,$second);
!!
!! $year = (localtime)[5] + 1900;
!! $month = (localtime)[4] + 1;
!! $day = (localtime)[3];
!! $hour = (localtime)[2];
!! $minute = (localtime)[1];
!! $second = (localtime)[0];
How about:
my ($second, $minute, $hour, $day, $month, $year) = localtime;
$year += 1900;
$month += 1;
That avoids showing the date as 'Jan 1 1999' if someone runs it around
Dec 31, 1999, 23:59:59.
!! $month = "0$month" unless length($month) == 2;
!! $day = "0$day" unless length($day) == 2;
!! $hour = "0$hour" unless length($hour) == 2;
!! $minute = "0$minute" unless length($minute) == 2;
!! $second = "0$second" unless length($second) == 2;
Or you use sprintf.
!! $datestamp = "$month/$day/$year $hour:$minute:$second";
Wouldn't 'localtime' in scalar context have worked? At least that
doesn't confuse non-USAians, where $month/$day will on 132 days
of the year.
!! }
!!
!! sub createRooms {
!! my($room,$value,$counter);
!!
!! $room_list = "\t<TR>\n\t\t<TD
!! COLSPAN=2>\n\t\t\t$html_tag_font_begin<B>Room:</B>$html_tag_font_end\n";
!!
!! if ($sys_create_rooms eq "0") {
!! $room_list .= "\t\t\t<INPUT TYPE=TEXT NAME=\"user_room\"
!! VALUE=\"$formdata{'user_room'}\" SIZE=10 MAXLENGTH=10>\n\t\t\t<INPUT
!! TYPE=SUBMIT VALUE=\" Talk \">\n\t\t\t<INPUT TYPE=SUBMIT VALUE=\" Listen
!! \">\n\t\t</TD>\n\t</TR>\n\t<TR>\n\t\t<TD
!! COLSPAN=2>\n\t\t\t$html_tag_font_begin<B>Public Rooms:</B> ";
Urg. How about a here document? Saves a lot on the backwacks.
!! foreach $room (@room_values) {
!! $room_list .= "\[ $room \]";
!! }
!!
!! $room_list .= "$html_tag_font_end\n\t\t</TD>\n\t</TR>\n";
Why the tabs?
!! } else {
!! $counter = 0;
!! $room_list = "\t<TR>\n\t\t<TD
!! COLSPAN=2>\n\t\t\t$html_tag_font_begin<B>Room:</B>$html_tag_font_end\n\t\t\t
!! <SELECT NAME=\"user_room\">";
!!
!! foreach $room (@room_names) {
!! $value = $room_values[$counter];
!!
!! if ($value eq $formdata{'user_room'}) {
!! $room_list .= "<OPTION VALUE=\"$value\" SELECTED>$room";
!! } else {
!! $room_list .= "<OPTION VALUE=\"$value\">$room";
!! }
!!
!! $counter++;
!! }
!!
!! $room_list .= "</SELECT>\n\t\t\t<INPUT TYPE=SUBMIT VALUE=\" Talk
!! \">\n\t\t\t<INPUT TYPE=SUBMIT VALUE=\" Listen \">\n\t\t</TD>\n\t</TR>";
!! }
!! }
!!
!! sub exitProgram {
!! exit(0);
!! }
!!
!! sub parsePostInput {
!! $buffer = "";
!! read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
!! @pairs=split(/&/,$buffer);
!! foreach $pair (@pairs) {
!!
!! @a = split(/=/,$pair);
!! $name=$a[0];
!! $value=$a[1];
!! $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
!! $value =~ s/~!/ ~!/g;
!! $value =~ s/\+/ /g;
!! $value =~ s/\r//g;
!! push (@data,$name);
!! push (@data, $value);
!! }
!! %formdata=@data;
Why reinvent the wheel when there are modules doing it for you?
!! }
!!
!! sub printChatLogon {
!! my($line,@chat_logon);
!!
!! @chat_logon = &readFile("$path_to_chat_files/index.html");
!!
!! print "Content-type: text/html\n\n";
!! print @chat_logon;
!!
!! &exitProgram();
!! }
!!
!! sub printChatPage {
!! my($line,@chat_page);
!!
!! @chat_page = &readFile("$path_to_templet_files/chatpage.templet");
!!
!! print "Content-type: text/html\n\n";
!!
!! foreach $line (@chat_page) {
!! $line =~ s/\*\*USER_ROOM_SINGLE\*\*/$formdata{'user_room'}/;
!! $line =~ s/\*\*USER_HANDLE\*\*/$formdata{'user_handle'}/;
!! $line =~ s/\*\*USER_COLOR\*\*/$formdata{'user_color'}/;
!! $line =~ s/\*\*USER_EMAIL\*\*/$formdata{'user_email'}/;
!! $line =~ s/\*\*USER_HOMEPAGE\*\*/$formdata{'user_homepage'}/;
!! $line =~ s/\*\*MESSAGES\*\*/@messages/;
!! $line =~ s/\*\*USER_DATESTAMP\*\*/$datestamp/;
!! $line =~ s/\*\*USER_ROOM\*\*/$room_list/;
!! $line =~ s/\*\*USER_IMAGE\*\*/$formdata{'user_image'}/;
!!
!! print $line;
!! }
!! }
!!
!! sub printErrorPage {
!! my($message) = @_;
!! my($line,@error_page);
!! chomp($message);
!!
!! open(ERRORPAGETEMP, "$path_to_templet_files/error.templet") ||
!! &exitProgram();
Well, that isn't very informative when it fails, now is it? The exit
program just exits, without giving any indication why things failed.
I think you would have found some problems if you bothered to write
the program such that it would inform you what went wrong.
!! @error_page = <ERRORPAGETEMP>;
!! close(ERRORPAGETEMP);
!!
!! print "Content-type: text/html\n\n";
!!
!! foreach $line (@error_page) {
!! if ($line =~ m/\*\*ERROR_MESSAGE\*\*/) {
!! $line =~ s/\*\*ERROR_MESSAGE\*\*/$message/;
Why the if?
!! }
!!
!! print @error_page;
!! }
!! }
!!
!! sub readFile {
!! my($file_to_read) = @_;
!! my(@file_in);
!!
!! open(FILE_IN, "$file_to_read") || &printErrorPage($msg_error_file_open);
!! @file_in = <FILE_IN>;
!! close(FILE_IN);
!!
!! return @file_in;
!! }
!!
!! sub readRoomFile {
!! if (-e "$path_to_chat_files/$formdata{'user_room'}.room") {
!! open(ROOMIN, "$path_to_chat_files/$formdata{'user_room'}.room") ||
!! &printErrorPage($msg_error_file_open);
!! @messages = <ROOMIN>;
!! close(ROOMIN);
!! }
!! }
!!
!! sub writeRoomFile {
!! if ($sys_display_ip eq "0") {
!! $ip = " from $ENV{'REMOTE_HOST'}";
!! }
!!
!! if ($formdata{'user_image'}) {
!! $user_icon = "<IMG SRC=\"$url_to_images/$formdata{'user_image'}\"
!! HEIGHT=55 WIDTH=42 BORDER=0>";
!! } else {
!! $user_icon = "";
!! }
!!
!! if ($formdata{'user_email'}) {
!! $email_icon = "<A HREF=\"mailto:$formdata{'user_email'}\"><IMG
!! SRC=\"$url_to_images/email.gif\" HEIGHT=26 WIDTH=52 BORDER=0></A><BR>";
!! } else {
!! $email_icon = "";
!! }
!!
!! if ($formdata{'user_homepage'}) {
!! $homepage_icon = "<A HREF=\"http://$formdata{'user_homepage'}\"
!! TARGET=_new><IMG SRC=\"$url_to_images/hp.gif\" HEIGHT=26 WIDTH=52
!! BORDER=0></A>";
!! } else {
!! $homepage_icon = "";
!! }
!!
!! $temparray = "<TABLE BORDER=0 WIDTH=100\% CELLPADDING=2><TR><TD
!! BGCOLOR=\"\#$formdata{'user_color'}\" COLSPAN=3>$html_tag_font_begin<FONT
!! COLOR=\"\#FFFFFF\"><B>\ \;\ \;$formdata{'user_handle'}</B>$ip
!! \($datestamp\)\, says\:</FONT>$html_tag_font_end</TD></TR><TR><TD WIDTH=10\%
!! VALIGN=TOP ALIGN=CENTER>$url_to_image</TD><TD WIDTH=80\%
!! VALIGN=TOP><BLOCKQUOTE><TT>$formdata{'user_body'}</TT></BLOCKQUOTE></TD><TD
!! WIDTH=10\% VALIGN=TOP
!! ALIGN=CENTER>$email_icon$homepage_icon</TD></TR></TABLE>\n";
!! $templog = "<TABLE BORDER=0 WIDTH=100\% CELLPADDING=2><TR><TD
!! BGCOLOR=\"\#$formdata{'user_color'}\" COLSPAN=3>$html_tag_font_begin<FONT
!! COLOR=\"\#FFFFFF\"><B>\ \;\ \;$formdata{'user_handle'}</B> from
!! $ENV{'REMOTE_HOST'} \($datestamp\)\,
!! says\:</FONT>$html_tag_font_end</TD></TR><TR><TD WIDTH=10\% VALIGN=TOP
!! ALIGN=CENTER>$url_to_image</TD><TD WIDTH=80\%
!! VALIGN=TOP><BLOCKQUOTE><TT>$formdata{'user_body'}</TT></BLOCKQUOTE></TD><TD
!! WIDTH=10\% VALIGN=TOP
!! ALIGN=CENTER>$email_icon$homepage_icon</TD></TR></TABLE>\n";
!! unshift(@messages, $temparray);
!! splice(@messages, $sys_num_of_posts, 30);
!!
!! if (-e "$path_to_chat_files/$formdata{'user_room'}.room") {
!! open(ROOMOUT, ">$path_to_chat_files/$formdata{'user_room'}.room") ||
!! &printErrorPage($msg_error_file_open);
!! flock(ROOMOUT, 2);
!! print ROOMOUT @messages;
!! flock(ROOMOUT, 8);
!! close(ROOMOUT);
!! } else {
!! if ($sys_create_rooms eq "0") {
!! open(ROOMOUT1, ">$path_to_chat_files/$formdata{'user_room'}.room") ||
!! &printErrorPage($msg_error_file_create);
!! flock(ROOMOUT1, 2);
!! print ROOMOUT1 @messages;
!! flock(ROOMOUT1, 8);
!! close(ROOMOUT1);
!! }
!! }
!! }
!!
!! sub writeRoomLog {
!! if ($sys_log_rooms eq "0") {
!! if (-e "$path_to_chat_files/$formdata{'user_room'}.log") {
!! open(ROOMLOG, ">>$path_to_chat_files/$formdata{'user_room'}.log") ||
!! &exitProgram();
Again, no indication what went wrong if this fails.
!! flock(ROOMLOG, 2);
!! print ROOMLOG $templog;
!! flock(ROOMLOG, 8);
!! close(ROOMLOG);
!! } else {
!! open(ROOMLOG1, ">$path_to_chat_files/$formdata{'user_room'}.log") ||
!! &exitProgram();
!! flock(ROOMLOG1, 2);
!! print ROOMLOG1 $templog;
!! flock(ROOMLOG1, 8);
!! close(ROOMLOG1);
!! }
!! }
!! }
The main reason you don't find bugs is because you keep Perl quiet.
Let Perl talk and you wouldn't have this much problems.
Abigail
--
perl -wlne '}for($.){print' file # Count the number of lines.
-----------== Posted via Newsfeeds.Com, Uncensored Usenet News ==----------
http://www.newsfeeds.com The Largest Usenet Servers in the World!
------== Over 73,000 Newsgroups - Including Dedicated Binaries Servers ==-----
------------------------------
Date: Sun, 04 Jul 1999 00:58:33 GMT
From: posting.account@lynxview.com (William Herrera)
Subject: Re: Implimenting Chat Script...More info
Message-Id: <377eb087.210288873@news.rmi.net>
On Sat, 3 Jul 1999 16:30:42 -0500, "John Curry" <kuzzero@nconnect.net>
wrote:
>As I said earlier, I'm running a Sambar Server with Active State Perl 5.004
>on a Win 98 op system, it generates a blank page with no tracable errors in
>the logs,,, here's the script.
>## Path Preferences
>$path_to_chat_files = "d:\sambar41\docs\chat";
>$path_to_templet_files = "d:\sambar41\docs\chat\templets";
>
>## URLs
>$url_of_referrer = d:\sambar41\docs\chat;
>$url_to_images = d:\sambar41\docs\chat\icons;
>$url_to_script = d:\sambar41\cgi-bin\chat.pl;
When using backslashes in path names. use a double backslash to
prevent errors. This is in the Active Perl docs under idiosyncracies
of the Windows implementation, I think.
In general, unless you will be feeding the pathname directly to the
system via a system() call, you can use regular forward slashes
instead anyway.
I suggest you change all the d:\path\dir names to d:/path/dir names
and try again after reading all of the Active Perl docs.
---
The above from: address is spamblocked. Use wherrera (at) lynxview (dot) com for the reply address.
------------------------------
Date: Mon, 05 Jul 1999 00:05:10 GMT
From: tm022ns@munich.netsurf.de (tom)
Subject: Re: INC not working properly
Message-Id: <377ff6a1.10152046@news.munich.netsurf.de>
On Thu, 01 Jul 1999 16:47:00 GMT, Dorr Lewright
<dlewright@nuworld.com> wrote:
>I am new to Perl, and when I attempt to use the "use" command, I get the
>message "Can't locate strict.pm in @INC (@INC contains: .) at
>D:\NCH\PERL\myscript.plx line 23." I am working on Windows NT 4.0 (I
>came from a Solaris shop to an NT shop).
a) You can use the -I<directory list> perl command line option.
b) You could set the PERL5LIB environment variable.
c) Specify the following in your script: use lib LIST
come to my mind.
e-mail: tm022ns@munich_dot__dont_spam_me_netsurf_dot_de (private)
------------------------------
Date: 3 Jul 1999 09:48:43 -0000
From: Jonathan Stowe <gellyfish@gellyfish.com>
Subject: Re: Inserting @ in a string???
Message-Id: <7lkm9r$2og$1@gellyfish.btinternet.com>
On Wed, 30 Jun 1999 12:45:02 -0400 Dan Gervais wrote:
>
> How can I insert a @ in a string in a perl script???
> if I do it as so:
>
> # print MAIL "sales@multicorpora.ca\n\n;
>
> The script doesn't want to run. Is there a special way of inserting a @???
>
You missed the helpful diagnostic message :
gellyfish@gellyfish:/home/gellyfish > perl -we 'print "jns@gellyfish.com"'
In string, @gellyfish now must be written as \@gellyfish at -e line 1, near "jns@gellyfish"
Execution of -e aborted due to compilation errors.
/J\
--
Jonathan Stowe <jns@gellyfish.com>
Some of your questions answered:
<URL:http://www.btinternet.com/~gellyfish/resources/wwwfaq.htm>
Hastings: <URL:http://www.newhoo.com/Regional/UK/England/East_Sussex/Hastings>
------------------------------
Date: Tue, 06 Jul 1999 00:17:36 +0200
From: Thierry METOUDI <thierry.metoudi@francemel.com>
Subject: installing modules with perl win32
Message-Id: <37812F00.B63C9AD6@francemel.com>
Hello,
it seems to me that installing packages on win32 seems to be a little
bit tricky when not using utilities like PPM.
So once we get the zipped package how do we proceed?
And what about the C compiler: how do we use it to install packages?
Thanks for your answers
------------------------------
Date: Tue, 6 Jul 1999 09:31:57 +1000
From: e-lephant@b-igpond.com (elephant)
Subject: Re: installing modules with perl win32
Message-Id: <MPG.11ebeb77eae1cfcf989aff@news-server>
Thierry METOUDI writes ..
>it seems to me that installing packages on win32 seems to be a little
>bit tricky when not using utilities like PPM.
>
>So once we get the zipped package how do we proceed?
>And what about the C compiler: how do we use it to install packages?
mostly .. it's just
perl Makefile.PL
make
make test
make install
like on UNIX .. if you're using Microsoft's C/C++ packages then
substitute make for nmake
and read the README and INSTALL files both in the root directory of the
package and in any Win32 package .. as well as any README.Win32 or
INSTALL.Win32 files
--
jason - remove all hyphens for email reply -
------------------------------
Date: 5 Jul 1999 04:17:23 GMT
From: Mathias Koerber <mathias@singapura.singnet.com.sg>
Subject: interpolating variables into string read from file
Message-Id: <7lpbkj$tfb$1@coco.singnet.com.sg>
Hi all,
I am trying to interpolate variables into a string read from a file.
The perlfaq4 says:
How can I expand variables in text strings?
Let's assume that you have a string like:
$text = 'this has a $foo in it and a $bar';
If those were both global variables, then this would suffice:
$text =~ s/\$(\w+)/${$1}/g;
But since they are probably lexicals, or at least, they could be, you'd have to do this:
$text =~ s/(\$\w+)/$1/eeg;
die if $@; # needed on /ee, not /e
It's probably better in the general case to treat those variables as entries in some special hash. For example:
%user_defs = (
foo => 23,
bar => 19,
);
$text =~ s/\$(\w+)/$user_defs{$1}/g;
See also ``How do I expand function calls in a string?'' in this section of the FAQ.
The second solutions seems to work, but not if the string contains variable references
using curly braces like ${serial} etc.
I tried modifying it to:
$text =~ s/\b\$[{]?(\w+)[}]?\b/${$1}/eeg;
or even:
$text =~ s/\b(\$[{]?\w+[}]?)\b/$1/eeg;
w/o luck
Is there a better method to doing this, like pasing the whole string to eval?
I tried several things and nothing seems to work.
tia
--
Mathias Koerber | Tel: +65 / 471 9820 | mathias@staff.singnet.com.sg
SingNet NOC | Fax: +65 / 475 3273 | mathias@koerber.org
Q'town Tel. Exch. | PGP: Keyid: 768/25E082BD finger mathias@singnet.com.sg
2 Stirling Rd | 1A 8B FC D4 93 F1 9A FC BD 98 A3 1A 0E 73 01 65
S'pore 148943 | Disclaimer: I speak only for myself
A conclusion is the place where you got tired of thinking
------------------------------
Date: 05 Jul 1999 00:43:57 -0400
From: Uri Guttman <uri@sysarch.com>
Subject: Re: interpolating variables into string read from file
Message-Id: <x7zp1byacy.fsf@home.sysarch.com>
>>>>> "MK" == Mathias Koerber <mathias@singapura.singnet.com.sg> writes:
MK> The second solutions seems to work, but not if the string contains
MK> variable references using curly braces like ${serial} etc.
MK> I tried modifying it to:
MK> $text =~ s/\b\$[{]?(\w+)[}]?\b/${$1}/eeg;
MK> or even:
MK> $text =~ s/\b(\$[{]?\w+[}]?)\b/$1/eeg;
you don't need the [] for a single character. and there is no need for
the \b's as the {} or \w will grab all of the name chars.
this works for me (tested):
$ab = 'qwert' ;
$cde = 'zxcvbn' ;
$_ = 'andn${ab}ks$cde@#' ;
s/(\$(:?{\w+?}|\w+))/$1/gee ;
you can't have both { and } be optional separately or ${abc@# will match
${abc and be wrong. so you have to use alternation.
maybe ilya has some trick up his sleeve that can handle the optional
paired {} but this works with existing perls.
uri
--
Uri Guttman ----------------- SYStems ARCHitecture and Software Engineering
uri@sysarch.com --------------------------- Perl, Internet, UNIX Consulting
Have Perl, Will Travel ----------------------------- http://www.sysarch.com
The Best Search Engine on the Net ------------- http://www.northernlight.com
"F**king Windows 98", said the general in South Park before shooting Bill.
------------------------------
Date: Mon, 5 Jul 1999 15:03:31 +1000
From: e-lephant@b-igpond.com (elephant)
Subject: Re: interpolating variables into string read from file
Message-Id: <MPG.11eae7aa16592660989ae3@news-server>
Mathias Koerber writes ..
>The perlfaq4 says:
>
> How can I expand variables in text strings?
>
> Let's assume that you have a string like:
>
> $text = 'this has a $foo in it and a $bar';
><...>
>Is there a better method to doing this, like pasing the whole string to eval?
>I tried several things and nothing seems to work.
yep .. just gotta wrap $text in '"'s .. so the vars are interpolated by
the eval
#--begin
$result1 = eval( '"' . $text . '"');
# or neater
$result2 = eval( qq("$text"));
#--end
--
jason - remove all hyphens for email reply -
------------------------------
Date: 6 Jul 1999 15:47:02 -0500
From: churchyh@ccwf.cc.utexas.edu (Henry Churchyard)
Subject: Re: Interpreting MS-ASCII - anyone have a filter?
Message-Id: <7ltq06$39q@piglet.cc.utexas.edu>
In article <376f9a38@cs.colorado.edu>,
Tom Christiansen <tchrist@mox.perl.com> wrote:
> http://language.perl.com/misc/demoroniser.html
> #!/bin/perl -0777pw
> # De-moron-ise Illegal Text and HTML from Microsoft Applications
> # Eliminate idiot MS-DOS carriage returns from line terminator.
> s/[\015\012]+/\n/g;
What does that mean? In having \r\n as line-ending sequence, MS-DOS
is arguably more closely following the intentions of the original
ASCII specification, and in fact Internet standards themselves seem to
show that \r\n is the more platform-independent way of doing things --
since in most cases when plain-text messages or commands are passed
around by various protocols (SMTP, NNTP, etc.) it's specified that
text lines will end with \r\n when being sent from one system to
another.
--
Henry Churchyard http://www.crossmyt.com/hc/ || "Is it possible? Can anyone
be so blind to the sordid side of human nature and picnics?"-Charles Willis
------------------------------
Date: 1 Jul 99 21:33:47 GMT (Last modified)
From: Perl-Users-Request@ruby.oce.orst.edu (Perl-Users-Digest Admin)
Subject: Digest Administrivia (Last modified: 1 Jul 99)
Message-Id: <null>
Administrivia:
The Perl-Users Digest is a retransmission of the USENET newsgroup
comp.lang.perl.misc. For subscription or unsubscription requests, send
the single line:
subscribe perl-users
or:
unsubscribe perl-users
to almanac@ruby.oce.orst.edu.
To submit articles to comp.lang.perl.misc (and this Digest), send your
article to perl-users@ruby.oce.orst.edu.
To submit articles to comp.lang.perl.announce, send your article to
clpa@perl.com.
To request back copies (available for a week or so), send your request
to almanac@ruby.oce.orst.edu with the command "send perl-users x.y",
where x is the volume number and y is the issue number.
The Meta-FAQ, an article containing information about the FAQ, is
available by requesting "send perl-users meta-faq". The real FAQ, as it
appeared last in the newsgroup, can be retrieved with the request "send
perl-users FAQ". Due to their sizes, neither the Meta-FAQ nor the FAQ
are included in the digest.
The "mini-FAQ", which is an updated version of the Meta-FAQ, is
available by requesting "send perl-users mini-faq". It appears twice
weekly in the group, but is not distributed in the digest.
For other requests pertaining to the digest, send mail to
perl-users-request@ruby.oce.orst.edu. Do not waste your time or mine
sending perl questions to the -request address, I don't have time to
answer them even if I did know the answer.
------------------------------
End of Perl-Users Digest V9 Issue 32
************************************
