Menu
▾
▴
psp-checkins — CVS Commit logs
You can subscribe to this list here.
| 2002 |
Jan
(1) |
Feb
|
Mar
|
Apr
|
May
|
Jun
|
Jul
|
Aug
|
Sep
|
Oct
(19) |
Nov
(220) |
Dec
|
|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 2003 |
Jan
|
Feb
|
Mar
|
Apr
|
May
|
Jun
|
Jul
(22) |
Aug
(49) |
Sep
|
Oct
|
Nov
|
Dec
|
|
From: James E. J. Jr. <mu...@us...> - 2003-08-02 07:53:55
|
Update of /cvsroot/psp/psp/lib/tools/Parser
In directory sc8-pr-cvs1:/tmp/cvs-serv6328/lib/tools/Parser
Modified Files:
Form.pm
Log Message:
rx on logical assignment expression apparently forbidden in pre-5.6.
Index: Form.pm
===================================================================
RCS file: /cvsroot/psp/psp/lib/tools/Parser/Form.pm,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -r1.6 -r1.7
--- Form.pm 21 Nov 2002 16:24:31 -0000 1.6
+++ Form.pm 2 Aug 2003 07:53:52 -0000 1.7
@@ -67,7 +67,8 @@
my $submit_sub;
if ($form_id) {
- ($submit_sub ||= $form_id) =~ s/\W/_/g;
+ $submit_sub ||= $form_id;
+ $submit_sub =~ s/\W/_/g;
} else {
(my $page_name = $this->{page_name} || "") =~ s/page__//;
|
|
From: James E. J. Jr. <mu...@us...> - 2003-08-02 07:53:51
|
Update of /cvsroot/psp/psp/cpan In directory sc8-pr-cvs1:/tmp/cvs-serv6315/cpan Modified Files: Makefile.in Log Message: oops. forgot the line continuation backslashes. Index: Makefile.in =================================================================== RCS file: /cvsroot/psp/psp/cpan/Makefile.in,v retrieving revision 1.10 retrieving revision 1.11 diff -u -r1.10 -r1.11 --- Makefile.in 2 Aug 2003 07:10:18 -0000 1.10 +++ Makefile.in 2 Aug 2003 07:53:48 -0000 1.11 @@ -16,16 +16,16 @@ ifeq ($(PERL_VERSION),5.5) CPANDIRS += \ - Data-Dumper - Time-HiRes + Data-Dumper \ + Time-HiRes \ CGI else ifeq ($(PERL_VERSION),5.6) CPANDIRS += \ - Data-Dumper - CGI + Data-Dumper \ + CGI \ Convert-Scalar else |
|
From: James E. J. Jr. <mu...@us...> - 2003-08-02 07:53:48
|
Update of /cvsroot/psp/psp In directory sc8-pr-cvs1:/tmp/cvs-serv6299 Modified Files: configure.in Log Message: call AC_OUTPUT() only once with a list of files. Index: configure.in =================================================================== RCS file: /cvsroot/psp/psp/configure.in,v retrieving revision 1.8 retrieving revision 1.9 diff -u -r1.8 -r1.9 --- configure.in 2 Aug 2003 07:10:11 -0000 1.8 +++ configure.in 2 Aug 2003 07:53:44 -0000 1.9 @@ -45,7 +45,7 @@ AC_MSG_RESULT([$PERL_VERSION]) AC_SUBST(PERL_VERSION) dnl -AC_OUTPUT( +INFILES=" Makefile mk/common.mk cpan/Makefile @@ -54,10 +54,10 @@ lib/Makefile etc-templates/Makefile etc-templates/psp.conf -) +" if test "$CPAN_STYLE" = ""; then - AC_OUTPUT( + INFILES="$INFILES lib/field/Makefile lib/base/Makefile lib/base/cgi/Makefile @@ -65,5 +65,7 @@ lib/parser/Makefile lib/parser/bin/Makefile lib/tools/Makefile - ) + " fi + +AC_OUTPUT($INFILES) |
|
From: James E. J. Jr. <mu...@us...> - 2003-08-02 07:10:24
|
Update of /cvsroot/psp/psp/mk
In directory sc8-pr-cvs1:/tmp/cvs-serv1788/mk
Modified Files:
common.mk.in
Log Message:
remove C- and Oracle- specific configurations.
Index: common.mk.in
===================================================================
RCS file: /cvsroot/psp/psp/mk/common.mk.in,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -r1.5 -r1.6
--- common.mk.in 13 Nov 2002 16:04:02 -0000 1.5
+++ common.mk.in 2 Aug 2003 07:10:22 -0000 1.6
@@ -11,22 +11,9 @@
# Main PSP Makefile include file
# This is the common makefile setup for the psp source tree
-# First, set CC variables
-
VERSION=@VERSION@
-LDFLAGS=@LDFLAGS@
-LDARGS = $(LDFLAGS)
-CC=@CC@
-LIBS=-L$(buildtop)/lib $(LOCAL_LIBS) @LIBS@
-CFLAGS=@CFLAGS@ $(LOCAL_CFLAGS)
-INCLUDES=$(PRECOMPPUBLIC) $(LOCAL_INCLUDES) -I$(srcdir) \
- -I$(buildtop)/include -I.
-
-LDFLAGS=@LDFLAGS@ $(LOCAL_LDFLAGS)
VPATH=$(srcdir)
-CPPFLAGS=@CPPFLAGS@ $(LOCAL_CPPFLAGS)
-DEFS=@DEFS@ $(LOCAL_DEFS)
-PROC=@PROC@
+PERL_VERSION=@PERL_VERSION@
ifeq ("@SITELIB_INSTALL@","yes")
@@ -137,34 +124,9 @@
# standard system variables
-RANLIB = @RANLIB@
LN_S =@LN_S@
# Variables for shared objects
-
-LIBTARGETS=@LIBTARGETS@ # Which library parts to install/build
-LIBEXT=@LIBEXT@
-SHLIBEXT=@SHLIBEXT@
-SHOBJEXT=@SHOBJEXT@
-PICFLAGS = @PICFLAGS@ # CC flags to produce PIC code
-LDCOMBINE = @LDCOMBINE@
-LDCOMBINE_TAIL = @LDCOMBINE_TAIL@
-SHLIB_DEPLIBS = $(LOCAL_SHLIB_DEPLIBS) -lm -lc
-BUILD_OBJS=@BUILD_OBJS@
-
-#Transform to produce shared objects
-
-SHOBJS = $(OBJS:.o=.$(SHOBJEXT))
-
-# A set of directories to search at link time for dependent libraries
-
-SHLIB_DEPLIBDIRS = $(LOCAL_SHLIB_DEPLIBDIRS) \
- -L$(TOP_LIBDIR) -L$(libdir) -L/usr/local/lib -L/usr/krb5/lib
-
-# A set of space separated directories to search for dependent shared
-# objects at run time
-
-SHLIB_RPATH = $(libdir) /usr/local/lib /usr/krb5/lib @SYSTEM_SHLIB_RPATH@
# special install setup
|
|
From: James E. J. Jr. <mu...@us...> - 2003-08-02 07:10:21
|
Update of /cvsroot/psp/psp/cpan
In directory sc8-pr-cvs1:/tmp/cvs-serv1770/cpan
Modified Files:
Makefile.in
Log Message:
install modules based on autoconf-determined perl version.
Index: Makefile.in
===================================================================
RCS file: /cvsroot/psp/psp/cpan/Makefile.in,v
retrieving revision 1.9
retrieving revision 1.10
diff -u -r1.9 -r1.10
--- Makefile.in 31 Jul 2003 13:31:24 -0000 1.9
+++ Makefile.in 2 Aug 2003 07:10:18 -0000 1.10
@@ -13,9 +13,41 @@
ifeq ('@BUILD_CPAN@','yes')
+ifeq ($(PERL_VERSION),5.5)
+
+CPANDIRS += \
+ Data-Dumper
+ Time-HiRes
+ CGI
+
+else
+ifeq ($(PERL_VERSION),5.6)
+
+CPANDIRS += \
+ Data-Dumper
+ CGI
+ Convert-Scalar
+
+else
+ifeq ($(PERL_VERSION),5.8)
+
+CPANDIRS += \
+ Convert-Scalar
+
+endif
+endif
+endif
+
CPANDIRS = \
- Error Time-modules CGI URI Set-IntSpan Data-Dumper Time-HiRes \
- HTML-Tagset PSP-HTML-Parser FCGI FCGI-ProcManager Convert-Scalar
+ Error \
+ Time-modules \
+ CGI \
+ URI \
+ Set-IntSpan \
+ HTML-Tagset \
+ PSP-HTML-Parser \
+ FCGI \
+ FCGI-ProcManager
endif
|
|
From: James E. J. Jr. <mu...@us...> - 2003-08-02 07:10:14
|
Update of /cvsroot/psp/psp In directory sc8-pr-cvs1:/tmp/cvs-serv1743 Modified Files: configure.in Log Message: add test to determine (estimate) perl version. Index: configure.in =================================================================== RCS file: /cvsroot/psp/psp/configure.in,v retrieving revision 1.7 retrieving revision 1.8 diff -u -r1.7 -r1.8 --- configure.in 1 Nov 2002 22:57:21 -0000 1.7 +++ configure.in 2 Aug 2003 07:10:11 -0000 1.8 @@ -33,6 +33,18 @@ AC_PSP_ENABLE_BUILD_SAMPLES AC_PSP_ENABLE_SITELIB +# Check Perl Version +AC_MSG_CHECKING(for perl version) +PERL_VERSION=`$perl -e 'print(($] < 5.006)?"5.5":($] < 5.008)?"5.6":"5.8")'` +AC_ARG_WITH([perlversion], + [ --perl-version Perl version (default autoselects)],[ + if test "x$withval" != xno -a "x$withval" != yes ; then + PERL_VERSION=$withval + fi +],[])dnl +AC_MSG_RESULT([$PERL_VERSION]) +AC_SUBST(PERL_VERSION) dnl + AC_OUTPUT( Makefile mk/common.mk |
|
From: James E. J. Jr. <mu...@us...> - 2003-08-02 07:10:11
|
Update of /cvsroot/psp/psp
In directory sc8-pr-cvs1:/tmp/cvs-serv1709
Modified Files:
configure
Log Message:
generated from configure.in changes.
Index: configure
===================================================================
RCS file: /cvsroot/psp/psp/configure,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -r1.6 -r1.7
--- configure 5 Nov 2002 19:16:52 -0000 1.6
+++ configure 2 Aug 2003 07:10:06 -0000 1.7
@@ -770,6 +770,11 @@
--enable-build-samples build sample piles. default=yes
--enable-sitelib install modules in site-lib. default=no
+Optional Packages:
+ --with-PACKAGE[=ARG] use PACKAGE [ARG=yes]
+ --without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no)
+ --perl-version Perl version (default autoselects)
+
_ACEOF
fi
@@ -1418,6 +1423,22 @@
fi
+# Check Perl Version
+echo "$as_me:$LINENO: checking for perl version" >&5
+echo $ECHO_N "checking for perl version... $ECHO_C" >&6
+PERL_VERSION=`$perl -e 'print(($] < 5.006)?"5.5":($] < 5.008)?"5.6":"5.8")'`
+
+# Check whether --with-perlversion or --without-perlversion was given.
+if test "${with_perlversion+set}" = set; then
+ withval="$with_perlversion"
+
+ if test "x$withval" != xno -a "x$withval" != yes ; then
+ PERL_VERSION=$withval
+ fi
+
+fi; echo "$as_me:$LINENO: result: $PERL_VERSION" >&5
+echo "${ECHO_T}$PERL_VERSION" >&6
+
ac_config_files="$ac_config_files Makefile mk/common.mk cpan/Makefile doc/Makefile samples/Makefile lib/Makefile etc-templates/Makefile etc-templates/psp.conf"
cat >confcache <<\_ACEOF
# This file is a shell script that caches the results of configure
@@ -2013,6 +2034,7 @@
s,@BUILD_CPAN@,$BUILD_CPAN,;t t
s,@BUILD_SAMPLES@,$BUILD_SAMPLES,;t t
s,@SITELIB_INSTALL@,$SITELIB_INSTALL,;t t
+s,@PERL_VERSION@,$PERL_VERSION,;t t
CEOF
_ACEOF
@@ -2844,6 +2866,7 @@
s,@BUILD_CPAN@,$BUILD_CPAN,;t t
s,@BUILD_SAMPLES@,$BUILD_SAMPLES,;t t
s,@SITELIB_INSTALL@,$SITELIB_INSTALL,;t t
+s,@PERL_VERSION@,$PERL_VERSION,;t t
CEOF
_ACEOF
|
|
From: James E. J. Jr. <mu...@us...> - 2003-08-02 06:20:26
|
Update of /cvsroot/psp/psp/samples
In directory sc8-pr-cvs1:/tmp/cvs-serv28354/samples
Modified Files:
Makefile.in
Log Message:
remove extra formtest and add call1.
put all propagated make variables into quotes.
Index: Makefile.in
===================================================================
RCS file: /cvsroot/psp/psp/samples/Makefile.in,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -r1.7 -r1.8
--- Makefile.in 21 Nov 2002 16:24:57 -0000 1.7
+++ Makefile.in 2 Aug 2003 06:20:24 -0000 1.8
@@ -12,7 +12,7 @@
include $(buildtop)/mk/common.mk
SUBDIRS=\
- formtest \
+ call1 \
contacts \
css \
guide \
@@ -31,8 +31,8 @@
all pile install clean distclean depend ::
for i in $(SUBDIRS); do \
$(MAKE) -C $$i $@ \
- INSTALL_DIR=${DESTDIR}$(piledir) \
- INSTALL_LIBDIR=$(inst_libperl) \
- PILER=$(PILER) \
+ INSTALL_DIR="${DESTDIR}$(piledir)" \
+ INSTALL_LIBDIR="$(inst_libperl)" \
+ PILER="$(PILER)" \
PILERFLAGS="$(PILERFLAGS)" || exit 1; \
done
|
|
From: James E. J. Jr. <mu...@us...> - 2003-08-02 06:17:47
|
Update of /cvsroot/psp/psp/samples/sharing In directory sc8-pr-cvs1:/tmp/cvs-serv27942/psp/samples/sharing Modified Files: Makefile Log Message: remove accidental -A flag. Index: Makefile =================================================================== RCS file: /cvsroot/psp/psp/samples/sharing/Makefile,v retrieving revision 1.5 retrieving revision 1.6 diff -u -r1.5 -r1.6 --- Makefile 8 Nov 2002 05:45:59 -0000 1.5 +++ Makefile 2 Aug 2003 06:17:44 -0000 1.6 @@ -1,6 +1,6 @@ INSTALL_DIR=/usr/local/share/piles -PILERFLAGS=-v -p -e $(@:.pile=.seed) -A +PILERFLAGS=-v -p -e $(@:.pile=.seed) PILER=piler PILES=share_base.pile share_one.pile share_two.pile share_three.pile \ |
|
From: James E. J. Jr. <mu...@us...> - 2003-08-02 06:17:43
|
Update of /cvsroot/psp/psp/samples/tutorial In directory sc8-pr-cvs1:/tmp/cvs-serv27926/psp/samples/tutorial Modified Files: .cvsignore Log Message: ignore sources/. Index: .cvsignore =================================================================== RCS file: /cvsroot/psp/psp/samples/tutorial/.cvsignore,v retrieving revision 1.1 retrieving revision 1.2 diff -u -r1.1 -r1.2 --- .cvsignore 4 Nov 2002 05:23:25 -0000 1.1 +++ .cvsignore 2 Aug 2003 06:17:41 -0000 1.2 @@ -1,3 +1,4 @@ *.pile *.seed .depend +sources |
|
From: James E. J. Jr. <mu...@us...> - 2003-08-02 06:17:40
|
Update of /cvsroot/psp/psp/lib/field/AtomicData
In directory sc8-pr-cvs1:/tmp/cvs-serv27909/psp/lib/field/AtomicData
Modified Files:
Date.pm
Log Message:
\A is not valid within a character class.
Index: Date.pm
===================================================================
RCS file: /cvsroot/psp/psp/lib/field/AtomicData/Date.pm,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- Date.pm 4 Nov 2002 05:34:28 -0000 1.3
+++ Date.pm 2 Aug 2003 06:17:37 -0000 1.4
@@ -127,7 +127,7 @@
my ($this, $value) = @_;
if ($this->{_format}->{no_pad}) {
- $value =~ s|([\A/])0*|$1|g;
+ $value =~ s,(\A|/)0*,$1,g;
}
if ($this->{_format}->{hyphens}) {
|
|
From: James E. J. Jr. <mu...@us...> - 2003-08-02 06:17:36
|
Update of /cvsroot/psp/psp/lib/field In directory sc8-pr-cvs1:/tmp/cvs-serv27895/psp/lib/field Modified Files: Makefile.in Log Message: added $(TEST_FILES) for automated testing. Index: Makefile.in =================================================================== RCS file: /cvsroot/psp/psp/lib/field/Makefile.in,v retrieving revision 1.2 retrieving revision 1.3 diff -u -r1.2 -r1.3 --- Makefile.in 29 Dec 2000 06:19:48 -0000 1.2 +++ Makefile.in 2 Aug 2003 06:17:33 -0000 1.3 @@ -68,4 +68,13 @@ HTMLIO/Types.pm \ HTMLIO/Utils.pm +TEST_VERBOSE = +TEST_FILES = \ + t/data.t \ + t/field.t \ + t/htmlio.t \ + t/list.t \ + t/possiblesets.t \ + t/utils.t + include $(top_srcdir)/mk/perl.mk |
|
From: James E. J. Jr. <mu...@us...> - 2003-08-02 06:17:32
|
Update of /cvsroot/psp/psp/mk In directory sc8-pr-cvs1:/tmp/cvs-serv27878/psp/mk Modified Files: perl.mk Log Message: use Test::Harness instead of for loop to run tests. Index: perl.mk =================================================================== RCS file: /cvsroot/psp/psp/mk/perl.mk,v retrieving revision 1.2 retrieving revision 1.3 diff -u -r1.2 -r1.3 --- perl.mk 27 Dec 2000 07:57:47 -0000 1.2 +++ perl.mk 2 Aug 2003 06:17:29 -0000 1.3 @@ -166,11 +166,8 @@ #------------- Test Rules ---------------------# -# Run tests install-test:: - cd $(srcdir)/t; \ - for i in *.t; do \ - echo $(srcdir)/t/$$i..; \ - $(perl) -I $(archlibperl) -I $(libperl) $$i; \ - done +ifneq ($(TEST_FILES),) + perl -MTest::Harness -e "\$$Test::Harness::verbose = '$(TEST_VERBOSE)'; unshift @INC, '$(archlibperl)','$(libperl)'; runtests(@ARGV);" $(TEST_FILES) +endif |
|
From: James E. J. Jr. <mu...@us...> - 2003-08-02 06:17:32
|
Update of /cvsroot/psp/psp/lib/tools/t
In directory sc8-pr-cvs1:/tmp/cvs-serv27844/psp/lib/tools/t
Added Files:
run_control.t run_error.t run_fieldspace.t run_form.t
run_group.t run_message.t run_page.t run_tablespace.t
Log Message:
automated piler-to-driver page tests.
--- NEW FILE ---
#! perl -w
use PSP::Test;
use Test::More;
my $n_iterations = 1;
my $n_tests = 10;
my @option_set = ({},{AUTO_PILE => 1});
#my @option_set = ({});
PSP::Test->plan( tests => @option_set * $n_iterations * $n_tests );
for my $options ( (@option_set) x $n_iterations ) {
set_test_options( %$options );
output_is(<<'PSP',<<'OUTPUT');
here is a page.
PSP
Content-length: 54
Content-Type: text/html; charset=ISO-8859-1
<!-- pile:test page:page__default -->
here is a page.
OUTPUT
output_is(<<'PSP',<<'OUTPUT');
here is a page.
<psp:if test="1">
and more.
</psp:if>
PSP
Content-length: 65
Content-Type: text/html; charset=ISO-8859-1
<!-- pile:test page:page__default -->
here is a page.
and more.
OUTPUT
output_is(<<'PSP',<<'OUTPUT');
here is a page.
<psp:if test="1">and more.
</psp:if>
PSP
Content-length: 64
Content-Type: text/html; charset=ISO-8859-1
<!-- pile:test page:page__default -->
here is a page.
and more.
OUTPUT
output_is(<<'PSP',<<'OUTPUT');
<%
my $foo = "lala";
my $bar = "oodle";
%>
[= (length($foo) > length($bar)) ? $foo : $bar =]
[= sprintf("%0.7f",2*atan2(1,0)) =]
PSP
Content-length: 55
Content-Type: text/html; charset=ISO-8859-1
<!-- pile:test page:page__default -->
oodle
3.1415927
OUTPUT
output_is(<<'PSP',<<'OUTPUT');
[= "foo" =] [= "bar" =]
[= "foo" =][= "bar" =]
PSP
Content-length: 53
Content-Type: text/html; charset=ISO-8859-1
<!-- pile:test page:page__default -->
foo bar
foobar
OUTPUT
output_is(<<'PSP',<<'OUTPUT');
<% my @data = qw(apple 0.41 banana 0.35 grape 0.02 celery 0.10); %>
<table>
<psp:while test="@data">
<% my $fruit = shift @data;
my $price = shift @data; %>
<tr><th>[+ $fruit +]</th><td>$[+ $price +]</td></tr>
</psp:while>
</table>
PSP
Content-length: 215
Content-Type: text/html; charset=ISO-8859-1
<!-- pile:test page:page__default -->
<table>
<tr><th>apple</th><td>$0.41</td></tr>
<tr><th>banana</th><td>$0.35</td></tr>
<tr><th>grape</th><td>$0.02</td></tr>
<tr><th>celery</th><td>$0.10</td></tr>
</table>
OUTPUT
output_is(<<'PSP',<<'OUTPUT');
here is a page.
PSP
Content-length: 54
Content-Type: text/html; charset=ISO-8859-1
<!-- pile:test page:page__default -->
here is a page.
OUTPUT
output_is(<<'PSP',<<'OUTPUT');
here is a page.
PSP
Content-length: 54
Content-Type: text/html; charset=ISO-8859-1
<!-- pile:test page:page__default -->
here is a page.
OUTPUT
output_is(<<'PSP',<<'OUTPUT');
here is a page.
PSP
Content-length: 54
Content-Type: text/html; charset=ISO-8859-1
<!-- pile:test page:page__default -->
here is a page.
OUTPUT
output_is(<<'PSP',<<'OUTPUT');
here is a page.
PSP
Content-length: 54
Content-Type: text/html; charset=ISO-8859-1
<!-- pile:test page:page__default -->
here is a page.
OUTPUT
} # iterations
1;
--- NEW FILE ---
#! perl -w
use PSP::Test;
use Test::More;
my $n_iterations = 1;
my $n_tests = 2;
my @option_set = ({},{AUTO_PILE => 1});
#my @option_set = ({});
PSP::Test->plan( tests => @option_set * $n_iterations * $n_tests );
for my $options ( (@option_set) x $n_iterations ) {
set_test_options( %$options );
output_is(<<'PSP',<<'OUTPUT');
<psp:errorreport/>
PSP
Content-length: 39
Content-Type: text/html; charset=ISO-8859-1
<!-- pile:test page:page__default -->
OUTPUT
output_is(<<'PSP',<<'OUTPUT');
<psp:errorreport full="yes"/>
PSP
Content-length: 39
Content-Type: text/html; charset=ISO-8859-1
<!-- pile:test page:page__default -->
OUTPUT
} # iterations
1;
--- NEW FILE ---
#! perl -w
use PSP::Test;
use Test::More;
my $n_iterations = 1;
my $n_tests = 5;
my @option_set = ({},{AUTO_PILE => 1});
#my @option_set = ({});
PSP::Test->plan( tests => @option_set * $n_iterations * $n_tests );
for my $options ( (@option_set) x $n_iterations ) {
set_test_options( %$options );
my $test1_fs=<<'FIELDSPACE';
<psp:fieldspace name="transfer">
<psp:define name="acc_num" blankok="0"/>
<psp:define name="acc_type" type="select" blankok="0">;;
$field->set_display(1);
$field->set_possible_hash
({''=>'None',DDA=>'Checking',SAV=>'Savings',LON=>'Loan'},
['',qw(DDA SAV LON)]);
</psp:define>
</psp:fieldspace>
FIELDSPACE
my $_poss_changed = "PSP::FieldSpace::test::transfer::_poss_changed";
my $test1_send_form=<<'PSP';
<psp:script> my $title = "Send Account Type"; </psp:script>
<html><head><title>Send</title></head>
<body>
<psp:form action="receive" fieldspace="transfer">
Sending:<br>
Account Type: <psp:input name="acc_type"/><br>
Account Number: <psp:input name="acc_num"/><br>
<input type="submit" name="submit" value="Submit">
<input type="submit" name="cancel" value="Cancel">
<input type="reset" value="Reset">
<psp:submit name="cancel" goto="first"/>
<psp:submit goto="receive" verify="instantiated"/>
</psp:form>
</body>
</html>
PSP
my $test1_receive=<<'PSP';
<html><head><title>Receive</title></head>
<psp:use_fieldspace name="transfer">
Received:<br>
Account Type: <psp:display name="acc_type"/><br>
Account Number: <psp:display name="acc_num"/><br>
</psp:use_fieldspace>
</body>
</html>
PSP
my $test2_fs=<<'PSP';
<psp:fieldspace name="form4">
<psp:declare>use Benchmark;</psp:declare>
<psp:define name="integer" data="integer">
$field->set_parameters({min_value => 10, max_value => 100});
$field->set_format({show_plus => 1});
</psp:define>
<psp:define name="text" data="text">
$field->set_parameters({blank_ok => 0});
</psp:define>
<psp:define name="date" data="date">
$field->set_parameters({blank_ok => 0});
$field->set_format({hyphens => 1});
</psp:define>
</psp:fieldspace>
PSP
my $test2_display_chunk=<<'PSP';
<psp:if test="$cgi->param('go')">
Your form contents:
<ul>
<psp:list list="$cgi->param()" iterator="$param">
<psp:list list="$cgi->param($param)" iterator="$value">
<li><b>[+ $param +]</b> = [+ $value +]</li>
</psp:list>
</psp:list>
</ul>
</psp:if>
PSP
my $test2_form_chunk=<<'PSP';
<h1>PSP Form with fieldspace and submit:</h1>
<psp:form fieldspace="form4">
<psp:errorreport full="yes"/>
integer: <psp:input name="integer"><br>
text: <psp:input name="text"><br>
date: <psp:input name="date"><br>
Verify integer and text:
<psp:submit name="go1" value="Go!" html="true">
<psp:vfield name="integer"/>
<psp:vfield name="text"/>
</psp:submit><br>
Verify integer only:
<psp:submit name="go2" value="Go!" html="true">
<psp:vfield name="integer"/>
</psp:submit><br>
Verify date only:
<psp:submit name="go3" value="Go!" html="true">
<psp:vfield name="date"/>
</psp:submit><br>
Verify instantiated:
<psp:submit name="go4" value="Go!" html="true">
<psp:vinstantiated/>
</psp:submit><br>
Verify special:
<psp:submit name="go5" value="Go!" html="true">
my $time = time();
if ($time % 2) {
$fs->add_error("special","time ($time) was odd");
} else {
$fs->add_error("special","time ($time) was even");
}
</psp:submit><br>
</psp:form>
PSP
##############################################################################
##############################################################################
output_is({"transfer.fs"=>$test1_fs,
"default.psp"=>$test1_send_form},<<'OUTPUT');
Content-length: 801
Content-Type: text/html; charset=ISO-8859-1
<!-- pile:test page:page__default -->
<html><head><title>Send</title></head>
<body>
<form method="POST" action="receive">
Sending:<br>
Account Type: <select name="acc_type">
<option value="" selected>None</option>
<option value="DDA">Checking</option>
<option value="SAV">Savings</option>
<option value="LON">Loan</option>
</select><br>
Account Number: <input name="acc_num" type="text" value=""><br>
<input type="submit" name="submit" value="Submit">
<input type="submit" name="cancel" value="Cancel">
<input type="reset" value="Reset">
<input type="hidden" name="PSP::FieldSpace::test::transfer::_poss_changed" value="acc_num~~acc_type">
<input type="hidden" name="_form_submitter" value="page__default">
<input type="hidden" name="_form_id" value="test:default:ABC123"></form>
</body>
</html>
OUTPUT
output_is({"transfer.fs"=>$test1_fs,
"receive.psp"=>$test1_receive,
"default.psp"=>$test1_send_form},
{ _form_id => "test:default:ABC123",
$_poss_changed => "acc_num~~acc_type",
submit => "Submit" },
<<'OUTPUT');
Content-length: 881
Content-Type: text/html; charset=ISO-8859-1
<!-- pile:test page:page__default -->
<html><head><title>Send</title></head>
<body>
<form method="POST" action="receive">
Sending:<br>
Account Type: <font color="#ff0000" size="+3">*</font><select name="acc_type">
<option value="" selected>None</option>
<option value="DDA">Checking</option>
<option value="SAV">Savings</option>
<option value="LON">Loan</option>
</select><br>
Account Number: <font color="#ff0000" size="+3">*</font><input name="acc_num" type="text" value=""><br>
<input type="submit" name="submit" value="Submit">
<input type="submit" name="cancel" value="Cancel">
<input type="reset" value="Reset">
<input type="hidden" name="PSP::FieldSpace::test::transfer::_poss_changed" value="acc_num~~acc_type">
<input type="hidden" name="_form_submitter" value="page__default">
<input type="hidden" name="_form_id" value="test:default:ABC123"></form>
</body>
</html>
OUTPUT
output_is({"transfer.fs"=>$test1_fs,
"receive.psp"=>$test1_receive,
"default.psp"=>$test1_send_form},
{ _form_id => "test:default:ABC123",
$_poss_changed => "acc_num~~acc_type",
submit => "Submit" },
<<'OUTPUT');
Content-length: 881
Content-Type: text/html; charset=ISO-8859-1
<!-- pile:test page:page__default -->
<html><head><title>Send</title></head>
<body>
<form method="POST" action="receive">
Sending:<br>
Account Type: <font color="#ff0000" size="+3">*</font><select name="acc_type">
<option value="" selected>None</option>
<option value="DDA">Checking</option>
<option value="SAV">Savings</option>
<option value="LON">Loan</option>
</select><br>
Account Number: <font color="#ff0000" size="+3">*</font><input name="acc_num" type="text" value=""><br>
<input type="submit" name="submit" value="Submit">
<input type="submit" name="cancel" value="Cancel">
<input type="reset" value="Reset">
<input type="hidden" name="PSP::FieldSpace::test::transfer::_poss_changed" value="acc_num~~acc_type">
<input type="hidden" name="_form_submitter" value="page__default">
<input type="hidden" name="_form_id" value="test:default:ABC123"></form>
</body>
</html>
OUTPUT
output_is({"transfer.fs"=>$test1_fs,
"receive.psp"=>$test1_receive,
"default.psp"=>$test1_send_form},
{ _form_id => "test:default:ABC123",
acc_num => "12345678",
acc_type => "SAV",
$_poss_changed => "acc_num~~acc_type",
submit => "Submit" },
<<'OUTPUT');
Content-length: 167
Content-Type: text/html; charset=ISO-8859-1
<!-- pile:test page:page__receive -->
<html><head><title>Receive</title></head>
Received:<br>
Account Type: Savings<br>
Account Number: 12345678<br>
</body>
</html>
OUTPUT
output_is(<<"PSP",<<'OUTPUT');
<html><head><title>Form Test 4</title></head><body>
$test2_fs
$test2_display_chunk
$test2_form_chunk
</body><html>
PSP
Content-length: 951
Content-Type: text/html; charset=ISO-8859-1
<!-- pile:test page:page__default -->
<html><head><title>Form Test 4</title></head><body>
<h1>PSP Form with fieldspace and submit:</h1>
<form method="POST">
integer: <input name="integer" type="text" value=""><br>
text: <input name="text" type="text" value=""><br>
date: <input name="date" type="text" value=""><br>
Verify integer and text:
<input type="submit" name="go1" value="Go!"><br>
Verify integer only:
<input type="submit" name="go2" value="Go!"><br>
Verify date only:
<input type="submit" name="go3" value="Go!"><br>
Verify instantiated:
<input type="submit" name="go4" value="Go!"><br>
Verify special:
<input type="submit" name="go5" value="Go!"><br>
<input type="hidden" name="PSP::FieldSpace::test::form4::_poss_changed" value="date~~integer~~text">
<input type="hidden" name="_form_submitter" value="page__default">
<input type="hidden" name="_form_id" value="test:default:ABC123"></form>
</body><html>
OUTPUT
} # iterations
1;
--- NEW FILE ---
#! perl -w
use PSP::Test;
use Test::More;
my $n_iterations = 1;
my $n_tests = 10;
my @option_set = ({},{AUTO_PILE => 1});
#my @option_set = ({});
PSP::Test->plan( tests => @option_set * $n_iterations * $n_tests );
for my $options ( (@option_set) x $n_iterations ) {
set_test_options( %$options );
my $test1_fs=<<'FIELDSPACE';
<psp:fieldspace name="transfer">
<psp:import vars="%pf_box,%acc_types"/>
$pf_box{type_map} = \%acc_types;
$pf_box{type_order} = [ sort { $a cmp $b } keys %{$pf_box{type_map}} ];
<psp:define name="acc_type" type="select" data="text">;;
my %mapping = map { $_ => $pf_box{type_map}->{$_}->{desc}
} @{$pf_box{type_order}};
my @order = map { $_->[0] }
sort { $a->[1] <=> $b->[1] or $a->[2] cmp $b->[2] }
map {[$_,$pf_box{type_map}->{$_}->{def},$pf_box{type_map}->{$_}->{def}]}
keys %{$pf_box{type_map}};
$pf_box{no_None} and @order = grep {$_ ne ""} @order;
$field->set_display(1);
$field->set_possible_hash(\%mapping,\@order);
$field->set_parameters({blank_ok => 0});
</psp:define>
<psp:define name="acc_num" type="text" data="text"> ;;
$field->set_parameters({blank_ok => 0});
</psp:define>
</psp:fieldspace>
FIELDSPACE
my $test1_send_form=<<'PSP';
<psp:script> my $title = "Send Account Type"; </psp:script>
<html>
<head>
<title>[= $title =]</title>
</head>
<body>
<center>
<psp:form action="receive" fieldspace="transfer">
<table border="1">
<tr align="center">
<th align="right">
Account type:
</th><td>
<psp:input name="acc_type"/><br>
</td>
</tr>
<tr>
<th align="right">
Account number:
</th><td>
<psp:input name="acc_num"/><br>
</td>
</tr>
<tr>
<td colspan="2">
<input type="submit" name="submit" value="Submit">
<input type="submit" name="cancel" value="Cancel">
<input type="reset" value="Reset">
</td>
</tr>
</table>
<psp:submit name="cancel" goto="first"/>
<psp:submit goto="receive">
<psp:vinstantiated>
</psp:submit>
</psp:form>
</center>
</body>
</html>
PSP
my $test1_receive=<<'PSP';
<psp:script> my $title = "Send Account Type"; </psp:script>
<html>
<head>
<title>[= $title =]</title>
</head>
<body>
<center>
<psp:use_fieldspace name="transfer">
Hello
</psp:use_fieldspace>
PSP
output_is(<<'PSP',<<'OUTPUT');
here is a page.
PSP
Content-length: 54
Content-Type: text/html; charset=ISO-8859-1
<!-- pile:test page:page__default -->
here is a page.
OUTPUT
output_is({"transfer.fs"=>$test1_fs,
"default.psp"=>$test1_send_form},<<'OUTPUT');
Content-length: 940
Content-Type: text/html; charset=ISO-8859-1
<!-- pile:test page:page__default -->
<html>
<head>
<title>Send Account Type</title>
</head>
<body>
<center>
<form method="POST" action="receive">
<table border="1">
<tr align="center">
<th align="right">
Account type:
</th><td>
<select name="acc_type">
</select><br>
</td>
</tr>
<tr>
<th align="right">
Account number:
</th><td>
<input name="acc_num" type="text" value=""><br>
</td>
</tr>
<tr>
<td colspan="2">
<input type="submit" name="submit" value="Submit">
<input type="submit" name="cancel" value="Cancel">
<input type="reset" value="Reset">
</td>
</tr>
</table>
<input type="hidden" name="PSP::FieldSpace::test::transfer::_poss_changed" value="acc_num~~acc_type">
<input type="hidden" name="_form_submitter" value="page__default">
<input type="hidden" name="_form_id" value="test:default:ABC123"></form>
</center>
</body>
</html>
OUTPUT
output_is({"transfer.fs"=>$test1_fs,
"receive.psp"=>$test1_receive,
"default.psp"=>$test1_send_form},
{ _form_id => "test:default:ABC123",
"PSP::FieldSpace::test::transfer::_poss_changed"
=> "acc_num~~acc_type",
submit => "Submit" },
<<'OUTPUT');
Content-length: 1020
Content-Type: text/html; charset=ISO-8859-1
<!-- pile:test page:page__default -->
<html>
<head>
<title>Send Account Type</title>
</head>
<body>
<center>
<form method="POST" action="receive">
<table border="1">
<tr align="center">
<th align="right">
Account type:
</th><td>
<font color="#ff0000" size="+3">*</font><select name="acc_type">
</select><br>
</td>
</tr>
<tr>
<th align="right">
Account number:
</th><td>
<font color="#ff0000" size="+3">*</font><input name="acc_num" type="text" value=""><br>
</td>
</tr>
<tr>
<td colspan="2">
<input type="submit" name="submit" value="Submit">
<input type="submit" name="cancel" value="Cancel">
<input type="reset" value="Reset">
</td>
</tr>
</table>
<input type="hidden" name="PSP::FieldSpace::test::transfer::_poss_changed" value="acc_num~~acc_type">
<input type="hidden" name="_form_submitter" value="page__default">
<input type="hidden" name="_form_id" value="test:default:ABC123"></form>
</center>
</body>
</html>
OUTPUT
output_is(<<'PSP',<<'OUTPUT');
<%
my $foo = "lala";
my $bar = "oodle";
%>
[= (length($foo) > length($bar)) ? $foo : $bar =]
[= sprintf("%0.7f",2*atan2(1,0)) =]
PSP
Content-length: 55
Content-Type: text/html; charset=ISO-8859-1
<!-- pile:test page:page__default -->
oodle
3.1415927
OUTPUT
output_is(<<'PSP',<<'OUTPUT');
[= "foo" =] [= "bar" =]
[= "foo" =][= "bar" =]
PSP
Content-length: 53
Content-Type: text/html; charset=ISO-8859-1
<!-- pile:test page:page__default -->
foo bar
foobar
OUTPUT
output_is(<<'PSP',<<'OUTPUT');
<% my @data = qw(apple 0.41 banana 0.35 grape 0.02 celery 0.10); %>
<table>
<psp:while test="@data">
<% my $fruit = shift @data;
my $price = shift @data; %>
<tr><th>[+ $fruit +]</th><td>$[+ $price +]</td></tr>
</psp:while>
</table>
PSP
Content-length: 215
Content-Type: text/html; charset=ISO-8859-1
<!-- pile:test page:page__default -->
<table>
<tr><th>apple</th><td>$0.41</td></tr>
<tr><th>banana</th><td>$0.35</td></tr>
<tr><th>grape</th><td>$0.02</td></tr>
<tr><th>celery</th><td>$0.10</td></tr>
</table>
OUTPUT
output_is(<<'PSP',<<'OUTPUT');
here is a page.
PSP
Content-length: 54
Content-Type: text/html; charset=ISO-8859-1
<!-- pile:test page:page__default -->
here is a page.
OUTPUT
output_is(<<'PSP',<<'OUTPUT');
here is a page.
PSP
Content-length: 54
Content-Type: text/html; charset=ISO-8859-1
<!-- pile:test page:page__default -->
here is a page.
OUTPUT
output_is(<<'PSP',<<'OUTPUT');
here is a page.
PSP
Content-length: 54
Content-Type: text/html; charset=ISO-8859-1
<!-- pile:test page:page__default -->
here is a page.
OUTPUT
output_is(<<'PSP',<<'OUTPUT');
here is a page.
PSP
Content-length: 54
Content-Type: text/html; charset=ISO-8859-1
<!-- pile:test page:page__default -->
here is a page.
OUTPUT
} # iterations
1;
--- NEW FILE ---
#! perl -w
use PSP::Test;
use Test::More;
my $n_iterations = 1;
my $n_tests = 3;
my @option_set = ({},{AUTO_PILE => 1});
#my @option_set = ({});
PSP::Test->plan( tests => @option_set * $n_iterations * $n_tests );
for my $options ( (@option_set) x $n_iterations ) {
set_test_options( %$options );
my $test1_fs=<<'FIELDSPACE';
<psp:fieldspace name="transfer">
<psp:define name="desc"/>
<psp:group name="accts" dummyok="1">
<psp:define name="acc_num" blankok="1"/>
<psp:define name="acc_type" type="select" blankok="1">;;
$field->set_display(1);
$field->set_possible_hash
({''=>'None',DDA=>'Checking',SAV=>'Savings',LON=>'Loan'},
['',qw(DDA SAV LON)]);
</psp:define>
</psp:group>
</psp:fieldspace>
FIELDSPACE
my $_poss_changed = "PSP::FieldSpace::test::transfer::_poss_changed";
my $test1_send_form=<<'PSP';
<html><head><title>Send</title></head>
<body>
<psp:form action="receive" fieldspace="transfer">
Description: <psp:input name="desc"/><br>
Sending:<br>
<psp:dynamicdisplay name="accts" numvar="$i" numdisplay="5" dummyok="1">
Account [= $i =]:
Type: <psp:input name="acc_type"/>
Number: <psp:input name="acc_num"/><br>
</psp:dynamicdisplay>
<input type="submit" name="submit" value="Submit">
<input type="submit" name="cancel" value="Cancel">
<input type="reset" value="Reset">
<psp:submit name="cancel" goto="send"/>
<psp:submit goto="receive" verify="current"/>
</psp:form>
</body>
</html>
PSP
my $test1_receive=<<'PSP';
<html><head><title>Receive</title></head>
<psp:use_fieldspace name="transfer">
Description: <psp:display name="desc"/><br>
Received:<br>
<psp:dynamicdisplay name="accts" numvar="$i">
Account [= $i =]:
Type: <psp:display name="acc_type"/>
Number: <psp:display name="acc_num"/><br>
</psp:dynamicdisplay>
</psp:use_fieldspace>
</body>
</html>
PSP
##############################################################################
##############################################################################
output_is({"transfer.fs"=>$test1_fs,
"default.psp"=>$test1_send_form},<<'OUTPUT');
Content-length: 2217
Content-Type: text/html; charset=ISO-8859-1
<!-- pile:test page:page__default -->
<html><head><title>Send</title></head>
<body>
<form method="POST" action="receive">
Description: <input name="desc" type="text" value=""><br>
Sending:<br>
Account 1:
Type: <select name="acc_type:1">
<option value="" selected>None</option>
<option value="DDA">Checking</option>
<option value="SAV">Savings</option>
<option value="LON">Loan</option>
</select>
Number: <input name="acc_num:1" type="text" value=""><br>
Account 2:
Type: <select name="acc_type:2">
<option value="" selected>None</option>
<option value="DDA">Checking</option>
<option value="SAV">Savings</option>
<option value="LON">Loan</option>
</select>
Number: <input name="acc_num:2" type="text" value=""><br>
Account 3:
Type: <select name="acc_type:3">
<option value="" selected>None</option>
<option value="DDA">Checking</option>
<option value="SAV">Savings</option>
<option value="LON">Loan</option>
</select>
Number: <input name="acc_num:3" type="text" value=""><br>
Account 4:
Type: <select name="acc_type:4">
<option value="" selected>None</option>
<option value="DDA">Checking</option>
<option value="SAV">Savings</option>
<option value="LON">Loan</option>
</select>
Number: <input name="acc_num:4" type="text" value=""><br>
Account 5:
Type: <select name="acc_type:5">
<option value="" selected>None</option>
<option value="DDA">Checking</option>
<option value="SAV">Savings</option>
<option value="LON">Loan</option>
</select>
Number: <input name="acc_num:5" type="text" value=""><br>
<input type="submit" name="submit" value="Submit">
<input type="submit" name="cancel" value="Cancel">
<input type="reset" value="Reset">
<input type="hidden" name="PSP::FieldSpace::Group::test::transfer::accts::_control" value="1~~5~~10">
<input type="hidden" name="PSP::FieldSpace::Group::test::transfer::accts::_control_names" value="">
<input type="hidden" name="PSP::FieldSpace::test::transfer::_poss_changed" value="desc~~acc_num:1~~acc_num:2~~acc_num:3~~acc_num:4~~acc_num:5~~acc_type:1~~acc_type:2~~acc_type:3~~acc_type:4~~acc_type:5">
<input type="hidden" name="_form_submitter" value="page__default">
<input type="hidden" name="_form_id" value="test:default:ABC123"></form>
</body>
</html>
OUTPUT
output_is({"transfer.fs"=>$test1_fs,
"receive.psp"=>$test1_receive,
"default.psp"=>$test1_send_form},
{ _form_id => "test:default:ABC123",
$_poss_changed => "desc~~acc_num:1~~acc_num:2~~acc_num:3~~acc_num:4~~acc_num:5~~acc_type:1~~acc_type:2~~acc_type:3~~acc_type:4~~acc_type:5",
submit => "Submit" },
<<'OUTPUT');
Content-length: 862
Content-Type: text/html; charset=ISO-8859-1
<!-- pile:test page:page__receive -->
<html><head><title>Receive</title></head>
Description: <br>
Received:<br>
Account 1:
Type: None
Number: <br>
Account 2:
Type: None
Number: <br>
Account 3:
Type: None
Number: <br>
Account 4:
Type: None
Number: <br>
Account 5:
Type: None
Number: <br>
Account 6:
Type: None
Number: <br>
Account 7:
Type: None
Number: <br>
Account 8:
Type: None
Number: <br>
Account 9:
Type: None
Number: <br>
Account 10:
Type: None
Number: <br>
Account 11:
Type: None
Number: <br>
Account 12:
Type: None
Number: <br>
Account 13:
Type: None
Number: <br>
Account 14:
Type: None
Number: <br>
Account 15:
Type: None
Number: <br>
Account 16:
Type: None
Number: <br>
Account 17:
Type: None
Number: <br>
Account 18:
Type: None
Number: <br>
Account 19:
Type: None
Number: <br>
Account 20:
Type: None
Number: <br>
</body>
</html>
OUTPUT
output_is({"transfer.fs"=>$test1_fs,
"receive.psp"=>$test1_receive,
"default.psp"=>$test1_send_form},
{ _form_id => "test:default:ABC123",
$_poss_changed => "desc~~acc_num:1~~acc_num:2~~acc_num:3~~acc_num:4~~acc_num:5~~acc_type:1~~acc_type:2~~acc_type:3~~acc_type:4~~acc_type:5",
submit => "Submit",
'desc' => "some accounts",
'acc_num:1' => '43218765',
'acc_type:1' => 'SAV'
},
<<'OUTPUT');
Content-length: 886
Content-Type: text/html; charset=ISO-8859-1
<!-- pile:test page:page__receive -->
<html><head><title>Receive</title></head>
Description: some accounts<br>
Received:<br>
Account 1:
Type: Savings
Number: 43218765<br>
Account 2:
Type: None
Number: <br>
Account 3:
Type: None
Number: <br>
Account 4:
Type: None
Number: <br>
Account 5:
Type: None
Number: <br>
Account 6:
Type: None
Number: <br>
Account 7:
Type: None
Number: <br>
Account 8:
Type: None
Number: <br>
Account 9:
Type: None
Number: <br>
Account 10:
Type: None
Number: <br>
Account 11:
Type: None
Number: <br>
Account 12:
Type: None
Number: <br>
Account 13:
Type: None
Number: <br>
Account 14:
Type: None
Number: <br>
Account 15:
Type: None
Number: <br>
Account 16:
Type: None
Number: <br>
Account 17:
Type: None
Number: <br>
Account 18:
Type: None
Number: <br>
Account 19:
Type: None
Number: <br>
Account 20:
Type: None
Number: <br>
</body>
</html>
OUTPUT
} # iterations
1;
--- NEW FILE ---
#! perl -w
use PSP::Test;
use Test::More;
my $n_iterations = 1;
my $n_tests = 10;
my @option_set = ({},{AUTO_PILE => 1});
#my @option_set = ({});
PSP::Test->plan( tests => @option_set * $n_iterations * $n_tests );
for my $options ( (@option_set) x $n_iterations ) {
set_test_options( %$options );
output_is(<<'PSP',<<'OUTPUT');
here is a page.
PSP
Content-length: 54
Content-Type: text/html; charset=ISO-8859-1
<!-- pile:test page:page__default -->
here is a page.
OUTPUT
output_is(<<'PSP',<<'OUTPUT');
here is a page.
<psp:if test="1">
and more.
</psp:if>
PSP
Content-length: 65
Content-Type: text/html; charset=ISO-8859-1
<!-- pile:test page:page__default -->
here is a page.
and more.
OUTPUT
output_is(<<'PSP',<<'OUTPUT');
here is a page.
<psp:if test="1">and more.
</psp:if>
PSP
Content-length: 64
Content-Type: text/html; charset=ISO-8859-1
<!-- pile:test page:page__default -->
here is a page.
and more.
OUTPUT
output_is(<<'PSP',<<'OUTPUT');
<%
my $foo = "lala";
my $bar = "oodle";
%>
[= (length($foo) > length($bar)) ? $foo : $bar =]
[= sprintf("%0.7f",2*atan2(1,0)) =]
PSP
Content-length: 55
Content-Type: text/html; charset=ISO-8859-1
<!-- pile:test page:page__default -->
oodle
3.1415927
OUTPUT
output_is(<<'PSP',<<'OUTPUT');
[= "foo" =] [= "bar" =]
[= "foo" =][= "bar" =]
PSP
Content-length: 53
Content-Type: text/html; charset=ISO-8859-1
<!-- pile:test page:page__default -->
foo bar
foobar
OUTPUT
output_is(<<'PSP',<<'OUTPUT');
<% my @data = qw(apple 0.41 banana 0.35 grape 0.02 celery 0.10); %>
<table>
<psp:while test="@data">
<% my $fruit = shift @data;
my $price = shift @data; %>
<tr><th>[+ $fruit +]</th><td>$[+ $price +]</td></tr>
</psp:while>
</table>
PSP
Content-length: 215
Content-Type: text/html; charset=ISO-8859-1
<!-- pile:test page:page__default -->
<table>
<tr><th>apple</th><td>$0.41</td></tr>
<tr><th>banana</th><td>$0.35</td></tr>
<tr><th>grape</th><td>$0.02</td></tr>
<tr><th>celery</th><td>$0.10</td></tr>
</table>
OUTPUT
output_is(<<'PSP',<<'OUTPUT');
here is a page.
PSP
Content-length: 54
Content-Type: text/html; charset=ISO-8859-1
<!-- pile:test page:page__default -->
here is a page.
OUTPUT
output_is(<<'PSP',<<'OUTPUT');
here is a page.
PSP
Content-length: 54
Content-Type: text/html; charset=ISO-8859-1
<!-- pile:test page:page__default -->
here is a page.
OUTPUT
output_is(<<'PSP',<<'OUTPUT');
here is a page.
PSP
Content-length: 54
Content-Type: text/html; charset=ISO-8859-1
<!-- pile:test page:page__default -->
here is a page.
OUTPUT
output_is(<<'PSP',<<'OUTPUT');
here is a page.
PSP
Content-length: 54
Content-Type: text/html; charset=ISO-8859-1
<!-- pile:test page:page__default -->
here is a page.
OUTPUT
} # iterations
1;
--- NEW FILE ---
#! perl -w
use strict;
use Test::More;
use PSP::Test;
my $n_iterations = 1;
my $n_tests = 15;
my @option_set = ({},{AUTO_PILE => 1});
#my @option_set = ({});
PSP::Test->plan( tests => @option_set * $n_iterations * $n_tests );
for my $options ( (@option_set) x $n_iterations ) {
set_test_options( %$options );
output_is(<<'PSP',<<'OUTPUT',"simple page");
here is a page.
PSP
Content-length: 54
Content-Type: text/html; charset=ISO-8859-1
<!-- pile:test page:page__default -->
here is a page.
OUTPUT
output_is(<<'PSP',<<'OUTPUT',"empty page");
PSP
Content-length: 38
Content-Type: text/html; charset=ISO-8859-1
<!-- pile:test page:page__default -->
OUTPUT
output_is(<<'PSP',<<'OUTPUT',"blank line page");
PSP
Content-length: 39
Content-Type: text/html; charset=ISO-8859-1
<!-- pile:test page:page__default -->
OUTPUT
output_is(<<'PSP',<<'OUTPUT');
<% my $var = "value"; %>
[= $var =]
PSP
Content-length: 45
Content-Type: text/html; charset=ISO-8859-1
<!-- pile:test page:page__default -->
value
OUTPUT
output_is(<<'PSP',<<'OUTPUT');
<psp:script> my $var = "value"; </psp:script>
[= $var =]
PSP
Content-length: 45
Content-Type: text/html; charset=ISO-8859-1
<!-- pile:test page:page__default -->
value
OUTPUT
output_is(<<'PSP',<<'OUTPUT');
<psp:script>
my $var = "value";
</psp:script>
[= $var =]
PSP
Content-length: 45
Content-Type: text/html; charset=ISO-8859-1
<!-- pile:test page:page__default -->
value
OUTPUT
output_is(<<'PSP',<<'OUTPUT');
<% my $var = "Hal & <Brothers>"; %>
[= $var =]
PSP
Content-length: 56
Content-Type: text/html; charset=ISO-8859-1
<!-- pile:test page:page__default -->
Hal & <Brothers>
OUTPUT
output_is(<<'PSP',<<'OUTPUT');
<% my $var = "Hal & <Brothers>"; %>
[+ $var +]
PSP
Content-length: 66
Content-Type: text/html; charset=ISO-8859-1
<!-- pile:test page:page__default -->
Hal & <Brothers>
OUTPUT
output_is(<<'PSP',<<'OUTPUT');
<% my $var = "Hal & <Brothers>"; %>
[- $var -]
PSP
Content-length: 66
Content-Type: text/html; charset=ISO-8859-1
<!-- pile:test page:page__default -->
Hal%20%26%20%3CBrothers%3E
OUTPUT
output_is({"default.psp"=><<'PSP',"testinc.inc"=><<'INCLUDE'},<<'OUTPUT');
here is a page.
<psp:include src="testinc.inc">
PSP
here is an include.
INCLUDE
Content-length: 74
Content-Type: text/html; charset=ISO-8859-1
<!-- pile:test page:page__default -->
here is a page.
here is an include.
OUTPUT
output_is({"default.psp"=><<'PSP',"testinc.inc"=><<'INCLUDE'},<<'OUTPUT');
here is a page. <psp:include src="testinc.inc"> and more.
PSP
here is an include.
INCLUDE
Content-length: 85
Content-Type: text/html; charset=ISO-8859-1
<!-- pile:test page:page__default -->
here is a page. here is an include.
and more.
OUTPUT
output_is({"default.psp"=><<'PSP',"testinc.inc"=><<'INCLUDE'},<<'OUTPUT');
<psp:include src="testinc.inc"> and more.
PSP
here is an include.
INCLUDE
Content-length: 69
Content-Type: text/html; charset=ISO-8859-1
<!-- pile:test page:page__default -->
here is an include.
and more.
OUTPUT
output_is({"default.psp"=><<'PSP',"testinc.inc"=><<'INCLUDE'},<<'OUTPUT');
<% my $testvar = "hello."; %>
including..
<psp:include src="testinc.inc">
end of include.
PSP
here is an include with: [= $testvar =]
INCLUDE
Content-length: 100
Content-Type: text/html; charset=ISO-8859-1
<!-- pile:test page:page__default -->
including..
here is an include with: hello.
end of include.
OUTPUT
output_is({"default.psp"=><<'PSP',"testinc.sub"=><<'SUB'},<<'OUTPUT');
<% my $testvar = "hello."; %>
including..
<psp:call src="testinc.sub">
end of include.
PSP
<psp:sub proto="$testvar"/>
here is an include with: [= $testvar =]
SUB
Content-length: 101
Content-Type: text/html; charset=ISO-8859-1
<!-- pile:test page:page__default -->
including..
here is an include with: hello.
end of include.
OUTPUT
output_is({"default.psp"=><<'PSP1',"subdir"=>{"here.psp"=><<'PSP2'}},<<'OUTPUT');
erf.
PSP1
hooyah!
PSP2
Content-length: 43
Content-Type: text/html; charset=ISO-8859-1
<!-- pile:test page:page__default -->
erf.
OUTPUT
} # iterations
1;
--- NEW FILE ---
#! perl -w
use PSP::Test;
use Test::More;
my $n_iterations = 1;
my $n_tests = 10;
my @option_set = ({},{AUTO_PILE => 1});
#my @option_set = ({});
PSP::Test->plan( tests => @option_set * $n_iterations * $n_tests );
for my $options ( (@option_set) x $n_iterations ) {
set_test_options( %$options );
my $test1_fs=<<'FIELDSPACE';
<psp:fieldspace name="transfer">
<psp:import vars="%pf_box,%acc_types"/>
$pf_box{type_map} = \%acc_types;
$pf_box{type_order} = [ sort { $a cmp $b } keys %{$pf_box{type_map}} ];
<psp:define name="acc_type" type="select" data="text">;;
my %mapping = map { $_ => $pf_box{type_map}->{$_}->{desc}
} @{$pf_box{type_order}};
my @order = map { $_->[0] }
sort { $a->[1] <=> $b->[1] or $a->[2] cmp $b->[2] }
map {[$_,$pf_box{type_map}->{$_}->{def},$pf_box{type_map}->{$_}->{def}]}
keys %{$pf_box{type_map}};
$pf_box{no_None} and @order = grep {$_ ne ""} @order;
$field->set_display(1);
$field->set_possible_hash(\%mapping,\@order);
$field->set_parameters({blank_ok => 0});
</psp:define>
<psp:define name="acc_num" type="text" data="text"> ;;
$field->set_parameters({blank_ok => 0});
</psp:define>
</psp:fieldspace>
FIELDSPACE
my $test1_send_form=<<'PSP';
<psp:script> my $title = "Send Account Type"; </psp:script>
<html>
<head>
<title>[= $title =]</title>
</head>
<body>
<center>
<psp:form action="receive" fieldspace="transfer">
<table border="1">
<tr align="center">
<th align="right">
Account type:
</th><td>
<psp:input name="acc_type"/><br>
</td>
</tr>
<tr>
<th align="right">
Account number:
</th><td>
<psp:input name="acc_num"/><br>
</td>
</tr>
<tr>
<td colspan="2">
<input type="submit" name="submit" value="Submit">
<input type="submit" name="cancel" value="Cancel">
<input type="reset" value="Reset">
</td>
</tr>
</table>
<psp:submit name="cancel" goto="first"/>
<psp:submit goto="receive">
<psp:vinstantiated>
</psp:submit>
</psp:form>
</center>
</body>
</html>
PSP
my $test1_receive=<<'PSP';
<psp:script> my $title = "Send Account Type"; </psp:script>
<html>
<head>
<title>[= $title =]</title>
</head>
<body>
<center>
<psp:use_fieldspace name="transfer">
Hello
</psp:use_fieldspace>
PSP
output_is(<<'PSP',<<'OUTPUT');
here is a page.
PSP
Content-length: 54
Content-Type: text/html; charset=ISO-8859-1
<!-- pile:test page:page__default -->
here is a page.
OUTPUT
output_is({"transfer.fs"=>$test1_fs,
"default.psp"=>$test1_send_form},<<'OUTPUT');
Content-length: 940
Content-Type: text/html; charset=ISO-8859-1
<!-- pile:test page:page__default -->
<html>
<head>
<title>Send Account Type</title>
</head>
<body>
<center>
<form method="POST" action="receive">
<table border="1">
<tr align="center">
<th align="right">
Account type:
</th><td>
<select name="acc_type">
</select><br>
</td>
</tr>
<tr>
<th align="right">
Account number:
</th><td>
<input name="acc_num" type="text" value=""><br>
</td>
</tr>
<tr>
<td colspan="2">
<input type="submit" name="submit" value="Submit">
<input type="submit" name="cancel" value="Cancel">
<input type="reset" value="Reset">
</td>
</tr>
</table>
<input type="hidden" name="PSP::FieldSpace::test::transfer::_poss_changed" value="acc_num~~acc_type">
<input type="hidden" name="_form_submitter" value="page__default">
<input type="hidden" name="_form_id" value="test:default:ABC123"></form>
</center>
</body>
</html>
OUTPUT
output_is({"transfer.fs"=>$test1_fs,
"receive.psp"=>$test1_receive,
"default.psp"=>$test1_send_form},
{ _form_id => "test:default:ABC123",
"PSP::FieldSpace::test::transfer::_poss_changed"
=> "acc_num~~acc_type",
submit => "Submit" },
<<'OUTPUT');
Content-length: 1020
Content-Type: text/html; charset=ISO-8859-1
<!-- pile:test page:page__default -->
<html>
<head>
<title>Send Account Type</title>
</head>
<body>
<center>
<form method="POST" action="receive">
<table border="1">
<tr align="center">
<th align="right">
Account type:
</th><td>
<font color="#ff0000" size="+3">*</font><select name="acc_type">
</select><br>
</td>
</tr>
<tr>
<th align="right">
Account number:
</th><td>
<font color="#ff0000" size="+3">*</font><input name="acc_num" type="text" value=""><br>
</td>
</tr>
<tr>
<td colspan="2">
<input type="submit" name="submit" value="Submit">
<input type="submit" name="cancel" value="Cancel">
<input type="reset" value="Reset">
</td>
</tr>
</table>
<input type="hidden" name="PSP::FieldSpace::test::transfer::_poss_changed" value="acc_num~~acc_type">
<input type="hidden" name="_form_submitter" value="page__default">
<input type="hidden" name="_form_id" value="test:default:ABC123"></form>
</center>
</body>
</html>
OUTPUT
output_is(<<'PSP',<<'OUTPUT');
<%
my $foo = "lala";
my $bar = "oodle";
%>
[= (length($foo) > length($bar)) ? $foo : $bar =]
[= sprintf("%0.7f",2*atan2(1,0)) =]
PSP
Content-length: 55
Content-Type: text/html; charset=ISO-8859-1
<!-- pile:test page:page__default -->
oodle
3.1415927
OUTPUT
output_is(<<'PSP',<<'OUTPUT');
[= "foo" =] [= "bar" =]
[= "foo" =][= "bar" =]
PSP
Content-length: 53
Content-Type: text/html; charset=ISO-8859-1
<!-- pile:test page:page__default -->
foo bar
foobar
OUTPUT
output_is(<<'PSP',<<'OUTPUT');
<% my @data = qw(apple 0.41 banana 0.35 grape 0.02 celery 0.10); %>
<table>
<psp:while test="@data">
<% my $fruit = shift @data;
my $price = shift @data; %>
<tr><th>[+ $fruit +]</th><td>$[+ $price +]</td></tr>
</psp:while>
</table>
PSP
Content-length: 215
Content-Type: text/html; charset=ISO-8859-1
<!-- pile:test page:page__default -->
<table>
<tr><th>apple</th><td>$0.41</td></tr>
<tr><th>banana</th><td>$0.35</td></tr>
<tr><th>grape</th><td>$0.02</td></tr>
<tr><th>celery</th><td>$0.10</td></tr>
</table>
OUTPUT
output_is(<<'PSP',<<'OUTPUT');
here is a page.
PSP
Content-length: 54
Content-Type: text/html; charset=ISO-8859-1
<!-- pile:test page:page__default -->
here is a page.
OUTPUT
output_is(<<'PSP',<<'OUTPUT');
here is a page.
PSP
Content-length: 54
Content-Type: text/html; charset=ISO-8859-1
<!-- pile:test page:page__default -->
here is a page.
OUTPUT
output_is(<<'PSP',<<'OUTPUT');
here is a page.
PSP
Content-length: 54
Content-Type: text/html; charset=ISO-8859-1
<!-- pile:test page:page__default -->
here is a page.
OUTPUT
output_is(<<'PSP',<<'OUTPUT');
here is a page.
PSP
Content-length: 54
Content-Type: text/html; charset=ISO-8859-1
<!-- pile:test page:page__default -->
here is a page.
OUTPUT
} # iterations
1;
|
|
From: James E. J. Jr. <mu...@us...> - 2003-08-02 06:17:31
|
Update of /cvsroot/psp/psp/samples/call1 In directory sc8-pr-cvs1:/tmp/cvs-serv27863/psp/samples/call1 Added Files: Makefile default.psp testinc.inc testinc2.inc testinc3.inc .cvsignore Log Message: for sample pile using psp:sub and psp:call. --- NEW FILE --- PILE = call1 include ../samples.mk --- NEW FILE --- <% my $var1 = "dog"; my @var2 = qw(cat mouse seed light); %> <html><head><title>Calling test</title></head> <body> Calling testinc with args:<br> <psp:call src="testinc.inc" args="$var1,@var2"/> <br> <psp:call src="testinc.inc" args="$var1,@var2"/> <hr> Calling testinc without args:<br> <psp:call src="testinc.inc"/><br> <psp:call src="testinc.inc"/> <hr> Including testinc:<br> <psp:include src="testinc.inc"/><br> <psp:include src="testinc.inc"/> </body> </html> --- NEW FILE --- <psp:sub prototype="$var1,@var2"/> Here is some testinc text. <psp:include src="testinc2.inc"> --- NEW FILE --- Here is another included file. <% my $doodah = "another value"; %> [= $doodah." == (@var2)" =] --- NEW FILE --- <psp:sub prototype="$var1"/> Here is yet more text. <% my $frah = "lalala"; %> [= $frah." and ".$var1 =] --- NEW FILE --- *.pile *.seed .depend |
|
From: James E. J. Jr. <mu...@us...> - 2003-08-02 06:17:31
|
Update of /cvsroot/psp/psp/lib/tools/t
In directory sc8-pr-cvs1:/tmp/cvs-serv27826/psp/lib/tools/t
Modified Files:
full_compiler.t include.t
Log Message:
depends member now {buildinfo}->{depends}.
communicate alternate includepath as member, not $incpath arg to parse_file().
Index: full_compiler.t
===================================================================
RCS file: /cvsroot/psp/psp/lib/tools/t/full_compiler.t,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- full_compiler.t 13 Nov 2002 16:03:54 -0000 1.2
+++ full_compiler.t 2 Aug 2003 06:17:17 -0000 1.3
@@ -27,8 +27,8 @@
ok !$compiler->compile("pile-src/test.psp");
ok !$compiler->{n_errors};
-ok $compiler->{depends}->[0] eq "pile-src/test.psp";
-ok !$compiler->{depends}->[1];
+ok $compiler->{buildinfo}->{depends}->[0], "pile-src/test.psp";
+ok !$compiler->{buildinfo}->{depends}->[1];
ok !$compiler->{output};
ok length($compiler->{seed}) == 6;
ok !$compiler->{pile_name};
@@ -45,11 +45,11 @@
ok !$compiler->compile("pile-src/test.psp");
ok !$compiler->{n_errors};
-ok $compiler->{depends}->[0] eq "pile-src/test.psp";
-ok !$compiler->{depends}->[1];
+ok $compiler->{buildinfo}->{depends}->[0], "pile-src/test.psp";
+ok !$compiler->{buildinfo}->{depends}->[1];
ok !$compiler->{output};
ok length($compiler->{seed}) == 6;
-ok $compiler->{pile_name} eq "foofoo";
+ok $compiler->{pile_name}, "foofoo";
ok !$compiler->{verbose};
ok 0 == @{$compiler->{includepath}};
ok 0 == keys(%{$compiler->{fieldspaces}});
@@ -75,7 +75,7 @@
ok ! -f $fname."#";
ok !$compiler->{output};
ok length($compiler->{seed}) == 6;
-ok $compiler->{pile_name} eq "foofoo";
+ok $compiler->{pile_name}, "foofoo";
ok 0 == @{$compiler->{includepath}};
ok 0 == keys(%{$compiler->{fieldspaces}});
@@ -88,9 +88,9 @@
ok !$compiler->compile("pile-src/testinc.psp");
-ok $compiler->{depends}->[0] eq "pile-src/testinc.psp";
-ok $compiler->{depends}->[1] eq "pile-src/small.inc";
-ok !$compiler->{depends}->[2];
+ok $compiler->{buildinfo}->{depends}->[0], "pile-src/testinc.psp";
+ok $compiler->{buildinfo}->{depends}->[1], "pile-src/small.inc";
+ok !$compiler->{buildinfo}->{depends}->[2];
ok 1 == @{$compiler->{includepath}};
ok 0 == keys(%{$compiler->{fieldspaces}});
@@ -102,8 +102,8 @@
ok !$compiler->compile("pile-src/emptyform.psp");
-ok $compiler->{depends}->[0] eq "pile-src/emptyform.psp";
-ok !$compiler->{depends}->[1];
+ok $compiler->{buildinfo}->{depends}->[0], "pile-src/emptyform.psp";
+ok !$compiler->{buildinfo}->{depends}->[1];
ok 1 == @{$compiler->{includepath}};
ok 0 == keys(%{$compiler->{fieldspaces}});
@@ -115,8 +115,8 @@
ok !$compiler->compile("pile-src/form.psp");
-ok $compiler->{depends}->[0] eq "pile-src/form.psp";
-ok !$compiler->{depends}->[1];
+ok $compiler->{buildinfo}->{depends}->[0], "pile-src/form.psp";
+ok !$compiler->{buildinfo}->{depends}->[1];
ok 1 == @{$compiler->{includepath}};
ok 0 == keys(%{$compiler->{fieldspaces}});
@@ -129,9 +129,9 @@
ok !$compiler->compile("pile-src/small.fs");
ok !$compiler->compile("pile-src/fsform.psp");
-ok $compiler->{depends}->[0] eq "pile-src/small.fs";
-ok $compiler->{depends}->[1] eq "pile-src/fsform.psp";
-ok !$compiler->{depends}->[2];
+ok $compiler->{buildinfo}->{depends}->[0], "pile-src/small.fs";
+ok $compiler->{buildinfo}->{depends}->[1], "pile-src/fsform.psp";
+ok !$compiler->{buildinfo}->{depends}->[2];
ok 1 == @{$compiler->{includepath}};
ok 1 == keys(%{$compiler->{fieldspaces}});
Index: include.t
===================================================================
RCS file: /cvsroot/psp/psp/lib/tools/t/include.t,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- include.t 13 Nov 2002 16:03:58 -0000 1.2
+++ include.t 2 Aug 2003 06:17:17 -0000 1.3
@@ -17,7 +17,7 @@
package main;
my $n_iterations = 1;
-plan tests => $n_iterations * 83;
+plan tests => $n_iterations * 85;
for (my $n=0; $n<$n_iterations; $n++) {
#create a parser.
@@ -30,14 +30,16 @@
ok !$parser->{pile_name};
ok !@{$parser->{includepath}};
ok !$parser->{sub_lvl};
-ok $parser->{back_compat} eq 1;
+ok $parser->{back_compat}, 1;
ok @{$parser->{propagatable}};
ok !%{$parser->{handlers_begin}};
ok !%{$parser->{handlers_end}};
ok @{$parser->{stack_text_sub}};
ok @{$parser->{stack_code_sub}};
ok !@{$parser->{stack_handlers}};
-ok !@{$parser->{depends}};
+ok !@{$parser->{buildinfo}->{depends}};
+ok !%{$parser->{buildinfo}->{requires}};
+ok !%{$parser->{buildinfo}->{provides}};
ok !%{$parser->{depends_h}};
ok !$parser->{is_cdata};
ok !$parser->{text_to_flush};
@@ -70,7 +72,7 @@
ok $parser = TestParser->new();
ok $parser->parse_file("tmp/test.psp");
-ok @{$parser->{depends}};
+ok @{$parser->{buildinfo}->{depends}};
ok %{$parser->{depends_h}};
ok $parser->{current_fname};
ok $context= $parser->pop_context();
@@ -128,10 +130,11 @@
ok touch_file("tmp/inc/include3.inc");
ok $parser = TestParser->new();
-ok $parser->parse_file("tmp/test.psp",["tmp/inc"]);
+$parser->{includepath} = ["tmp/inc"];
+ok $parser->parse_file("tmp/test.psp");
#print Dumper($parser);
-ok @{$parser->{depends}};
+ok @{$parser->{buildinfo}->{depends}};
ok %{$parser->{depends_h}};
ok $parser->{current_fname};
ok $context= $parser->pop_context();
|
|
From: James E. J. Jr. <mu...@us...> - 2003-08-02 06:17:16
|
Update of /cvsroot/psp/psp/lib/tools/t
In directory sc8-pr-cvs1:/tmp/cvs-serv27812/psp/lib/tools/t
Added Files:
psp.conf
Log Message:
a psp.conf for automated testing.
--- NEW FILE ---
use strict;
$Error::Debug = 1;
my $prefix = $ENV{PSP_TOP} or die "PSP_TOP must be defined.";
$psp_cfg_fname = $cur_fname;
$psp_pile_dir = $ENV{PILEDRIVER_PILE_DIR} || $prefix;
$psp_cache_dir = $ENV{PILEDRIVER_CACHE_DIR} || "_scratch/cache";
$psp_driver_log = $ENV{PILEDRIVER_LOG} || "_scratch/piledriver.log";
#$psp_save_or_restore_env = $ENV{PSP_TOP}."/pile.env";
#$psp_stuck_seconds = 10;
$psp_loader->unload() if $psp_loader;
undef $psp_loader;
|
|
From: James E. J. Jr. <mu...@us...> - 2003-08-02 06:17:12
|
Update of /cvsroot/psp/psp/lib/tools/t In directory sc8-pr-cvs1:/tmp/cvs-serv27796/psp/lib/tools/t Added Files: .cvsignore Log Message: ignore build artifacts. --- NEW FILE --- _scratch |
|
From: James E. J. Jr. <mu...@us...> - 2003-08-02 06:17:08
|
Update of /cvsroot/psp/psp/lib/tools/Parser
In directory sc8-pr-cvs1:/tmp/cvs-serv27778/psp/lib/tools/Parser
Modified Files:
FieldSpace.pm
Log Message:
add preliminary buildinfo: requires and provides.
$out is now local() -- no longer lexical -- allows for a lexical $out.
treat $out as scalar ref.
correct $name -> $vname typo for verifies provides.
Index: FieldSpace.pm
===================================================================
RCS file: /cvsroot/psp/psp/lib/tools/Parser/FieldSpace.pm,v
retrieving revision 1.21
retrieving revision 1.22
diff -u -r1.21 -r1.22
--- FieldSpace.pm 18 Jul 2003 07:02:51 -0000 1.21
+++ FieldSpace.pm 2 Aug 2003 06:17:06 -0000 1.22
@@ -70,7 +70,10 @@
# Initialize these attributes.
$fs->{name} = $fsname;
$fs->{fullname} = $full;
- $fs->{package} = $package;
+ $fs->{package} = $package;
+
+ $fs->{provides} =
+ $this->{buildinfo}->{provides}->{fieldspaces}->{$full} ||= {};
}
push @{$this->{stack_fsdef}}, $fs;
@@ -249,6 +252,8 @@
Error::Simple("<$tag> requires NAME attribute.");
$this->{current_define} = $name;
+ $fs->{provides}->{fields}->{$name}++;
+
# create a define field context.
my $context = $this->push_context
({ type => "definefield",
@@ -378,6 +383,9 @@
$fs->{name} = $fsname;
$fs->{fullname} = $full;
$fs->{package} = $package;
+
+ $fs->{requires} =
+ $this->{buildinfo}->{requires}->{fieldspaces}->{$full} ||= {};
}
push @{$this->{stack_fsuse}}, $fs;
@@ -476,9 +484,13 @@
my $form;
if ($this->can("form") and ($form = $this->form())) {
+ my $page_name = $this->{page_name};
+ my $pile_name = $this->{pile_name};
+ my $package = $pile_name ? "Pile::".$pile_name : "Page::".$page_name;
+
$form->{fieldspace} = $fs->{name};
$this->context_lexical('$_no_prop');
- $this->code('$out->put($fs->propagate($_no_prop));');
+ $this->code("\$\${${package}::out}.=".'($fs->propagate($_no_prop));');
}
delete $this->{current_sname} and throw
@@ -502,11 +514,14 @@
# Ensure fieldspace context.
my $fs = $this->get_use_fieldspace();
+ my $fsname = $fs->{name};
my $name = $attr->{name} or throw
Error::Simple("<$tag> requires NAME attribute.");
$name = quote_bareword($name);
+ $fs->{requires}->{fields}->{$name}++;
+
# Make sure this variable is declared.
$this->context_lexical('$_field');
@@ -568,7 +583,11 @@
my $out = '$_field->'.$method."($noformat,$index_name,$delimiter)";
- $this->code("\$out->put($out);");
+ my $page_name = $this->{page_name};
+ my $pile_name = $this->{pile_name};
+ my $package = $pile_name ? "Pile::".$pile_name : "Page::".$page_name;
+
+ $this->code("\$\${${package}::out}.=($out);");
}
=head2 begin_pspalias
@@ -590,7 +609,11 @@
my ($field_name) =
$this->begin_pspfield($tag,$attr,$attr_seq,$orig_text);
- $this->code('$out->put($_field->alias());');
+ my $page_name = $this->{page_name};
+ my $pile_name = $this->{pile_name};
+ my $package = $pile_name ? "Pile::".$pile_name : "Page::".$page_name;
+
+ $this->code("\$\${${package}::out}.=".'($_field->alias());');
}
=head2 begin_pspinput
@@ -610,6 +633,9 @@
my($this,@args) = @_;
my $attr = $args[1];
+ my $append = defined $attr->{group_index} ? $attr->{group_index} : "";
+ $append =~ s/^([^,])/,$1/;
+
my ($field_name,$index_name,$value,$change,$noformat,$delimiter) =
$this->begin_pspfield(@args);
@@ -618,27 +644,24 @@
$this->code_add_indent(" ");
}
+ my $page_name = $this->{page_name};
+ my $pile_name = $this->{pile_name};
+ my $package = $pile_name ? "Pile::".$pile_name : "Page::".$page_name;
+
# accumulate code here.
my @code;
- my $dyndisp;
- if (my $gname = $this->{stack_ddisplay}->[-1]) {
- $dyndisp = $this->{dyndisp}->{$gname};
- }
- my $numcode = $dyndisp->{numvar}
- ? ",".quote_bareword($dyndisp->{numvar}) : "";
-
# check for errors and possibly insert a star.
unless (bool_att($attr->{nomark})) {
push @code,
- ("if (\$fs->in_error('field',$field_name$numcode)) {",
- " \$out->put('$ERR_STAR');",
+ ("if (\$fs->in_error('field',$field_name$append)) {",
+ " \$\${${package}::out}.=('$ERR_STAR');",
"}");
}
$this->context_lexical('$_no_prop');
push @code,
- ('$out->put($_field->html_input('."$index_name,$delimiter));",
+ ("\$\${${package}::out}.=(\$_field->html_input($index_name,$delimiter));",
"\$_field->poss_changed_p(1);",
"for my \$val (\$_field->value($index_name)) {",
" \$_no_prop->{$field_name}->{\$val}++;",
@@ -675,10 +698,14 @@
my ($field_name,$index_name,$value,$change,$noformat,$delimiter) =
$this->begin_pspfield($tag,$attr,$attr_seq,$orig_text);
+ my $page_name = $this->{page_name};
+ my $pile_name = $this->{pile_name};
+ my $package = $pile_name ? "Pile::".$pile_name : "Page::".$page_name;
+
$this->context_lexical('$_no_prop');
$this->context_lexical('$_field');
my @code =
- ("\$out->put(\$_field->html_hidden($index_name));",
+ ("\$\${${package}::out}.=(\$_field->html_hidden($index_name));",
"for my \$val (\$_field->value($index_name)) {",
" \$_no_prop->{$field_name}->{\$val}++;",
"}");
@@ -709,6 +736,8 @@
(defined $vname and defined $test) or throw
Error::Simple("<$tag> requires NAME and TEST attributes.");
+ $fs->{provides}->{verifies}->{$vname}++;
+
my $context = $this->push_context
({type => "verify",
code => "",
@@ -818,10 +847,7 @@
my $name = $attr->{name} or throw
Error::Simple("<$tag> requires a NAME attribute.");
- $fs->{use_vfield}->{$name} ||= {};
-# XXX - no longer valid: fieldspace may not be available yet.
-# $fs->{field_defs}->{$name} or throw
-# Error::Simple("Undefined reference to $fs->{name} field, $name");
+ $fs->{requires}->{fields}->{$name}++;
$name = quote_bareword($name);
@@ -906,10 +932,7 @@
my $name = $attr->{name} or throw
Error::Simple("<$tag> requires a NAME attribute.");
- $fs->{use_verify}->{$name} ||= {};
-# if (!$fs->{verify_defs}->{$name}) {
-# throw Error::Simple("<$tag> refers to an unknown $fs->{name} verify: '$name'");
-# }
+ $fs->{requires}->{verifies}->{$name}++;
$name = quote_bareword($name);
@@ -1197,8 +1220,8 @@
' my $out = PSP::Output->new();',
$verify_def->{code},
' $out or',
- " \$out->put(\"VERIFY '$verify_name' failed without reason.\");",
- ' return $out->get();',
+ " \$\$out.=(\"VERIFY '$verify_name' failed without reason.\");",
+ ' return $$out;',
'}',
""))."\n";
}
|
|
From: James E. J. Jr. <mu...@us...> - 2003-08-02 06:17:04
|
Update of /cvsroot/psp/psp/lib/tools/Parser
In directory sc8-pr-cvs1:/tmp/cvs-serv27721/psp/lib/tools/Parser
Modified Files:
Group.pm
Log Message:
rename "group" stack to "grpdef".
rename "ddisplay" stack to "grpuse".
add much logic for group def to follow fieldspace and tablespace def.
allow dummyok attribute on dynamicdisplay tag.
replace all fieldspace-based @current with 'do_field'.
we now use dummy_ok() accessor.
Index: Group.pm
===================================================================
RCS file: /cvsroot/psp/psp/lib/tools/Parser/Group.pm,v
retrieving revision 1.18
retrieving revision 1.19
diff -u -r1.18 -r1.19
--- Group.pm 18 Jul 2003 07:02:52 -0000 1.18
+++ Group.pm 2 Aug 2003 06:17:01 -0000 1.19
@@ -22,15 +22,107 @@
@handled = qw(group dynamicdisplay do
rollto rollover rollback refresh);
@handled_no_end = qw(indexoverride);
-
- @stacks = qw(group ddisplay);
- @current = qw(gname obj numvar
- form fsdef define fsuse submit verify);
+ @stacks = qw(grpdef grpuse);
+ @current = qw(do_field);
@propagatable = ((map { "stack_$_" } @stacks),
(map { "current_$_" } @current));
- $ERR_STAR='<font color="#ff0000" size="+3" face="arial,helvetica">*</font>';
+ *ERR_STAR = \$PSP::Parser::FieldSpace::ERR_STAR;
};
+=head2 define_group
+
+ [private] instance
+ () define_group (string fsname)
+
+DESCRIPTION:
+
+=cut
+
+sub define_group {
+ my ($this,$gname) = @_;
+
+ # Construct the new full group name, with input name component.
+ my $full = join ".", (map{ $_->{name} } @{$this->{stack_grpdef}}), $gname;
+ $this->debug_line("gname[$gname],full[$full]");
+
+ # get the current fieldspace.
+ my $fs = $this->get_define_fieldspace();
+
+ my $group;
+ if (! ($group = $fs->{group_defs}->{$full})) {
+
+ # We are creating a new define context.
+ $group = $fs->{group_defs}->{$full} = {};
+
+ # Note this new group definition.
+ $this->{new_groups} ||= [];
+ push @{$this->{new_groups}}, $full;
+
+ # Construct the group package.
+ my @pkgcomp = qw(PSP::FieldSpace::Group);
+ push @pkgcomp, $this->{pile_name} if $this->{pile_name};
+ push @pkgcomp, map { $_->{name} } @{$this->{stack_fsdef}};
+ push @pkgcomp, map { $_->{name} } @{$this->{stack_grpdef}};
+ push @pkgcomp, $gname;
+ my $package = join "::", @pkgcomp;
+
+ # Initialize these attributes.
+ $group->{name} = $gname;
+ $group->{fullname} = $full;
+ $group->{package} = $package;
+ $group->{field_names} = [];
+
+ $group->{provides} =
+ $this->{buildinfo}->{provides}->{groups}->{$full} ||= {};
+ }
+
+ push @{$this->{stack_grpdef}}, $group;
+ return $group;
+}
+
+=head2 get_define_group
+
+=cut
+
+sub get_define_group {
+ my ($this,$no_throw_on_fail) = @_;
+
+ # Construct the full group name.
+ my $full = join ".", map { $_->{name} } @{$this->{stack_grpdef}};
+ $this->debug_line("full[$full]");
+
+ # get the current fieldspace.
+ my $fs = $this->get_define_fieldspace();
+
+ # get the current group.
+ my $group = $fs->{group_defs}->{$full};
+
+ if (!$group and !$no_throw_on_fail) {
+ local $Error::Depth += 1;
+ throw Error::Simple("Group DEFINE context expected.");
+ }
+
+ return $group;
+}
+
+=head2 pop_define_group
+
+ [private] instance
+ (hashref) pop_define_group()
+
+DESCRIPTION:
+
+Pops any current group DEFINE context. Called by
+end_pspgroup().
+
+=cut
+
+sub pop_define_group {
+ my ($this) = @_;
+ $this->debug_line("last[$this->{stack_grpdef}->[-1]->{name}]");
+ return pop @{$this->{stack_grpdef}};
+}
+
=head2 begin_pspgroup
[private] instance
@@ -45,12 +137,8 @@
sub begin_pspgroup {
my ($this, $tag, $attr) = @_;
- my $fs = $this->get_define_fieldspace();
my $gname = $attr->{name} or throw
Error::Simple("<$tag> requires NAME attribute.");
- $fs->{group_defs}->{$gname} and throw
- Error::Simple("A <$tag> with NAME '$gname' already exists.");
- my $fsname = $fs->{fullname};
# create a group context.
my $context = $this->push_context
@@ -60,25 +148,15 @@
# group context starts out in script mode.
$this->script_mode();
- my $basepkg = "Group";
- $basepkg .= "::$this->{pile_name}" if $this->{pile_name};
-
- my $group = $fs->{group_defs}->{$gname} =
- {
- setup => "",
- name => $gname,
- grpvar => $attr->{grpvar} || '$_'.$gname.'_group',
+ my $group = $this->define_group($gname);
+ %$group =
+ (grpvar => $attr->{grpvar} || '$_'.$gname.'_group',
numvar => $attr->{numvar} || '$_'.$gname.'_index',
objvar => $attr->{obj} || '$_'.$gname.'_obj',
number => $attr->{numdisplay} || 20,
maxnum => $attr->{maxnum} || "",
- package => $basepkg."::${fsname}::${gname}",
- field_names => [],
- dummy_ok => bool_att($attr->{dummyok}) ? 1 : 0
- };
-
- $this->{stack_group} ||= [];
- push @{$this->{stack_group}}, $group;
+ dummy_ok => bool_att($attr->{dummyok}) ? 1 : 0,
+ %$group);
# Override default inherited tag definitions
my ($begin0,$end0) = $this->handlers();
@@ -101,9 +179,9 @@
sub end_pspgroup {
my ($this,$tag) = @_;
- # forget which group we have.
- my $group = pop @{$this->{stack_group}} or throw
- Error::Simple("<$tag> used outside of GROUP context");
+ # pop which group we have.
+ my $group = $this->pop_define_group();
+
$this->pop_handlers();
$this->script_mode(0);
@@ -116,6 +194,141 @@
$this->{verbose} and print " Group '$group->{name}' defined\n";
}
+=head2 begin_group_pspdefine
+
+ [private] instance
+ () begin_group_pspdefine (string $tag, \%attrs, \@atrseq, string $orig)
+
+=cut
+
+sub begin_group_pspdefine {
+ my ($this,$tag,$attr,$attr_seq,$orig_txt) = @_;
+ $this->debug_line($orig_txt);
+
+ my $group = $this->get_define_group();
+ my $name = $attr->{name} or throw
+ Error::Simple("<$tag> requires NAME attribute.");
+
+ my $fs = $this->get_define_fieldspace();
+
+ $group->{provides}->{fields}->{$name}++;
+
+ # defer to the normal DEFINE operation..
+ $this->begin_pspdefine($tag,$attr,$attr_seq,$orig_txt);
+
+ # the normal operation should have created a field def.
+ my $field_def = $fs->{field_defs}->{$name} or throw
+ Error::Simple("Internal error: $name field not defined?!?");
+
+ # note the group of this field in the field def.
+ $field_def->{group} = $group->{name};
+ push @{$group->{field_names}}, $name;
+}
+
+=head2 end_group_pspdefine
+
+ [private] instance
+ () end_group_pspdefine (string $tag)
+
+=cut
+
+sub end_group_pspdefine {
+ my ($this,$tag) = @_;
+ $this->debug_line($tag);
+
+ # simply defer to the normal DEFINE operation..
+ $this->end_pspdefine($tag);
+}
+
+=head2 use_group
+
+ [private] instance
+ () use_group (string fsname)
+
+DESCRIPTION:
+
+=cut
+
+sub use_group {
+ my ($this,$gname) = @_;
+
+ # Construct the new full group name, with input name component.
+ my $full = join ".", (map{ $_->{name} } @{$this->{stack_grpuse}}), $gname;
+ $this->debug_line("gname[$gname],full[$full]");
+
+ # get the current fieldspace.
+ my $fs = $this->get_use_fieldspace();
+
+ my $group;
+ if (! ($group = $fs->{use_groups}->{$full})) {
+
+ # We are creating a new define context.
+ $group = $fs->{use_groups}->{$full} = {};
+
+ # Construct the group package.
+ my @pkgcomp = qw(PSP::FieldSpace::Group);
+ push @pkgcomp, $this->{pile_name} if $this->{pile_name};
+ push @pkgcomp, map { $_->{name} } @{$this->{stack_grpuse}};
+ push @pkgcomp, $gname;
+ my $package = join "::", @pkgcomp;
+
+ # Initialize these attributes.
+ $group->{name} = $gname;
+ $group->{fullname} = $full;
+ $group->{package} = $package;
+
+ $group->{requires} =
+ $this->{buildinfo}->{requires}->{groups}->{$full} ||= {};
+ }
+
+ push @{$this->{stack_grpuse}}, $group;
+
+ return $group;
+}
+
+=head2 get_use_group
+
+=cut
+
+sub get_use_group {
+ my ($this,$no_throw_on_fail) = @_;
+
+ # Construct the full group name.
+ my $full = join ".", map { $_->{name} } @{$this->{stack_grpuse}};
+ $this->debug_line("full[$full]");
+
+ # get the current fieldspace.
+ my $fs = $this->get_use_fieldspace();
+
+ # get the current group.
+ my $group = $fs->{use_groups}->{$full};
+
+ if (!$group and !$no_throw_on_fail) {
+ local $Error::Depth += 1;
+ throw Error::Simple("Group USE context expected.");
+ }
+
+ return $group;
+}
+
+=head2 pop_use_group
+
+ [private] instance
+ (hashref) pop_use_group()
+
+DESCRIPTION:
+
+Pops any current group USE context. Called by
+end_pspgroup().
+
+=cut
+
+sub pop_use_group {
+ my ($this) = @_;
+ $this->debug_line("last[$this->{stack_grpuse}->[-1]->{name}]");
+ return pop @{$this->{stack_grpuse}};
+}
+
=head2 begin_pspdynamicdisplay
[private] instance
@@ -130,46 +343,49 @@
sub begin_pspdynamicdisplay {
my ($this,$tag,$attr,$attr_seq,$orig_txt) = @_;
- my $fs = $this->get_use_fieldspace();
my $gname = $attr->{name} or throw
Error::Simple("<$tag> requires NAME attribute.");
- $fs->{use_group}->{$gname} ||= {};
-# my $group_def = $fs->{group_defs}->{$gname} or
-# $this->log_exception("There is no group defined for $gname.");
- $this->{dyndisp}->{$gname} and throw
- Error::Simple("<$tag> used in nested $gname \U$tag\E context.");
+ my $group = $this->use_group($gname);
- push @{$this->{stack_ddisplay}}, $gname;
+ # there should not be a current dynamicdisplay for this group.
+ $group->{dyndisp} and throw
+ Error::Simple("<$tag> used in nested $gname \U$tag\E context.");
- my $dyndisp = $this->{dyndisp}->{$gname} = {};
+ # define they current dynamicdisplay group element.
+ my %d; $group->{dyndisp} = \%d;
for my $p (qw(grp num obj)) {
- $dyndisp->{$p."var"} =
- ($attr->{$p."var"} || '$_'.$p.'_'.$gname);
-# ($attr->{$p."var"} || $group_def->{$p."var"} || '$_'.$p.'_'.$gname);
+ $d{$p."var"} = ($attr->{$p."var"} || '$_'.$p.'_'.$gname);
}
+ my $dummy_ok = quote_bareword($attr->{dummyok}) if defined $attr->{dummyok};
# note, index effectively starts at 1
$this->code("${gname}_setup:");
$this->begin_pspblock("setup($gname)");
- $this->code("my (".$dyndisp->{numvar}.",".$dyndisp->{objvar}.");");
- $this->code("my ".$dyndisp->{grpvar}." = \$fs->group('$gname');");
+ $this->code("my (".$d{numvar}.",".$d{objvar}.");");
+ $this->code("my ".$d{grpvar}." = \$fs->group('$gname');");
+ $this->code($d{grpvar}."->dummy_ok($dummy_ok);") if defined $dummy_ok;
if (my $num = $attr->{numdisplay}) {
- $this->code($dyndisp->{grpvar}."->{propagated_controls} or");
- $this->code(" ".$dyndisp->{grpvar}."->n_items_per_page($num);");
+ $this->code($d{grpvar}."->{propagated_controls} or");
+ $this->code(" ".$d{grpvar}."->n_items_per_page($num);");
}
- $this->code($dyndisp->{grpvar}."->set_cursor(".
- $dyndisp->{grpvar}."->first_item_n());");
+ $this->code($d{grpvar}."->set_cursor(".
+ $d{grpvar}."->first_item_n());");
$this->code("\$fs->errors_p() or");
- $this->code(" ".$dyndisp->{grpvar}."->import_controls(\$cgi);");
+ $this->code(" ".$d{grpvar}."->import_controls(\$cgi);");
$this->code("${gname}_loop:");
- $this->code("while (".$dyndisp->{grpvar}."->more_to_come())");
+ $this->code("while (".$d{grpvar}."->more_to_come())");
$this->begin_pspblock("while($gname->more_to_come)");
- $this->code($dyndisp->{numvar}." = ".$dyndisp->{grpvar}."->cursor();");
- $this->code($dyndisp->{objvar}." = ".$dyndisp->{grpvar}."->object();");
+ $this->code($d{numvar}." = ".$d{grpvar}."->cursor();");
+ $this->code($d{objvar}." = ".$d{grpvar}."->object();");
# $this->code("print STDERR \"top of $gname loop: ".
-# "\\".$dyndisp->{numvar}."='".$dyndisp->{numvar}."'\\n\";");
+# "\\".$d{numvar}."='".$d{numvar}."'\\n\";");
+
+ # Override default inherited tag definitions
+ my ($begin0,$end) = $this->handlers();
+ my $begin = { %$begin0 , 'psp:input' => \&begin_group_pspinput };
+ $this->push_handlers($begin,$end);
}
=head2 end_pspdynamicdisplay
@@ -186,19 +402,18 @@
sub end_pspdynamicdisplay {
my ($this,$tag) = @_;
- my $fs = $this->get_use_fieldspace();
- my $gname = pop @{$this->{stack_ddisplay}} or throw
- Error::Simple("<$tag> used outside of GROUP context");
- $fs->{use_group}->{$gname} ||= {};
-# my $group_def = $fs->{group_defs}->{$gname} or
-# $this->log_exception("There is no group defined for $gname.");
- my $dyndisp = delete $this->{dyndisp}->{$gname} or throw
+ my $group = $this->pop_use_group();
+ my $gname = $group->{name};
+
+ $this->pop_handlers();
+
+ my $d = delete $group->{dyndisp} or throw
Error::Simple("<$tag> used outside of $gname \U$tag\E context.");
$this->end_pspblock("while($gname->more_to_come)");
$this->code("continue");
$this->begin_pspblock("continue($gname->more_to_come)");
- $this->code($dyndisp->{grpvar}."->advance_cursor();");
+ $this->code($d->{grpvar}."->advance_cursor();");
$this->end_pspblock("continue($gname->more_to_come)");
$this->end_pspblock("setup($gname)");
@@ -219,12 +434,15 @@
my ($this,$tag,$attr,$attr_seq,$orig_txt) = @_;
$this->debug_line($orig_txt);
+ my $group = $this->get_use_group();
+
# defer to dynamic display
$this->begin_pspdynamicdisplay($tag,$attr,$attr_seq,$orig_txt);
- if (my $do_field = $attr->{field}) {
- $this->{current_do_field} = $do_field;
- $this->begin_pspfield($tag,{name => $do_field});
+ if (my $name = $attr->{field}) {
+ $this->{current_do_field} = $name;
+ $group->{requires}->{fields}->{$name}++;
+ $this->begin_pspfield($tag,{name => $name});
}
$this->script_mode();
@@ -253,42 +471,42 @@
$this->pop_handlers();
$this->script_mode(0);
- if (my $do_field = delete $this->{current_do_field}) {
+ if (my $name = delete $this->{current_do_field}) {
$this->end_pspfield($tag);
}
$this->end_pspdynamicdisplay($tag);
}
-sub begin_group_pspdefine {
- my ($this,$tag,$attr,$attr_seq,$orig_txt) = @_;
- $this->debug_line($orig_txt);
+=head2 begin_group_pspinput
- my $fs = $this->get_define_fieldspace();
+ [private] instance
+ () begin_group_pspinput (string $tag, \%attrs, \@atrseq, string $orig)
- my $group = $this->{stack_group}->[-1] or throw
- Error::Simple("Internal error: begin_pspdefine_group without a group?!?");
- my $name = $attr->{name} or throw
- Error::Simple("<$tag> requires NAME attribute.");
+DESCRIPTION:
- # defer to the normal DEFINE operation..
- $this->begin_pspdefine($tag,$attr,$attr_seq,$orig_txt);
+See PSP specification.
- # the normal operation should have created a field def.
- my $field_def = $fs->{field_defs}->{$name} or throw
- Error::Simple("Internal error: $name field not defined?!?");
+See PSP::Parser::FieldSpace for more information.
- # note the group of this field in the field def.
- $field_def->{group} = $group->{name};
- push @{$group->{field_names}}, $name;
-}
+=cut
-sub end_group_pspdefine {
- my ($this,$tag) = @_;
- $this->debug_line($tag);
+sub begin_group_pspinput {
+ my($this,$tag,$attr,$attr_seq,$orig_txt) = @_;
- # simply defer to the normal DEFINE operation..
- $this->end_pspdefine($tag);
+ if (! defined $attr->{group_index}) {
+ my $index = "";
+ for my $group (@{$this->{stack_grpuse}}) {
+ my $d = $group->{dyndisp} or throw
+ Error::Simple("Nested used group without nested display???");
+ $index .= "," if length $index;
+ $index .= $d->{numvar};
+ }
+ $attr->{group_index} = $index;
+ }
+
+ # defer to the normal DEFINE operation..
+ $this->begin_pspinput($tag,$attr,$attr_seq,$orig_txt);
}
=head2 begin_pspindexoverride
@@ -305,12 +523,8 @@
sub begin_pspindexoverride {
my ($this, $tag, $attr) = @_;
- my $fs = $this->get_use_fieldspace();
- my $gname = $attr->{group} or throw
- Error::Simple("<$tag> requires GROUP attribute.");
- $fs->{use_group}->{$gname} ||= {};
-# my $group = $fs->{group_defs}->{$gname} or
-# $this->log_exception("There is no group defined for $gname.");
+ my $group = $this->get_use_group();
+ my $gname = $group->{name};
my $test = defined $attr->{test} ? $attr->{test} : '1';
my $previous = bool_att($attr->{previous});
@@ -319,17 +533,10 @@
# (!$previous and !($steps and $number)) and throw
# Error::Simple("<$tag>: PREVIOUS attribute requires STEP");
- $this->code("if ($test) {");
- if ($previous) {
- $this->code(" \$_dd_index_$gname = \$_prev_dd_index_$gname;");
-# } elsif ($steps) {
-# $this->code(" \$_dd_index_$gname += \$number * $steps;");
- }
- $this->code(" \$cgi->param('_dd_index_$gname', \$_dd_index_$gname);");
-
- #$this->fs_init_code($fsname);
-
- $this->code('}');
+ $this->code("if ($test) ");
+ $this->begin_pspblock("indexoverride-if");
+ $this->code("# insert code here to control the starting index of dd.");
+ $this->end_pspblock("indexoverride-if");
}
=head2 begin_psprollto
@@ -348,11 +555,11 @@
$this->debug_line($orig_txt);
my $fs = $this->get_use_fieldspace();
+
my $gname = $attr->{group} or throw
Error::Simple("<$tag> requires GROUP attribute.");
- $fs->{use_group}->{$gname} ||= {};
-# my $group = $fs->{group_defs}->{$gname} or throw
-# Error::Simple("GROUP $gname does not exist in ".ref($fs));
+ my $group = $this->use_group($gname);
+
my $name = $attr->{name} || "$gname:rollto";
my $text = $attr->{text} || "Go to page -->";
@@ -366,7 +573,7 @@
$this->code("my \$_grp = \$fs->group('$gname');");
my $qname = quote_bareword($name);
my $qtext = quote_bareword($text);
- $this->code("\$out->put(\$_grp->html_page_select($qtext,$qname));");
+ $this->code("\$\$out.=(\$_grp->html_page_select($qtext,$qname));");
$this->end_pspblock("rollto($gname)");
# prepare the call for and call pspsubmit
@@ -396,6 +603,9 @@
sub end_psprollto {
my ($this,$orig_txt) = @_;
+
+ my $group = $this->pop_use_group();
+
return $this->end_pspsubmit($orig_txt);
}
@@ -415,11 +625,11 @@
$this->debug_line($orig_txt);
my $fs = $this->get_use_fieldspace();
- my $gname = $attr->{group} or
- throw Error::Simple("<$tag> requires GROUP attribute.");
- $fs->{use_group}->{$gname} ||= {};
-# my $group = $fs->{group_defs}->{$gname} or throw
-# Error::Simple("GROUP $gname does not exist in ".ref($fs));
+
+ my $gname = $attr->{group} or throw
+ Error::Simple("<$tag> requires GROUP attribute.");
+ my $group = $this->use_group($gname);
+
my $name = $attr->{name} || "$gname:rollover";
my $text = $attr->{text} || "Next >>";
@@ -430,11 +640,11 @@
$this->begin_pspblock("rollover($gname)");
$this->code("my \$_grp = \$fs->group('$gname');");
- $this->code('if ($_grp->{dummy_ok} or $_grp->page_n() < $_grp->n_pages())');
+ $this->code('if ($_grp->dummy_ok() or $_grp->page_n() < $_grp->n_pages())');
$this->begin_pspblock("index($gname)");
my $qname = quote_bareword($name);
my $qtext = quote_bareword($text);
- $this->code("\$out->put(\$_grp->html_next_page_button($qtext,$qname));");
+ $this->code("\$\$out.=(\$_grp->html_next_page_button($qtext,$qname));");
$this->end_pspblock("index($gname)");
$this->end_pspblock("rollover($gname)");
@@ -467,6 +677,7 @@
sub end_psprollover {
my ($this,$orig_txt) = @_;
+ my $group = $this->pop_use_group();
return $this->end_pspsubmit($orig_txt);
}
@@ -485,13 +696,12 @@
my ($this,$tag,$attr,$attr_seq,$orig_txt) = @_;
$this->debug_line($orig_txt);
- my $fs = $this->get_use_fieldspace() or throw
- Error::Simple("<$tag> called outside of FIELDSPACE context.");
+ my $fs = $this->get_use_fieldspace();
+
my $gname = $attr->{group} or throw
Error::Simple("<$tag> requires GROUP attribute.");
- $fs->{use_group}->{$gname} ||= {};
-# my $group = $fs->{group_defs}->{$gname} or throw
-# Error::Simple("GROUP $gname does not exist in ".ref($fs));
+ my $group = $this->use_group($gname);
+
my $name = $attr->{name} || "$gname:rollback";
my $text = $attr->{text} || "<< Previous";
@@ -506,7 +716,7 @@
$this->begin_pspblock("index($gname)");
my $qname = quote_bareword($name);
my $qtext = quote_bareword($text);
- $this->code("\$out->put(\$_grp->html_prev_page_button($qtext,$qname));");
+ $this->code("\$\$out.=(\$_grp->html_prev_page_button($qtext,$qname));");
$this->end_pspblock("index($gname)");
$this->end_pspblock("rollback($gname)");
@@ -539,6 +749,7 @@
sub end_psprollback {
my ($this,$orig_txt) = @_;
+ my $group = $this->pop_use_group();
return $this->end_pspsubmit($orig_txt);
}
@@ -559,11 +770,11 @@
$this->debug_line($orig_txt);
my $fs = $this->get_use_fieldspace();
- my $gname = $attr->{group} or
- throw Error::Simple("<$tag> requires GROUP attribute.");
- $fs->{use_group}->{$gname} ||= {};
-# my $group = $fs->{group_defs}->{$gname} or throw
-# Error::Simple("GROUP $gname does not exist in ".ref($fs));
+
+ my $gname = $attr->{group} or throw
+ Error::Simple("<$tag> requires GROUP attribute.");
+ my $group = $this->use_group($gname);
+
my $name = $attr->{name} || "$gname:refresh";
my $text = $attr->{text} || "Refresh";
@@ -576,7 +787,7 @@
$this->code("my \$_grp = \$fs->group('$gname');");
my $qname = quote_bareword($name);
my $qtext = quote_bareword($text);
- $this->code("\$out->put(\$_grp->html_refresh_button($qtext,$qname));");
+ $this->code("\$\$out.=(\$_grp->html_refresh_button($qtext,$qname));");
$this->end_pspblock("refresh($gname)");
# prepare the call for and call pspsubmit
@@ -608,6 +819,7 @@
sub end_psprefresh {
my ($this,$orig_txt) = @_;
+ my $group = $this->pop_use_group();
return $this->end_pspsubmit($orig_txt);
}
@@ -653,11 +865,11 @@
sub process_groups {
my ($fs) = @_;
- my $group_defs = $fs->{group_defs} || {};
+ my $groups = $fs->{group_defs} || {};
my $out = "";
- for my $gname (sort keys %$group_defs) {
- my $group = $group_defs->{$gname};
+ for my $gname (sort keys %$groups) {
+ my $group = $groups->{$gname};
$out .= process_group($fs,$group);
}
return $out;
|
|
From: James E. J. Jr. <mu...@us...> - 2003-08-02 06:17:00
|
Update of /cvsroot/psp/psp/lib/tools/Parser
In directory sc8-pr-cvs1:/tmp/cvs-serv27689/psp/lib/tools/Parser
Modified Files:
Page.pm
Log Message:
added psp:call and psp:sub features.
$out is now local() -- no longer lexical -- allows for a lexical $out.
treat $out as scalar ref.
use local() on special page variables when detected.
Index: Page.pm
===================================================================
RCS file: /cvsroot/psp/psp/lib/tools/Parser/Page.pm,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -r1.5 -r1.6
--- Page.pm 12 Nov 2002 22:25:44 -0000 1.5
+++ Page.pm 2 Aug 2003 06:16:57 -0000 1.6
@@ -27,7 +27,7 @@
@propagatable @persist_prop);
BEGIN {
@ISA = qw(PSP::Parser);
- @handled = qw(script declare comment include nop);
+ @handled = qw(script declare comment include call sub nop);
};
=head1 TAG HANDLERS
@@ -243,6 +243,102 @@
my ($this, $orig_txt) = @_;
}
+=head2 begin_pspcall
+
+ [private] instance
+ () begin_pspcall (string $tag, \%attributes)
+
+DESCRIPTION:
+
+See PSP specification.
+
+XXX
+
+=cut
+
+sub begin_pspcall {
+ my ($this, $tag, $attr, $tagseq, $orig) = @_;
+ $this->debug_line($orig);
+
+ #validate input.
+ my $src = $attr->{src};
+ my $name = $attr->{name};
+ my $args = $attr->{args};
+ (defined($src) xor defined($name)) or
+ Error::Simple("<$tag> requires only one of SRC or NAME attribute.");
+
+ # XXX src -> name or name -> src may become more complex.
+ if (defined $name) {
+ $src = $name.".inc";
+ } else {
+ ($name = $src) =~ s/\.[^\.]+$//;
+ }
+
+ my $subdef = $this->include_sub($src);
+
+ $args ||= $subdef->{default_args} || "";
+
+ my $page_name = $this->{page_name};
+ my $pile_name = $this->{pile_name};
+ my $package = $pile_name ? "Pile::".$pile_name : "Page::".$page_name;
+
+ $this->begin_pspblock("call:");
+ $this->code("my \$sub_out = \$page->$name($args);");
+ $this->code("\$\${${package}::out}.=".'ref($sub_out) ? $$sub_out : $sub_out;');
+ $this->end_pspblock("call:");
+}
+sub end_pspcall {
+ my ($this, $orig_txt) = @_;
+}
+
+=head2 begin_pspsub
+
+ [private] instance
+ () begin_pspsub (string $tag, \%attributes)
+
+DESCRIPTION:
+
+See PSP specification.
+
+Define characteristics of the compilation unit as a subroutine.
+
+=cut
+
+sub begin_pspsub {
+ my ($this, $tag, $attr, $tagseq, $orig) = @_;
+ $this->debug_line($orig);
+
+ $this->{subdef} and throw
+ Error::Simple("Multiple <$tag> not allowed in compilation unit");
+
+ my $name = $attr->{name};
+ my $prototype = $attr->{prototype} || $attr->{proto} || "";
+ my $default_args = $attr->{default_args};
+
+ if (! $name) {
+ # XXX we need a better way to find the current compilation unit name.
+ ($name = $this->{current_fname}) =~ s,.*/,,;
+ $name =~ s,\.[^.]+$,,;
+ $name =~ s/\./_/g;
+ }
+
+ if (! defined $default_args) {
+ # XXX prototype will likely be perl6-ish and more complex than this.
+ $default_args = $prototype;
+ }
+
+ $this->{subdef} =
+ {name => $name,
+ prototype => $prototype,
+ default_args => $default_args
+ };
+
+ return $this->{subdef};
+}
+sub end_pspsub {
+ my ($this, $orig_txt) = @_;
+}
+
=head2 generate
[public] instance
@@ -270,9 +366,9 @@
my $page_code = $context->{code};
my $decl_code = $context->{decl};
- # MIC compatibility hack: convert output() -> $out->put()
+ # MIC compatibility hack: convert output() -> $$out.=()
if ($this->{back_compat}) {
- $page_code =~ s/ \boutput\( / \$out->put\( /g;
+ $page_code =~ s/ \boutput\( / \$\${${package}::out}.=\( /g;
}
my $page_method;
@@ -299,6 +395,26 @@
$this->{new_fieldspaces} and @{$this->{new_fieldspaces}} ) {
return "";
}
+
+ my $args;
+ if (my $subdef = $this->{subdef}) {
+ $args = $subdef->{default_args} || $subdef->{prototype};
+ }
+
+ my @sub_decl;
+ push @sub_decl, " local \${${package}::page} = shift \@_;";
+ $args and
+ push @sub_decl, " my ($args) = \@_;";
+ $page_code =~ /\bpage_args\b/ and
+ push @sub_decl, " local \@{${package}::page_args} = \@_;";
+ $page_code =~ /\bpile\b/ and
+ push @sub_decl, " local \${${package}::pile} = \$page;";
+ $page_code =~ /\bpage_name\b/ and
+ push @sub_decl, " local \${${package}::page_name} = (caller(0))[3];",
+ " \${${package}::page_name} =~ s/.*::page__//;";
+ $page_code =~ /\bcgi\b/ and
+ push @sub_decl, " local \${${package}::cgi} = \$page->cgi();";
+ push @sub_decl, " local \${${package}::out} = PSP::Output->new();";
#print the page that we just parsed
return join("\n",
@@ -306,11 +422,7 @@
"package $package;",
($decl_code?($decl_code):()),
"sub $page_method {",
- ' my ($page) = @_;',
- ' my $pile = $page;',
- ' (my $page_name = (caller(0))[3]) =~ s/.*::page__//;',
- ' my $cgi = $page->cgi();',
- ' my $out = PSP::Output->new();',
+ @sub_decl,
'',
$page_code,
'',
|
|
From: James E. J. Jr. <mu...@us...> - 2003-08-02 06:16:56
|
Update of /cvsroot/psp/psp/lib/tools/Parser
In directory sc8-pr-cvs1:/tmp/cvs-serv27675/psp/lib/tools/Parser
Modified Files:
Error.pm
Log Message:
$out is now local() -- no longer lexical -- allows for a lexical $out.
treat $out as scalar ref.
declare need for $fs lexical within error report context.
make sure fieldspace is defined before processing with report.
Index: Error.pm
===================================================================
RCS file: /cvsroot/psp/psp/lib/tools/Parser/Error.pm,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- Error.pm 21 Nov 2002 16:24:21 -0000 1.3
+++ Error.pm 2 Aug 2003 06:16:53 -0000 1.4
@@ -65,7 +65,8 @@
$title = "Errors Were Encountered" unless defined $title;
- $this->code('if ($fs->errors_p())');
+ $this->context_lexical('$fs');
+ $this->code('if ($fs && $fs->errors_p())');
$this->begin_pspblock('if fs->errors_p');
$this->code('my $field_errors = 0;');
@@ -98,8 +99,11 @@
# process the error object here when doing "full".
if ($do_full) {
+ my $page_name = $this->{page_name};
+ my $pile_name = $this->{pile_name};
+ my $package = $pile_name ? "Pile::".$pile_name : "Page::".$page_name;
$this->code('$error_obj->isa("field") and $field_errors++;');
- $this->code('$out->put( $error_obj->as_bullets() );');
+ $this->code("\$\${${package}::out}.=( \$error_obj->as_bullets() );");
}
}
|
|
From: James E. J. Jr. <mu...@us...> - 2003-08-02 06:16:52
|
Update of /cvsroot/psp/psp/lib/tools/FieldSpace
In directory sc8-pr-cvs1:/tmp/cvs-serv27658/psp/lib/tools/FieldSpace
Modified Files:
Propagation.pm
Log Message:
do not consider empty string to be a pair.
Index: Propagation.pm
===================================================================
RCS file: /cvsroot/psp/psp/lib/tools/FieldSpace/Propagation.pm,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- Propagation.pm 1 Nov 2002 22:59:34 -0000 1.3
+++ Propagation.pm 2 Aug 2003 06:16:49 -0000 1.4
@@ -186,6 +186,7 @@
@pairs or @values or next;
$group->{import_controls} = [];
for my $pair (@pairs) {
+ length($pair) or last;
my ($key,$value) = ($pair =~ /^([^=]+)=(.*)$/);
push @{$group->{import_controls}}, $key => $value;
}
|
|
From: James E. J. Jr. <mu...@us...> - 2003-08-02 06:16:48
|
Update of /cvsroot/psp/psp/lib/tools/FieldSpace
In directory sc8-pr-cvs1:/tmp/cvs-serv27645/psp/lib/tools/FieldSpace
Modified Files:
Group.pm
Log Message:
we now use dummy_ok() accessor.
make sure n_items() is 0 when undefined.
Index: Group.pm
===================================================================
RCS file: /cvsroot/psp/psp/lib/tools/FieldSpace/Group.pm,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- Group.pm 1 Nov 2002 22:59:34 -0000 1.3
+++ Group.pm 2 Aug 2003 06:16:46 -0000 1.4
@@ -127,6 +127,7 @@
sub n_items_per_page { shift->gen_value('n_items_per_page', @_) }
sub n_pages_at_a_time { shift->gen_value('n_pages_at_a_time', @_) }
sub poss_n_items_per_page { shift->gen_value('poss_n_items_per_page', @_) }
+sub dummy_ok { shift->gen_value('dummy_ok', @_) }
sub gen_int_rule {
my ($this,$name,$val) = @_;
@@ -221,7 +222,7 @@
# if we have dummy_ok, do not guess any further than the number
# of the last object we currently have.
- if (!$this->{dummy_ok}) {
+ if (!$this->dummy_ok()) {
# otherwise, compute the next objects until we find the last one.
# leave the objects array sparse, but cache the last object.
@@ -252,7 +253,7 @@
$this->cursor() - $this->first_item_n() >= $this->n_items_per_page()) {
return undef;
}
- return($this->object() || $this->{dummy_ok});
+ return($this->object() || $this->dummy_ok());
}
sub object {
@@ -318,7 +319,7 @@
$index or $index = $this->cursor();
if (defined $field) {
$this->{fields}->{$field_name}->[$index-1] = $field;
- $this->n_items($index) if $index > $this->n_items();
+ $this->n_items($index) if $index > ($this->n_items()||0);
}
return unless $this->{fields}->{$field_name};
return $this->{fields}->{$field_name}->[$index-1];
@@ -503,7 +504,7 @@
$new_first_item_n = 1;
}
# next, validate upper boundary.
- if (! $this->{dummy_ok} and $new_first_item_n > $this->n_items()) {
+ if (! $this->dummy_ok() and $new_first_item_n > $this->n_items()) {
$new_first_item_n = $this->first_item_n_from_page_n($this->n_pages());
}
# if the $new_first_item is the same as current, it is not new.
|
|
From: James E. J. Jr. <mu...@us...> - 2003-08-02 06:16:46
|
Update of /cvsroot/psp/psp/lib/parser
In directory sc8-pr-cvs1:/tmp/cvs-serv27592/psp/lib/parser
Modified Files:
PilerBase.pm
Log Message:
commented debug statements would now go to STDERR.
Index: PilerBase.pm
===================================================================
RCS file: /cvsroot/psp/psp/lib/parser/PilerBase.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- PilerBase.pm 1 Nov 2002 22:58:58 -0000 1.1
+++ PilerBase.pm 2 Aug 2003 06:16:34 -0000 1.2
@@ -210,9 +210,9 @@
}
# remove the input directory from each path.
- #print "before: (@out) - $input_dir;\n";
+ #print STDERR "before: (@out) - $input_dir;\n";
grep s/^$input_dir\///, @out if $input_dir;
- #print "after: (@out);\n";
+ #print STDERR "after: (@out);\n";
$this->{verbose} and print "found ".@out." sources in $input.\n";
|
