Forum Moderators: coopster & phranque

Message Too Old, No Replies

changing output

script doesn't work

         

specter

12:36 am on Feb 18, 2006 (gmt 0)

WebmasterWorld Senior Member 10+ Year Member



Hi guys,

I'm editing a cgi script but I'm coming across an output problem:

There is a subroutine that generates a form for e-mailing with five text fields;each one oh these fields is generated by a string like:

print "<TR><TD ALIGN=RIGHT><B><FONT $font SIZE=2>your text : </FONT></B></TD><TD><INPUT NAME=description TYPE=text SIZE=35 MAXLENGTH=$maxdescription><BR></TD></TR>\n";

I would increase the height of some of these fields changing the <input tag with the <textarea tag

print "<TR><TD ALIGN=RIGHT><B><FONT $font SIZE=2>your text : </FONT></B></TD><TD><textarea style="overflow:hidden" rows="10" cols="20"></textarea><BR></TD></TR>\n";

but it doesn't work...
Really I'm not a programmer but I see a html string that should work...what am I missing?

Thanks very much for any useful reply

Sincerely

perl_diver

12:59 am on Feb 18, 2006 (gmt 0)

10+ Year Member



what you have is a double-quoted string:

print "...";

notice the double-quotes are used to determine the beginning and end of the string.

In your string you have double-quotes in the string so perl thinks the string ended and code follows after the second double-quote in the string:

print "<TR><TD ALIGN=RIGHT><B><FONT $font SIZE=2>
your text : </FONT></B></TD><TD><textarea style=" <- string ended

now perl thinks the rest of the line is perl code:

overflow:hidden" rows="10" cols="20"></textarea><BR></TD></TR>\n";

and since it isn't, perl throws a syntax error and the script bombs. Now you know the problem. The solution is to use the qq operator with double-quoted strings that have variables in them, like $font:

print qq~<TR><TD ALIGN=RIGHT><B><FONT $font SIZE=2>your text : </FONT></B></TD><TD><textarea style="overflow:hidden" rows="10" cols="20"></textarea><BR></TD></TR>\n~;

perl will handle the escaping of the double-quotes inside a string using the qq operator, or you could do it the old fashioned way and escape all the double-quotes with a back-slash:

print "<TR><TD ALIGN=RIGHT><B><FONT $font SIZE=2>your text : </FONT></B></TD><TD><textarea style=\"overflow:hidden\" rows=\"10\" cols=\"20\"></textarea><BR></TD></TR>\n";

note I used qq~...~;

