richter 2005/09/25 06:43:39
Modified: . Changes.pod TODO embperl.h epinit.c epio.c epmain.c
epparse.c
Embperl App.pm
eg/web base.epl config.pl
eg/web/db addsel.epl epwebapp.pl wiki.epl
Log:
- Integrated KWiki into Embperl website (available under eg/web)
- Don't croak if Apache request record is not available (e.g. during
startup)
- Fixed wrong setup of $epreq -> param -> filename, when a Embperl offline
processing is made inside an Embperl page. Reported by Gavin Carr.
- Return correct http status codes 403 and 404 if access to a file is
forbidden or the file was not found. Reported by Cliff Rayman.
Revision Changes Path
1.289 +5 -1 embperl/Changes.pod
Index: Changes.pod
===================================================================
RCS file: /home/cvs/embperl/Changes.pod,v
retrieving revision 1.288
retrieving revision 1.289
diff -u -r1.288 -r1.289
--- Changes.pod 5 Sep 2005 04:09:24 -0000 1.288
+++ Changes.pod 25 Sep 2005 13:43:38 -0000 1.289
@@ -3,8 +3,12 @@
=head4 2.0.1
- Turn off Apache maintainer mode symbols, so it works with SuSE Apache
- - Wiki
+ - Integrated KWiki into Embperl website (available under eg/web)
- Don't croak if Apache request record is not available (e.g. during
startup)
+ - Fixed wrong setup of $epreq -> param -> filename, when a Embperl
offline
+ processing is made inside an Embperl page. Reported by Gavin Carr.
+ - Return correct http status codes 403 and 404 if access to a file is
+ forbidden or the file was not found. Reported by Cliff Rayman.
=head4 2.0rc6
1.137 +11 -0 embperl/TODO
Index: TODO
===================================================================
RCS file: /home/cvs/embperl/TODO,v
retrieving revision 1.136
retrieving revision 1.137
diff -u -r1.136 -r1.137
--- TODO 6 May 2005 07:15:36 -0000 1.136
+++ TODO 25 Sep 2005 13:43:38 -0000 1.137
@@ -20,6 +20,17 @@
- content-type in Embperl::Mail [ abe 4.4.05]
+- Mail Date Header [Robert]
+
+- 404 Error for not found [Cliff Raymann]
+
+- %Udat not clearing after 500 error [Cliff Raymann]
+
+- $req_rec not available in preload pages [Neil Gunton]
+
+
+
+
TODO for Embperl 2.1 and later
- make Embperl run with threads and threaded Apache 2
1.37 +2 -1 embperl/embperl.h
Index: embperl.h
===================================================================
RCS file: /home/cvs/embperl/embperl.h,v
retrieving revision 1.36
retrieving revision 1.37
diff -u -r1.36 -r1.37
--- embperl.h 7 Aug 2005 00:02:58 -0000 1.36
+++ embperl.h 25 Sep 2005 13:43:38 -0000 1.37
@@ -96,6 +96,7 @@
rcUnknownOption,
rcTimeFormatErr,
rcSubCallNotRequest,
+ rcTokenNotFound,
rcForbidden = 403,
rcNotFound = 404,
rcDecline = -1
1.32 +5 -3 embperl/epinit.c
Index: epinit.c
===================================================================
RCS file: /home/cvs/embperl/epinit.c,v
retrieving revision 1.31
retrieving revision 1.32
diff -u -r1.31 -r1.32
--- epinit.c 7 Aug 2005 14:40:39 -0000 1.31
+++ epinit.c 25 Sep 2005 13:43:38 -0000 1.32
@@ -1423,10 +1423,12 @@
if (pParamHV)
{
+ char * fn = GetHashValueStrDup(aTHX_ pPool, pParamHV, "inputfile",
NULL) ;
Embperl__Req__Config_new_init(aTHX_ &r -> Config, (SV *)pParamHV, 0)
;
Embperl__Req__Param_new_init(aTHX_ &r -> Param, (SV *)pParamHV, 0) ;
- if (!r -> Param.sFilename || !*r -> Param.sFilename)
- r -> Param.sFilename = GetHashValueStrDup(aTHX_ pPool, pParamHV,
"inputfile", NULL) ;
+ if (fn)
+ r -> Param.sFilename = fn ;
+
}
tainted = 0 ;
1.32 +5 -1 embperl/epio.c
Index: epio.c
===================================================================
RCS file: /home/cvs/embperl/epio.c,v
retrieving revision 1.31
retrieving revision 1.32
diff -u -r1.31 -r1.32
--- epio.c 7 Aug 2005 00:02:58 -0000 1.31
+++ epio.c 25 Sep 2005 13:43:38 -0000 1.32
@@ -601,6 +601,10 @@
{
strncpy (r -> errdat1, sInputfile, sizeof (r -> errdat1) - 1) ;
strncpy (r -> errdat2, Strerror(errno), sizeof (r -> errdat2) - 1) ;
+ if (errno == EACCES)
+ return rcForbidden ;
+ else if (errno == ENOENT)
+ return rcNotFound ;
return rcFileOpenErr ;
}
1.142 +11 -7 embperl/epmain.c
Index: epmain.c
===================================================================
RCS file: /home/cvs/embperl/epmain.c,v
retrieving revision 1.141
retrieving revision 1.142
diff -u -r1.141 -r1.142
--- epmain.c 9 Aug 2005 05:12:19 -0000 1.141
+++ epmain.c 25 Sep 2005 13:43:38 -0000 1.142
@@ -135,6 +135,7 @@
case rcIsDir: msg ="[%d]ERR: %d: %s Forbidden %s
is a directory%s" ; break ;
case rcXNotSet: msg ="[%d]ERR: %d: %s Forbidden %s
X Bit not set%s" ; break ;
case rcNotFound: msg ="[%d]ERR: %d: %s Not found
'%s', searched: %s" ; break ;
+ case rcTokenNotFound: msg ="[%d]ERR: %d: %s Token not
found '%s', %s" ; break ;
case rcUnknownVarType: msg ="[%d]ERR: %d: %s Type for
Variable %s is unknown %s" ; break ;
case rcPerlWarn: msg ="[%d]ERR: %d: %s Warning in
Perl code: %s%s" ; break ;
case rcVirtLogNotSet: msg ="[%d]ERR: %d: %s
EMBPERL_VIRTLOG must be set, when dbgLogLink is set %s%s" ; break ;
@@ -746,13 +747,20 @@
-static int GenerateErrorPage (/*i/o*/ register req * r)
+static int GenerateErrorPage (/*i/o*/ register req * r,
+ /*in*/ int rc)
{
epTHX_
dSP; /* initialize stack pointer */
+#ifdef APACHE
+ if (r -> pApacheReq && rc >= 400)
+ r -> pApacheReq -> status = rc ;
+ else
+ r -> pApacheReq -> status = 500 ;
+#endif
if (r -> pApp -> Config.sMailErrorsTo)
{
@@ -801,10 +809,6 @@
PUTBACK;
perl_call_method ("send_error_page", G_DISCARD) ;
SPAGAIN ;
-#ifdef APACHE
- if (r -> pApacheReq)
- r -> pApacheReq -> status = 500 ;
-#endif
SetHashValueInt (r, r -> pThread -> pHeaderHash, "Content-Length",
GetContentLength (r) ) ;
}
@@ -1149,7 +1153,7 @@
if (rc != ok || r -> bError)
{ /* --- generate error page if necessary --- */
- GenerateErrorPage (r) ;
+ GenerateErrorPage (r, rc) ;
if (r -> bExit)
return ok ;
}
1.16 +9 -9 embperl/epparse.c
Index: epparse.c
===================================================================
RCS file: /home/cvs/embperl/epparse.c,v
retrieving revision 1.15
retrieving revision 1.16
diff -u -r1.15 -r1.16
--- epparse.c 7 Aug 2005 00:02:58 -0000 1.15
+++ epparse.c 25 Sep 2005 13:43:38 -0000 1.16
@@ -178,7 +178,7 @@
{
strncpy (r -> errdat1, "BuildTokenHash", sizeof (r -> errdat1))
;
sprintf (r -> errdat2, "%s => %s does not contain any tokens",
pKey, pAttr) ;
- return rcNotFound ;
+ return rcTokenNotFound ;
}
hv_store(pSubHash, "--cptr", sizeof ("--cptr") - 1, newSViv
((IV)pNewTokenTable), 0) ;
@@ -425,7 +425,7 @@
{
strncpy (r -> errdat1, "BuildTokenHash", sizeof (r -> errdat1))
;
sprintf (r -> errdat2, " EndTag %s for %s not found",
pTable[i].sText, s) ;
- return rcNotFound ;
+ return rcTokenNotFound ;
}
}
@@ -444,7 +444,7 @@
{
strncpy (r -> errdat1, "BuildTokenHash", sizeof (r -> errdat1))
;
sprintf (r -> errdat2, " StartTag %s for %s not found",
pTable[i].sText, s) ;
- return rcNotFound ;
+ return rcTokenNotFound ;
}
}
@@ -854,7 +854,7 @@
pToken -> bDontEat) ;
if (rc == ok)
bInsideMustExist = 0 ;
- else if (pToken -> bInsideMustExist && rc == rcNotFound)
+ else if (pToken -> bInsideMustExist && rc ==
rcTokenNotFound)
{
rc = ok ;
/*
@@ -876,7 +876,7 @@
if (!(xNewNode = Node_appendChild (r -> pApp,
pDomTree, xParentNode, 0, (tNodeType)pTokenTable -> nDefNodeType, 0,
pCurrStart, pCurr - pCurrStart, level, GetLineNoOf (r, pCurrStart), NULL)))
return 1 ;
}
- else if (rc != rcNotFound)
+ else if (rc != rcTokenNotFound)
{
return rc ;
}
@@ -1015,7 +1015,7 @@
return 1 ;
}
*ppCurr = pCurr ;
- return bInsideMustExist?rcNotFound:ok ;
+ return bInsideMustExist?rcTokenNotFound:ok ;
}
else if (sEndText == NULL ||
((*pCurr == *sEndText && (strncmp (pCurr, sEndText, nEndText) ==
0)) ||
@@ -1044,7 +1044,7 @@
if (!pCDATAStart && !sStopText && (bDontEat & 2) == 0)
pCurr += nEndText ;
*ppCurr = pCurr ;
- return bInsideMustExist?rcNotFound:ok ;
+ return bInsideMustExist?rcTokenNotFound:ok ;
}
else if (!pToken && bFollow < 2)
pCurr++ ;
@@ -1063,7 +1063,7 @@
return 1 ;
*ppCurr = pCurr ;
- return bInsideMustExist?rcNotFound:ok ;
+ return bInsideMustExist?rcTokenNotFound:ok ;
}
1.7 +14 -2 embperl/Embperl/App.pm
Index: App.pm
===================================================================
RCS file: /home/cvs/embperl/Embperl/App.pm,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -r1.6 -r1.7
--- App.pm 7 Aug 2005 00:03:00 -0000 1.6
+++ App.pm 25 Sep 2005 13:43:38 -0000 1.7
@@ -81,6 +81,7 @@
my $logfilepos = $r -> log_file_start_pos ;
my $url = '' ; # $Embperl::dbgLogLink?"<A
HREF=\"$virtlog\?$logfilepos\&$$\">Logfile</A>":'' ;
my $req_rec = $r -> apache_req ;
+ my $status = $req_rec?$req_rec -> status:0 ;
my $err ;
my $cnt = 0 ;
local $Embperl::escmode = 0 ;
@@ -91,7 +92,18 @@
# don't use method call to avoid trouble with overloading
Embperl::Req::output ($r,"<HTML><HEAD><TITLE>Embperl
Error</TITLE></HEAD><BODY bgcolor=\"#FFFFFF\">\r\n$url") ;
- Embperl::Req::output ($r,"<H1>Internal Server Error</H1>\r\n") ;
+ if ($status == 403)
+ {
+ Embperl::Req::output ($r,"<H1>Forbidden</H1>\r\n") ;
+ }
+ elsif ($status == 404)
+ {
+ Embperl::Req::output ($r,"<H1>Not Found</H1>\r\n") ;
+ }
+ else
+ {
+ Embperl::Req::output ($r,"<H1>Internal Server Error</H1>\r\n") ;
+ }
Embperl::Req::output ($r,"The server encountered an internal error or
misconfiguration and was unable to complete your request.<P>\r\n") ;
Embperl::Req::output ($r,"Please contact the server administrator, $mail
and inform them of the time the error occurred, and anything you might have
done that may have caused the error.<P><P>\r\n") ;
1.7 +44 -44 embperl/eg/web/base.epl
Index: base.epl
===================================================================
RCS file: /home/cvs/embperl/eg/web/base.epl,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -r1.6 -r1.7
--- base.epl 4 Sep 2005 12:55:59 -0000 1.6
+++ base.epl 25 Sep 2005 13:43:38 -0000 1.7
@@ -49,50 +49,50 @@
table {[+ $base12 +]}
.cHeadline {[+ $base14 +] font-weight: bold;}
a:hover { color: red ;}
-
-
- .diff-added, .diff-removed, .diff-unmodified, .diff-changed {
- font-family: monospace;
- }
- .diff-added {
- background: #cfc;
- color: #000;
- }
- .diff-removed {
- background: #fcc;
- color: #000;
- }
- .diff-unmodified {
- background: inherit;
- color: #000;
- }
- .diff-changed {
- background: #ffc;
- color: #000;
- }
-
- table.diff {
- border: 1px solid #666;
- }
-
- table th {
- border-bottom: 1px solid #666;
- }
-
- th.lhs, td.lhs {
- padding-right: 1em;
- }
- th.rhs, td.rhs {
- padding-left: 1em;
- border-left: 1px solid #666;
- }
-
- h1 small {
- color: #f00;
- }
-
-
-
+
+
+ .diff-added, .diff-removed, .diff-unmodified, .diff-changed {
+ font-family: monospace;
+ }
+ .diff-added {
+ background: #cfc;
+ color: #000;
+ }
+ .diff-removed {
+ background: #fcc;
+ color: #000;
+ }
+ .diff-unmodified {
+ background: inherit;
+ color: #000;
+ }
+ .diff-changed {
+ background: #ffc;
+ color: #000;
+ }
+
+ table.diff {
+ border: 1px solid #666;
+ }
+
+ table th {
+ border-bottom: 1px solid #666;
+ }
+
+ th.lhs, td.lhs {
+ padding-right: 1em;
+ }
+ th.rhs, td.rhs {
+ padding-left: 1em;
+ border-left: 1px solid #666;
+ }
+
+ h1 small {
+ color: #f00;
+ }
+
+
+
</style>
</head>
<body bgcolor="#ffffff">
1.13 +2 -2 embperl/eg/web/config.pl
Index: config.pl
===================================================================
RCS file: /home/cvs/embperl/eg/web/config.pl,v
retrieving revision 1.12
retrieving revision 1.13
diff -u -r1.12 -r1.13
--- config.pl 4 Sep 2005 12:55:59 -0000 1.12
+++ config.pl 25 Sep 2005 13:43:38 -0000 1.13
@@ -202,8 +202,8 @@
{ menu => 'Support', uri =>
'pod/doc/Embperl.-page-17-.htm' },
{ menu => 'Changes', uri => 'pod/Changes.htm',
file => 'Changes.pod' },
#{ menu => 'Sites using Embperl', uri => 'pod/Sites.htm',
file => 'Sites.pod' },
- { menu => 'Wiki', uri => 'db/wiki/index.cgi', file =>
'/eg/web/db/wiki.epl' },
- { menu => 'More infos', uri => 'db/', sub =>
+ { menu => 'Wiki', uri => 'db/wiki/index.cgi', file =>
'/eg/web/db/wiki.epl' },
+ { menu => 'More infos', uri => 'db/', sub =>
[
{ menu => 'News', uri => 'news/news.htm',
file => 'eg/web/db/news/data.epd', fdat => { 'category_id' => 1 },
desc => { en => 'Full list of all news.',
1.8 +4 -4 embperl/eg/web/db/addsel.epl
Index: addsel.epl
===================================================================
RCS file: /home/cvs/embperl/eg/web/db/addsel.epl,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -r1.7 -r1.8
--- addsel.epl 4 Sep 2005 12:55:59 -0000 1.7
+++ addsel.epl 25 Sep 2005 13:43:38 -0000 1.8
@@ -61,10 +61,10 @@
</li>
[$endif$]
</ul>
-
-
-<p class="cHeadline"><a href="wiki/index.cgi">Wiki</a></p>
-
+
+
+<p class="cHeadline"><a href="wiki/index.cgi">Wiki</a></p>
+
[$else$]
1.18 +23 -11 embperl/eg/web/db/epwebapp.pl
Index: epwebapp.pl
===================================================================
RCS file: /home/cvs/embperl/eg/web/db/epwebapp.pl,v
retrieving revision 1.17
retrieving revision 1.18
diff -u -r1.17 -r1.18
--- epwebapp.pl 4 Sep 2005 12:55:59 -0000 1.17
+++ epwebapp.pl 25 Sep 2005 13:43:39 -0000 1.18
@@ -154,14 +154,26 @@
return $dest if (!$r -> {action_prefix}) ;
-
- my $buri = $r->{config}{baseuri} ;
+ my $config = $r->{config} ;
+ my $buri = $config -> {baseuri} ;
+ $buri .= '/' if (!$buri =~ m#/$#) ;
my $uri = $r-> param -> uri ;
- my $path = ($uri =~ /$buri(.*?)$/)?$1:$uri ;
+ my $path = ($uri =~ /\Q$buri\E(.*?)$/)?$1:$uri ;
my $lang = (@{$config -> {supported_languages}} > 1)?$r -> param ->
language . '/':'' ;
- return $r -> {action_prefix} . $buri . $lang . $path if (!$dest) ;
- return $r -> {action_prefix} . $buri . $lang . dirname("/$path") .'/' .
$dest ;
+ my $url ;
+ if (!$dest)
+ {
+ $url = $r -> {action_prefix} . $buri . $lang . $path ;
+ }
+ else
+ {
+ $path =~ m#^/?(.*)/# ;
+ my $dir = $1 ;
+ $url = $r -> {action_prefix} . $buri . $lang . $dir . '/' . $dest ;
+ }
+
+ return $url ;
}
@@ -194,7 +206,7 @@
{
$r -> {user_id} = $udat{user_id} ;
$r -> {user_email} = $udat{user_email} ;
- $r -> {user_name} = $udat{user_name} ;
+ $r -> {user_name} = $udat{user_name} ;
$r -> {user_admin} = $udat{user_admin} ;
return $r -> {user_admin}?2:1 ;
}
@@ -210,8 +222,8 @@
if ($udat{user_id} && $udat{user_email} && !$fdat{-logout})
{
$r -> {user_id} = $udat{user_id} ;
- $r -> {user_email} = $udat{user_email} ;
- $r -> {user_name} = $udat{user_name} ;
+ $r -> {user_email} = $udat{user_email} ;
+ $r -> {user_name} = $udat{user_name} ;
$r -> {user_admin} = $udat{user_admin} ;
return $r -> {user_admin}?2:1 ;
}
@@ -238,7 +250,7 @@
{
$r -> {user_id} = $udat{user_id} = $user -> {id} ;
$r -> {user_email} = $udat{user_email} = $user -> {email} ;
- $r -> {user_name} = $udat{user_name} = $user -> {user_name} ;
+ $r -> {user_name} = $udat{user_name} = $user -> {user_name} ;
$r -> {user_admin} = $udat{user_admin} = $user -> {admin} ;
$r -> {success} = "suc_login";
return $r -> {user_admin}?2:1 ;
@@ -252,8 +264,8 @@
if ($fdat{-logout})
{
$r -> {user_id} = $udat{user_id} = undef ;
- $r -> {user_email} = $udat{user_email} = undef ;
- $r -> {user_name} = $udat{user_name} = undef ;
+ $r -> {user_email} = $udat{user_email} = undef ;
+ $r -> {user_name} = $udat{user_name} = undef ;
$r -> {user_admin} = $udat{user_admin} = undef ;
$r -> {success} = 'suc_logout';
return ;
1.2 +100 -112 embperl/eg/web/db/wiki.epl
Index: wiki.epl
===================================================================
RCS file: /home/cvs/embperl/eg/web/db/wiki.epl,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- wiki.epl 4 Sep 2005 12:55:59 -0000 1.1
+++ wiki.epl 25 Sep 2005 13:43:39 -0000 1.2
@@ -1,112 +1,100 @@
-[-
-package Kwiki::Embperl ;
-
-use Kwiki -base;
-use Data::Dumper ;
-
-sub get_new_hub {
- my $self = shift ;
- my $path = shift;
- chdir $path;
- my $hub = $self->new->debug->load_hub(
- "config.yaml", -plugins => "plugins",
- );
- return $hub;
-}
-
-sub run
- {
- my $epreq = shift ;
- my $self = __PACKAGE__ ;
- my $path = '/usr/msrc/embperl/eg/kwiki' ;
-
- warn "r=$ENV{REQUEST_URI} s=$ENV{SCRIPT_NAME} p=$ENV{PATH_INFO}" ;
-
- # set path for source of Kwiki's redirect url
- $ENV{PATH_INFO} = '' ;
-
-
- foreach my $k (sort keys %$epreq)
- {
- local $^W = 0 ;
- print STDERR "$k = $epreq->{$k}\n" ;
- }
-
- if (my $user = $epreq -> {user_name} || $epreq -> {user_email})
- {
-
- $user =~ s/(?:^|\s+|\W)(.)/uc($1)/ge ;
- $user =~ s/[^a-zA-Z0-9]//g ;
- $ENV{REMOTE_USER} = $user ;
- }
-
- warn "ru=$ENV{REMOTE_USER}" ;
-
- require CGI ;
- foreach my $k (keys %Embperl::fdat)
- {
- CGI::param($k, $Embperl::fdat{$k}) ;
- warn "CGI::param($k, $Embperl::fdat{$k})" ;
- }
-
-
- my $hub = $self->get_new_hub($path);
- $hub->registry->load;
- $hub->add_hooks;
-
- eval { $hub->pre_process }
- or return $self->print_error($@,$r,$hub,'Pre-Process Error');
-
- my $html = eval { $hub->process };
- return $self->print_error($@,$r,$hub,'Process Error') if $@;
-
- if (defined $html) {
- unless($Embperl::req_rec->header_only) {
- $self->utf8_encode($html);
- }
- }
- eval { $hub->post_process }
- or return $self->print_error($@,$r,$hub,'Post-Process Error');
-
- if (my $redir = $hub->headers->redirect)
- {
- $Embperl::http_headers_out{'Location'} = $redir ;
- }
-
-
- return $html ;
-}
-
-sub print_error {
- my $self = shift ;
- my $error = $self->html_escape(shift);
- my ($r,$hub,$msg) = @_;
- #$hub->headers->content_type('text/html');
- #$hub->headers->charset('UTF-8');
- #$hub->headers->expires('now');
- #$hub->headers->pragma('no-cache');
- #$hub->headers->cache_control('no-cache');
- #$hub->headers->redirect('');
- #$hub->headers->print;
- print STDERR "<h1>Software Error:</h1><h2>$msg</h2><pre>\n$error</pre>" ;
- return "<h1>Software Error:</h1><h2>$msg</h2><pre>\n$error</pre>";
-}
-
--]
-[+
-do { local $escmode = 0 ;
-my $html = Kwiki::Embperl::run ($epreq) ;
-$html =~ m#<body>(.*)</body>#s ;
-$1 ;
-}
-+]
-[#
- <link rel="stylesheet" type="text/css"
href="theme/basic/css/kwiki.css" />
-
- <link rel="stylesheet" type="text/css" href="css/toolbar.css" />
- <link rel="stylesheet" type="text/css" href="css/user_name.css" />
- <link rel="stylesheet" type="text/css" href="css/search.css" />
- <link rel="stylesheet" type="text/css" href="css/formatter.css" />
- <link rel="shortcut icon" href="" />
- <link rel="start" href="index.cgi" title="Home" />
-#]
+[-
+package Kwiki::Embperl ;
+
+use Kwiki -base;
+use Data::Dumper ;
+
+sub get_new_hub {
+ my $self = shift ;
+ my $path = shift;
+ chdir $path;
+ my $hub = $self->new->debug->load_hub(
+ "config.yaml", -plugins => "plugins",
+ );
+ return $hub;
+}
+
+sub run
+ {
+ my $epreq = shift ;
+ my $self = __PACKAGE__ ;
+ my $path = $epreq -> {config}{root} . '/eg/kwiki' ;
+
+ # set path for source of Kwiki's redirect url
+ $ENV{SCRIPT_NAME} .= $ENV{PATH_INFO} ;
+ $ENV{PATH_INFO} = '' ;
+
+ if (my $user = $epreq -> {user_name} || $epreq -> {user_email})
+ {
+ $user =~ s/(?:^|\s+|\W)(.)/uc($1)/ge ;
+ $user =~ s/[^a-zA-Z0-9]//g ;
+ $ENV{REMOTE_USER} = $user ;
+ }
+
+ require CGI ;
+ foreach my $k (keys %Embperl::fdat)
+ {
+ CGI::param($k, $Embperl::fdat{$k}) ;
+ }
+
+ my $hub = $self->get_new_hub($path);
+ $hub->registry->load;
+ $hub->add_hooks;
+
+ eval { $hub->pre_process }
+ or return $self->print_error($@,$r,$hub,'Pre-Process Error');
+
+ my $html = eval { $hub->process };
+ return $self->print_error($@,$r,$hub,'Process Error') if $@;
+
+ if (defined $html) {
+ unless($Embperl::req_rec->header_only) {
+ $self->utf8_encode($html);
+ }
+ }
+ eval { $hub->post_process }
+ or return $self->print_error($@,$r,$hub,'Post-Process Error');
+
+ if (my $redir = $hub->headers->redirect)
+ {
+ print STDERR "redir to $redir" ;
+ $Embperl::http_headers_out{'Location'} = $redir ;
+ }
+
+
+ return $html ;
+}
+
+sub print_error {
+ my $self = shift ;
+ my $error = $self->html_escape(shift);
+ my ($r,$hub,$msg) = @_;
+ #$hub->headers->content_type('text/html');
+ #$hub->headers->charset('UTF-8');
+ #$hub->headers->expires('now');
+ #$hub->headers->pragma('no-cache');
+ #$hub->headers->cache_control('no-cache');
+ #$hub->headers->redirect('');
+ #$hub->headers->print;
+ print STDERR "<h1>Software Error:</h1><h2>$msg</h2><pre>\n$error</pre>" ;
+ return "<h1>Software Error:</h1><h2>$msg</h2><pre>\n$error</pre>";
+}
+
+-]
+[+
+do { local $escmode = 0 ;
+my $html = Kwiki::Embperl::run ($epreq) ;
+$html =~ m#<body>(.*)</body>#s ;
+$1 || $html ;
+}
++]
+[#
+ <link rel="stylesheet" type="text/css"
href="theme/basic/css/kwiki.css" />
+
+ <link rel="stylesheet" type="text/css" href="css/toolbar.css" />
+ <link rel="stylesheet" type="text/css" href="css/user_name.css" />
+ <link rel="stylesheet" type="text/css" href="css/search.css" />
+ <link rel="stylesheet" type="text/css" href="css/formatter.css" />
+ <link rel="shortcut icon" href="" />
+ <link rel="start" href="index.cgi" title="Home" />
+#]
---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
