Thread Script hängt sich auf: Warum nur? (20 answers)
Opened by pktm at 2003-09-26 01:41

pktm
 2003-09-26 16:51
#4715 #4715
User since
2003-08-07
2921 Artikel
BenutzerIn
[Homepage]
user image
Also ok, hier das Script:
Code: (dl )
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
#!c:/usr/bin/perl -w
# ---------------------------------------------------
# MODULE
# ---------------------------------------------------
use strict;
use warnings;
use diagnostics;
use CGI qw/:standard/;
use CGI::Carp qw/fatalsToBrowser warningsToBrowser/;
$CGI::POST_MAX=1024 * 100; # max 100K posts
$CGI::DISABLE_UPLOADS = 1; # no uploads
use Data::Dumper;
use vars;
# ---------------------------------------------------
# KONSTANTEN
# ---------------------------------------------------
use constant UNIX => 0; # Unix y/n
# ---------------------------------------------------
# VARIABLEN
# ---------------------------------------------------
$| = 1;
my $cgi = CGI->new();
my $query = $cgi->Vars; #extract parameters
my $index_file = 'c:/apache/cgi-bin/gcp/txt/index.txt'; # nr. | key | pfad
my $index = 'c:/apache/cgi-bin/gcp/html/index.html';
my $domain = '127.0.0.1';
# ---- TEMPLATE
my $tmplDir = 'c:/apache/cgi-bin/gcp/html'; # Verzeichnis mit Templates
my %subs = (); # global hash for &substitute substitute_key => value
# ---- SETTINGS
$subs{relative_url} = $cgi->url(-relative=>1);
$subs{full_url} = $cgi->url(-full=>1);
$subs{self} = $cgi->url(-relative=>1) . '?action=';
# ---------------------------------------------------
# LOGIK
# ---------------------------------------------------
print $cgi->header(-charset=>'ISO-8859-1',
-expires=>'+1s',
-type=>'text/html',
);
warningsToBrowser(1);
if($query->{action}){
&zeigeSeite($query->{action});
}else{
&zeigeSeite('index');
}
exit( 0 );
# ---------------------------------------------------
# SUBS
# ---------------------------------------------------
sub zeigeSeite{
my $key = $_[0]; #Schlüsselwort für Aufzurufende Seite in /txt/index.txt
my $pfad = 0;
my @index = extractFile( $index_file );
# print;
foreach (@index){
chomp $_;
if($_ =~ m/$key/ig){
$pfad = (split /\t/,$_)[2];
last;
}
}
if($pfad eq 0){ die "zeigeSeite: $!"; } # -> Fehlerseite?
my @inhalt = extractFile( $pfad );
foreach (@inhalt){
chomp $_;
}
# ---------------------------------------------------
# DYN. INHALT

$subs{titel} = (split/\|/, $inhalt[0])[2];
$subs{keywords} = (split/\|/, $inhalt[1])[2];
$subs{desc} = (split/\|/, $inhalt[2])[2];
$subs{page_topic} = (split/\|/, $inhalt[3])[2];
my $page = (split/\|/, $inhalt[4])[2];

$subs{inhalt} = join"",substitute( extractFile( $page ) ); # CONTENT auselesen & serialisieren

# $subs{inhalt} =~ s/\n/ /g;

print substitute( extractFile( $index ) ); # SUBSTITUTION IN INDEX.HTML

# print;

} #ZeigeSeite
# --------------------------------------------------------
sub extractFile{
# ---- usage
# my @extractedFile = extractFile( "FileName" ); # dieing if file doesn't exists
my $file = $_[0];
open(DAT, "$file") || die "$! ($file)";
my @inhalt = <DAT>;
close(DAT);
return @inhalt;
} #extractFile
# --------------------------------------------------------
sub substitute{
# ---- usage
# my @substitutedFile = substitute( @contentToSubstitute ); # substitute-keywords must be added to %subs (global %hash)
my @err = (); # array für fehler
my @file = @_;
foreach my $eintrag( @file ){
if( $eintrag =~ /\%\%(.*)\%\%/ ){
my $keyword = $1;
unless( exists $subs{$keyword} ){ push @err, "Wert nicht gesetzt: $keyword\n"; $subs{$keyword} = ""; }
unless( $eintrag =~ s/\Q$&\E/$subs{$keyword}/g ){ print STDERR "Fehler beim ersetzen!\n"; }
print STDERR "ersetzte: $& mit $eintrag\n";
}
}
print STDERR @err;
return @file;
} #substitute
# --------------------------------------------------------

Wenn ich das Script im Browser starte hängt dieser. Wenn ich dann Escape drücke gibt erm ir die Seite bis nach der Substitution des Hauptinhalts aus.
In meinem perl-Editor ist die Ausgabe aber vollständig.
mfg pktm
PS: braucht ihr auch die verwendeten Dateien?

EDIT: Code aktualisiert!\n\n

<!--EDIT|pktm|1064686535-->
http://www.intergastro-service.de (mein erstes CMS :) )

View full thread Script hängt sich auf: Warum nur?