You are viewing a plain text version of this content. The canonical link for it is here.
Posted to site-cvs@tcl.apache.org by mx...@apache.org on 2013/12/03 17:35:08 UTC
svn commit: r1547463 - in /tcl/rivet/trunk: ChangeLog Makefile.in
doc/xml/commands.xml rivet/packages/dio/dio.tcl
rivet/packages/dio/dio_Mysql.tcl rivet/rivet-tcl/lassign_array.tcl
rivet/rivet-tcl/tclIndex src/apache-2/mod_rivet.c
Author: mxmanghi
Date: Tue Dec 3 16:35:08 2013
New Revision: 1547463
URL: http://svn.apache.org/r1547463
Log:
* src/apache-2/mod_rivet.c: Rivet template preprocessor symbols renamed in
the more expressive RIVET_TEMPLATE and RIVET_TCLFILE
* rivet/rivet-tcl/lassing_array.tcl: new command lassing_array taken
from DIO's result set class (inspired by Tclx)
* doc/xml/commands.xml: lassign_array documented in the manual
* rivet/packages/dio/dio.tcl: reformatted during analysis for supporting
tdbc based driver
Added:
tcl/rivet/trunk/rivet/rivet-tcl/lassign_array.tcl (with props)
Modified:
tcl/rivet/trunk/ChangeLog
tcl/rivet/trunk/Makefile.in
tcl/rivet/trunk/doc/xml/commands.xml
tcl/rivet/trunk/rivet/packages/dio/dio.tcl
tcl/rivet/trunk/rivet/packages/dio/dio_Mysql.tcl
tcl/rivet/trunk/rivet/rivet-tcl/tclIndex
tcl/rivet/trunk/src/apache-2/mod_rivet.c
Modified: tcl/rivet/trunk/ChangeLog
URL: http://svn.apache.org/viewvc/tcl/rivet/trunk/ChangeLog?rev=1547463&r1=1547462&r2=1547463&view=diff
==============================================================================
--- tcl/rivet/trunk/ChangeLog (original)
+++ tcl/rivet/trunk/ChangeLog Tue Dec 3 16:35:08 2013
@@ -1,3 +1,12 @@
+2013-12-03 Massimo Manghi <mx...@apache.org>
+ * src/apache-2/mod_rivet.c: Rivet template preprocessor symbols renamed in
+ the more expressive RIVET_TEMPLATE and RIVET_TCLFILE
+ * rivet/rivet-tcl/lassing_array.tcl: new command lassing_array taken
+ from DIO's result set class (inspired by Tclx)
+ * doc/xml/commands.xml: lassign_array documented in the manual
+ * rivet/packages/dio/dio.tcl: reformatted during analysis for supporting
+ tdbc based driver
+
2013-11-04 Massimo Manghi <mx...@apache.org>
* src/Makefile.am: this Makefile.am is now in charge for building mod_rivet
librivet.so and librivetparser.so. This fixes and problem with the 'distclean'
Modified: tcl/rivet/trunk/Makefile.in
URL: http://svn.apache.org/viewvc/tcl/rivet/trunk/Makefile.in?rev=1547463&r1=1547462&r2=1547463&view=diff
==============================================================================
--- tcl/rivet/trunk/Makefile.in (original)
+++ tcl/rivet/trunk/Makefile.in Tue Dec 3 16:35:08 2013
@@ -1,8 +1,9 @@
-# Makefile.in generated by automake 1.14 from Makefile.am.
+# Makefile.in generated by automake 1.11.6 from Makefile.am.
# @configure_input@
-# Copyright (C) 1994-2013 Free Software Foundation, Inc.
-
+# Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002,
+# 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011 Free Software
+# Foundation, Inc.
# This Makefile.in is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
@@ -24,51 +25,23 @@
# before invoking pkg_mkIndex.
# 2013/01/20: removing libtool created .la files
VPATH = @srcdir@
-am__is_gnu_make = test -n '$(MAKEFILE_LIST)' && test -n '$(MAKELEVEL)'
-am__make_running_with_option = \
- case $${target_option-} in \
- ?) ;; \
- *) echo "am__make_running_with_option: internal error: invalid" \
- "target option '$${target_option-}' specified" >&2; \
- exit 1;; \
- esac; \
- has_opt=no; \
- sane_makeflags=$$MAKEFLAGS; \
- if $(am__is_gnu_make); then \
- sane_makeflags=$$MFLAGS; \
- else \
+am__make_dryrun = \
+ { \
+ am__dry=no; \
case $$MAKEFLAGS in \
*\\[\ \ ]*) \
- bs=\\; \
- sane_makeflags=`printf '%s\n' "$$MAKEFLAGS" \
- | sed "s/$$bs$$bs[$$bs $$bs ]*//g"`;; \
- esac; \
- fi; \
- skip_next=no; \
- strip_trailopt () \
- { \
- flg=`printf '%s\n' "$$flg" | sed "s/$$1.*$$//"`; \
- }; \
- for flg in $$sane_makeflags; do \
- test $$skip_next = yes && { skip_next=no; continue; }; \
- case $$flg in \
- *=*|--*) continue;; \
- -*I) strip_trailopt 'I'; skip_next=yes;; \
- -*I?*) strip_trailopt 'I';; \
- -*O) strip_trailopt 'O'; skip_next=yes;; \
- -*O?*) strip_trailopt 'O';; \
- -*l) strip_trailopt 'l'; skip_next=yes;; \
- -*l?*) strip_trailopt 'l';; \
- -[dEDm]) skip_next=yes;; \
- -[JT]) skip_next=yes;; \
+ echo 'am--echo: ; @echo "AM" OK' | $(MAKE) -f - 2>/dev/null \
+ | grep '^AM OK$$' >/dev/null || am__dry=yes;; \
+ *) \
+ for am__flg in $$MAKEFLAGS; do \
+ case $$am__flg in \
+ *=*|--*) ;; \
+ *n*) am__dry=yes; break;; \
+ esac; \
+ done;; \
esac; \
- case $$flg in \
- *$$target_option*) has_opt=yes; break;; \
- esac; \
- done; \
- test $$has_opt = yes
-am__make_dryrun = (target_option=n; $(am__make_running_with_option))
-am__make_keepgoing = (target_option=k; $(am__make_running_with_option))
+ test $$am__dry = yes; \
+ }
pkgdatadir = $(datadir)/@PACKAGE@
pkgincludedir = $(includedir)/@PACKAGE@
pkglibdir = $(libdir)/@PACKAGE@
@@ -88,20 +61,16 @@ POST_UNINSTALL = :
build_triplet = @build@
host_triplet = @host@
subdir = .
-DIST_COMMON = $(srcdir)/Makefile.in $(srcdir)/Makefile.am \
- $(top_srcdir)/configure $(am__configure_deps) \
- $(srcdir)/config.h.in ChangeLog tclconfig/ChangeLog INSTALL \
- README TODO tclconfig/compile tclconfig/config.guess \
+DIST_COMMON = README $(am__configure_deps) $(srcdir)/Makefile.am \
+ $(srcdir)/Makefile.in $(srcdir)/config.h.in \
+ $(top_srcdir)/configure ChangeLog INSTALL TODO \
+ tclconfig/ChangeLog tclconfig/compile tclconfig/config.guess \
tclconfig/config.sub tclconfig/depcomp tclconfig/install-sh \
- tclconfig/missing tclconfig/ltmain.sh \
- $(top_srcdir)/tclconfig/compile \
- $(top_srcdir)/tclconfig/config.guess \
- $(top_srcdir)/tclconfig/config.sub \
- $(top_srcdir)/tclconfig/install-sh \
- $(top_srcdir)/tclconfig/ltmain.sh \
- $(top_srcdir)/tclconfig/missing
+ tclconfig/ltmain.sh tclconfig/missing
ACLOCAL_M4 = $(top_srcdir)/aclocal.m4
am__aclocal_m4_deps = $(top_srcdir)/m4/ax_compare_version.m4 \
+ $(top_srcdir)/m4/ltoptions.m4 $(top_srcdir)/m4/ltsugar.m4 \
+ $(top_srcdir)/m4/ltversion.m4 $(top_srcdir)/m4/lt~obsolete.m4 \
$(top_srcdir)/acinclude.m4 $(top_srcdir)/tclconfig/tcl.m4 \
$(top_srcdir)/tclconfig/libtool.m4 \
$(top_srcdir)/m4/ax_prefix_config_h.m4 \
@@ -114,28 +83,15 @@ mkinstalldirs = $(install_sh) -d
CONFIG_HEADER = config.h
CONFIG_CLEAN_FILES =
CONFIG_CLEAN_VPATH_FILES =
-AM_V_P = $(am__v_P_@AM_V@)
-am__v_P_ = $(am__v_P_@AM_DEFAULT_V@)
-am__v_P_0 = false
-am__v_P_1 = :
-AM_V_GEN = $(am__v_GEN_@AM_V@)
-am__v_GEN_ = $(am__v_GEN_@AM_DEFAULT_V@)
-am__v_GEN_0 = @echo " GEN " $@;
-am__v_GEN_1 =
-AM_V_at = $(am__v_at_@AM_V@)
-am__v_at_ = $(am__v_at_@AM_DEFAULT_V@)
-am__v_at_0 = @
-am__v_at_1 =
SOURCES =
DIST_SOURCES =
-RECURSIVE_TARGETS = all-recursive check-recursive cscopelist-recursive \
- ctags-recursive dvi-recursive html-recursive info-recursive \
- install-data-recursive install-dvi-recursive \
- install-exec-recursive install-html-recursive \
- install-info-recursive install-pdf-recursive \
- install-ps-recursive install-recursive installcheck-recursive \
- installdirs-recursive pdf-recursive ps-recursive \
- tags-recursive uninstall-recursive
+RECURSIVE_TARGETS = all-recursive check-recursive dvi-recursive \
+ html-recursive info-recursive install-data-recursive \
+ install-dvi-recursive install-exec-recursive \
+ install-html-recursive install-info-recursive \
+ install-pdf-recursive install-ps-recursive install-recursive \
+ installcheck-recursive installdirs-recursive pdf-recursive \
+ ps-recursive uninstall-recursive
am__can_run_installinfo = \
case $$AM_UPDATE_INFO_DIR in \
n|no|NO) false;; \
@@ -143,33 +99,11 @@ am__can_run_installinfo = \
esac
RECURSIVE_CLEAN_TARGETS = mostlyclean-recursive clean-recursive \
distclean-recursive maintainer-clean-recursive
-am__recursive_targets = \
- $(RECURSIVE_TARGETS) \
- $(RECURSIVE_CLEAN_TARGETS) \
- $(am__extra_recursive_targets)
-AM_RECURSIVE_TARGETS = $(am__recursive_targets:-recursive=) TAGS CTAGS \
- cscope distdir dist dist-all distcheck
-am__tagged_files = $(HEADERS) $(SOURCES) $(TAGS_FILES) \
- $(LISP)config.h.in
-# Read a list of newline-separated strings from the standard input,
-# and print each of them once, without duplicates. Input order is
-# *not* preserved.
-am__uniquify_input = $(AWK) '\
- BEGIN { nonempty = 0; } \
- { items[$$0] = 1; nonempty = 1; } \
- END { if (nonempty) { for (i in items) print i; }; } \
-'
-# Make sure the list of sources is unique. This is necessary because,
-# e.g., the same source file might be shared among _SOURCES variables
-# for different programs/libraries.
-am__define_uniq_tagged_files = \
- list='$(am__tagged_files)'; \
- unique=`for i in $$list; do \
- if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \
- done | $(am__uniquify_input)`
+AM_RECURSIVE_TARGETS = $(RECURSIVE_TARGETS:-recursive=) \
+ $(RECURSIVE_CLEAN_TARGETS:-recursive=) tags TAGS ctags CTAGS \
+ distdir dist dist-all distcheck
ETAGS = etags
CTAGS = ctags
-CSCOPE = cscope
DIST_SUBDIRS = $(SUBDIRS)
DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST)
distdir = $(PACKAGE)-$(VERSION)
@@ -180,7 +114,6 @@ am__remove_distdir = \
&& rm -rf "$(distdir)" \
|| { sleep 5 && rm -rf "$(distdir)"; }; \
else :; fi
-am__post_remove_distdir = $(am__remove_distdir)
am__relativize = \
dir0=`pwd`; \
sed_first='s,^\([^/]*\)/.*$$,\1,'; \
@@ -208,14 +141,12 @@ am__relativize = \
reldir="$$dir2"
DIST_ARCHIVES = $(distdir).tar.gz
GZIP_ENV = --best
-DIST_TARGETS = dist-gzip
distuninstallcheck_listfiles = find . -type f -print
am__distuninstallcheck_listfiles = $(distuninstallcheck_listfiles) \
| sed 's|^\./|$(prefix)/|' | grep -v '$(infodir)/dir$$'
distcleancheck_listfiles = find . -type f -print
ACLOCAL = @ACLOCAL@
AMTAR = @AMTAR@
-AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@
APR_CPPFLAGS = @APR_CPPFLAGS@
APR_INCLUDES = @APR_INCLUDES@
APR_LDFLAGS = @APR_LDFLAGS@
@@ -449,8 +380,8 @@ $(ACLOCAL_M4): $(am__aclocal_m4_deps)
$(am__aclocal_m4_deps):
config.h: stamp-h1
- @test -f $@ || rm -f stamp-h1
- @test -f $@ || $(MAKE) $(AM_MAKEFLAGS) stamp-h1
+ @if test ! -f $@; then rm -f stamp-h1; else :; fi
+ @if test ! -f $@; then $(MAKE) $(AM_MAKEFLAGS) stamp-h1; else :; fi
stamp-h1: $(srcdir)/config.h.in $(top_builddir)/config.status
@rm -f stamp-h1
@@ -473,25 +404,22 @@ distclean-libtool:
-rm -f libtool config.lt
# This directory's subdirectories are mostly independent; you can cd
-# into them and run 'make' without going through this Makefile.
-# To change the values of 'make' variables: instead of editing Makefiles,
-# (1) if the variable is set in 'config.status', edit 'config.status'
-# (which will cause the Makefiles to be regenerated when you run 'make');
-# (2) otherwise, pass the desired values on the 'make' command line.
-$(am__recursive_targets):
- @fail=; \
- if $(am__make_keepgoing); then \
- failcom='fail=yes'; \
- else \
- failcom='exit 1'; \
- fi; \
+# into them and run `make' without going through this Makefile.
+# To change the values of `make' variables: instead of editing Makefiles,
+# (1) if the variable is set in `config.status', edit `config.status'
+# (which will cause the Makefiles to be regenerated when you run `make');
+# (2) otherwise, pass the desired values on the `make' command line.
+$(RECURSIVE_TARGETS):
+ @fail= failcom='exit 1'; \
+ for f in x $$MAKEFLAGS; do \
+ case $$f in \
+ *=* | --[!k]*);; \
+ *k*) failcom='fail=yes';; \
+ esac; \
+ done; \
dot_seen=no; \
target=`echo $@ | sed s/-recursive//`; \
- case "$@" in \
- distclean-* | maintainer-clean-*) list='$(DIST_SUBDIRS)' ;; \
- *) list='$(SUBDIRS)' ;; \
- esac; \
- for subdir in $$list; do \
+ list='$(SUBDIRS)'; for subdir in $$list; do \
echo "Making $$target in $$subdir"; \
if test "$$subdir" = "."; then \
dot_seen=yes; \
@@ -506,12 +434,57 @@ $(am__recursive_targets):
$(MAKE) $(AM_MAKEFLAGS) "$$target-am" || exit 1; \
fi; test -z "$$fail"
-ID: $(am__tagged_files)
- $(am__define_uniq_tagged_files); mkid -fID $$unique
-tags: tags-recursive
-TAGS: tags
+$(RECURSIVE_CLEAN_TARGETS):
+ @fail= failcom='exit 1'; \
+ for f in x $$MAKEFLAGS; do \
+ case $$f in \
+ *=* | --[!k]*);; \
+ *k*) failcom='fail=yes';; \
+ esac; \
+ done; \
+ dot_seen=no; \
+ case "$@" in \
+ distclean-* | maintainer-clean-*) list='$(DIST_SUBDIRS)' ;; \
+ *) list='$(SUBDIRS)' ;; \
+ esac; \
+ rev=''; for subdir in $$list; do \
+ if test "$$subdir" = "."; then :; else \
+ rev="$$subdir $$rev"; \
+ fi; \
+ done; \
+ rev="$$rev ."; \
+ target=`echo $@ | sed s/-recursive//`; \
+ for subdir in $$rev; do \
+ echo "Making $$target in $$subdir"; \
+ if test "$$subdir" = "."; then \
+ local_target="$$target-am"; \
+ else \
+ local_target="$$target"; \
+ fi; \
+ ($(am__cd) $$subdir && $(MAKE) $(AM_MAKEFLAGS) $$local_target) \
+ || eval $$failcom; \
+ done && test -z "$$fail"
+tags-recursive:
+ list='$(SUBDIRS)'; for subdir in $$list; do \
+ test "$$subdir" = . || ($(am__cd) $$subdir && $(MAKE) $(AM_MAKEFLAGS) tags); \
+ done
+ctags-recursive:
+ list='$(SUBDIRS)'; for subdir in $$list; do \
+ test "$$subdir" = . || ($(am__cd) $$subdir && $(MAKE) $(AM_MAKEFLAGS) ctags); \
+ done
+
+ID: $(HEADERS) $(SOURCES) $(LISP) $(TAGS_FILES)
+ list='$(SOURCES) $(HEADERS) $(LISP) $(TAGS_FILES)'; \
+ unique=`for i in $$list; do \
+ if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \
+ done | \
+ $(AWK) '{ files[$$0] = 1; nonempty = 1; } \
+ END { if (nonempty) { for (i in files) print i; }; }'`; \
+ mkid -fID $$unique
+tags: TAGS
-tags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files)
+TAGS: tags-recursive $(HEADERS) $(SOURCES) config.h.in $(TAGS_DEPENDENCIES) \
+ $(TAGS_FILES) $(LISP)
set x; \
here=`pwd`; \
if ($(ETAGS) --etags-include --version) >/dev/null 2>&1; then \
@@ -527,7 +500,12 @@ tags-am: $(TAGS_DEPENDENCIES) $(am__tagg
set "$$@" "$$include_option=$$here/$$subdir/TAGS"; \
fi; \
done; \
- $(am__define_uniq_tagged_files); \
+ list='$(SOURCES) $(HEADERS) config.h.in $(LISP) $(TAGS_FILES)'; \
+ unique=`for i in $$list; do \
+ if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \
+ done | \
+ $(AWK) '{ files[$$0] = 1; nonempty = 1; } \
+ END { if (nonempty) { for (i in files) print i; }; }'`; \
shift; \
if test -z "$(ETAGS_ARGS)$$*$$unique"; then :; else \
test -n "$$unique" || unique=$$empty_fix; \
@@ -539,11 +517,15 @@ tags-am: $(TAGS_DEPENDENCIES) $(am__tagg
$$unique; \
fi; \
fi
-ctags: ctags-recursive
-
-CTAGS: ctags
-ctags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files)
- $(am__define_uniq_tagged_files); \
+ctags: CTAGS
+CTAGS: ctags-recursive $(HEADERS) $(SOURCES) config.h.in $(TAGS_DEPENDENCIES) \
+ $(TAGS_FILES) $(LISP)
+ list='$(SOURCES) $(HEADERS) config.h.in $(LISP) $(TAGS_FILES)'; \
+ unique=`for i in $$list; do \
+ if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \
+ done | \
+ $(AWK) '{ files[$$0] = 1; nonempty = 1; } \
+ END { if (nonempty) { for (i in files) print i; }; }'`; \
test -z "$(CTAGS_ARGS)$$unique" \
|| $(CTAGS) $(CTAGSFLAGS) $(AM_CTAGSFLAGS) $(CTAGS_ARGS) \
$$unique
@@ -552,31 +534,9 @@ GTAGS:
here=`$(am__cd) $(top_builddir) && pwd` \
&& $(am__cd) $(top_srcdir) \
&& gtags -i $(GTAGS_ARGS) "$$here"
-cscope: cscope.files
- test ! -s cscope.files \
- || $(CSCOPE) -b -q $(AM_CSCOPEFLAGS) $(CSCOPEFLAGS) -i cscope.files $(CSCOPE_ARGS)
-clean-cscope:
- -rm -f cscope.files
-cscope.files: clean-cscope cscopelist
-cscopelist: cscopelist-recursive
-
-cscopelist-am: $(am__tagged_files)
- list='$(am__tagged_files)'; \
- case "$(srcdir)" in \
- [\\/]* | ?:[\\/]*) sdir="$(srcdir)" ;; \
- *) sdir=$(subdir)/$(srcdir) ;; \
- esac; \
- for i in $$list; do \
- if test -f "$$i"; then \
- echo "$(subdir)/$$i"; \
- else \
- echo "$$sdir/$$i"; \
- fi; \
- done >> $(top_builddir)/cscope.files
distclean-tags:
-rm -f TAGS ID GTAGS GRTAGS GSYMS GPATH tags
- -rm -f cscope.out cscope.in.out cscope.po.out cscope.files
distdir: $(DISTFILES)
$(am__remove_distdir)
@@ -644,42 +604,40 @@ distdir: $(DISTFILES)
|| chmod -R a+r "$(distdir)"
dist-gzip: distdir
tardir=$(distdir) && $(am__tar) | GZIP=$(GZIP_ENV) gzip -c >$(distdir).tar.gz
- $(am__post_remove_distdir)
+ $(am__remove_distdir)
dist-bzip2: distdir
tardir=$(distdir) && $(am__tar) | BZIP2=$${BZIP2--9} bzip2 -c >$(distdir).tar.bz2
- $(am__post_remove_distdir)
+ $(am__remove_distdir)
dist-lzip: distdir
tardir=$(distdir) && $(am__tar) | lzip -c $${LZIP_OPT--9} >$(distdir).tar.lz
- $(am__post_remove_distdir)
+ $(am__remove_distdir)
+
+dist-lzma: distdir
+ tardir=$(distdir) && $(am__tar) | lzma -9 -c >$(distdir).tar.lzma
+ $(am__remove_distdir)
dist-xz: distdir
tardir=$(distdir) && $(am__tar) | XZ_OPT=$${XZ_OPT--e} xz -c >$(distdir).tar.xz
- $(am__post_remove_distdir)
+ $(am__remove_distdir)
dist-tarZ: distdir
- @echo WARNING: "Support for shar distribution archives is" \
- "deprecated." >&2
- @echo WARNING: "It will be removed altogether in Automake 2.0" >&2
tardir=$(distdir) && $(am__tar) | compress -c >$(distdir).tar.Z
- $(am__post_remove_distdir)
+ $(am__remove_distdir)
dist-shar: distdir
- @echo WARNING: "Support for distribution archives compressed with" \
- "legacy program 'compress' is deprecated." >&2
- @echo WARNING: "It will be removed altogether in Automake 2.0" >&2
shar $(distdir) | GZIP=$(GZIP_ENV) gzip -c >$(distdir).shar.gz
- $(am__post_remove_distdir)
+ $(am__remove_distdir)
dist-zip: distdir
-rm -f $(distdir).zip
zip -rq $(distdir).zip $(distdir)
- $(am__post_remove_distdir)
+ $(am__remove_distdir)
-dist dist-all:
- $(MAKE) $(AM_MAKEFLAGS) $(DIST_TARGETS) am__post_remove_distdir='@:'
- $(am__post_remove_distdir)
+dist dist-all: distdir
+ tardir=$(distdir) && $(am__tar) | GZIP=$(GZIP_ENV) gzip -c >$(distdir).tar.gz
+ $(am__remove_distdir)
# This target untars the dist file and tries a VPATH configuration. Then
# it guarantees that the distribution is self-contained by making another
@@ -690,6 +648,8 @@ distcheck: dist
GZIP=$(GZIP_ENV) gzip -dc $(distdir).tar.gz | $(am__untar) ;;\
*.tar.bz2*) \
bzip2 -dc $(distdir).tar.bz2 | $(am__untar) ;;\
+ *.tar.lzma*) \
+ lzma -dc $(distdir).tar.lzma | $(am__untar) ;;\
*.tar.lz*) \
lzip -dc $(distdir).tar.lz | $(am__untar) ;;\
*.tar.xz*) \
@@ -701,9 +661,9 @@ distcheck: dist
*.zip*) \
unzip $(distdir).zip ;;\
esac
- chmod -R a-w $(distdir)
- chmod u+w $(distdir)
- mkdir $(distdir)/_build $(distdir)/_inst
+ chmod -R a-w $(distdir); chmod u+w $(distdir)
+ mkdir $(distdir)/_build
+ mkdir $(distdir)/_inst
chmod a-w $(distdir)
test -d $(distdir)/_build || exit 0; \
dc_install_base=`$(am__cd) $(distdir)/_inst && pwd | sed -e 's,^[^:\\/]:[\\/],/,'` \
@@ -735,7 +695,7 @@ distcheck: dist
&& $(MAKE) $(AM_MAKEFLAGS) distcleancheck \
&& cd "$$am__cwd" \
|| exit 1
- $(am__post_remove_distdir)
+ $(am__remove_distdir)
@(echo "$(distdir) archives ready for distribution: "; \
list='$(DIST_ARCHIVES)'; for i in $$list; do echo $$i; done) | \
sed -e 1h -e 1s/./=/g -e 1p -e 1x -e '$$p' -e '$$x'
@@ -871,14 +831,15 @@ ps-am:
uninstall-am: uninstall-local
-.MAKE: $(am__recursive_targets) all install-am install-strip
+.MAKE: $(RECURSIVE_CLEAN_TARGETS) $(RECURSIVE_TARGETS) all \
+ ctags-recursive install-am install-strip tags-recursive
-.PHONY: $(am__recursive_targets) CTAGS GTAGS TAGS all all-am \
- am--refresh check check-am clean clean-cscope clean-generic \
- clean-libtool cscope cscopelist-am ctags ctags-am dist \
- dist-all dist-bzip2 dist-gzip dist-lzip dist-shar dist-tarZ \
- dist-xz dist-zip distcheck distclean distclean-generic \
- distclean-hdr distclean-libtool distclean-local distclean-tags \
+.PHONY: $(RECURSIVE_CLEAN_TARGETS) $(RECURSIVE_TARGETS) CTAGS GTAGS \
+ all all-am am--refresh check check-am clean clean-generic \
+ clean-libtool ctags ctags-recursive dist dist-all dist-bzip2 \
+ dist-gzip dist-lzip dist-lzma dist-shar dist-tarZ dist-xz \
+ dist-zip distcheck distclean distclean-generic distclean-hdr \
+ distclean-libtool distclean-local distclean-tags \
distcleancheck distdir distuninstallcheck dvi dvi-am html \
html-am info info-am install install-am install-data \
install-data-am install-data-local install-dvi install-dvi-am \
@@ -888,7 +849,7 @@ uninstall-am: uninstall-local
installcheck installcheck-am installdirs installdirs-am \
maintainer-clean maintainer-clean-generic mostlyclean \
mostlyclean-generic mostlyclean-libtool pdf pdf-am ps ps-am \
- tags tags-am uninstall uninstall-am uninstall-local
+ tags tags-recursive uninstall uninstall-am uninstall-local
libtool: $(LIBTOOL_DEPS)
Modified: tcl/rivet/trunk/doc/xml/commands.xml
URL: http://svn.apache.org/viewvc/tcl/rivet/trunk/doc/xml/commands.xml?rev=1547463&r1=1547462&r2=1547463&view=diff
==============================================================================
--- tcl/rivet/trunk/doc/xml/commands.xml (original)
+++ tcl/rivet/trunk/doc/xml/commands.xml Tue Dec 3 16:35:08 2013
@@ -933,6 +933,37 @@ keyvalue_map(args) = 1 2 3 4 5</programl
</para>
</refsect1>
</refentry -->
+ <refentry id="lassign_array">
+ <refnamediv>
+ <refname>lassign_array</refname>
+ <refpurpose>Assign a list of values to array variables</refpurpose>
+ </refnamediv>
+ <refsynopsisdiv>
+ <cmdsynopsis>
+ <command>::rivet::lassign_array</command>
+ <arg>value_list</arg>
+ <arg>array_name</arg>
+ <arg>array_variables</arg>
+ </cmdsynopsis>
+ </refsynopsisdiv>
+ <refsect1>
+ <title>Description</title>
+ <para>
+ <command>lassign_array</command> is an utility command inspired by the same Tclx command.
+ The first argument is a list of values to be assigned to an array that must be
+ given as second argument. The remaining arguments are the array's variable names to take
+ as values the elements of the list. The command exploit Tcl's <command>foreach</command> construct
+ ability to scan multiple lists. Variables names don't matching values in the list are given an empty string.
+ </para>
+ <programlisting>::rivet::lassign_array {1 2 3 4} assigned_array a b c d
+parray assigned_array
+<emphasis role="strong">assigned_list</emphasis>
+assigned_list(a) = 1
+assigned_list(b) = 2
+assigned_list(c) = 3
+assigned_list(d) = 4</programlisting>
+ </refsect1>
+ </refentry>
<refentry id="lempty">
<refnamediv>
Modified: tcl/rivet/trunk/rivet/packages/dio/dio.tcl
URL: http://svn.apache.org/viewvc/tcl/rivet/trunk/rivet/packages/dio/dio.tcl?rev=1547463&r1=1547462&r2=1547463&view=diff
==============================================================================
--- tcl/rivet/trunk/rivet/packages/dio/dio.tcl (original)
+++ tcl/rivet/trunk/rivet/packages/dio/dio.tcl Tue Dec 3 16:35:08 2013
@@ -6,7 +6,7 @@
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
-# http://www.apache.org/licenses/LICENSE-2.0
+# http://www.apache.org/licenses/LICENSE-2.0
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
@@ -26,8 +26,8 @@ proc handle {interface args} {
set obj \#auto
set first [lindex $args 0]
if {![lempty $first] && [string index $first 0] != "-"} {
- set obj [lindex $args 0]
- set args [lreplace $args 0 0]
+ set obj [lindex $args 0]
+ set args [lreplace $args 0 0]
}
uplevel \#0 package require dio_$interface
return [uplevel \#0 ::DIO::$interface $obj $args]
@@ -38,11 +38,11 @@ proc handle {interface args} {
##
::itcl::class Database {
constructor {args} {
- eval configure $args
+ eval configure $args
}
destructor {
- close
+ close
}
#
@@ -51,7 +51,7 @@ proc handle {interface args} {
# result object.
#
protected method result {interface args} {
- return [eval uplevel \#0 ::DIO::${interface}Result \#auto $args]
+ return [eval uplevel \#0 ::DIO::${interface}Result \#auto $args]
}
#
@@ -59,8 +59,8 @@ proc handle {interface args} {
# quote characters preceded by a backslash
#
method quote {string} {
- regsub -all {'} $string {\'} string
- return $string
+ regsub -all {'} $string {\'} string
+ return $string
}
#
@@ -72,92 +72,92 @@ proc handle {interface args} {
#
protected method build_select_query {args} {
- set bool AND
- set first 1
- set req ""
- set myTable $table
- set what "*"
-
- # for each argument passed us...
- # (we go by integers because we mess with the index based on
- # what we find)
- for {set i 0} {$i < [llength $args]} {incr i} {
- # fetch the argument we're currently processing
- set elem [lindex $args $i]
-
- switch -- [::string tolower $elem] {
- "-and" {
- # -and -- switch to AND-style processing
- set bool AND
- }
-
- "-or" {
- # -or -- switch to OR-style processing
- set bool OR
- }
-
- "-table" {
- # -table -- identify which table the query is about
- set myTable [lindex $args [incr i]]
- }
-
- "-select" {
- # -select -
- set what [lindex $args [incr i]]
- }
-
- default {
- # it wasn't -and, -or, -table, or -select...
-
- # if the first character of the element is a dash,
- # it's a field name and a value
-
- if {[::string index $elem 0] == "-"} {
- set field [::string range $elem 1 end]
- set elem [lindex $args [incr i]]
-
- # if it's the first field being processed, append
- # WHERE to the SQL request we're generating
- if {$first} {
- append req " WHERE"
- set first 0
- } else {
- # it's not the first variable in the comparison
- # expression, so append the boolean state, either
- # AND or OR
- append req " $bool"
- }
-
- # convert any asterisks to percent signs in the
- # value field
- regsub -all {\*} $elem {%} elem
-
- # if there is a percent sign in the value
- # field now (having been there originally or
- # mapped in there a moment ago), the SQL aspect
- # is appended with a "field LIKE value"
-
- if {[::string first {%} $elem] != -1} {
- append req " $field LIKE [makeDBFieldValue $myTable $field $elem]"
- } elseif {[regexp {^([<>]) *([0-9.]*)$} $elem _ fn val]} {
- # value starts with <, or >, then space,
- # and a something
- append req " $field$fn$val"
- } elseif {[regexp {^([<>]=) *([0-9.]*)$} $elem _ fn val]} {
- # value starts with <= or >=, space, and something.
- append req " $field$fn$val"
- } else {
- # otherwise it's a straight key=value comparison
- append req " $field=[makeDBFieldValue $myTable $field $elem]"
- }
-
- continue
- }
- append req " $elem"
- }
- }
- }
- return "select $what from $myTable $req"
+ set bool AND
+ set first 1
+ set req ""
+ set myTable $table
+ set what "*"
+
+ # for each argument passed us...
+ # (we go by integers because we mess with the index based on
+ # what we find)
+ for {set i 0} {$i < [llength $args]} {incr i} {
+ # fetch the argument we're currently processing
+ set elem [lindex $args $i]
+
+ switch -- [::string tolower $elem] {
+ "-and" {
+ # -and -- switch to AND-style processing
+ set bool AND
+ }
+
+ "-or" {
+ # -or -- switch to OR-style processing
+ set bool OR
+ }
+
+ "-table" {
+ # -table -- identify which table the query is about
+ set myTable [lindex $args [incr i]]
+ }
+
+ "-select" {
+ # -select -
+ set what [lindex $args [incr i]]
+ }
+
+ default {
+ # it wasn't -and, -or, -table, or -select...
+
+ # if the first character of the element is a dash,
+ # it's a field name and a value
+
+ if {[::string index $elem 0] == "-"} {
+ set field [::string range $elem 1 end]
+ set elem [lindex $args [incr i]]
+
+ # if it's the first field being processed, append
+ # WHERE to the SQL request we're generating
+ if {$first} {
+ append req " WHERE"
+ set first 0
+ } else {
+ # it's not the first variable in the comparison
+ # expression, so append the boolean state, either
+ # AND or OR
+ append req " $bool"
+ }
+
+ # convert any asterisks to percent signs in the
+ # value field
+ regsub -all {\*} $elem {%} elem
+
+ # if there is a percent sign in the value
+ # field now (having been there originally or
+ # mapped in there a moment ago), the SQL aspect
+ # is appended with a "field LIKE value"
+
+ if {[::string first {%} $elem] != -1} {
+ append req " $field LIKE [makeDBFieldValue $myTable $field $elem]"
+ } elseif {[regexp {^([<>]) *([0-9.]*)$} $elem _ fn val]} {
+ # value starts with <, or >, then space,
+ # and a something
+ append req " $field$fn$val"
+ } elseif {[regexp {^([<>]=) *([0-9.]*)$} $elem _ fn val]} {
+ # value starts with <= or >=, space, and something.
+ append req " $field$fn$val"
+ } else {
+ # otherwise it's a straight key=value comparison
+ append req " $field=[makeDBFieldValue $myTable $field $elem]"
+ }
+
+ continue
+ }
+ append req " $elem"
+ }
+ }
+ }
+ return "select $what from $myTable $req"
}
#
@@ -168,17 +168,17 @@ proc handle {interface args} {
# coming from the array
#
protected method build_insert_query {arrayName fields {myTable ""}} {
- upvar 1 $arrayName array
+ upvar 1 $arrayName array
- if {[lempty $myTable]} { set myTable $table }
- set vals [::list]
- set vars [::list]
- foreach field $fields {
- if {![info exists array($field)]} { continue }
- lappend vars "$field"
- lappend vals "[makeDBFieldValue $myTable $field $array($field)]"
- }
- return "insert into $myTable ([join $vars {,}]) VALUES ([join $vals {,}])"
+ if {[lempty $myTable]} { set myTable $table }
+ set vals [::list]
+ set vars [::list]
+ foreach field $fields {
+ if {![info exists array($field)]} { continue }
+ lappend vars "$field"
+ lappend vals "[makeDBFieldValue $myTable $field $array($field)]"
+ }
+ return "insert into $myTable ([join $vars {,}]) VALUES ([join $vals {,}])"
}
#
@@ -192,14 +192,14 @@ proc handle {interface args} {
# you might update a lot more than you bargained for
#
protected method build_update_query {arrayName fields {myTable ""}} {
- upvar 1 $arrayName array
- if {[lempty $myTable]} { set myTable $table }
- set string [::list]
- foreach field $fields {
- if {![info exists array($field)]} { continue }
- lappend string "$field=[makeDBFieldValue $myTable $field $array($field)]"
- }
- return "update $myTable SET [join $string {,}]"
+ upvar 1 $arrayName array
+ if {[lempty $myTable]} { set myTable $table }
+ set string [::list]
+ foreach field $fields {
+ if {![info exists array($field)]} { continue }
+ lappend string "$field=[makeDBFieldValue $myTable $field $array($field)]"
+ }
+ return "update $myTable SET [join $string {,}]"
}
#
@@ -209,10 +209,10 @@ proc handle {interface args} {
# arguments, into the named array. From TclX.
#
protected method lassign_array {list arrayName args} {
- upvar 1 $arrayName array
- foreach elem $list field $args {
- set array($field) $elem
- }
+ upvar 1 $arrayName array
+ foreach elem $list field $args {
+ set array($field) $elem
+ }
}
#
@@ -221,8 +221,8 @@ proc handle {interface args} {
# variable to the string.
#
protected method configure_variable {varName string} {
- if {[lempty $string]} { return [cget -$varName] }
- configure -$varName $string
+ if {[lempty $string]} { return [cget -$varName] }
+ configure -$varName $string
}
#
@@ -232,18 +232,18 @@ proc handle {interface args} {
# together.
#
protected method build_key_where_clause {myKeyfield myKey} {
- ## If we're not using multiple keyfields, just return a simple
- ## where clause.
- if {[llength $myKeyfield] < 2} {
- return " WHERE $myKeyfield = [makeDBFieldValue $table $myKeyfield $myKey]"
- }
-
- # multiple fields, construct it as a where-and
- set req " WHERE 1 = 1"
- foreach field $myKeyfield key $myKey {
- append req " AND $field = [makeDBFieldValue $table $field $key]"
- }
- return $req
+ ## If we're not using multiple keyfields, just return a simple
+ ## where clause.
+ if {[llength $myKeyfield] < 2} {
+ return " WHERE $myKeyfield = [makeDBFieldValue $table $myKeyfield $myKey]"
+ }
+
+ # multiple fields, construct it as a where-and
+ set req " WHERE 1 = 1"
+ foreach field $myKeyfield key $myKey {
+ append req " AND $field = [makeDBFieldValue $table $field $key]"
+ }
+ return $req
}
##
@@ -257,51 +257,51 @@ proc handle {interface args} {
# values as a list
##
method makekey {arrayName {myKeyfield ""}} {
- if {[lempty $myKeyfield]} { set myKeyfield $keyfield }
- if {[lempty $myKeyfield]} {
- return -code error "No -keyfield specified in object"
- }
- upvar 1 $arrayName array
-
- ## If we're not using multiple keyfields, we want to check and see
- ## if we're using auto keys. If we are, create a new key and
- ## return it. If not, just return the value of the single keyfield
- ## in the array.
- if {[llength $myKeyfield] < 2} {
- if {$autokey} {
- set array($myKeyfield) [$this nextkey]
- } else {
- if {![info exists array($myKeyfield)]} {
- return -code error \
- "${arrayName}($myKeyfield) does not exist"
- }
- }
- return $array($myKeyfield)
- }
-
- ## We're using multiple keys. Return a list of all the keyfield
- ## values.
- foreach field $myKeyfield {
- if {![info exists array($field)]} {
- return -code error "$field does not exist in $arrayName"
- }
- lappend key $array($field)
- }
- return $key
+ if {[lempty $myKeyfield]} { set myKeyfield $keyfield }
+ if {[lempty $myKeyfield]} {
+ return -code error "No -keyfield specified in object"
+ }
+ upvar 1 $arrayName array
+
+ ## If we're not using multiple keyfields, we want to check and see
+ ## if we're using auto keys. If we are, create a new key and
+ ## return it. If not, just return the value of the single keyfield
+ ## in the array.
+ if {[llength $myKeyfield] < 2} {
+ if {$autokey} {
+ set array($myKeyfield) [$this nextkey]
+ } else {
+ if {![info exists array($myKeyfield)]} {
+ return -code error \
+ "${arrayName}($myKeyfield) does not exist"
+ }
+ }
+ return $array($myKeyfield)
+ }
+
+ ## We're using multiple keys. Return a list of all the keyfield
+ ## values.
+ foreach field $myKeyfield {
+ if {![info exists array($field)]} {
+ return -code error "$field does not exist in $arrayName"
+ }
+ lappend key $array($field)
+ }
+ return $key
}
method destroy {} {
- ::itcl::delete object $this
+ ::itcl::delete object $this
}
#
# string - execute a SQL request and only return a string of one row.
#
method string {req} {
- set res [exec $req]
- $res next -list val
- $res destroy
- return $val
+ set res [exec $req]
+ $res next -list val
+ $res destroy
+ return $val
}
#
@@ -309,13 +309,13 @@ proc handle {interface args} {
# row returned.
#
method list {req} {
- set res [exec $req]
- set list ""
- $res forall -list line {
- lappend list [lindex $line 0]
- }
- $res destroy
- return $list
+ set res [exec $req]
+ set list ""
+ $res forall -list line {
+ lappend list [lindex $line 0]
+ }
+ $res destroy
+ return $list
}
#
@@ -324,11 +324,11 @@ proc handle {interface args} {
# the values
#
method array {req arrayName} {
- upvar 1 $arrayName $arrayName
- set res [exec $req]
- set ret [$res next -array $arrayName]
- $res destroy
- return $ret
+ upvar 1 $arrayName $arrayName
+ set res [exec $req]
+ set ret [$res next -array $arrayName]
+ $res destroy
+ return $ret
}
#
@@ -337,23 +337,23 @@ proc handle {interface args} {
# matching values, executing the specified code body for each, in turn.
#
method forall {req arrayName body} {
- upvar 1 $arrayName $arrayName
+ upvar 1 $arrayName $arrayName
- set res [exec $req]
+ set res [exec $req]
- $res forall -array $arrayName {
- uplevel 1 $body
+ $res forall -array $arrayName {
+ uplevel 1 $body
}
- if {[$res error]} {
- set errinf [$res errorinfo]
- $res destroy
- return -code error "Got '$errinf' executing '$req'"
- }
+ if {[$res error]} {
+ set errinf [$res errorinfo]
+ $res destroy
+ return -code error "Got '$errinf' executing '$req'"
+ }
set ret [$res numrows]
- $res destroy
- return $ret
+ $res destroy
+ return $ret
}
#
@@ -366,21 +366,21 @@ proc handle {interface args} {
# determined.
#
protected method table_check {list {tableVar myTable} {keyVar myKeyfield}} {
- upvar 1 $tableVar $tableVar $keyVar $keyVar
- set data(-table) $table
- set data(-keyfield) $keyfield
- ::array set data $list
-
- if {[lempty $data(-table)]} {
- return -code error -errorcode missing_table "-table not specified in DIO object"
- }
- set $tableVar $data(-table)
-
- if {[lempty $data(-keyfield)]} {
- return -code error -errorcode missing_keyfield "-keyfield not specified in DIO object"
- }
+ upvar 1 $tableVar $tableVar $keyVar $keyVar
+ set data(-table) $table
+ set data(-keyfield) $keyfield
+ ::array set data $list
+
+ if {[lempty $data(-table)]} {
+ return -code error -errorcode missing_table "-table not specified in DIO object"
+ }
+ set $tableVar $data(-table)
- set $keyVar $data(-keyfield)
+ if {[lempty $data(-keyfield)]} {
+ return -code error -errorcode missing_keyfield "-keyfield not specified in DIO object"
+ }
+
+ set $keyVar $data(-keyfield)
}
#
@@ -389,13 +389,13 @@ proc handle {interface args} {
# autokey, there can't be more than one key.
#
protected method key_check {myKeyfield myKey} {
- if {[llength $myKeyfield] < 2} { return }
- if {$autokey} {
- return -code error "Cannot have autokey and multiple keyfields"
- }
- if {[llength $myKeyfield] != [llength $myKey]} {
- return -code error "Bad key length."
- }
+ if {[llength $myKeyfield] < 2} { return }
+ if {$autokey} {
+ return -code error "Cannot have autokey and multiple keyfields"
+ }
+ if {[llength $myKeyfield] != [llength $myKey]} {
+ return -code error "Bad key length."
+ }
}
#
@@ -404,23 +404,23 @@ proc handle {interface args} {
# the key into the array
#
method fetch {key arrayName args} {
- table_check $args
- key_check $myKeyfield $key
- upvar 1 $arrayName $arrayName
- set req "select * from $myTable"
- append req [build_key_where_clause $myKeyfield $key]
-
- set res [$this exec $req]
- if {[$res error]} {
- set errinf [$res errorinfo]
- $res destroy
- return -code error "Got '$errinf' executing '$req'"
- }
- set rows_found [expr [$res numrows] > 0]
- $res next -array $arrayName
- $res destroy
+ table_check $args
+ key_check $myKeyfield $key
+ upvar 1 $arrayName $arrayName
+ set req "select * from $myTable"
+ append req [build_key_where_clause $myKeyfield $key]
+
+ set res [$this exec $req]
+ if {[$res error]} {
+ set errinf [$res errorinfo]
+ $res destroy
+ return -code error "Got '$errinf' executing '$req'"
+ }
+ set rows_found [expr [$res numrows] > 0]
+ $res next -array $arrayName
+ $res destroy
- return $rows_found
+ return $rows_found
}
#
@@ -429,29 +429,29 @@ proc handle {interface args} {
# corresponding table entry.
#
method store {arrayName args} {
- table_check $args
- upvar 1 $arrayName $arrayName $arrayName array
- if {[llength $myKeyfield] > 1 && $autokey} {
- return -code error "Cannot have autokey and multiple keyfields"
- }
-
- set key [makekey $arrayName $myKeyfield]
- set req "select * from $myTable"
- append req [build_key_where_clause $myKeyfield $key]
- set res [exec $req]
- if {[$res error]} {
- set errinf [$res errorinfo]
- $res destroy
- return -code error "Got '$errinf' executing '$req'"
- }
- set numrows [$res numrows]
- $res destroy
+ table_check $args
+ upvar 1 $arrayName $arrayName $arrayName array
+ if {[llength $myKeyfield] > 1 && $autokey} {
+ return -code error "Cannot have autokey and multiple keyfields"
+ }
- if {$numrows} {
+ set key [makekey $arrayName $myKeyfield]
+ set req "select * from $myTable"
+ append req [build_key_where_clause $myKeyfield $key]
+ set res [exec $req]
+ if {[$res error]} {
+ set errinf [$res errorinfo]
+ $res destroy
+ return -code error "Got '$errinf' executing '$req'"
+ }
+ set numrows [$res numrows]
+ $res destroy
+
+ if {$numrows} {
$this update $arrayName {*}$args
- } else {
+ } else {
$this insert $myTable $arrayName
- }
+ }
return 1
}
@@ -461,27 +461,27 @@ proc handle {interface args} {
# an insert
#
method update {arrayName args} {
- table_check $args
- upvar 1 $arrayName $arrayName $arrayName array
+ table_check $args
+ upvar 1 $arrayName $arrayName $arrayName array
- set key [makekey $arrayName $myKeyfield]
+ set key [makekey $arrayName $myKeyfield]
- set fields [::array names array]
- set req [build_update_query array $fields $myTable]
- append req [build_key_where_clause $myKeyfield $key]
-
- set res [exec $req]
- if {[$res error]} {
- set errinf [$res errorinfo]
- $res destroy
- return -code error "Got '$errinf' executing '$req'"
- }
-
- # this doesn't work on postgres, you've got to use cmdRows,
- # we need to figure out what to do with this
- set numrows [$res numrows]
- $res destroy
- return $numrows
+ set fields [::array names array]
+ set req [build_update_query array $fields $myTable]
+ append req [build_key_where_clause $myKeyfield $key]
+
+ set res [exec $req]
+ if {[$res error]} {
+ set errinf [$res errorinfo]
+ $res destroy
+ return -code error "Got '$errinf' executing '$req'"
+ }
+
+ # this doesn't work on postgres, you've got to use cmdRows,
+ # we need to figure out what to do with this
+ set numrows [$res numrows]
+ $res destroy
+ return $numrows
}
#
@@ -493,26 +493,26 @@ proc handle {interface args} {
# want to change the value of a key field
#
method update_with_explicit_key {key arrayName args} {
- table_check $args
- key_check $myKeyfield $key
- upvar 1 $arrayName $arrayName $arrayName array
-
- set fields [::array names array]
- set req [build_update_query array $fields $myTable]
- append req [build_key_where_clause $myKeyfield $key]
-
- set res [exec $req]
- if {[$res error]} {
- set errinf [$res errorinfo]
- $res destroy
- return -code error "Got '$errinf' executing '$req'"
- }
-
- # this doesn't work on postgres, you've got to use cmdRows,
- # we need to figure out what to do with this
- set numrows [$res numrows]
- $res destroy
- return $numrows
+ table_check $args
+ key_check $myKeyfield $key
+ upvar 1 $arrayName $arrayName $arrayName array
+
+ set fields [::array names array]
+ set req [build_update_query array $fields $myTable]
+ append req [build_key_where_clause $myKeyfield $key]
+
+ set res [exec $req]
+ if {[$res error]} {
+ set errinf [$res errorinfo]
+ $res destroy
+ return -code error "Got '$errinf' executing '$req'"
+ }
+
+ # this doesn't work on postgres, you've got to use cmdRows,
+ # we need to figure out what to do with this
+ set numrows [$res numrows]
+ $res destroy
+ return $numrows
}
#
@@ -521,54 +521,54 @@ proc handle {interface args} {
# an insert -- this shouldn't require fields, it's broken
#
method insert {table arrayName} {
- upvar 1 $arrayName $arrayName $arrayName array
- set req [build_insert_query array [::array names array] $table]
+ upvar 1 $arrayName $arrayName $arrayName array
+ set req [build_insert_query array [::array names array] $table]
- set res [exec $req]
- if {[$res error]} {
- set errinf [$res errorinfo]
- $res destroy
- return -code error "Got '$errinf' executing '$req'"
- }
- $res destroy
- return 1
+ set res [exec $req]
+ if {[$res error]} {
+ set errinf [$res errorinfo]
+ $res destroy
+ return -code error "Got '$errinf' executing '$req'"
+ }
+ $res destroy
+ return 1
}
#
# delete - delete matching record from the specified table
#
method delete {key args} {
- table_check $args
- set req "DELETE FROM $myTable"
- append req [build_key_where_clause $myKeyfield $key]
-
- set res [exec $req]
- if {[$res error]} {
- set errinf [$res errorinfo]
- $res destroy
- return -code error "Got '$errinf' executing '$req'"
- }
-
- set n_deleted_rows [$res numrows]
- $res destroy
- return $n_deleted_rows
+ table_check $args
+ set req "DELETE FROM $myTable"
+ append req [build_key_where_clause $myKeyfield $key]
+
+ set res [exec $req]
+ if {[$res error]} {
+ set errinf [$res errorinfo]
+ $res destroy
+ return -code error "Got '$errinf' executing '$req'"
+ }
+
+ set n_deleted_rows [$res numrows]
+ $res destroy
+ return $n_deleted_rows
}
#
# keys - return all keys in a tbale
#
method keys {args} {
- table_check $args
- set req "select * from $myTable"
- set obj [$this exec $req]
-
- set keys ""
- $obj forall -array a {
- lappend keys [makekey a $myKeyfield]
- }
- $obj destroy
+ table_check $args
+ set req "select * from $myTable"
+ set obj [$this exec $req]
+
+ set keys ""
+ $obj forall -array a {
+ lappend keys [makekey a $myKeyfield]
+ }
+ $obj destroy
- return $keys
+ return $keys
}
#
@@ -576,8 +576,8 @@ proc handle {interface args} {
# build_select_query style and return the result handle.
#
method search {args} {
- set req [eval build_select_query $args]
- return [exec $req]
+ set req [eval build_select_query $args]
+ return [exec $req]
}
#
@@ -596,15 +596,15 @@ proc handle {interface args} {
}
}
- return [string "select count(*) from $myTable"]
+ return [string "select count(*) from $myTable"]
}
method makeDBFieldValue {table_name field_name val} {
- return "'[quote $val]'"
+ return "'[quote $val]'"
}
method registerSpecialField {table_name field_name type} {
- set specialFields(${table_name}@${field_name}) $type
+ set specialFields(${table_name}@${field_name}) $type
}
##
@@ -635,28 +635,28 @@ proc handle {interface args} {
protected variable specialFields
- public variable interface ""
- public variable errorinfo ""
+ public variable interface ""
+ public variable errorinfo ""
- public variable db ""
- public variable table ""
- public variable sequence ""
-
- public variable user ""
- public variable pass ""
- public variable host ""
- public variable port ""
-
- public variable keyfield "" {
- if {[llength $keyfield] > 1 && $autokey} {
- return -code error "Cannot have autokey and multiple keyfields"
- }
- }
-
- public variable autokey 0 {
- if {[llength $keyfield] > 1 && $autokey} {
- return -code error "Cannot have autokey and multiple keyfields"
- }
+ public variable db ""
+ public variable table ""
+ public variable sequence ""
+
+ public variable user ""
+ public variable pass ""
+ public variable host ""
+ public variable port ""
+
+ public variable keyfield "" {
+ if {[llength $keyfield] > 1 && $autokey} {
+ return -code error "Cannot have autokey and multiple keyfields"
+ }
+ }
+
+ public variable autokey 0 {
+ if {[llength $keyfield] > 1 && $autokey} {
+ return -code error "Cannot have autokey and multiple keyfields"
+ }
}
} ; ## ::itcl::class Database
@@ -666,13 +666,13 @@ proc handle {interface args} {
#
::itcl::class Result {
constructor {args} {
- eval configure $args
+ eval configure $args
}
destructor { }
method destroy {} {
- ::itcl::delete object $this
+ ::itcl::delete object $this
}
#
@@ -681,8 +681,8 @@ proc handle {interface args} {
# variable to the string.
#
protected method configure_variable {varName string} {
- if {[lempty $string]} { return [cget -$varName] }
- configure -$varName $string
+ if {[lempty $string]} { return [cget -$varName] }
+ configure -$varName $string
}
#
@@ -692,10 +692,10 @@ proc handle {interface args} {
# arguments, into the named array. From TclX.
#
protected method lassign_array {list arrayName args} {
- upvar 1 $arrayName array
- foreach elem $list field $args {
- set array($field) $elem
- }
+ upvar 1 $arrayName array
+ foreach elem $list field $args {
+ set array($field) $elem
+ }
}
#
@@ -703,100 +703,100 @@ proc handle {interface args} {
# to the specified row ID
#
method seek {newrowid} {
- set rowid $newrowid
+ set rowid $newrowid
}
method cache {{size "all"}} {
- set cacheSize $size
- if {$size == "all"} { set cacheSize $numrows }
+ set cacheSize $size
+ if {$size == "all"} { set cacheSize $numrows }
- ## Delete the previous cache array.
- catch {unset cacheArray}
+ ## Delete the previous cache array.
+ catch {unset cacheArray}
- set autostatus $autocache
- set currrow $rowid
- set autocache 1
- seek 0
- set i 0
- while {[next -list list]} {
- if {[incr i] >= $cacheSize} { break }
- }
- set autocache $autostatus
- seek $currrow
- set cached 1
+ set autostatus $autocache
+ set currrow $rowid
+ set autocache 1
+ seek 0
+ set i 0
+ while {[next -list list]} {
+ if {[incr i] >= $cacheSize} { break }
+ }
+ set autocache $autostatus
+ seek $currrow
+ set cached 1
}
#
# forall -- walk the result object, executing the code body over it
#
method forall {type varName body} {
- upvar 1 $varName $varName
- set currrow $rowid
- seek 0
- while {[next $type $varName]} {
- uplevel 1 $body
- }
- set rowid $currrow
- return
+ upvar 1 $varName $varName
+ set currrow $rowid
+ seek 0
+ while {[next $type $varName]} {
+ uplevel 1 $body
+ }
+ set rowid $currrow
+ return
}
method next {type {varName ""}} {
- set return 1
- if {![lempty $varName]} {
- upvar 1 $varName var
- set return 0
- }
-
- catch {unset var}
-
- set list ""
- ## If we have a cached result for this row, use it.
- if {[info exists cacheArray($rowid)]} {
- set list $cacheArray($rowid)
- } else {
- set list [$this nextrow]
- if {[lempty $list]} {
- if {$return} { return }
- set var ""
- return 0
- }
- if {$autocache} { set cacheArray($rowid) $list }
- }
-
- incr rowid
-
- switch -- $type {
- "-list" {
- if {$return} {
- return $list
- } else {
- set var $list
- }
- }
- "-array" {
- if {$return} {
- foreach field $fields elem $list {
- lappend var $field $elem
- }
- return $var
- } else {
- eval lassign_array [list $list] var $fields
- }
- }
- "-keyvalue" {
- foreach field $fields elem $list {
- lappend var -$field $elem
- }
- if {$return} { return $var }
- }
-
- default {
- incr rowid -1
- return -code error \
- "In-valid type: must be -list, -array or -keyvalue"
- }
- }
- return [expr [lempty $list] == 0]
+ set return 1
+ if {![lempty $varName]} {
+ upvar 1 $varName var
+ set return 0
+ }
+
+ catch {unset var}
+
+ set list ""
+ ## If we have a cached result for this row, use it.
+ if {[info exists cacheArray($rowid)]} {
+ set list $cacheArray($rowid)
+ } else {
+ set list [$this nextrow]
+ if {[lempty $list]} {
+ if {$return} { return }
+ set var ""
+ return 0
+ }
+ if {$autocache} { set cacheArray($rowid) $list }
+ }
+
+ incr rowid
+
+ switch -- $type {
+ "-list" {
+ if {$return} {
+ return $list
+ } else {
+ set var $list
+ }
+ }
+ "-array" {
+ if {$return} {
+ foreach field $fields elem $list {
+ lappend var $field $elem
+ }
+ return $var
+ } else {
+ eval lassign_array [list $list] var $fields
+ }
+ }
+ "-keyvalue" {
+ foreach field $fields elem $list {
+ lappend var -$field $elem
+ }
+ if {$return} { return $var }
+ }
+
+ default {
+ incr rowid -1
+ return -code error \
+ "In-valid type: must be -list, -array or -keyvalue"
+ }
+ }
+ return [expr [lempty $list] == 0]
}
method resultid {{string ""}} { return [configure_variable resultid $string] }
@@ -808,17 +808,17 @@ proc handle {interface args} {
method errorinfo {{string ""}} { return [configure_variable errorinfo $string] }
method autocache {{string ""}} { return [configure_variable autocache $string] }
- public variable resultid ""
- public variable fields ""
- public variable rowid 0
- public variable numrows 0
- public variable error 0
- public variable errorcode 0
- public variable errorinfo ""
- public variable autocache 1
+ public variable resultid ""
+ public variable fields ""
+ public variable rowid 0
+ public variable numrows 0
+ public variable error 0
+ public variable errorcode 0
+ public variable errorinfo ""
+ public variable autocache 1
- protected variable cached 0
- protected variable cacheSize 0
+ protected variable cached 0
+ protected variable cacheSize 0
protected variable cacheArray
} ; ## ::itcl::class Result
Modified: tcl/rivet/trunk/rivet/packages/dio/dio_Mysql.tcl
URL: http://svn.apache.org/viewvc/tcl/rivet/trunk/rivet/packages/dio/dio_Mysql.tcl?rev=1547463&r1=1547462&r2=1547463&view=diff
==============================================================================
--- tcl/rivet/trunk/rivet/packages/dio/dio_Mysql.tcl (original)
+++ tcl/rivet/trunk/rivet/packages/dio/dio_Mysql.tcl Tue Dec 3 16:35:08 2013
@@ -6,7 +6,7 @@
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
-# http://www.apache.org/licenses/LICENSE-2.0
+# http://www.apache.org/licenses/LICENSE-2.0
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
@@ -20,116 +20,116 @@ package provide dio_Mysql 0.2
namespace eval DIO {
::itcl::class Mysql {
- inherit Database
+ inherit Database
- constructor {args} {eval configure $args} {
- if { [catch {package require Mysqltcl}] \
- && [catch {package require mysqltcl}] \
- && [catch {package require mysql} ] } {
- return -code error "No MySQL Tcl package available"
- }
-
- eval configure $args
-
- if {[lempty $db]} {
- if {[lempty $user]} {
- set user $::env(USER)
- }
- set db $user
- }
- }
-
- destructor {
- close
- }
-
- method open {} {
- set command "mysqlconnect"
-
- if {![lempty $user]} { lappend command -user $user }
- if {![lempty $pass]} { lappend command -password $pass }
- if {![lempty $port]} { lappend command -port $port }
- if {![lempty $host]} { lappend command -host $host }
- if {[catch $command error]} { return -code error $error }
-
- set conn $error
-
- if {![lempty $db]} { mysqluse $conn $db }
- }
-
- method close {} {
- if {![info exists conn]} { return }
- catch {mysqlclose $conn}
- unset conn
- }
+ constructor {args} {eval configure $args} {
+ if { [catch {package require Mysqltcl}] \
+ && [catch {package require mysqltcl}] \
+ && [catch {package require mysql} ] } {
+ return -code error "No MySQL Tcl package available"
+ }
+
+ eval configure $args
+
+ if {[lempty $db]} {
+ if {[lempty $user]} {
+ set user $::env(USER)
+ }
+ set db $user
+ }
+ }
+
+ destructor {
+ close
+ }
+
+ method open {} {
+ set command "mysqlconnect"
+
+ if {![lempty $user]} { lappend command -user $user }
+ if {![lempty $pass]} { lappend command -password $pass }
+ if {![lempty $port]} { lappend command -port $port }
+ if {![lempty $host]} { lappend command -host $host }
+ if {[catch $command error]} { return -code error $error }
+
+ set conn $error
+
+ if {![lempty $db]} { mysqluse $conn $db }
+ }
+
+ method close {} {
+ if {![info exists conn]} { return }
+ catch {mysqlclose $conn}
+ unset conn
+ }
- method exec {req} {
- if {![info exists conn] || ![mysqlping $conn]} { open }
+ method exec {req} {
+ if {![info exists conn] || ![mysqlping $conn]} { open }
- set cmd mysqlexec
+ set cmd mysqlexec
#
-# if {[::string tolower [lindex $req 0]] == "select"} { set cmd mysqlsel }
-# select is a 6 characters word, so let's see if the query is a select
+# if {[::string tolower [lindex $req 0]] == "select"} { set cmd mysqlsel }
+# select is a 6 characters word, so let's see if the query is a select
#
- set q [::string trim $req]
+ set q [::string trim $req]
-# set q [::string tolower $q]
-# set q [::string range $q 0 5]
-# if {[::string match select $q]} { set cmd mysqlsel }
-
- if {[regexp -nocase {^\(*\s*select\s+} $q]} { set cmd mysqlsel }
-
- set errorinfo ""
- if {[catch {$cmd $conn $req} error]} {
- set errorinfo $error
- set obj [result Mysql -error 1 -errorinfo [::list $error]]
- return $obj
- }
- if {[catch {mysqlcol $conn -current name} fields]} { set fields "" }
- set obj [result Mysql -resultid $conn \
- -numrows [::list $error] -fields [::list $fields]]
- return $obj
- }
-
- method lastkey {} {
- if {![info exists conn] || ![mysqlping $conn]} { return }
- return [mysqlinsertid $conn]
- }
-
- method quote {string} {
- if {![catch {mysqlquote $string} result]} { return $result }
- regsub -all {'} $string {\'} string
- return $string
- }
-
- method sql_limit_syntax {limit {offset ""}} {
- if {[lempty $offset]} {
- return " LIMIT $limit"
- }
- return " LIMIT [expr $offset - 1],$limit"
- }
-
- method handle {} {
- if {![info exists conn] || ![mysqlping $conn]} { open }
-
- return $conn
- }
-
- method makeDBFieldValue {table_name field_name val {convert_to {}}} {
- if {[info exists specialFields(${table_name}@${field_name})]} {
- switch $specialFields(${table_name}@${field_name}) {
- DATE {
- set secs [clock scan $val]
- set my_val [clock format $secs -format {%Y-%m-%d}]
- return "DATE_FORMAT('$my_val', '%Y-%m-%d')"
- }
- DATETIME {
- set secs [clock scan $val]
- set my_val [clock format $secs -format {%Y-%m-%d %T}]
- return "DATE_FORMAT('$my_val', '%Y-%m-%d %T')"
- }
- NOW {
- switch $convert_to {
+# set q [::string tolower $q]
+# set q [::string range $q 0 5]
+# if {[::string match select $q]} { set cmd mysqlsel }
+
+ if {[regexp -nocase {^\(*\s*select\s+} $q]} { set cmd mysqlsel }
+
+ set errorinfo ""
+ if {[catch {$cmd $conn $req} error]} {
+ set errorinfo $error
+ set obj [result Mysql -error 1 -errorinfo [::list $error]]
+ return $obj
+ }
+ if {[catch {mysqlcol $conn -current name} fields]} { set fields "" }
+ set obj [result Mysql -resultid $conn \
+ -numrows [::list $error] -fields [::list $fields]]
+ return $obj
+ }
+
+ method lastkey {} {
+ if {![info exists conn] || ![mysqlping $conn]} { return }
+ return [mysqlinsertid $conn]
+ }
+
+ method quote {string} {
+ if {![catch {mysqlquote $string} result]} { return $result }
+ regsub -all {'} $string {\'} string
+ return $string
+ }
+
+ method sql_limit_syntax {limit {offset ""}} {
+ if {[lempty $offset]} {
+ return " LIMIT $limit"
+ }
+ return " LIMIT [expr $offset - 1],$limit"
+ }
+
+ method handle {} {
+ if {![info exists conn] || ![mysqlping $conn]} { open }
+
+ return $conn
+ }
+
+ method makeDBFieldValue {table_name field_name val {convert_to {}}} {
+ if {[info exists specialFields(${table_name}@${field_name})]} {
+ switch $specialFields(${table_name}@${field_name}) {
+ DATE {
+ set secs [clock scan $val]
+ set my_val [clock format $secs -format {%Y-%m-%d}]
+ return "DATE_FORMAT('$my_val', '%Y-%m-%d')"
+ }
+ DATETIME {
+ set secs [clock scan $val]
+ set my_val [clock format $secs -format {%Y-%m-%d %T}]
+ return "DATE_FORMAT('$my_val', '%Y-%m-%d %T')"
+ }
+ NOW {
+ switch $convert_to {
# we try to be coherent with the original purpose of this method whose
# goal is to provide to the programmer a uniform way to handle timestamps.
@@ -138,67 +138,67 @@ namespace eval DIO {
# can be done and session expirations are computed consistently.
# (Bug #53703)
- SECS {
- if {[::string compare $val "now"] == 0} {
-# set secs [clock seconds]
-# set my_val [clock format $secs -format {%Y%m%d%H%M%S}]
-# return $my_val
+ SECS {
+ if {[::string compare $val "now"] == 0} {
+# set secs [clock seconds]
+# set my_val [clock format $secs -format {%Y%m%d%H%M%S}]
+# return $my_val
return [clock seconds]
- } else {
- return "UNIX_TIMESTAMP($field_name)"
- }
- }
- default {
- if {[::string compare $val, "now"] == 0} {
- set secs [clock seconds]
- } else {
- set secs [clock scan $val]
- }
+ } else {
+ return "UNIX_TIMESTAMP($field_name)"
+ }
+ }
+ default {
+ if {[::string compare $val, "now"] == 0} {
+ set secs [clock seconds]
+ } else {
+ set secs [clock scan $val]
+ }
# this is kind of going back and forth from the same
# format,
- #set my_val [clock format $secs -format {%Y-%m-%d %T}]
- return "FROM_UNIXTIME('$secs')"
- }
- }
- }
- default {
+ #set my_val [clock format $secs -format {%Y-%m-%d %T}]
+ return "FROM_UNIXTIME('$secs')"
+ }
+ }
+ }
+ default {
# no special code for that type!!
return "'[quote $val]'"
- }
- }
- } else {
- return "'[quote $val]'"
- }
- }
-
- public variable db "" {
- if {[info exists conn] && [mysqlping $conn]} {
- mysqluse $conn $db
- }
- }
+ }
+ }
+ } else {
+ return "'[quote $val]'"
+ }
+ }
+
+ public variable db "" {
+ if {[info exists conn] && [mysqlping $conn]} {
+ mysqluse $conn $db
+ }
+ }
- public variable interface "Mysql"
- private variable conn
+ public variable interface "Mysql"
+ private variable conn
} ; ## ::itcl::class Mysql
::itcl::class MysqlResult {
- inherit Result
+ inherit Result
- constructor {args} {
- eval configure $args
- }
+ constructor {args} {
+ eval configure $args
+ }
- destructor {
+ destructor {
- }
+ }
- method nextrow {} {
- return [mysqlnext $resultid]
- }
-
+ method nextrow {} {
+ return [mysqlnext $resultid]
+ }
+
} ; ## ::itcl::class MysqlResult
}
Added: tcl/rivet/trunk/rivet/rivet-tcl/lassign_array.tcl
URL: http://svn.apache.org/viewvc/tcl/rivet/trunk/rivet/rivet-tcl/lassign_array.tcl?rev=1547463&view=auto
==============================================================================
--- tcl/rivet/trunk/rivet/rivet-tcl/lassign_array.tcl (added)
+++ tcl/rivet/trunk/rivet/rivet-tcl/lassign_array.tcl Tue Dec 3 16:35:08 2013
@@ -0,0 +1,21 @@
+#
+# -- lassign_array
+#
+# given a list, an array name, and a variable number
+# of arguments consisting of variable names, assign each element in
+# the list, in turn, to elements corresponding to the variable
+# arguments, into the named array. From DIO (originally from TclX).
+#
+# $Id$
+#
+
+namespace eval ::rivet {
+
+ proc lassign_array {list arrayName args} {
+ upvar 1 $arrayName array
+ foreach elem $list field $args {
+ set array($field) $elem
+ }
+ }
+
+}
Propchange: tcl/rivet/trunk/rivet/rivet-tcl/lassign_array.tcl
------------------------------------------------------------------------------
svn:keywords = Id
Modified: tcl/rivet/trunk/rivet/rivet-tcl/tclIndex
URL: http://svn.apache.org/viewvc/tcl/rivet/trunk/rivet/rivet-tcl/tclIndex?rev=1547463&r1=1547462&r2=1547463&view=diff
==============================================================================
--- tcl/rivet/trunk/rivet/rivet-tcl/tclIndex (original)
+++ tcl/rivet/trunk/rivet/rivet-tcl/tclIndex Tue Dec 3 16:35:08 2013
@@ -27,3 +27,4 @@ set auto_index(::rivet::parray_table) [l
set auto_index(::rivet::load_cookies) [list source [file join $dir load_cookies.tcl]]
set auto_index(::rivet::http_accept) [list source [file join $dir http_accept.tcl]]
set auto_index(::rivet::xml) [list source [file join $dir xml.tcl]]
+set auto_index(::rivet::lassign_array) [list source [file join $dir lassign_array.tcl]]
Modified: tcl/rivet/trunk/src/apache-2/mod_rivet.c
URL: http://svn.apache.org/viewvc/tcl/rivet/trunk/src/apache-2/mod_rivet.c?rev=1547463&r1=1547462&r2=1547463&view=diff
==============================================================================
--- tcl/rivet/trunk/src/apache-2/mod_rivet.c (original)
+++ tcl/rivet/trunk/src/apache-2/mod_rivet.c Tue Dec 3 16:35:08 2013
@@ -75,8 +75,8 @@ static server_rec *rivet_panic_server_
/* rivet or tcl file */
#define CTYPE_NOT_HANDLED 0
-#define RIVET_FILE 1
-#define TCL_FILE 2
+#define RIVET_TEMPLATE 1
+#define RIVET_TCLFILE 2
/* rivet return codes */
#define RIVET_OK 0
@@ -84,14 +84,27 @@ static server_rec *rivet_panic_server_
TCL_DECLARE_MUTEX(sendMutex);
-#define RIVET_FILE_CTYPE "application/x-httpd-rivet"
-#define TCL_FILE_CTYPE "application/x-rivet-tcl"
+#define RIVET_TEMPLATE_CTYPE "application/x-httpd-rivet"
+#define RIVET_TCLFILE_CTYPE "application/x-rivet-tcl"
static Tcl_Interp* Rivet_CreateTclInterp (server_rec* s);
static void Rivet_CreateCache (server_rec *s, apr_pool_t *p);
-
-/* This snippet of code came from the mod_ruby project, which is under a BSD license. */
+/*
+ * -- Rivet_chdir_file (const char* filename)
+ *
+ * Determines the directory name from the filename argument
+ * and sets it as current working directory
+ *
+ * Argument:
+ *
+ * const char* filename: file name to be used for determining
+ * the current directory (URI style path)
+ * the directory name is everything comes
+ * before the last '/' (slash) character
+ *
+ * This snippet of code came from the mod_ruby project, which is under a BSD license.
+ */
static int Rivet_chdir_file (const char *file)
{
@@ -118,8 +131,8 @@ static int Rivet_chdir_file (const char
* Utility function internally used to determine which type
* of file (whether rvt template or plain Tcl script) we are
* dealing with. In order to speed up multiple tests the
- * the test returns an integer (RIVET_FILE) for rvt templates
- * or TCL_FILE for Tcl scripts
+ * the test returns an integer (RIVET_TEMPLATE) for rvt templates
+ * or RIVET_TCLFILE for Tcl scripts
*
* Argument:
*
@@ -141,10 +154,10 @@ Rivet_CheckType (request_rec *req)
int ctype = CTYPE_NOT_HANDLED;
if ( req->content_type != NULL ) {
- if( STRNEQU( req->content_type, RIVET_FILE_CTYPE) ) {
- ctype = RIVET_FILE;
- } else if( STRNEQU( req->content_type, TCL_FILE_CTYPE) ) {
- ctype = TCL_FILE;
+ if( STRNEQU( req->content_type, RIVET_TEMPLATE_CTYPE) ) {
+ ctype = RIVET_TEMPLATE;
+ } else if( STRNEQU( req->content_type, RIVET_TCLFILE_CTYPE) ) {
+ ctype = RIVET_TCLFILE;
}
}
return ctype;
@@ -495,11 +508,13 @@ Rivet_ParseExecFile(TclWebRequest *req,
* file (files included through the 'parse' command) is treated as a template.
*/
- if (!toplevel || (Rivet_CheckType(req->req) == RIVET_FILE))
+ if (!toplevel || (Rivet_CheckType(req->req) == RIVET_TEMPLATE))
{
/* toplevel == 0 means we are being called from the parse
* command, which only works on Rivet .rvt files. */
+
result = Rivet_GetRivetFile(filename, toplevel, outbuf, interp);
+
} else {
/* It's a plain Tcl file */
result = Rivet_GetTclFile(filename, outbuf, interp);
@@ -511,10 +526,8 @@ Rivet_ParseExecFile(TclWebRequest *req,
return result;
}
- if (toplevel) {
- if (rsc->rivet_after_script) {
- Tcl_AppendObjToObj(outbuf,rsc->rivet_after_script);
- }
+ if (toplevel && rsc->rivet_after_script) {
+ Tcl_AppendObjToObj(outbuf,rsc->rivet_after_script);
}
if (*(rsc->cache_size)) {
@@ -1973,8 +1986,8 @@ Rivet_SendContent(request_rec *r)
{
int content_type_len = strlen(r->content_type);
- if (((ctype==RIVET_FILE) && (content_type_len > strlen(RIVET_FILE_CTYPE))) || \
- ((ctype==TCL_FILE) && (content_type_len > strlen(TCL_FILE_CTYPE)))) {
+ if (((ctype==RIVET_TEMPLATE) && (content_type_len > strlen(RIVET_TEMPLATE_CTYPE))) || \
+ ((ctype==RIVET_TCLFILE) && (content_type_len > strlen(RIVET_TCLFILE_CTYPE)))) {
char* charset;
---------------------------------------------------------------------
To unsubscribe, e-mail: site-cvs-unsubscribe@tcl.apache.org
For additional commands, e-mail: site-cvs-help@tcl.apache.org