God help me !

Who knows why this script causes internal server error ?
It's driving me crazy, script is actually copy of script that works fine
I reduced script to smallest size for error debugging. It should just find match in flat file database and print it.

<BLOCKQUOTE><font size="1" face="Verdana,Arial,Helvetica">code:</font><HR><pre>
#!/usr/bin/perl

$datafile = 'update.txt';
$oldurl = 'upitnik.com';

###
open(DATA, $datafile) or dienice ("Can't open for reading:$!");
@filelist=<DATA>;
close(DATA);

open(DATA, ">$datafile") or dienice ("Can't open for overwriting:$!");
flock(DATA,2);
foreach $value (@filelist) {

if ("$oldurl" eq "$value") {
print "Content-type: text/html nn";
print "Match found in this line $value";
# print DATA "$newurln";
}
}
close(DATA);

###########

sub dienice {
my($msg) = @_;
print "<h2>Error:</h2>n";
print $msg;
exit;
}

[/code]



[This message has been edited by Pepe (edited June 07, 2000).]

Please show an example of your update.txt.

I will then rewrite your script.

>>Who knows why this script causes internal server error ?
500 error is no big deal. I experienced it million times. That's how you should learn from those errors to improve.

syntax is right in this script.


open(DATA, ">$datafile") or dienice ("Can't open for overwriting:$!");
flock(DATA,2);
foreach $value (@filelist) {
if ("$oldurl" eq "$value") { print "Content-type: text/html nn";
print "Match found in this line $value";
}

# print DATA "$newurln";
}
close(DATA);


But one thing i noticed here is that,you have commented one line.

# print DATA "$newurln";

you opened your flatfile in write mode .but you are not writing any thing to the flatfile.i think that is the reason why it is showing error.

just remove that comment.

print DATA "$newurln";



------------------
SR -
shiju.dreamcenter.net

"The fear of the LORD is the beginning of knowledge..."



[This message has been edited by Shiju Rajan (edited June 07, 2000).]

There is no difference if I uncomment that line. I also noticed that update.txt appears empty after script executed with error.
Here is update.txt:

http://upitnik.com/update.txt




[This message has been edited by Pepe (edited June 08, 2000).]

I also noticed that update.txt appears empty after script executed with error.
update text looks like:


Pepe,
when you execute this program .you are writing $newurl to the database.right now $newurl is nothing .so it will erase all the existing record(your database is in overwrite mode).

this program you will have to re-write.



if ("$oldurl" eq "$value") {
print "Content-type: text/html nn";


print "Match found in this line $value";

print DATA "$newurln"; }

This line not going to work bcoz you are not spliting the $value.

it should be:


foreach $value (@filelist) {
($url)=split(/::/,$value);

if ($oldurl=~ /$url/) {
print "Match found in this line $value";
print DATA "newurl.comn";
}

}

Also put header in the top of the script.

print "Content-type: text/html nn";

open(DATA, $datafile) or dienice ("Can't open for reading:$!");
@filelist=<DATA>;close(DATA);

..........
..........
I am not sure what you are trying to do with this script..

------------------
SR -
shiju.dreamcenter.net

"The fear of the LORD is the beginning of knowledge..."

[This message has been edited by Shiju Rajan (edited June 07, 2000).]

I do not know exactly what tasks you wanted to do, here is the example anyway.

1) A member trying to add new record by himself.
############################################
#!/usr/bin/perl

$datafile = "update.txt";
&parse_form;

local($check_record) = 0;
open(DATA, "$datafile") or die &error ("Can't open for reading:$!");
@filelist=<DATA>;
close(DATA);
foreach $value (@filelist) {
chomp($value);
($oldurl,$title,$description,$keyword,$email,$password) = split(/::/,$value);
if ($oldurl eq "FORM{'newurl'}") {
$check_record = 1;
last;
}
}
if ($check_record == "1") {
&duplicate;
}
else {
&add_record;
}

sub duplicate {
print "Content-type: text/html nn";
print "Record exists: FORM{'newurl'}n";
print "No duplicate allowed!n";
exit(0);
}