the ~ is an arbitrary delimiter I p[icked because you rarely use that symbol in strings, but you can use almost anythinbg you want instead:

qq¦...¦;
qq(...);

note if you use matching sets of symbols, like () you have to use the left one and right one:

qq(...);
qq{...};
qq[...];

specter

10:26 am on Feb 18, 2006 (gmt 0)

WebmasterWorld Senior Member 10+ Year Member



Thank you very much!

Your suggestion was very useful:really I simply removed quotes from attribute values and now it runs fine.
But replacing the <input tag with the <textarea tag now originates a bug:
It seems that the new "extended" field is not recognized;
Since there are five text fields in the form and they ALL have to be filled out because mail is accepted,this causes an error message and the submission is not accepted...
Are you able to explain me why,please?

Thanks again

Sincerely

perl_diver

7:56 pm on Feb 18, 2006 (gmt 0)

10+ Year Member



in the html code you posted you have this:

<textarea style="overflow:hidden" rows="10" cols="20"></textarea>

the textarea tag has no name attribute:

<textarea name=comments style="overflow:hidden" rows="10" cols="20"></textarea>

add the name in the tag and add the name to the part of your script processing the form data and hopefully thats all you need.

specter

8:45 pm on Feb 18, 2006 (gmt 0)

WebmasterWorld Senior Member 10+ Year Member



Right!
I missed it!
I'll try and I'll let you know

Thanks again.

specter

11:44 pm on Feb 19, 2006 (gmt 0)

WebmasterWorld Senior Member 10+ Year Member



Ok.Now it runs fine!
But there is another problem for wich I'd like to have again your help:
The script provides an anti-spam filter that prevents to enter in the fields of the form the same information more than once;I would disable this filter but I'm not able to do it;I tried to disable the error subroutines switching them from "1" to "0" but nothing happens...Over that I don't know what to manipulate...
Could you give me a suggestion,please?
If it can be useful for you I could sticky you the whole script that is not very long.

Thanks in advance for any help

Sincerely

perl_diver

12:21 am on Feb 20, 2006 (gmt 0)

10+ Year Member



please just post the script in this thread, removing anything that posting guidelines do not allow like real URLs and real names, etc, replace them with www.example.com or fakename. I prefer not to give individual help, I hope you understand. If you would rather not post the script maybe someone else will have a look at it for you in a sticky.

specter

2:32 am on Feb 20, 2006 (gmt 0)

WebmasterWorld Senior Member 10+ Year Member



No problem.
This is the whole script:

#!/usr/bin/perl

# Get the form variables

if ($ENV{'REQUEST_METHOD'} eq 'GET') {
$buffer = $ENV{'QUERY_STRING'};
}
else {
read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
}

# Break em up into a format the script can read

@pairs = split(/&/, $buffer);
foreach $pair (@pairs) {
($name, $value) = split(/=/, $pair);
$value =~ tr/+/ /;
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
$FORM{$name} = $value;
}

# Get the heading information

unless (open (DATA,"$headfile")) {die (&error);}
if ($uselock eq '1') {
flock DATA, 2;
seek DATA, 0, 0;
}
@headinfo = <DATA>;
if ($uselock eq '1') {
flock DATA, 8;
}
close (DATA);
foreach $headline (@headinfo){
$heading = $heading.$headline;
}

# Get the footer information

unless (open (DATA,"$footfile")) {die (&error);}
if ($uselock eq '1') {
flock DATA, 2;
seek DATA, 0, 0;
}
@footinfo = <DATA>;
if ($uselock eq '1') {
flock DATA, 8;
}
close (DATA);
foreach $footline (@footinfo){
$footer = $footer.$footline;
}

# Get the smut filter information

unless (open (DATA,"$smutfile")) {die (&error);}
if ($uselock eq '1') {
flock DATA, 2;
seek DATA, 0, 0;
}
@smutinfo = <DATA>;
if ($uselock eq '1') {
flock DATA, 8;
}
close (DATA);
foreach $smutline (@smutinfo){
$smutfilter = $smutfilter.$smutline;
@smutwords = split (/::/,$smutfilter);
}

# Determine what part of the script we need

if ($FORM{'action'} eq "showadd") {
&showadd;
}

if ($FORM{'action'} eq "addurl") {
&addurl;
}

if ($FORM{'action'} eq "newurls"){
&newurls;
}

if ($FORM{'action'} eq "randomurl"){
&randomurl;
}

# Assign shorter variable names
# (Laziness on my part - but I find the longer
# a script gets the more work typing long
# variable names becomes.)

$position = $FORM{'code'};
$addshow = 0;
$noshow = 0;
$match = 0;
if ($FORM{'safe'} ne "on") {
$safekey = "off";
} else {
$safekey = "on";
}

# Begin the search process and output the results

unless (open (DATA,"$base")) {die (&error);}
if ($uselock eq '1') {
flock DATA, 2;
seek DATA, 0, 0;
}
@input = <DATA>;
if ($uselock eq '1') {
flock DATA, 8;
}
close (DATA);

# Routine for 'words' search

if ($FORM{'mode'} eq "words") {
$searchstring=$FORM{'keywords'};
@words = split (/ /,$searchstring);
foreach $word (@words) {
$wordlength = length($word);
if ($wordlength < $minword) {
&stringshort;
}
}
&heading;
$entries = @input;
if ($position == 0) {
$currentline = $entries;
} else {
$currentline = $position;
}
$found="0";
print "<CENTER><FONT $font SIZE=3><B>Search Results : </B>'$FORM{'keywords'}'<P></FONT></CENTER>";
print "<HR WIDTH=400>";
print "<FONT $font SIZE=2>";
until ($found > 9 ¦¦ $currentline == 0) {
foreach $word (@words) {
if ($input[$currentline] =~ /$word/i) {
@data = split (/::/,$input[$currentline]);
if ($data[4] ne "") {
if ($safekey eq "on" && $match == 0) {
foreach $smutword (@smutwords) {
if ($input[$currentline] =~ /$smutword/i) {
$smut = 1;
}
}
unless ($smut == 1) {
print "<A HREF=\"$data[0]\"><B>$data[1]</B></A><BR>";
print "$data[4]<BR>";
print "<I>$data[0]</I><P>";
++$found;
++$match;
}
$smut = 0;
}
if ($safekey eq "off" && $match == 0) {
print "<A HREF=\"$data[0]\"><B>$data[1]</B></A><BR>";
print "$data[4]<BR>";
print "<I>$data[0]</I><P>";
++$found;
++$match;
}
}
}
}
--$currentline;
$match = 0;
}
}

# Routine for 'phrases' search

if ($FORM{'mode'} eq "phrases") {
$searchstring=$FORM{'keywords'};
$wordlength = length($FORM{'keywords'});
if ($wordlength < $minword) {
&phrase;
}
&heading;
$entries = @input;
if ($position == 0) {
$currentline=$entries;
} else {
$currentline = $position;
}
print "<CENTER><FONT $font SIZE=3><B>Search Results : </B>'$FORM{'keywords'}'<P></FONT></CENTER>";
print "<HR WIDTH=400>";
print "<FONT $font SIZE=2>";
until ($found > 9 ¦¦ $currentline == 0) {
if ($input[$currentline] =~ /$FORM{'keywords'}/i) {
@data = split (/::/,$input[$currentline]);
if ($data[4] ne "") {
if ($safekey eq "on") {
foreach $smutword (@smutwords) {
if ($input[$currentline] =~ /$smutword/i) {
$smut = 1;
}
}
unless ($smut == 1) {
print "<A HREF=\"$data[0]\"><B>$data[1]</B></A><BR>";
print "$data[4]<BR>";
print "<I>$data[0]</I><P>";
++$found;
}
$smut = 0;
}
if ($safekey eq "off") {
print "<A HREF=\"$data[0]\"><B>$data[1]</B></A><BR>";
print "$data[4]<BR>";
print "<I>$data[0]</I><P>";
++$found;
}
}
}
--$currentline;
}
}
print "</FONT>";
&footer;

################# SUBROUTINES ######################

sub heading {
print "Content-type: text/html\n\n";
print "$heading";
}

sub footer {
$keyencode=$FORM{'keywords'};
$keyencode =~ tr/ /+/;
if ($found > 9) {
$position=$currentline;
print "<CENTER><FONT $font size=3><A HREF=\"$scripturl?keywords=$keyencode&code=$position&mode=$FORM{'mode'}&safe=$safekey \"><B>More Results</B></A><BR><HR WIDTH=400></FONT></CENTER>";
}
else {
unless ($addshow == 1) {
print "<CENTER><FONT $font SIZE=2><B>End of Results.</B><BR><HR WIDTH=400></FONT></CENTER>\n";
}
}
unless ($noshow == 1) {
unless ($addshow == 1) {
print "<CENTER><P><FORM METHOD=post ACTION=$scripturl><TABLE><TR><TD VALIGN=TOP><FONT $font SIZE=3><B>Search For :</B></FONT></TD><TD><INPUT TYPE=TEXT NAME=keywords SIZE=25 VALUE=\"$FORM{'keywords'}\"><BR><FONT $font SIZE=2><B>Mode :</B><INPUT TYPE=\"radio\" NAME=\"mode\" VALUE=\"words\" CHECKED>Words<INPUT TYPE=\"radio\" NAME=\"mode\" VALUE=\"phrases\">Phrase<BR><B>Safe : </B><INPUT TYPE=\"checkbox\" NAME=\"safe\" CHECKED>Omit Offensive Slang</FONT></TD><TD VALIGN=TOP ALIGN=CENTER WIDTH=60><INPUT TYPE=SUBMIT VALUE=\"Search!\"></TD></TR></TABLE></FORM><p></CENTER>\n";
}
if ($FORM{'keywords'} ne "") {
print "<CENTER><FONT $font size=2><B>Search for \"$FORM{'keywords'}\" in these search engines...<br><A HREF=\"http://www.altavista.com/cgi-bin/query?pg=q&what=web&q=$keyencode\">AltaVista</A> <A HREF=\"http://search.dejanews.com/dnquery.xp?query=$keyencode&defaultOp=AND&svcclass=dncurrent&maxhits=20\">DejaNews</A> <A HREF=\"http://search.excite.com/search.gw?search=$keyencode\">Excite</A> <A HREF=\"http://guide-p.infoseek.com/Titles/?qt=$keyencode\">GO Network</A> <A HREF=\"http://www.hotbot.com/?MT=$keyencode&SM=MC&DV=0&LG=any&DC=10&DE=2&_v=2&OPs=MDRTP&Search.x=38&Search.y=15\">HotBot</A> <A HREF=\"http://www.lycos.com/cgi-bin/pursuit?query=$keyencode&maxhits=20\">Lycos</A> <A HREF=\"http://www.webcrawler.com/cgi-bin/WebQuery?searchText=$keyencode&maxHits=20\">WebCrawler</A> <A HREF=\"http://search.yahoo.com/bin/search?p=$keyencode\">Yahoo!</A></B><P></CENTER>\n";
}
}
&generate;
print "$footer";
exit;
}

sub error {
$noshow = 1;
&heading;
print "<CENTER><FONT $font><h2>File Access Error</h2><P><B>You have an error in your PATH configuration variables in the $ENV{'SCRIPT_NAME'} file.</B><P>Your server reports that your BASE path is : $ENV{'DOCUMENT_ROOT'}<BR>Note that this is reported as your BASE path, not the FULL path to your files.<P>If you require help installing this script please consider purchasing the professional version of this script. Your purchase includes full tech support and installation.<P><B>Get it at : <A HREF=http://www.getperl.com/easysearch/>http://www.getperl.com/easysearch/</A></B></FONT></CENTER><P>\n";
&footer;
}

sub stringshort {
$noshow = 1;
print "Content-type: text/html\n\n";
&heading;
print "<CENTER><FONT $font><h2>Word Too Short</h2><P><B>Sorry...each word must be at least $minword characters long.</B></FONT></CENTER><P>\n";
&footer;
}

sub phrase {
$noshow = 1;
print "Content-type: text/html\n\n";
&heading;
print "<CENTER><FONT $font><h2>Phrase Too Short</h2><P><B>Sorry...your phrase must be at least $minword characters long.</B></FONT></CENTER><P>\n";
&footer;
}

sub generate {
print "<HR WIDTH=400>\n";
print "<FONT $font SIZE=2><CENTER><P>Powered by : <A HREF=\"http://www.getperl.com/\"><B>EasySearch</B></A> - Copyright 1999 by Thomas J. Delorme</CENTER></FONT><P>\n";
print "<HR WIDTH=400>\n";
}

sub showadd {
&heading;
$addshow = 1;
print "<CENTER><FONT $font SIZE=3><B>Add URL</B></FONT><HR WIDTH=400>\n";
print "<FONT $font SIZE=2>Please fill out the following information and press the SUBMIT button.<BR>\n";
print "<B>Please note that all fields are required</B>.</FONT><P>\n";
print "<FORM METHOD=post ACTION=$scripturl>\n";
print "<TABLE BORDER=0 CELLPADDING=0 CELLSPACING=5>\n";
print "<TR><TD ALIGN=RIGHT><B><FONT $font SIZE=2>E-mail :</FONT></B></TD><TD><INPUT NAME=email TYPE=text SIZE=35><BR></TD></TR>\n";
print "<TR><TD ALIGN=RIGHT><B><FONT $font SIZE=2>Site Title : </FONT></B></TD><TD><INPUT NAME=title TYPE=text SIZE=35 MAXLENGTH=$maxtitle><BR></TD></TR>\n";
print "<TR><TD ALIGN=RIGHT><B><FONT $font SIZE=2>Url : </FONT></B></TD><TD><INPUT NAME=url TYPE=text SIZE=35 value=http://><BR></TD></TR>\n";
print "<TR><TD ALIGN=RIGHT><B><FONT $font SIZE=2>Description : </FONT></B></TD><TD><INPUT NAME=description TYPE=text SIZE=35 MAXLENGTH=$maxdescription><BR></TD></TR>\n";
print "<TR><TD VALIGN=TOP ALIGN=RIGHT><FONT $font SIZE=2><B>Keywords : </B><BR><I>(Commas, no spaces)</I></FONT></TD><TD VALIGN=TOP><INPUT NAME=keywords TYPE=text SIZE=35 MAXLENGTH=$maxkeywords><BR></TD></TR>\n";
print "</TABLE>\n";
print "<INPUT TYPE=checkbox NAME=send CHECKED><FONT $font SIZE=2> I would like to receive occassional news from $sitetitle.</FONT><P>\n";
print "<INPUT TYPE=hidden NAME=action VALUE=addurl>\n";
print "<INPUT TYPE=submit VALUE=Submit> <INPUT TYPE=reset VALUE=Clear></FORM></CENTER>\n";
&footer;
}

sub addurl {
&heading;
$noshow = 1;
unless ($FORM{'url'} =~ /http:\/\//) {
&submiterror;
}

if ($FORM{'url'} eq "" ¦¦ $FORM{'title'} eq "" ¦¦ $FORM{'email'} eq "" ¦¦ $FORM{'description'} eq "" ¦¦ $FORM{'keywords'} eq "") {
&empty;
}

unless (open (DATA,"$base")) {die (&error);}
if ($uselock eq '1') {
flock DATA, 2;
seek DATA, 0, 0;
}
@input = <DATA>;
if ($uselock eq '1') {
flock DATA, 8;
}
close (DATA);
$entries = @input;

$urlsearch = "$FORM{'url'}"."::";
$urltemp = $FORM{'url'};
chomp($urltemp);
chop($urltemp);
$urlsearchtwo = "$urltemp"."::";
$urlsearchthree = "$FORM{'url'}"."/::";
$currentline = 0;
until ($currentline == $entries) {
if ($input[$currentline] =~ /$urlsearch/i) {
&exists;
}
if ($input[$currentline] =~ /$urlsearchtwo/i) {
&exists;
}
if ($input[$currentline] =~ /$urlsearchthree/i) {
&exists;
}
++$currentline;
}

$testline = $input[$currentline-1];
$testline2 = $input[$currentline-2];
$testline3 = $input[$currentline-3];
$testline4 = $input[$currentline-4];
$testline5 = $input[$currentline-5];
$testline6 = $input[$currentline-6];
$testline7 = $input[$currentline-7];
$testline8 = $input[$currentline-8];
$testline9 = $input[$currentline-9];
$testline10 = $input[$currentline-10];

if ($testline =~ /$FORM{'description'}/) {
&samestuff;
}

if ($testline =~ /$FORM{'title'}/) {
&samestuff;
}

if ($testline =~ /$FORM{'keywords'}/) {
&samestuff;
}

if ($testline =~ /$FORM{'email'}/i ¦¦ $testline2 =~ /$FORM{'email'}/i ¦¦ $testline3 =~ /$FORM{'email'}/i ¦¦ $testline4 =~ /$FORM{'email'}/i ¦¦ $testline5 =~ /$FORM{'email'}/i ¦¦ $testline6 =~ /$FORM{'email'}/i ¦¦ $testline7 =~ /$FORM{'email'}/i ¦¦ $testline8 =~ /$FORM{'email'}/i ¦¦ $testline9 =~ /$FORM{'email'}/i ¦¦ $testline10 =~ /$FORM{'email'}/i) {
&justsubmitted;
}

$newemail = $FORM{'email'};
if ($FORM{'send'} ne "on") {
$newemail = "X"."$newemail"."X";
}
$newtitle = substr($FORM{'title'},0,$maxtitle);
$newdesc = substr($FORM{'description'},0,$maxdescription);
$newkeywords = substr($FORM{'keywords'},0,$maxkeywords);
$line = join ("::","$FORM{'url'}","$newtitle","$newkeywords","$newemail","$newdesc");

unless (open (DATA,">>$base")) {die (&error);}
if ($uselock eq '1') {
flock DATA, 2;
seek DATA, 0, 2;
}
print DATA "$line\n";
if ($uselock eq '1') {
flock DATA, 8;
}
close (DATA);

print "<center><HR WIDTH=400><FONT $font SIZE=3><b>Submission Received</b></font><p>\n";
print "<FONT $font SIZE=2><B>The following submission has been received by $sitetitle :</B></font><br>\n";
print "<table width=400><tr><td align=right><FONT $font SIZE=2><B>URL :</B></font></td>\n";
print "<td><a href=\"$FORM{'url'}\"><FONT $font SIZE=2><b>$FORM{'url'}</b></font></a></td></tr>\n";
print "<tr><td align=right><FONT $font SIZE=2><B>Title :</B></font></td><td><FONT $font SIZE=2> $FORM{'title'}</td></tr>\n";
print "<tr><td align=right><FONT $font SIZE=2><B>Keywords :</B></font></td><td><FONT $font SIZE=2> $FORM{'keywords'}</td></tr>\n";
print "<tr><td align=right><FONT $font SIZE=2><B>Description :</B></font></td><td><FONT $font SIZE=2> $FORM{'description'}</td></tr>\n";
print "<tr><td align=right><FONT $font SIZE=2><B>E-mail :</B></font></td><td><FONT $font SIZE=2> $FORM{'email'}</font></td></tr></table></center><p>\n";

if ($userespond eq '1') {
unless (open (DATA,"$respondfile")) {die (&error);}
if ($uselock eq '1') {
flock DATA, 2;
seek DATA, 0, 0;
}
@respondinfo = <DATA>;
if ($uselock eq '1') {
flock DATA, 8;
}
close (DATA);
foreach $respondline (@respondinfo){
$respondmessage = $respondmessage.$respondline;
}

open (MAIL, "¦$mailprogram -t");
print MAIL "To: $FORM{'email'}\n";
print MAIL "From: $searchemail\n";
print MAIL "Subject: Got it!\n\n";
print MAIL "Welcome to $sitetitle!\n";
print MAIL "We are located at $searchurl\n\n";
print MAIL "YOUR SUBMISSION:\n";
print MAIL "------------------------------------------------------------------\n";
print MAIL "URL : $FORM{'url'}\n";
print MAIL "Title : $FORM{'title'}\n";
print MAIL "Description : $FORM{'description'}\n";
print MAIL "Keywords : $FORM{'keywords'}\n";
print MAIL "E-mail : $FORM{'email'}\n";
print MAIL "------------------------------------------------------------------\n\n";
print MAIL "$respondmessage";
print MAIL "------------------------------------------------------------------\n\n";
print MAIL "Thanks again,\n";
print MAIL "---------------------------------------------\n";
print MAIL "$sitetitle\n";
print MAIL "$searchemail\n";
print MAIL "$searchurl\n";
print MAIL "---------------------------------------------\n";
print MAIL "Powered by :\n";
print MAIL "EasySearch - Copyright 1999\n";
print MAIL "http://www.getperl.com\n";
print MAIL "---------------------------------------------\n";
close (MAIL);
}
&footer;
}

sub exists {
$noshow = 1;
print "<CENTER><FONT $font SIZE=2><h2>URL Already Exists</h2><BR>$FORM{'url'}<HR WIDTH=400><B>Sorry...Each URL is only allowed one entry.</B><P>\n";
&footer;
}

sub samestuff {
$noshow = 1;
print "<CENTER><FONT $font SIZE=2><h2>Recent URL Submission</h2><HR WIDTH=400><TABLE WIDTH=400><TR><TD><B>You have recently submitted an URL with either the exact same title, description, or keywords. Since this is a different URL, please change your title, description and keywords to match this new page.</B></TD></TR></TABLE><P>\n";
&footer;
}

sub justsubmitted {
$noshow = 1;
print "<CENTER><FONT $font SIZE=2><h2>Recent URL Submission</h2><HR WIDTH=400><B>In order to avoid domain name overflow on the Newest URLs page,<BR> we ask that you try your submission again later.</B><P>\n";
&footer;
}

sub empty {
$noshow = 1;
print "<CENTER><FONT $font SIZE=2><h2>Field Empty</h2><HR WIDTH=400><B>Please make sure that you have filled in all fields on the form.</B><P>\n";
&footer;
}

sub submiterror {
$noshow = 1;
print "<CENTER><FONT $font SIZE=2><h2>Invalid URL</h2><HR WIDTH=400><B>Please make sure that your URL contains <B>http://</B> and is correct.</B><P>\n";
&footer;
}

sub newurls {
&heading;
unless (open (DATA,"$base")) {die (&error);}
if ($uselock eq '1') {
flock DATA, 2;
seek DATA, 0, 0;
}
@input = <DATA>;
if ($uselock eq '1') {
flock DATA, 8;
}
close (DATA);
$entries = @input;
print "<FONT $font SIZE=3><CENTER><B>Newest URLs : </B><HR WIDTH=400></CENTER></FONT>";
$currentline = $entries;
print "<FONT $font SIZE=2>";
$count = 0;
until ($count == $numnew) {
@data = split (/::/,$input[$currentline]);
if ($data[4] ne "") {
foreach $smutword (@smutwords) {
if ($input[$currentline] =~ /$smutword/i) {
$smut = 1;
}
}
unless ($smut == 1) {
print ("<a href=\"$data[0]\"><B>$data[1]</B></a><br>");
print ("$data[4]<br>");
print ("<I>$data[0]</I><P>");
++$count;
}
$smut = 0;
}
--$currentline;
}
print "</FONT>";
&footer;
}

sub randomurl {
&heading;
unless (open (DATA,"$base")) {die (&error);}
if ($uselock eq '1') {
flock DATA, 2;
seek DATA, 0, 0;
}
@input = <DATA>;
if ($uselock eq '1') {
flock DATA, 8;
}
close (DATA);
$entries = @input;
print "<FONT $font SIZE=3><CENTER><B>Random URL : </B><HR WIDTH=400></CENTER></FONT>";
$count=0;
while ($count!= 1) {
srand (time + $$);
$currentline = int( rand ($entries));
print "<FONT $font SIZE=2>";
@data = split (/::/,$input[$currentline]);
foreach $smutword (@smutwords) {
if ($input[$currentline] =~ /$smutword/i) {
$smut = 1;
}
}
unless ($smut == 1) {
if ($data[4] ne "") {
print "<A HREF=\"$data[0]\"><B>$data[1]</B></A><BR>";
print "$data[4]<BR>";
print "<I>$data[0]</I></FONT><P>";
$count=1;
}
}
$smut = 0;
}
&footer;
}

again thanks

perl_diver

2:54 am on Feb 20, 2006 (gmt 0)

10+ Year Member



well, I am not sure what the anti-spam filtering is after looking at the script, but if it's stuff like this:

if ($testline =~ /$FORM{'description'}/) {
&samestuff;
}

just comment them out:

#if ($testline =~ /$FORM{'description'}/) {
#&samestuff;
#}

specter

4:59 am on Feb 20, 2006 (gmt 0)

WebmasterWorld Senior Member 10+ Year Member



Bingo!
They were correct.
Really I came across a last problem with the url field,but following your suggestion I easily individuated the part of the script to comment out (variable &exists ):

$urlsearch = "$FORM{'url'}"."::";
$urltemp = $FORM{'url'};
chomp($urltemp);
chop($urltemp);
$urlsearchtwo = "$urltemp"."::";
$urlsearchthree = "$FORM{'url'}"."/::";
$currentline = 0;
until ($currentline == $entries) {
if ($input[$currentline] =~ /$urlsearch/i) {
&exists;
}
if ($input[$currentline] =~ /$urlsearchtwo/i) {
&exists;
}
if ($input[$currentline] =~ /$urlsearchthree/i) {
&exists;
}

++$currentline;
}

Now the script runs fine and exactly as I want!

I'm very grateful to you for your precious and fundamental help.
Thanks very much!

I see you on this forum!

Sincerely

perl_diver

6:45 am on Feb 20, 2006 (gmt 0)

10+ Year Member



you're welcome mate :)