webForumDet fria alternativet

Felsökning

9 svar · 236 visningar · startad av stevenet

stevenetMedlem sedan juni 20001 251 inlägg
#1

Jag har försökt få BoltSearch att använda sig av MySQL i stället för textfiler. Vad gick snett?

r Vad är fel på skriptet? ;)

#!/usr/bin/perl
use DBI;

my $username = 'localhost';
my $password = 'nisse';
my $database = 'nisse';
my $dbh = DBI->connect( "DBI:mysql:$database", $username, $password )  or die( "Couldn't connect to database: " . DBI->errstr );
$cgipath = "./srchen.cgi";

# Default timeout second(s) (in 180 seconds).
$timedef = "5";
$flockchk = 1;
$cacdtaf = "./cache";
$coudtaf = "./count";

# Directory for module files.
$comftaf = "./mods";

# Directory for module list files.
$comltaf = "./modlist";

# how many run child processes per one time
$child = 4;

# How many display source-search engines' status in a line?
$ssline = 4;

#################### form parsing
if( $ENV{'REQUEST_METHOD'} eq "GET" ) {
$buffer = $ENV{'QUERY_STRING'}	;
} else {
read( STDIN, $buffer, $ENV{'CONTENT_LENGTH'})	;
}
@pairs = split(/&/, $buffer );
foreach $pair( @pairs ) {
($name, $value )=split( /=/, $pair );
$nvalue = $value;
$value =~ tr/+/ /;
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg	;
$FORM{$name} = $value	;
$FORM2{$name} = $nvalue;
}
####
$modlistf = $FORM{'modlist'};
$typ = $FORM{'typ'};
if(!$typ) {
$typ="webb";
}
####

if ($$FORM{'timeout'}) {
$TIMEOUT = $FORM{'timeout'};
}
if (!$TIMEOUT || $TIMEOUT > 180) {
$TIMEOUT = 4;
}
else {}
###########################
$formxyy = $FORM{'q'};

@qxvy = split(/ /, $formxyy);

$nambazero = 0;
$nambahana = 0;
$gltong = "";
foreach $nambaz(@qxvy) {
if ($nambaz) {
$nambazero++;
$gltong .= "$nambaz";
$nambahana2 = length($nambaz);
if ($nambahana2 > 50) {
$nambahana = 1;
}
}
else {}
}
chop($gltong);

$gltong2 = length($gltong);
######### Buffer Cleaner.
$| = 1;

#################### if not user doesn't puts keyword(s) or don't exists modules' list file name, print error message & search form.
if(!$modlistf || !-e "$comltaf/$modlistf") {
sub encode {
my $char = $_[0];
my $bar;
return sprintf "%%%X", ord($char);
}
########
# Moden exister ej
########
opendir(mox, "$comltaf");
@modlix = readdir(mox);
closedir(mox);

@modlix = sort {$a cmp $b} @modlix;

foreach $modxa (@modlix) {

if ($modxa ne "." && $modxa ne "..") {
$modxa2 = $modxa;
$modxa2 =~ s/([^.\w\-_])/&encode($1)/ge;
$modxa2 =~ s/%20/+/g;
# Välj mod
}

else {}

}
########
exit;
}
#################### if not user doesn't puts keyword(s), print error message & search form.
elsif(!$FORM{'q'} || $nambahana || $nambazero > 16) {
########
######## Skriv in det du vill sök på
exit;
}
else {
######## Söker

}

############## Open the Module-List file

open (xxvr, "$comltaf/$modlistf");
@modxx = <xxvr>;
close (xxvr);

$modxx2 = @modxx;

############## Get data files by FORK-Multiple-Processes.

$ifor = 0;

$child2v = 0;