sub add_record {
open(ADD, ">>$datafile") or die &error ("Can't open for reading:$!");
flock (ADD, 2);
print ADD "$FORM{'newurl'}::$FORM{'title'}::$FORM{'description'}::$FORM{'keyword'}::$FORM{'email'}::$FORM{'pass word'}n";
close(ADD);
print "Content-type: text/html nn";
print "Record added!n";
exit(0);
}
sub parse_form {
read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
@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;
$value =~ s/<!--(.|n)*-->//g;
$value =~ s/<([^>]|n)*>//g;
$value =~ s/^s+//;
$value =~ s/s+$//;
$FORM{$name} = $value;
}
}



[This message has been edited by freebsd (edited June 08, 2000).]

Thanks freebsd, I really appreciate it.
My previous posts weren't very clear, so I'll try to explain what I want:
I already have script that runs simple search engine for local web pages.
It can add new entry, display search results... and it works fine.

Only thing I want, is to add function that users can submit theirs URL even
if URL already exist in database, and when they do submit URL it should overwrite
existing one (with new description, keywords, password,,,) if password matches. (duplicate URLs are allowed).

----------------------------------------------------

I use to do that by reading entire database in to string, substituting data, and then I would write entire script to file.
That requires double disc space and it is slow.

I have seen script that opens database for overwriting, and in foreach loop it search for match between old and new URL. If match is found script seeks to saved position and overwrites that line with new line in which description, keywords... are different. And then after foreach loop (when all lines are checked for match) database is closed.
But I can't make that script work for me.


[This message has been edited by Pepe (edited June 08, 2000).]

So each URL in $datafile is unique? If it's found, overwrite the existing one, else, add it as a new record?
If it's not unique, the newurl doesn't know which oldurl (if more than one) to replace.

For the url match, do you want to make case-insensitive? are the URLs always without path like: upitnik.com/dir/ and all of them do not have "http://www"?

Example:
Will subdomain.upitnik.com match upitnik.com or it has to be exact match with case-insensitive?

Every URL in $datafile is unique.
Every URL starts with http://
They should be case sensitive.

Example:
It should be exact match, and case sensitive because URLs are.
new URL: URL=http://upitnik.com/ should replace: URL=http://upitnik.com only
but not: URL=http://www.upitnik.com http://shop.upitnik.com http://upitnik.com/chat.html

If match is not found it should add URL.

[This message has been edited by Pepe (edited June 09, 2000).]

#Form page
<html>
<body>
<form method=POST action="addurl.pl">
URL: <input type=text name="newurl"><br>
Title: <input type=text name="title"><br>
Description: <input type=text name="description"><br>
Keyword: <input type=text name="keyword"><br>
Email: <input type=text name="email"><br>
Password: <input type=text name="password"><br>
<input type=submit value=Submit>
</form>
</body>
</html>

#addurl.pl
#!/usr/local/bin/perl

$datafile = "update.txt";
&parse_form;
print "Content-type: text/htmlnn";

if ($FORM{'newurl'} eq "") {
&error("url field is required!");
}
else {
open(DATA, "$datafile") or die &error ("Can't open for reading:$!");
@filelist = <DATA>;
close (DATA);
$count =0;
foreach $line (@filelist) {
($oldurl,$title,$description,$keyword,$email,$password) = split(/::/,$line);
if ($oldurl eq "$FORM{'newurl'}") {
print "URL found, replacing old URL with $FORM{'newurl'}<br>n";
$oldurl = $1;
last;
}
else {$count++};
}
splice (@filelist, $count, 1);
open(DATA, ">$datafile") or die &error ("Can't open for overwriting:$!");
foreach $line (@filelist) {
print DATA $line;
}
close(DATA);
if ($count != "1") {
&add_new;
}
}

sub add_new {
open(ADD, ">>$datafile") or die &error ("Can't open for reading:$!");
flock (ADD, 2);
print ADD "$FORM{'newurl'}::$FORM{'title'}::$FORM{'description'}::$FORM{'keyword'}::$FORM{'email'}::$FORM{'pass word'}n";
close(ADD);
print "Record added!n";
exit(0);
}

sub parse_form {
read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
@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;
$value =~ s/<!--(.|n)*-->//g;
$value =~ s/<([^>]|n)*>//g;
$value =~ s/^s+//;
$value =~ s/s+$//;
$FORM{$name} = $value;
}
}

sub error {
$error = $_[0];
print "$errorn";
exit(0);
}