richter 01/12/04 12:09:20
Modified: . Changes.pod Embperl.pm epmain.c test.pl
eg/images jazzbkgd.gif
test/cmp chdir.htm
test/conf httpd.conf.src
test/html chdir.htm
Log:
fixes for win32
Revision Changes Path
1.186 +4 -1 embperl/Changes.pod
Index: Changes.pod
===================================================================
RCS file: /home/cvs/embperl/Changes.pod,v
retrieving revision 1.185
retrieving revision 1.186
diff -u -r1.185 -r1.186
--- Changes.pod 2001/11/02 10:03:48 1.185
+++ Changes.pod 2001/12/04 20:09:19 1.186
@@ -46,7 +46,10 @@
- Added optShowBacktrace to enable backtrace of filename in error messages
- Removed obsolete debug flags dbgDisableCache, dbgWatchScalar,
dbgEarlyHttpHeader
-
+ - Fixed problem with changeing to page directory on win32. Reported by
+ Hans de Groot.
+ - Fixed problems with mod_perl environement handling with ActiveState Perl
+ on win32.
=head1 1.3.3 (RELEASE) 6. Juni 2001
1.175 +62 -44 embperl/Embperl.pm
Index: Embperl.pm
===================================================================
RCS file: /home/cvs/embperl/Embperl.pm,v
retrieving revision 1.174
retrieving revision 1.175
diff -u -r1.174 -r1.175
--- Embperl.pm 2001/11/02 10:15:22 1.174
+++ Embperl.pm 2001/12/04 20:09:19 1.175
@@ -10,7 +10,7 @@
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
-# $Id: Embperl.pm,v 1.174 2001/11/02 10:15:22 richter Exp $
+# $Id: Embperl.pm,v 1.175 2001/12/04 20:09:19 richter Exp $
#
###################################################################################
@@ -900,53 +900,54 @@
%fdat = %{$$req{'fdat'}} ;
@ffld = keys %fdat if (!defined ($$req{'ffld'})) ;
}
- elsif (!defined ($import) &&
+ else
+ {
+ my $content_type = $req_rec?$req_rec ->
header_in('Content-type'):$ENV{'CONTENT_TYPE'} ;
+ if (!defined ($import) &&
!($optDisableFormData) &&
!($r -> SubReq) &&
- defined($ENV{'CONTENT_TYPE'}) &&
- $ENV{'CONTENT_TYPE'}=~m|^multipart/form-data|)
- { # just let CGI.pm read the multipart form data, see cgi docu
- #eval 'require CGI' ;
- #die "require CGI failed: $@" if ($@);
- require CGI ;
-
- my $cgi ;
- #$cgi = new CGI ;
- eval { $cgi = new CGI } ;
- if ($@ || !$cgi)
- {
- $r -> logerror (rcCGIError, $@) ;
- $@ = '' ;
- }
- else
- {
- @ffld = $cgi->param;
+ $content_type &&
+ ($content_type=~m|^multipart/form-data|))
+ { # just let CGI.pm read the multipart form data, see cgi docu
+ require CGI ;
+
+ my $cgi ;
+ eval { $cgi = new CGI } ;
+ if ($@ || !$cgi)
+ {
+ $r -> logerror (rcCGIError, $@) ;
+ $@ = '' ;
+ }
+ else
+ {
+ @ffld = $cgi->param;
- my $params ;
- foreach ( @ffld )
- {
- # the param_fetch needs CGI.pm 2.43
- #$params = $cgi->param_fetch( $_ ) ;
- $params = $cgi->{$_} ;
- if ($#$params > 0)
- {
- $fdat{ $_ } = join ("\t", @$params) ;
- }
- else
- {
- $fdat{ $_ } = $params -> [0] ;
- }
-
- ##print LOG "[$$]FORM: $_=" . (ref ($fdat{$_})?ref
($fdat{$_}):$fdat{$_}) . "\n" if ($dbgForm) ;
- print LOG "[$$]FORM: $_=$fdat{$_}\n" if ($dbgForm) ;
-
- if (ref($fdat{$_}) eq 'Fh')
+ my $params ;
+ foreach ( @ffld )
{
- $fdat{"-$_"} = $cgi -> uploadInfo($fdat{$_}) ;
- }
- }
- }
- }
+ # the param_fetch needs CGI.pm 2.43
+ #$params = $cgi->param_fetch( $_ ) ;
+ $params = $cgi->{$_} ;
+ if ($#$params > 0)
+ {
+ $fdat{ $_ } = join ("\t", @$params) ;
+ }
+ else
+ {
+ $fdat{ $_ } = $params -> [0] ;
+ }
+
+ ##print LOG "[$$]FORM: $_=" . (ref ($fdat{$_})?ref
($fdat{$_}):$fdat{$_}) . "\n" if ($dbgForm) ;
+ print LOG "[$$]FORM: $_=$fdat{$_}\n" if ($dbgForm) ;
+
+ if (ref($fdat{$_}) eq 'Fh')
+ {
+ $fdat{"-$_"} = $cgi -> uploadInfo($fdat{$_}) ;
+ }
+ }
+ }
+ }
+ }
my $saved_param = undef;
if ( ref $$req{'param'} eq 'ARRAY') {
@@ -1467,6 +1468,23 @@
}
@cleanups = () ;
+
+
+ if ($^O eq 'MSWin32' && $ENV{MOD_PERL})
+ {
+ # workaround for mod_perl problems with environment
+ foreach my $k (keys %ENV)
+ {
+ delete $ENV{$k} if ($k =~ /^EMBPERL/) ;
+ }
+ delete $ENV{'QUERY_STRING'} ;
+ delete $ENV{'CONTENT_LENGTH'} ;
+ delete $ENV{'CONTENT_TYPE'} ;
+ delete $ENV{'HTTP_COOKIE'} ;
+ }
+
+
+
flushlog () ;
1.118 +47 -5 embperl/epmain.c
Index: epmain.c
===================================================================
RCS file: /home/cvs/embperl/epmain.c,v
retrieving revision 1.117
retrieving revision 1.118
diff -u -r1.117 -r1.118
--- epmain.c 2001/12/04 07:43:15 1.117
+++ epmain.c 2001/12/04 20:09:20 1.118
@@ -10,7 +10,7 @@
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
-# $Id: epmain.c,v 1.117 2001/12/04 07:43:15 richter Exp $
+# $Id: epmain.c,v 1.118 2001/12/04 20:09:20 richter Exp $
#
###################################################################################*/
@@ -527,6 +527,7 @@
if (nKey > 0 && (nVal > 0 || (r -> bOptions & optAllFormData)))
{
char * sid = r -> pConf -> sCookieName ;
+
if (sid)
{ /* remove session id */
if (strncmp (pKey, sid, nKey) != 0)
@@ -3705,6 +3706,7 @@
char fname[_MAX_FNAME];
char ext[_MAX_EXT];
char * c = sInputfile ;
+ char * p ;
while (*c)
{ /* convert / to \ */
@@ -3716,14 +3718,54 @@
olddrive = _getdrive () ;
getcwd (olddir, sizeof (olddir) - 1) ;
- _splitpath(sInputfile, drive, dir, fname, ext );
- _chdrive (drive[0] - 'A' + 1) ;
+
+ if (sInputfile[1] == ':')
+ {
+ drive[0] = toupper (sInputfile[0]) ;
+ c = sInputfile + 2 ;
+ }
+ else
+ {
+ drive[0] = olddrive + 64 ;
+ c = sInputfile ;
+ }
+
+ dir[0] = drive[0] ;
+ dir[1] = ':' ;
+ p = strrchr (sInputfile, '\\') ;
+ if (p && p - c < PATH_MAX - 4)
+ {
+ memcpy (dir+2, c, p - c) ;
+ dir[2 + (p - c)] = '\0' ;
+ }
+ else
+ {
+ dir[2] = '.' ;
+ dir[3] = '\0' ;
+ }
+
+ if (_chdrive (toupper(drive[0]) - 'A' + 1) < 0)
+ lprintf (r, "Cannot change to drive %c\n", drive[0] ) ;
+ if (chdir (dir) < 0)
+ lprintf (r, "Cannot change directory to %s on drive %c for file %s\n", dir,
drive[0], sInputfile ) ;
+ /*
+ if (r -> bDebug)
+ {
+ char ndir[PATH_MAX];
+ int ndrive ;
+
+ ndrive = _getdrive () ;
+ getcwd (ndir, sizeof (ndir) - 1) ;
+
+ lprintf (r, "Change directory to %s on drive %c (is %d:%s, was %d:%s)\n",
dir, drive[0], ndrive, ndir, olddrive, olddir) ;
+ }
+ */
#else
Dirname (sInputfile, dir, sizeof (dir) - 1) ;
getcwd (olddir, sizeof (olddir) - 1) ;
-#endif
if (chdir (dir) < 0)
- lprintf (r, "chdir error\n" ) ;
+ lprintf (r, "Cannot change directory to %s\n", dir ) ;
+#endif
}
else
r -> bOptions |= optDisableChdir ;
1.118 +12 -12 embperl/test.pl
Index: test.pl
===================================================================
RCS file: /home/cvs/embperl/test.pl,v
retrieving revision 1.117
retrieving revision 1.118
diff -u -r1.117 -r1.118
--- test.pl 2001/12/04 07:43:15 1.117
+++ test.pl 2001/12/04 20:09:20 1.118
@@ -11,7 +11,7 @@
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
-# $Id: test.pl,v 1.117 2001/12/04 07:43:15 richter Exp $
+# $Id: test.pl,v 1.118 2001/12/04 20:09:20 richter Exp $
#
###################################################################################
@@ -253,6 +253,17 @@
'cgi' => 0,
'repeat' => 2,
},
+ 'chdir.htm' => {
+ 'query_info' => 'a=1&b=2&c=&d=&f=5&g&h=7&=8&=',
+ },
+ 'chdir.htm' => {
+ 'query_info' => 'a=1&b=2&c=&d=&f=5&g&h=7&=8&=',
+ },
+ 'nochdir/nochdir.htm' => {
+ 'query_info' => 'a=1&b=2',
+ 'option' => '384',
+ 'cgi' => 0,
+ },
'include.htm' => {
'version' => 1,
},
@@ -351,12 +362,6 @@
'version' => 1,
'offline' => 0,
},
- 'chdir.htm' => {
- 'query_info' => 'a=1&b=2&c=&d=&f=5&g&h=7&=8&=',
- },
- 'chdir.htm' => {
- 'query_info' => 'a=1&b=2&c=&d=&f=5&g&h=7&=8&=',
- },
'allform/allform.htm' => {
'query_info' => 'a=1&b=2&c=&d=&f=5&g&h=7&=8&=',
'option' => '8192',
@@ -365,11 +370,6 @@
'stdout/stdout.htm' => {
'option' => '16384',
'version' => 1,
- 'cgi' => 0,
- },
- 'nochdir/nochdir.htm' => {
- 'query_info' => 'a=1&b=2',
- 'option' => '384',
'cgi' => 0,
},
'match/div.htm' => {
1.2 +1 -16 embperl/eg/images/jazzbkgd.gif
<<Binary file>>
1.4 +3 -3 embperl/test/cmp/chdir.htm
Index: chdir.htm
===================================================================
RCS file: /home/cvs/embperl/test/cmp/chdir.htm,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- chdir.htm 1999/10/05 06:02:03 1.3
+++ chdir.htm 2001/12/04 20:09:20 1.4
@@ -6,13 +6,13 @@
<body>
-^Script CWD:
+^Script CWD:.*\/test\/html <BR>
^Embperl CWD:
^\$0:
^\$0 \(absolut\):
Equal: No<BR>
-Diff CWD: >/test/html<<BR>
-Diff $0: >/test/html/chdir.htm<<BR>
+^Diff CWD:
+^Diff \$0:
<table>
<tr>
1.46 +81 -41 embperl/test/conf/httpd.conf.src
Index: httpd.conf.src
===================================================================
RCS file: /home/cvs/embperl/test/conf/httpd.conf.src,v
retrieving revision 1.45
retrieving revision 1.46
diff -u -r1.45 -r1.46
--- httpd.conf.src 2001/12/04 07:43:16 1.45
+++ httpd.conf.src 2001/12/04 20:09:20 1.46
@@ -21,11 +21,15 @@
StartServers 2
MaxClients 2
MaxRequestsPerChild 0
-
-#PerlFixupHandler test::handler
-#PerlInitHandler Apache::Reload
-#PerlInitHandler Apache::StatINC
+
+#PerlFixupHandler test::handler
+
+#PerlInitHandler Apache::Reload
+
+#PerlInitHandler Apache::StatINC
+
+
EOD
}
@@ -47,6 +51,7 @@
SetEnv EMBPERL_DEBUG $EPDEBUG
+PerlSetEnv EMBPERL_DEBUG $EPDEBUG
SetEnv EMBPERL_VIRTLOG /embperl/log
PerlSetEnv EMBPERL_LOG \"$EPPATH/test/tmp/test.log\"
SetEnv EMBPERL_LOG \"$EPPATH/test/tmp/test.log\"
@@ -129,8 +134,10 @@
AddType text/html .htm
AddType text/html .xhtm
-Alias /embperl/uidurl/ \"$EPPATH/test/html/sidurl/\"
-Alias /embperl/suidurl/ \"$EPPATH/test/html/sidurl/\"
+Alias /embperl/uidurl/ \"$EPPATH/test/html/sidurl/\"
+
+Alias /embperl/suidurl/ \"$EPPATH/test/html/sidurl/\"
+
Alias /embperl/sub/ \"$EPPATH/test/html/\"
Alias /embperl/ \"$EPPATH/test/html/\"
Alias /embperl2/ \"$EPPATH/test/html2/\"
@@ -200,7 +207,6 @@
SetHandler perl-script
PerlHandler HTML::Embperl
Options ExecCGI
-#PerlSetEnv EMBPERL_OPTIONS 16384
PerlSetEnv EMBPERL_OPTIONS 16400
PerlSetEnv EMBPERL_ESCMODE 0
PerlSetupEnv Off
@@ -306,9 +312,11 @@
PerlSetEnv EMBPERL_OUTPUT_FUNC \"LogOutput, $EPPATH/test/tmp/log.out\"
</Location>
+
+Alias /cgi-bin/uidurl/ \"$EPPATH/test/html/sidurl/\"
+
+Alias /cgi-bin/suidurl/ \"$EPPATH/test/html/sidurl/\"
-Alias /cgi-bin/uidurl/ \"$EPPATH/test/html/sidurl/\"
-Alias /cgi-bin/suidurl/ \"$EPPATH/test/html/sidurl/\"
Alias /cgi-bin/ \"$EPPATH/test/html/\"
Alias /cgi-bin-32/ \"$EPPATH/test/html/\"
ScriptAlias /cgi/ \"$EPPATH/\"
@@ -440,39 +448,71 @@
</IfModule>
EOD
}
+
+if ($EPSESSIONVERSION)
+
+ {
+
+print OFH <<EOD ;
+
+
+
+
+
+<Location /embperl/sidurl>
+
+SetHandler perl-script
+
+PerlHandler HTML::Embperl
+
+Options ExecCGI
+
+PerlSetEnv EMBPERL_OPTIONS 0x6000000
+
+</Location>
+
+
+
+<Location /embperl/uidurl>
+
+SetHandler perl-script
+
+PerlHandler HTML::Embperl
+
+Options ExecCGI
+
+PerlSetEnv EMBPERL_OPTIONS 0x5000000
+
+</Location>
+
+
+
+<Location /embperl/suidurl>
+
+SetHandler perl-script
+
+PerlHandler HTML::Embperl
+
+Options ExecCGI
+
+PerlSetEnv EMBPERL_OPTIONS 0x7000000
+
+</Location>
+
+
+
+
+
+
+
+EOD
+
+
+
+ }
+
+
-if ($EPSESSIONVERSION)
- {
-print OFH <<EOD ;
-
-
-<Location /embperl/sidurl>
-SetHandler perl-script
-PerlHandler HTML::Embperl
-Options ExecCGI
-PerlSetEnv EMBPERL_OPTIONS 0x6000000
-</Location>
-
-<Location /embperl/uidurl>
-SetHandler perl-script
-PerlHandler HTML::Embperl
-Options ExecCGI
-PerlSetEnv EMBPERL_OPTIONS 0x5000000
-</Location>
-
-<Location /embperl/suidurl>
-SetHandler perl-script
-PerlHandler HTML::Embperl
-Options ExecCGI
-PerlSetEnv EMBPERL_OPTIONS 0x7000000
-</Location>
-
-
-
-EOD
-
- }
-
print OFH <<EOD ;
<IfModule mod_jserv.c>
1.6 +2 -2 embperl/test/html/chdir.htm
Index: chdir.htm
===================================================================
RCS file: /home/cvs/embperl/test/html/chdir.htm,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -r1.5 -r1.6
--- chdir.htm 2001/03/27 12:27:51 1.5
+++ chdir.htm 2001/12/04 20:09:20 1.6
@@ -8,11 +8,11 @@
[- use Cwd -]
-Script CWD: [+ $script = fastcwd +] <BR>
+Script CWD: [+ $script = getcwd +] <BR>
Embperl CWD: [+ $ep = $HTML::Embperl::cwd +] <BR>
$0: [+ $abs = $0 +]
-[- $abs = $ep . '/' . $0 if (!($0 =~ /^\//)) ; -]
+[- $abs = $ep . '/' . $0 if (!($0 =~ /^(\w:)?\//)) ; -]
$0 (absolut): [+ $abs +]
Equal: [+ $script eq $ep?'Yes':'No' +]<BR>
---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