foreach $modxxr (@modxx) {

$child2v++;

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

##########

unless ( fork ) {

########## definition of Socket.
use IO::Socket;

############# definition of Alarm(Timeout Function).

$sig{ALRM} = sub { exit (0); };

alarm ($TIMEOUT);

$modxxr =~ s/\n//s;

if (-e "$comftaf/$modxxr") {

require "$comftaf/$modxxr";

}

else {

exit (0);

}

if ($senam && $url && $parse) {
}

else {

exit (0);

}

#######

open (modka, "$comftaf/$modxxr");

@moduka = <modka>;

close (modka);

$moduka2 = "";

foreach $moduka3 (@moduka) {
$moduka2 .= $moduka3;
}

if (!$sprotocol) {
$sprotocol = "tcp";
}

if (!$speerport) {
$speerport = "80";
}

if (!$sreuse) {
$sreuse = "1";
}

if (!$shtmlsta) {
$shtmlsta = "<html.*?>";
}

if (!$shtmlend) {
$shtmlend = "</html>";
}

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

$url1 = "$url";
$url1 =~ s/http:\/\///s;
@urlnfile1 = split (/\//, $url1);
$filex1 = $url1;
$filex1 =~ s/$urlnfile1[0]\///s;
$server1 = "$urlnfile1[0]";
$document1 = "$filex1";
###
$EOL = "\015\012";
$BLANK = $EOL x 2;
###
$remote1 = IO::Socket::INET->new(Proto=>"$sprotocol", PeerAddr=>$server1, PeerPort=>"$speerport", Reuse => $sreuse,);
$remote1->autoflush(1);
###
if ($rfullurl eq "yes") {
print $remote1 "GET $url HTTP/1.0" . $BLANK;
}
else {
print $remote1 "GET /$document1 HTTP/1.0" . $BLANK;
}
###
$sw2x = 0;
while ($input1 = <$remote1> ) {

if ($input1 =~ /$shtmlsta/i) {
$sw1 = 1;
}
if ($input1 =~ /$shtmlend/i) {

$result .= $input1;

$sw1 = "";

close $remote1;

$sw2x = 1;

close (md1);

}
if ($sw1) {

$result .= $input1;

}
}

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

if (!$sw2x) {

close $remote1;

}

$numb = 0;

@datavo = ();

if (!$numstart) {
$numstart = 1;
}
else {
if ($numstart > 1) {
$numstart = 1;
}
}

#

if ($casese eq "yes") {

while ($result =~ m#$parse#sog) {

$v1 = "$1";
$v2 = "$2";
$v3 = "$3";

#

$numb++;
$numstart2 = $numstart -1;
$numb2 = $numstart2 + $numb;

#

if ($moduka2 =~ /sub fintou/i) {
&fintou;
}
else {}

#

if ($v1 && $v1 !~ /</ && $v1 !~ />/ && $v1 !~ /\&#0124;\&#0124;\&#0124;/) {

####

$v2 =~ s/\r//g;
$v2 =~ s/\t//g;
$v2 =~ s/\n//g;
$v2 =~ s/^ //g;
$v2 =~ s/ $//g;
$v2 =~ s/\&#0124;/ /g;
$v2 =~ s/&.*?;/ /g;
$v2 =~ s/<.*?>//g;
$v2 =~ s/>//g;
$v2 =~ s/<//g;
$v2 =~ s/#/ /g;
$v2 =~ s/\.\.\./ /g;
@dyaa = split(/ /, $v2);
$outdata = "";
foreach $dyaa2 (@dyaa) {
$dyaa3 = length($dyaa2);
if ($dyaa3 >= 1) {
$outdata .= "$dyaa2 ";
}
else {}
}
chop($outdata);
$v2 = $outdata;

#######

$v3 =~ s/\r//g;
$v3 =~ s/\t//g;
$v3 =~ s/\n//g;
$v3 =~ s/^ //g;
$v3 =~ s/ $//g;
$v3 =~ s/\&#0124;/ /g;
$v3 =~ s/&.*?;/ /g;
$v3 =~ s/<.*?>//g;
$v3 =~ s/>//g;
$v3 =~ s/<//g;
$v3 =~ s/#/ /g;
$v3 =~ s/\.\.\./ /g;
@dyaa = split(/ /, $v3);
$outdata = "";
foreach $dyaa2 (@dyaa) {
$dyaa3 = length($dyaa2);
if ($dyaa3 >= 1) {
$outdata .= "$dyaa2 ";
}
else {}
}
chop($outdata);
$v3 = $outdata;

#######
$query = qq~SELECT * FROM s_webb WHERE sokord='$q' AND typ='$typ' AND url='$v1'~;
my $finns = $dbh->do($query);

if ($finns==0) {
$query = qq~INSERT INTO s_webb(id, sokord, typ, url, namn, beskrivning, soktjanst, traffar) VALUES('', '$q', '$typ', '$v1', '$v2', '$v3', '$senam', '$numb2')~;
$r = $dbh->do($query);
}
else {
my $sth = $dbh->prepare("SELECT soktjanst FROM s_webb WHERE sokord='$q' AND typ='$typ' AND url='$v1'"); 
$row = $sth->fetchrow_arrayref;
$query = qq~UPDATE s_webb SET soktjanst='$row->[0], $senam',traffar='traffar+$numb2' WHERE url='$v1' AND sokord='$q')~;
$r = $dbh->do($query);
}
#######

}

else {}

}

}

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

else {

while ($result =~ m#$parse#sogi) {

$v1 = "$1";
$v2 = "$2";
$v3 = "$3";

#

$numb++;
$numstart2 = $numstart -1;
$numb2 = $numstart2 + $numb;

#

if ($moduka2 =~ /sub fintou/i) {
&fintou;
}
else {}

#

}

}

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

exit (0);

}

$ifor++;

if ($child2v >= $child &#0124;&#0124; $ifor >= $modxx2) {
$child2v = 0;
1 while( wait > 0 );
}

else {}

$dbh->disconnect;
exit;
}

