You are viewing a plain text version of this content. The canonical link for it is here.
Posted to embperl-cvs@perl.apache.org by ri...@apache.org on 2001/01/29 11:44:08 UTC
cvs commit: embperl/test/html/opmask opmask.htm
richter 01/01/29 02:44:07
Modified: . Changes.pod Embperl.pm Embperl.pod EmbperlD.pod
EmbperlObject.pm TODO epmain.c test.pl
Embperl Mail.pm
test/cmp opmask.htm
test/conf httpd.conf.src startup.pl
test/html/opmask opmask.htm
Log:
- Make EmbperlObject work better with relative paths and drive letters
on Windows. Based on a patch from Freddy Vulto.
- Fixed a problem with the cache key, which could cause that the same
file is compiled within different packages.
Revision Changes Path
1.151 +5 -2 embperl/Changes.pod
Index: Changes.pod
===================================================================
RCS file: /home/cvs/embperl/Changes.pod,v
retrieving revision 1.150
retrieving revision 1.151
diff -u -r1.150 -r1.151
--- Changes.pod 2001/01/15 20:17:32 1.150
+++ Changes.pod 2001/01/29 10:43:52 1.151
@@ -2,7 +2,7 @@
-=head1 1.3.1_devv -- That's what currently under developement
+=head1 1.3.1b1_dev -- That's what currently under developement
Last Update: <$localtime$> (MET)
@@ -14,7 +14,10 @@
- Corrected a problem that leads to very strange errors when an
Embperl sub is called from an in memory source (that is passed
via the Execute input parameter). Spotted by Neil Gunton.
-
+ - Make EmbperlObject work better with relative paths and drive letters
+ on Windows. Based on a patch from Freddy Vulto.
+ - Fixed a problem with the cache key, which could cause that the same
+ file is compiled within different packages.
=head1 1.3.0 (RELEASE) 4 Dec. 2000
1.139 +2 -4 embperl/Embperl.pm
Index: Embperl.pm
===================================================================
RCS file: /home/cvs/embperl/Embperl.pm,v
retrieving revision 1.138
retrieving revision 1.139
diff -u -r1.138 -r1.139
--- Embperl.pm 2001/01/10 06:21:22 1.138
+++ Embperl.pm 2001/01/29 10:43:52 1.139
@@ -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.138 2001/01/10 06:21:22 richter Exp $
+# $Id: Embperl.pm,v 1.139 2001/01/29 10:43:52 richter Exp $
#
###################################################################################
@@ -81,7 +81,7 @@
@ISA = qw(Exporter DynaLoader);
-$VERSION = '1.3.1_dev';
+$VERSION = '1.3.1b1_dev';
# HTML::Embperl cannot be bootstrapped in nonlazy mode except
# under mod_perl, because its dependencies import symbols like ap_palloc
@@ -459,8 +459,6 @@
$cp = new Safe ($sName) ;
$NameSpace{$sName} = $cp ;
-
- $cp -> share ('&_evalsub_', '&_eval_') ;
return $cp ;
}
1.67 +31 -0 embperl/Embperl.pod
Index: Embperl.pod
===================================================================
RCS file: /home/cvs/embperl/Embperl.pod,v
retrieving revision 1.66
retrieving revision 1.67
diff -u -r1.66 -r1.67
--- Embperl.pod 2000/12/23 20:13:17 1.66
+++ Embperl.pod 2001/01/29 10:43:53 1.67
@@ -382,6 +382,37 @@
all errormessages, if any.
+=item B<object> (1.3.1b1 and above)
+
+Takes a filename and returns an hashref that is blessed into the package of
+the given file. That's usefull, if you want to call the subs inside the
+given file, as methods. By using the C<isa> parameter (see below) you
+are able to provide an inherence tree. Additionaly you can use the returned
+hashref to store data for that obeject.
+
+ Example:
+
+ [# the file eposubs.htm defines two subs: txt1 and txt2 #]
+ [# first we create a new object #]
+ [- $subs = Execute ({'object' => 'eposubs.htm'}) -]
+
+ [# then we call methods inside the object #]
+ txt1: [+ $subs -> txt1 +] <br>
+
+ txt2: [+ $subs -> txt2 +] <br>
+
+
+=item B<isa> (1.3.1b1 and above)
+
+Takes a name of a file and pushes the package of that file into the @ISA
+array of the current file. By using this you can setup an inherence tree
+between Embperl documents. Is is also usefull within I<EmbperlObject>.
+
+ Example:
+
+ [! Execute ({'isa' => '../eposubs.htm'}) !]
+
+
=back
1.39 +33 -0 embperl/EmbperlD.pod
Index: EmbperlD.pod
===================================================================
RCS file: /home/cvs/embperl/EmbperlD.pod,v
retrieving revision 1.38
retrieving revision 1.39
diff -u -r1.38 -r1.39
--- EmbperlD.pod 2000/12/23 20:13:19 1.38
+++ EmbperlD.pod 2001/01/29 10:43:54 1.39
@@ -332,6 +332,39 @@
Erwartet eine Referenz auf ein Array. Nach der R�ckkehr der Funktion enth�lt das Array
alle Fehlermeldungen der aufgerufenen Seite, soweit welche aufgetreten sind.
+=item B<object> (ab 1.3.1b1)
+
+Erwartet einen Dateinamen und liefert eine Hashreferenz zur�ck, die in das
+Package der Datei "geblessed" ist, d.h. die Hashreferenze kann dazu genutzt
+werden, um Funktionen die in der Datei definiert sind, also Methoden
+aufzurufen. Zus�tzlich kann durch den C<isa> Parameter (siehe unten) eine
+Vererbungshierachie zwischen Embperlseiten aufgebaut werden. Au�erdem ist
+es m�glich in dem Hash Objektdaten zu speichern.
+
+ Beispiel:
+
+ [# Die Datei eposubs.htm definiert zwei Funktionen: txt1 und txt2 #]
+ [# Als erstes erstellen wir ein neues Objekt #]
+ [- $subs = Execute ({'object' => 'eposubs.htm'}) -]
+
+ [# Nun kann man Methoden aufrufen #]
+ txt1: [+ $subs -> txt1 +] <br>
+
+ txt2: [+ $subs -> txt2 +] <br>
+
+
+=item B<isa> (ab 1.3.1b1)
+
+Erwarten den Namen einer Datei und schiebt den Packagename der Datei
+auf das @ISA Array der aktuellen Seite. Dadurch wird es m�glich eine
+Vererbung zwischen Embperlseiten aufzubauen. Dies ist auch innerhalb
+von I<EmbperlObject> hilfreich.
+
+ Beispiel:
+
+ [! Execute ({'isa' => '../eposubs.htm'}) !]
+
+
=back
1.40 +37 -11 embperl/EmbperlObject.pm
Index: EmbperlObject.pm
===================================================================
RCS file: /home/cvs/embperl/EmbperlObject.pm,v
retrieving revision 1.39
retrieving revision 1.40
diff -u -r1.39 -r1.40
--- EmbperlObject.pm 2000/11/07 11:28:18 1.39
+++ EmbperlObject.pm 2001/01/29 10:43:55 1.40
@@ -10,7 +10,7 @@
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
-# $Id: EmbperlObject.pm,v 1.39 2000/11/07 11:28:18 richter Exp $
+# $Id: EmbperlObject.pm,v 1.40 2001/01/29 10:43:55 richter Exp $
#
###################################################################################
@@ -46,15 +46,22 @@
use vars qw(
@ISA
$VERSION
+ $volume
+ $fsignorecase
) ;
@ISA = qw(Exporter DynaLoader);
-$VERSION = '1.3b4';
+$VERSION = '1.3.1b1_dev';
+$volume = (File::Spec -> splitpath ($HTML::Embperl::cwd))[0] ;
+$fsignorecase = File::Spec->case_tolerant ;
+
+1 ;
+
#############################################################################
#
# Normalize path into filesystem
@@ -67,12 +74,29 @@
sub norm_path
{
- return '' if (!$_[0]) ;
+ my $path = shift ;
+ return '' if (!$path) ;
- my $path = File::Spec -> canonpath (shift) ;
- $path =~ s/\\/\//g ;
+ # remove spaces
$path = $1 if ($path =~ /^\s*(.*?)\s*$/) ;
+ if (File::Spec->file_name_is_absolute ($path))
+ {
+ $path = File::Spec -> canonpath ($path) ;
+ }
+ else
+ {
+ $_[0] ||= Cwd::fastcwd ;
+ # make absolute path
+ $path = File::Spec -> rel2abs ($path, $_[0]) ;
+ }
+ # Use always forward slashes
+ $path =~ s/\\/\//g ;
+ # Add volume (i.e. drive on Windows) if not exists
+ $path = $volume . $path if ($path =~ /^\//) ;
+ # Make lower case if filesystem doesn't cares about case
+ $path = lc ($path) if ($fsignorecase) ;
+
return $path ;
}
@@ -102,13 +126,12 @@
my $mod ;
if ($filename =~ /^(.*)__(.*?)$/)
{
- $filename = norm_path ($1) ;
+ $filename = $1 ;
$mod = $2 ;
$mod =~ s/[^a-zA-Z0-9]/_/g ;
}
else
{
- $filename = norm_path ($filename) ;
$mod = '' ;
}
@@ -136,7 +159,8 @@
{
my $req = shift ;
- my $filename = $req -> {inputfile} ;
+ my $cwd ;
+ my $filename = norm_path ($req -> {inputfile}, $cwd) ;
my $r ;
$r = $req -> {req_rec} if ($req -> {req_rec}) ;
@@ -156,10 +180,10 @@
my $basename = $req -> {object_base} ;
$basename =~ s/%modifier%/$req->{object_base_modifier}/ ;
my $addpath = $req -> {object_addpath} ;
- my @addpath = $addpath?split (/:/, $addpath):() ;
+ my @addpath = $addpath?split (/$HTML::Embperl::pathsplit:/, $addpath):() ;
my $directory ;
- my $rootdir = $r?norm_path ($r -> document_root):'/' ;
- my $stopdir = norm_path ($req -> {object_stopdir}) ;
+ my $rootdir = $r?norm_path ($r -> document_root, $cwd):"$volume/" ;
+ my $stopdir = norm_path ($req -> {object_stopdir}, $cwd) ;
my $debug = $req -> {debug} & HTML::Embperl::dbgObjectSearch ;
if (-d $filename)
@@ -422,6 +446,8 @@
=back
+See also the C<object> and C<isa> parameters in Embperl's Execute function, on how
+to setup additional inherence and how to create Perl objects out of Embperl pages.
=head1 Basic Example
1.105 +0 -3 embperl/TODO
Index: TODO
===================================================================
RCS file: /home/cvs/embperl/TODO,v
retrieving revision 1.104
retrieving revision 1.105
diff -u -r1.104 -r1.105
--- TODO 2000/12/23 20:13:20 1.104
+++ TODO 2001/01/29 10:43:55 1.105
@@ -66,9 +66,6 @@
- discard output [ Roman Maeder 28.11.00]
-- object bless via Execute [ Neil Gunton 21.12.00 ]
-
-- [$ uses xxx $] -> ISA [ Angus Lees 21.12.00 ]
Test
----
1.91 +4 -4 embperl/epmain.c
Index: epmain.c
===================================================================
RCS file: /home/cvs/embperl/epmain.c,v
retrieving revision 1.90
retrieving revision 1.91
diff -u -r1.90 -r1.91
--- epmain.c 2001/01/15 20:17:33 1.90
+++ epmain.c 2001/01/29 10:43:56 1.91
@@ -1833,10 +1833,10 @@
cache_key_len += strlen( pConf->sPackage );
/* is it a relativ filename? -> append path */
- if (sSourcefile[0] == '/' ||
+ if (!(sSourcefile[0] == '/' ||
sSourcefile[0] == '\\' ||
(isalpha(sSourcefile[0]) && sSourcefile[1] == ':' &&
- (sSourcefile[2] == '\\' || sSourcefile[2] == '/')))
+ (sSourcefile[2] == '\\' || sSourcefile[2] == '/'))))
getcwd (olddir, sizeof (olddir) - 1) ;
if ( olddir[0] )
@@ -1955,10 +1955,10 @@
cache_key_len += strlen( sPackage );
/* is it a relativ filename? -> append path */
- if (sSourcefile[0] == '/' ||
+ if (!(sSourcefile[0] == '/' ||
sSourcefile[0] == '\\' ||
(isalpha(sSourcefile[0]) && sSourcefile[1] == ':' &&
- (sSourcefile[2] == '\\' || sSourcefile[2] == '/')))
+ (sSourcefile[2] == '\\' || sSourcefile[2] == '/'))))
getcwd (olddir, sizeof (olddir) - 1) ;
if ( olddir[0] )
1.91 +10 -1 embperl/test.pl
Index: test.pl
===================================================================
RCS file: /home/cvs/embperl/test.pl,v
retrieving revision 1.90
retrieving revision 1.91
diff -u -r1.90 -r1.91
--- test.pl 2001/01/15 20:17:33 1.90
+++ test.pl 2001/01/29 10:43:57 1.91
@@ -300,6 +300,7 @@
'option' => '12',
'errors' => '-1',
'compartment'=> 'TEST',
+ 'package' => 'TEST',
'version' => 1,
'cgi' => 0,
},
@@ -483,6 +484,7 @@
use vars qw ($httpconfsrc $httpconf $EPPORT $EPPORT2 *SAVEERR *ERR $EPHTTPDDLL $EPSTARTUP $EPDEBUG
$EPSESSIONDS $EPSESSIONCLASS $EPSESSIONVERSION $EP1COMPAT
+ $testshare
$opt_offline $opt_ep1 $opt_cgi $opt_modperl $opt_execute $opt_nokill $opt_loop
$opt_multchild $opt_memcheck $opt_exitonmem $opt_exitonsv $opt_config $opt_nostart $opt_uniquefn
$opt_quite $opt_ignoreerror $opt_tests $opt_blib $opt_help $opt_dbgbreak $opt_finderr
@@ -1123,10 +1125,14 @@
$version = $EP2?2:1 ;
$frommem = 0 ;
+$testshare = "Shared Data" ;
+
$cp = HTML::Embperl::AddCompartment ('TEST') ;
$cp -> deny (':base_loop') ;
+$cp -> share ('$testshare') ;
+
$ENV{EMBPERL_ALLOW} = 'asc|\\.htm$|\\.htm-1$' ;
do
@@ -1186,8 +1192,11 @@
$seen{"o:$page"} = 1 ;
delete $ENV{EMBPERL_OPTIONS} if (defined ($ENV{EMBPERL_OPTIONS})) ;
- $ENV{EMBPERL_OPTIONS} = $test -> {option} if (defined ($test -> {option})) ;
+ $ENV{EMBPERL_OPTIONS} = $test -> {option} if (defined ($test -> {option})) ;
+ delete $ENV{EMBPERL_COMPARTMENT} if (defined ($ENV{EMBPERL_COMPARTMENT})) ;
$ENV{EMBPERL_COMPARTMENT} = $test -> {compartment} if (defined ($test -> {compartment})) ;
+ delete $ENV{EMBPERL_PACKAGE} if (defined (delete $ENV{EMBPERL_PACKAGE})) ;
+ $ENV{EMBPERL_PACKAGE} = $test -> {package} if (defined ($test -> {package})) ;
@testargs = ( '-o', $outfile ,
'-l', $logfile,
'-d', $debug,
1.30 +2 -2 embperl/Embperl/Mail.pm
Index: Mail.pm
===================================================================
RCS file: /home/cvs/embperl/Embperl/Mail.pm,v
retrieving revision 1.29
retrieving revision 1.30
diff -u -r1.29 -r1.30
--- Mail.pm 2000/09/11 09:53:33 1.29
+++ Mail.pm 2001/01/29 10:44:02 1.30
@@ -9,7 +9,7 @@
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
-# $Id: Mail.pm,v 1.29 2000/09/11 09:53:33 richter Exp $
+# $Id: Mail.pm,v 1.30 2001/01/29 10:44:02 richter Exp $
#
###################################################################################
@@ -32,7 +32,7 @@
@ISA = qw(HTML::Embperl);
-$VERSION = '1.3b4';
+$VERSION = '1.3.0';
1.4 +3 -0 embperl/test/cmp/opmask.htm
Index: opmask.htm
===================================================================
RCS file: /home/cvs/embperl/test/cmp/opmask.htm,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- opmask.htm 1999/10/05 06:02:18 1.3
+++ opmask.htm 2001/01/29 10:44:03 1.4
@@ -285,6 +285,9 @@
</tr>
</table>
+ Shared data: Shared Data <br>
+Not Shared data: <br>
+
<P><P>
<P>17<P>
1.32 +2 -1 embperl/test/conf/httpd.conf.src
Index: httpd.conf.src
===================================================================
RCS file: /home/cvs/embperl/test/conf/httpd.conf.src,v
retrieving revision 1.31
retrieving revision 1.32
diff -u -r1.31 -r1.32
--- httpd.conf.src 2000/12/23 20:13:26 1.31
+++ httpd.conf.src 2001/01/29 10:44:04 1.32
@@ -147,7 +147,8 @@
PerlHandler HTML::Embperl
Options ExecCGI
PerlSetEnv EMBPERL_OPTIONS 12
-PerlSetEnv EMBPERL_COMPARTMENT TEST
+PerlSetEnv EMBPERL_COMPARTMENT TEST
+PerlSetEnv EMBPERL_PACKAGE TEST
</Location>
<Location /embperl/rawinput>
1.10 +6 -0 embperl/test/conf/startup.pl
Index: startup.pl
===================================================================
RCS file: /home/cvs/embperl/test/conf/startup.pl,v
retrieving revision 1.9
retrieving revision 1.10
diff -u -r1.9 -r1.10
--- startup.pl 1999/11/04 05:30:20 1.9
+++ startup.pl 2001/01/29 10:44:05 1.10
@@ -15,8 +15,14 @@
use Apache::Registry ;
use HTML::Embperl ;
+$testshare = "Shared Data" ;
+
$cp = HTML::Embperl::AddCompartment ('TEST') ;
$cp -> deny (':base_loop') ;
+
+$cp -> share ('$testshare') ;
+
+
1 ;
1.2 +3 -0 embperl/test/html/opmask/opmask.htm
Index: opmask.htm
===================================================================
RCS file: /home/cvs/embperl/test/html/opmask/opmask.htm,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- opmask.htm 1998/07/14 20:11:24 1.1
+++ opmask.htm 2001/01/29 10:44:07 1.2
@@ -201,6 +201,9 @@
</tr>
</table>
+ Shared data: [+ $testshare +] <br>
+Not Shared data: [+ $testshareX +] <br>
+
<P>[+ $HTML::Embperl::VERSION +]<P>
<P>[+ $tabmode +]<P>