------------------
SteveNet
------------------
- Det var motgräs!
Roland Sandberg förklarar varför han missade öppet mål.

[Redigerat av stevenet den 07 nov 2001]

Peter_BMedlem sedan apr. 2000642 inlägg
#2

du kan ju börja med att prova att dela upp problemet i mindre delproblem som du kan testa var för sig. jag orkar inte testa ett så stort script på en gång ;)

------------------
PeterSign v 2.3.36

stevenetMedlem sedan juni 20001 251 inlägg
#3

Får inte igång mitt felsökningsskript heller. :(

------------------
SteveNet
------------------
- Det var motgräs!
Roland Sandberg förklarar varför han missade öppet mål.

HansenMedlem sedan aug. 2000374 inlägg
#4

#!/usr/bin/perl -w
use strict;

Börja koda rätt så kommer det bli lättare att felsöka.

------------------
Hansen
c.h@ngmedia.com

stevenetMedlem sedan juni 20001 251 inlägg
#5

På vilket sätt?
När jag kör skriptet skrivs Internal Server Error ut. Skriptet har de rättigheterna 755.

------------------
SteveNet
------------------
- Det var motgräs!
Roland Sandberg förklarar varför han missade öppet mål.

spangoMedlem sedan juni 20008 205 inlägg
#6

Internal Server Error brukar bero på syntaxfel eller något knas med sökvägen. Prova att köra från kommandoraden?

------------------
You can be a coward for a few minutes, or dead forever. /Rincewind

stevenetMedlem sedan juni 20001 251 inlägg
#7

Nej, kan inte. Sökvägen är rätt.

------------------
SteveNet
------------------
- Det var motgräs!
Roland Sandberg förklarar varför han missade öppet mål.

stevenetMedlem sedan juni 20001 251 inlägg
#8

Sammanfattning:
Skriptet fungerar inte och jag kan inte felsöka.

------------------
SteveNet
------------------
- Det var motgräs!
Roland Sandberg förklarar varför han missade öppet mål.

stevenetMedlem sedan juni 20001 251 inlägg
#9

Har prövat att påbörja skriptet med

#!/usr/bin/perl -w
use strict;

men det hjälper inte. Samma felmeddelande. Hjälp!

------------------
SteveNet
------------------
- Det var motgräs!
Roland Sandberg förklarar varför han missade öppet mål.

stevenetMedlem sedan juni 20001 251 inlägg
#10

Jojoxx tips i http://cgi.webforum.nu/wf/Forum14/HTML/000508.html fungerade utmärkt.

------------------
SteveNet
------------------
- Det var motgräs!
Roland Sandberg förklarar varför han missade öppet mål.

136 ms totalt · 3 externa anrop · v20260731065814-full.0e50b1ef
0 ms — hämta forumlista (cache)
0 ms — hämta statistik (cache)
134 ms — hämta tråd, inlägg och bilagor (db)