libcgi-xmlform-perl-0.10.orig/0042775000175000017500000000000007014571040014706 5ustar ardoardolibcgi-xmlform-perl-0.10.orig/Path/0042775000175000017500000000000007014571040015602 5ustar ardoardolibcgi-xmlform-perl-0.10.orig/Path/Changes0100664000175000017500000000020307014567614017077 0ustar ardoardoRevision history for Perl extension CGI::XMLForm::Path. 0.01 Wed Jan 20 14:31:54 1999 - original version; created by h2xs 1.18 libcgi-xmlform-perl-0.10.orig/Path/MANIFEST0100664000175000017500000000005507014567614016742 0ustar ardoardoChanges MANIFEST Makefile.PL Path.pm test.pl libcgi-xmlform-perl-0.10.orig/Path/Makefile0100664000175000017500000002434007014567614017254 0ustar ardoardo# This Makefile is for the CGI::XMLForm::Path extension to perl. # # It was generated automatically by MakeMaker version # 5.42 (Revision: 1.216) from the contents of # Makefile.PL. Don't edit this file, edit Makefile.PL instead. # # ANY CHANGES MADE HERE WILL BE LOST! # # MakeMaker Parameters: # NAME => q[CGI::XMLForm::Path] # VERSION_FROM => q[Path.pm] # --- MakeMaker post_initialize section: # --- MakeMaker const_config section: # These definitions are from config.sh (via /usr/lib/perl5/i386-linux/5.00404/Config.pm) # They may have been overridden via Makefile.PL or on the command line AR = ar CC = cc CCCDLFLAGS = -fpic CCDLFLAGS = -rdynamic DLEXT = so DLSRC = dl_dlopen.xs LD = cc LDDLFLAGS = -shared -L/usr/local/lib LDFLAGS = -L/usr/local/lib LIBC = LIB_EXT = .a OBJ_EXT = .o RANLIB = : SO = so EXE_EXT = # --- MakeMaker constants section: AR_STATIC_ARGS = cr NAME = CGI::XMLForm::Path DISTNAME = CGI-XMLForm-Path NAME_SYM = CGI_XMLForm_Path VERSION = 0.01 VERSION_SYM = 0_01 XS_VERSION = 0.01 INST_BIN = .././blib/bin INST_EXE = .././blib/script INST_LIB = .././blib/lib INST_ARCHLIB = .././blib/arch INST_SCRIPT = .././blib/script PREFIX = /usr INSTALLDIRS = site INSTALLPRIVLIB = $(PREFIX)/lib/perl5 INSTALLARCHLIB = $(PREFIX)/lib/perl5/i386-linux/5.00404 INSTALLSITELIB = $(PREFIX)/lib/perl5/site_perl INSTALLSITEARCH = $(PREFIX)/lib/perl5/site_perl/i386-linux INSTALLBIN = $(PREFIX)/bin INSTALLSCRIPT = $(PREFIX)/bin PERL_LIB = /usr/lib/perl5 PERL_ARCHLIB = /usr/lib/perl5/i386-linux/5.00404 SITELIBEXP = /usr/lib/perl5/site_perl SITEARCHEXP = /usr/lib/perl5/site_perl/i386-linux LIBPERL_A = libperl.a FIRST_MAKEFILE = Makefile MAKE_APERL_FILE = Makefile.aperl PERLMAINCC = $(CC) PERL_INC = /usr/lib/perl5/i386-linux/5.00404/CORE PERL = /usr/bin/perl FULLPERL = /usr/bin/perl VERSION_MACRO = VERSION DEFINE_VERSION = -D$(VERSION_MACRO)=\"$(VERSION)\" XS_VERSION_MACRO = XS_VERSION XS_DEFINE_VERSION = -D$(XS_VERSION_MACRO)=\"$(XS_VERSION)\" MAKEMAKER = /usr/lib/perl5/ExtUtils/MakeMaker.pm MM_VERSION = 5.42 # FULLEXT = Pathname for extension directory (eg Foo/Bar/Oracle). # BASEEXT = Basename part of FULLEXT. May be just equal FULLEXT. (eg Oracle) # ROOTEXT = Directory part of FULLEXT with leading slash (eg /DBD) !!! Deprecated from MM 5.32 !!! # PARENT_NAME = NAME without BASEEXT and no trailing :: (eg Foo::Bar) # DLBASE = Basename part of dynamic library. May be just equal BASEEXT. FULLEXT = CGI/XMLForm/Path BASEEXT = Path PARENT_NAME = CGI::XMLForm:: DLBASE = $(BASEEXT) VERSION_FROM = Path.pm OBJECT = LDFROM = $(OBJECT) LINKTYPE = dynamic # Handy lists of source code files: XS_FILES= C_FILES = O_FILES = H_FILES = MAN1PODS = MAN3PODS = INST_MAN1DIR = .././blib/man1 INSTALLMAN1DIR = /usr/man/man1 MAN1EXT = 1 INST_MAN3DIR = .././blib/man3 INSTALLMAN3DIR = $(PREFIX)/lib/perl5/man/man3 MAN3EXT = 3 # work around a famous dec-osf make(1) feature(?): makemakerdflt: all .SUFFIXES: .xs .c .C .cpp .cxx .cc $(OBJ_EXT) # Nick wanted to get rid of .PRECIOUS. I don't remember why. I seem to recall, that # some make implementations will delete the Makefile when we rebuild it. Because # we call false(1) when we rebuild it. So make(1) is not completely wrong when it # does so. Our milage may vary. # .PRECIOUS: Makefile # seems to be not necessary anymore .PHONY: all config static dynamic test linkext manifest # Where is the Config information that we are using/depend on CONFIGDEP = $(PERL_ARCHLIB)/Config.pm $(PERL_INC)/config.h # Where to put things: INST_LIBDIR = $(INST_LIB)/CGI/XMLForm INST_ARCHLIBDIR = $(INST_ARCHLIB)/CGI/XMLForm INST_AUTODIR = $(INST_LIB)/auto/$(FULLEXT) INST_ARCHAUTODIR = $(INST_ARCHLIB)/auto/$(FULLEXT) INST_STATIC = INST_DYNAMIC = INST_BOOT = EXPORT_LIST = PERL_ARCHIVE = TO_INST_PM = Path.pm PM_TO_BLIB = Path.pm \ $(INST_LIBDIR)/Path.pm # --- MakeMaker tool_autosplit section: # Usage: $(AUTOSPLITFILE) FileToSplit AutoDirToSplitInto AUTOSPLITFILE = $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -e 'use AutoSplit;autosplit($$ARGV[0], $$ARGV[1], 0, 1, 1) ;' # --- MakeMaker tool_xsubpp section: # --- MakeMaker tools_other section: SHELL = /bin/sh CHMOD = chmod CP = cp LD = cc MV = mv NOOP = $(SHELL) -c true RM_F = rm -f RM_RF = rm -rf TEST_F = test -f TOUCH = touch UMASK_NULL = umask 0 DEV_NULL = > /dev/null 2>&1 # The following is a portable way to say mkdir -p # To see which directories are created, change the if 0 to if 1 MKPATH = $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Command -e mkpath # This helps us to minimize the effect of the .exists files A yet # better solution would be to have a stable file in the perl # distribution with a timestamp of zero. But this solution doesn't # need any changes to the core distribution and works with older perls EQUALIZE_TIMESTAMP = $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Command -e eqtime # --- MakeMaker dist section skipped. # --- MakeMaker macro section: # --- MakeMaker depend section: # --- MakeMaker cflags section: # --- MakeMaker const_loadlibs section: # --- MakeMaker const_cccmd section: # --- MakeMaker post_constants section: # --- MakeMaker pasthru section: PASTHRU = LIB="$(LIB)"\ LIBPERL_A="$(LIBPERL_A)"\ LINKTYPE="$(LINKTYPE)"\ PREFIX="$(PREFIX)"\ OPTIMIZE="$(OPTIMIZE)" # --- MakeMaker c_o section: # --- MakeMaker xs_c section: # --- MakeMaker xs_o section: # --- MakeMaker top_targets section: #all :: config $(INST_PM) subdirs linkext manifypods all :: pure_all manifypods @$(NOOP) pure_all :: config pm_to_blib subdirs linkext @$(NOOP) subdirs :: $(MYEXTLIB) @$(NOOP) config :: Makefile $(INST_LIBDIR)/.exists @$(NOOP) config :: $(INST_ARCHAUTODIR)/.exists @$(NOOP) config :: $(INST_AUTODIR)/.exists @$(NOOP) $(INST_AUTODIR)/.exists :: /usr/lib/perl5/i386-linux/5.00404/CORE/perl.h @$(MKPATH) $(INST_AUTODIR) @$(EQUALIZE_TIMESTAMP) /usr/lib/perl5/i386-linux/5.00404/CORE/perl.h $(INST_AUTODIR)/.exists -@$(CHMOD) 755 $(INST_AUTODIR) $(INST_LIBDIR)/.exists :: /usr/lib/perl5/i386-linux/5.00404/CORE/perl.h @$(MKPATH) $(INST_LIBDIR) @$(EQUALIZE_TIMESTAMP) /usr/lib/perl5/i386-linux/5.00404/CORE/perl.h $(INST_LIBDIR)/.exists -@$(CHMOD) 755 $(INST_LIBDIR) $(INST_ARCHAUTODIR)/.exists :: /usr/lib/perl5/i386-linux/5.00404/CORE/perl.h @$(MKPATH) $(INST_ARCHAUTODIR) @$(EQUALIZE_TIMESTAMP) /usr/lib/perl5/i386-linux/5.00404/CORE/perl.h $(INST_ARCHAUTODIR)/.exists -@$(CHMOD) 755 $(INST_ARCHAUTODIR) help: perldoc ExtUtils::MakeMaker Version_check: @$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) \ -MExtUtils::MakeMaker=Version_check \ -e "Version_check('$(MM_VERSION)')" # --- MakeMaker linkext section: linkext :: $(LINKTYPE) @$(NOOP) # --- MakeMaker dlsyms section: # --- MakeMaker dynamic section: ## $(INST_PM) has been moved to the all: target. ## It remains here for awhile to allow for old usage: "make dynamic" #dynamic :: Makefile $(INST_DYNAMIC) $(INST_BOOT) $(INST_PM) dynamic :: Makefile $(INST_DYNAMIC) $(INST_BOOT) @$(NOOP) # --- MakeMaker dynamic_bs section: BOOTSTRAP = # --- MakeMaker dynamic_lib section: # --- MakeMaker static section: ## $(INST_PM) has been moved to the all: target. ## It remains here for awhile to allow for old usage: "make static" #static :: Makefile $(INST_STATIC) $(INST_PM) static :: Makefile $(INST_STATIC) @$(NOOP) # --- MakeMaker static_lib section: # --- MakeMaker manifypods section: manifypods : @$(NOOP) # --- MakeMaker processPL section: # --- MakeMaker installbin section: # --- MakeMaker subdirs section: # none # --- MakeMaker clean section: # Delete temporary files but do not touch installed files. We don't delete # the Makefile here so a later make realclean still has a makefile to use. clean :: -rm -rf ./blib $(MAKE_APERL_FILE) $(INST_ARCHAUTODIR)/extralibs.all perlmain.c mon.out core so_locations pm_to_blib *~ */*~ */*/*~ *$(OBJ_EXT) *$(LIB_EXT) perl.exe $(BOOTSTRAP) $(BASEEXT).bso $(BASEEXT).def $(BASEEXT).exp -mv Makefile Makefile.old $(DEV_NULL) # --- MakeMaker realclean section: # Delete temporary files (via clean) and also delete installed files realclean purge :: clean rm -rf $(INST_AUTODIR) $(INST_ARCHAUTODIR) rm -f $(INST_LIBDIR)/Path.pm rm -rf Makefile Makefile.old # --- MakeMaker dist_basics section skipped. # --- MakeMaker dist_core section skipped. # --- MakeMaker dist_dir section skipped. # --- MakeMaker dist_test section skipped. # --- MakeMaker dist_ci section skipped. # --- MakeMaker install section skipped. # --- MakeMaker force section: # Phony target to force checking subdirectories. FORCE: @$(NOOP) # --- MakeMaker perldepend section: # --- MakeMaker makefile section: # We take a very conservative approach here, but it\'s worth it. # We move Makefile to Makefile.old here to avoid gnu make looping. Makefile : Makefile.PL $(CONFIGDEP) @echo "Makefile out-of-date with respect to $?" @echo "Cleaning current config before rebuilding Makefile..." -@$(MV) Makefile Makefile.old -$(MAKE) -f Makefile.old clean $(DEV_NULL) || $(NOOP) $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" Makefile.PL @echo "==> Your Makefile has been rebuilt. <==" @echo "==> Please rerun the make command. <==" false # To change behavior to :: would be nice, but would break Tk b9.02 # so you find such a warning below the dist target. #Makefile :: $(VERSION_FROM) # @echo "Warning: Makefile possibly out of date with $(VERSION_FROM)" # --- MakeMaker staticmake section: # --- MakeMaker makeaperl section --- MAP_TARGET = ../perl FULLPERL = /usr/bin/perl # --- MakeMaker test section: TEST_VERBOSE=0 TEST_TYPE=test_$(LINKTYPE) TEST_FILE = test.pl TEST_FILES = TESTDB_SW = -d testdb :: testdb_$(LINKTYPE) test :: $(TEST_TYPE) test_dynamic :: pure_all PERL_DL_NONLAZY=1 $(FULLPERL) -I$(INST_ARCHLIB) -I$(INST_LIB) -I$(PERL_ARCHLIB) -I$(PERL_LIB) $(TEST_FILE) testdb_dynamic :: pure_all PERL_DL_NONLAZY=1 $(FULLPERL) $(TESTDB_SW) -I$(INST_ARCHLIB) -I$(INST_LIB) -I$(PERL_ARCHLIB) -I$(PERL_LIB) $(TEST_FILE) test_ : test_dynamic test_static :: test_dynamic testdb_static :: testdb_dynamic # --- MakeMaker pm_to_blib section: pm_to_blib: $(TO_INST_PM) @$(PERL) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)" \ "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -MExtUtils::Install \ -e "pm_to_blib({qw{$(PM_TO_BLIB)}},'$(INST_LIB)/auto')" @$(TOUCH) $@ # --- MakeMaker selfdocument section: # --- MakeMaker postamble section: # End. libcgi-xmlform-perl-0.10.orig/Path/Makefile.PL0100664000175000017500000000036107014567614017563 0ustar ardoardouse ExtUtils::MakeMaker; # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. WriteMakefile( 'NAME' => 'CGI::XMLForm::Path', 'VERSION_FROM' => 'Path.pm', # finds $VERSION ); libcgi-xmlform-perl-0.10.orig/Path/Path.pm0100664000175000017500000000622307014567614017046 0ustar ardoardopackage CGI::XMLForm::Path; use strict; use vars qw($VERSION @ISA @EXPORT @EXPORT_OK); require Exporter; require AutoLoader; @ISA = qw(Exporter AutoLoader); # Items to export into callers namespace by default. Note: do not export # names by default without a very good reason. Use EXPORT_OK instead. # Do not simply export all your public functions/methods/constants. @EXPORT = qw( ); $VERSION = '0.01'; 1; __END__ # This class allows comparison of current paths sub new { my $proto = shift; my $class = ref($proto) || $proto; my $self; $self->{_path} = $_[0]; $self->{_fullpath} = []; bless ($self, $class); # reconsecrate if ($self->{_path}) { $self->buildSelf($_[1] || new $class); } return $self; } sub buildSelf { my $self = shift; my $prev = shift; if ($self->{_path} =~ s/\*$//) { $self->{_repeat} = 1; } # warn "Building from ", $self->{_path}, "\n"; my @parts = split('/', $self->{_path}); my @fullpath; $self->{Relative} = 0; if ($self->{_path} !~ /^\//) { # It's a relative path $self->{_relative} = 1; @fullpath = @{$prev->{_fullpath}}; if ($prev->isRelative) { # prev was a relative path so remove top item pop @fullpath; } foreach ( @parts ) { if ($_ eq "..") { pop @fullpath; } else { push @fullpath, $_; } } } else { # remove crap from beginning (empty because of preceding "/") shift @parts; @fullpath = @parts; } if ($fullpath[$#fullpath] =~ /^\@(\w+)$/) { pop @fullpath; pop @parts; $self->{_attrib} = $1; } $self->{Parts} = \@parts; $self->{_fullpath} = \@fullpath; # warn "Built: ", $self->FullPath, "\n"; } sub rebuildSelf { my $self = shift; $self->buildSelf(new CGI::XMLExt::Path); } sub isRelative { $_[0]->{_relative}; } sub isRepeat { $_[0]->{_repeat}; } sub isChildPath { my $self = shift; my $compare = shift; # Now compare each level of the tree, and throw away attributes. my @a = @{$self->{_fullpath}}; my @b = @{$compare->{_fullpath}}; if (@a >= @b) { return 0; } foreach ($#a..0) { $a[$_] =~ s/\[.*\]//; $b[$_] =~ s/\[.*\]//; return 0 if ($a[$_] ne $b[$_]); } return 1; } sub Attrib { $_[0]->{_attrib}; } sub isEqual { my $self = shift; my $compare = shift; my @a = @{$self->{_fullpath}}; my @b = @{$compare->{_fullpath}}; # warn "Comparing: ", $self->FullPath, "\nTo : ", $compare->FullPath, # "\n"; if (scalar @a != scalar @b) { return 0; } foreach (0..$#a) { $a[$_] =~ s/\[.*\]//; $b[$_] =~ s/\[.*\]//; if ($a[$_] ne $b[$_]) { return 0; } } # warn "*** FOUND ***\n"; return 1; } sub Append { my $self = shift; my $element = shift; my %attribs = @_; if (%attribs) { $element .= "["; $element .= join " and ", (map "\@$_=\"$attribs{$_}\"", (keys %attribs)); $element .= "]"; } push @{$self->{_fullpath}}, $element; push @{$self->{Parts}}, $element; $self->{_path} .= "/". $element; } sub Pop { my $self = shift; pop @{$self->{_fullpath}}; $self->{_path} =~ s/^(.*)\/.*?$/$1/; pop @{$self->{Parts}}; } sub Path { $_[0]->{_path}; } sub FullPath { my $self = shift; my $path = "/" . (join "/", @{$self->{_fullpath}}); $path .= ($self->Attrib ? "/\@" . $self->Attrib : ''); $path; } 1; libcgi-xmlform-perl-0.10.orig/Path/test.pl0100664000175000017500000000122707014567614017127 0ustar ardoardo# Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl test.pl' ######################### We start with some black magic to print on failure. # Change 1..1 below to 1..last_test_to_print . # (It may become useful if the test is moved to ./t subdirectory.) BEGIN { $| = 1; print "1..1\n"; } END {print "not ok 1\n" unless $loaded;} use CGI::XMLForm::Path; $loaded = 1; print "ok 1\n"; ######################### End of black magic. # Insert your test code below (better if it prints "ok 13" # (correspondingly "not ok 13") depending on the success of chunk 13 # of the test code): libcgi-xmlform-perl-0.10.orig/Changes0100664000175000017500000000326707014567614016220 0ustar ardoardoRevision history for Perl extension CGI::ToXML. 0.10 Tue Jun 8 1999 - Fixed stupid NT CRLF's... Grrr... (thanks Tim) 0.09 Mon Jun 7 1999 - Bug fix for when typing a / in the form field 0.08 Internal bug fix release 0.07 Wed Jan 27 1999 - Speed improvements. Now faster than XML::XQL (DOM) for all cases - Some minor bug fixes - Fixes to Stream mode 0.06 Fri Jan 22 1999 - "Pretty" XML fixed. - Removed ToCGI - that was a dumb name! - Fixed - the module was actually totally broken, except in a mod-perl environment where we'd already included XML::Parser at the server level. 0.05 Thu Jan 21 1999 - Used parse_params again. For some reason $self->query_string isn't in the order it's recieved from the browser. Grr. - Renamed to CGI::XMLForm after discussion with J.Eisenzopf. - Added readXML function. - tries to make "pretty" XML. Fails . - Encoding should have been ISO-8859-1. Duh! 0.04 Thu Jan 14 1999 - Fixed bug in relative (parent) paths - Added xml encoding="ISO-8859-2" - Don't overload parse_params any more - that could be problematic. - Don't allow people to enter entities in forms any more (always encodes & as & from now on, even if followed by \w+;). - Thought very hard about rewriting to be neater, but didn't bother in the end ;-) Next version maybe! 0.03 Wed Jan 06 1999 - Syntax updates - Allow relative paths - Improved docs - Improved examples - Some bug fixes - Properly deal with fixed entities (&,<,>,',") - Properly subclasses CGI.pm 0.02 Wed Dec 30 11:50:00 1998 - Updated to use the XSL style syntax - Added some more docs - Added example files 0.01 Mon Dec 21 16:48:48 1998 - original version; created by h2xs 1.18 libcgi-xmlform-perl-0.10.orig/MANIFEST0100664000175000017500000000031007014567614016040 0ustar ardoardoChanges MANIFEST Makefile.PL Path/Changes Path/MANIFEST Path/Makefile Path/Makefile.PL Path/Makefile.old Path/Path.pm Path/test.pl README TODO XMLForm.pm example.html example.pl example2.html test.pl libcgi-xmlform-perl-0.10.orig/Makefile.PL0100664000175000017500000000054307014567614016671 0ustar ardoardouse ExtUtils::MakeMaker; # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. WriteMakefile( 'NAME' => 'CGI::XMLForm', 'DIR' => [qw(Path)], 'PREREQ_PM' => {'XML::Parser' => '2.20' }, 'VERSION_FROM' => 'XMLForm.pm', # finds $VERSION 'dist' => {COMPRESS => 'gzip', 'SUFFIX' => 'gz'}, ); libcgi-xmlform-perl-0.10.orig/README0100664000175000017500000001733507014567614015606 0ustar ardoardo0.07 Wed Jan 27 1999 - Speed improvements. Now faster than XML::XQL (DOM) for all cases - Some minor bug fixes - Fixes to Stream mode - see README - needs to patch XML::Parser version 2.19 ==================================================================== *** WARNING *** WARNING *** WARNING *** WARNING *** This module requires XML::Parser version 2.20, but that's not been released yet. To get around this you need to make 2 patches to XML::Parser (1 of them is non-essential). First, the non-essential bug fix: In XML::Parser, the Stream style has a function doText which looks like: sub doText { ... if ($_) { ... } } change that to: sub doText { ... if (defined $_) { ... } } And the other, required fix is to add the following function to Expat.pm: sub finish { my ($self) = @_; foreach (keys %{$self->{_Setters}}) { &{$self->{_Setters}->{$_}}($self->{Parser}, undef); } } The first patch fixes a bug where you have 0 and the finish function allows you to break out of a parse phase. END OF WARNING. ==================================================================== NAME CGI::XMLForm - Extension of CGI.pm which reads/generates formated XML. This is currently alpha software, and I'm looking for feedback. Note though that it is proving quite stable in our mod_perl environment, so it is ready for production use. NB: This is a subclass of CGI.pm, so can be used in it's place. SYNOPSIS use CGI::XMLForm; my $cgi = new CGI::XMLForm; if ($cgi->param) { print $cgi->header, $cgi->pre($cgi->escapeHTML($cgi->toXML)); } else { open(FILE, "test.xml") or die "Can't open: $!"; my @queries = ('/a', '/a/b*', '/a/b/c*', /a/d'); print $cgi->header, $cgi->pre($cgi->escapeHTML( join "\n", $cgi->readXML(*FILE, @queries))); } DESCRIPTION This module can either create form field values from XML based on XQL style queries (full XQL is _not_ supported - this module is designed for speed), or it can create XML from form values. There are 2 key functions: toXML and readXML. toXML The module takes form fields given in a specialised format, and outputs them to XML based on that format. The idea is that you can create forms that define the resulting XML at the back end. The format for the form elements is: which creates the following XML:

It's the user's responsibility to design appropriate forms to make use of this module, although coming later will be a small module that uses my XML::DTDParser to create all the form elements given a DTD. Also supported are attribute form items, that allow creation of element attributes. The syntax for this is: Which creates the following XML:

Also possible are relative paths. So the following form elements: Will create the following XML:
value1 value2
value3
SYNTAX The following is a brief syntax guideline Full paths start with a "/" : "/table/tr/td" Relative paths start with either ".." or just a tag name. "../tr/td" "td" Relative paths go at the level above the previous path, unless the previous path was also a relative path, in which case it goes at the same level. This seems confusing at first (you might expect it to always go at the level above the previous element), but it makes your form easier to design. Take the following example: You have a timesheet (see the example supplied in the archive) that has monday,tuesday,etc. Our form can look like this: ... Rather than: ... If unsure I recommend using full paths, relative paths are great for repeating groups of data, but weak for heavily structured data. Picture the following paths: /timesheet/employee/name/forename ../surname title ../department This actually creates the following XML: val1 val2 val3> val4 Confusing eh? Far better to say: /timesheet/employee/name/forename /timesheet/employee/name/surname /timesheet/employee/name/title /timesheet/employee/department Or alternatively, better still: /timesheet/employee/name (Make hidden and no value) forename surname title ../department Attributes go in square brackets. Attribute names are preceded with an "@", and attribute values follow an "=" sign and are enclosed in quotes. Multiple attributes are separated with " and ". /table[@bgcolor="blue" and @width="100%"]/tr/td If setting an attribute, it follows after the tag that it is associated with, after a "/" and it's name is preceded with an "@". /table/@bgcolor readXML readXML takes either a file handle or text as the first parameter and a list of queries following that. The XML is searched for the queries and it returns a list of tuples that are the query and the match. It's easier to demonstrate this with an example. Given the following XML: Foo Bar Fred Blogs Red Barbara Cartland Food And the following queries: /a /a/b* c* /a/d it returns the following result as a list: /a Foo /a/b Bar c Fred c Blogs /a/b Red c Barbara c Cartland /a/d Food (NB: This is slightly incorrect - for /a and /a/b it will return "Foo\n " and "Bar\n " respectively). The queries support relative paths like toXML (including parent paths), and they also support wildcards using ".*" or ".*?" (preferably ".*?" as it's probably a better match). If a wildcard is specified the results will have the actual value substituted with the wildcard. Wildcards are a bit experimental, so be careful ;-) Caveats There are a few caveats to using this module: AUTHOR Matt Sergeant msergeant@ndirect.co.uk, sergeant@geocities.com Based on an original concept, and discussions with, Jonathan Eisenzopf. Thanks to the Perl-XML mailing list for suggesting the XSL syntax. Special thanks to Francois Belanger (francois@sitepak.com) for his mentoring and help with the syntax design. SEE ALSO CGI(1), CGI::XML libcgi-xmlform-perl-0.10.orig/TODO0100664000175000017500000000027307014567614015407 0ustar ardoardoTODO - Add in support for Doctype headers - Add in xmlcgi:combine (for combining 2 or more params into 1 element) - Add in more pragmas - Figure out how to figure out the encoding... :) libcgi-xmlform-perl-0.10.orig/XMLForm.pm0100664000175000017500000003260507014567614016545 0ustar ardoardopackage CGI::XMLForm; use strict; use vars qw($VERSION @ISA @EXPORT @EXPORT_OK); use CGI; use CGI::XMLForm::Path; use XML::Parser; @ISA = qw(CGI); # Items to export into callers namespace by default. Note: do not export # names by default without a very good reason. Use EXPORT_OK instead. # Do not simply export all your public functions/methods/constants. @EXPORT = qw( ); $VERSION = '0.10'; sub new { my $proto = shift; my $class = ref($proto) || $proto; my $self = $class->SUPER::new(@_); bless ($self, $class); # reconsecrate return $self; } sub readXML { my $self = shift; my $xml = shift; my @queries = @_; my @Requests; my $req = new CGI::XMLForm::Path(); do { $req = new CGI::XMLForm::Path(shift @queries, $req); push @Requests, $req; } while @queries; my $currenttree = new CGI::XMLForm::Path(); my $p = new XML::Parser(Style => 'Stream', _parseresults => [], _currenttree => $currenttree, _requests => \@Requests, ); my $results; eval { $results = $p->parse($xml); # warn "Parse returned ", @{$results}, "\n"; }; if ($@) { return $@; } else { return @{$results}; } } sub StartTag { my $expat = shift; return $expat->finish() if $expat->{_done}; my $element = shift; # my %attribs = %_; #warn "Start: $element\n"; $expat->{_currenttree}->Append($element, %_); my $current = $expat->{_currenttree}; #warn "Path now: ", $expat->{_currenttree}->Path, "\n"; foreach (0..$#{$expat->{_requests}}) { next unless defined $expat->{_requests}->[$_]->Attrib; # warn "Looking for attrib: ", $expat->{_requests}->[$_]->Attrib, "\n"; if (defined $_{$expat->{_requests}->[$_]->Attrib}) { # Looking for attrib if ($expat->{_requests}->[$_]->isEqual($current)) { # We have equality! found($expat, $expat->{_requests}->[$_], $_{$expat->{_requests}->[$_]->Attrib}); splice(@{$expat->{_requests}}, $_, 1) unless $expat->{_requests}->[$_]->isRepeat; $expat->{_done} = 1 if (@{$expat->{_requests}} == 0); return; } } } } sub EndTag { my $expat = shift; return $expat->finish() if $expat->{_done}; # warn "End: $_\n"; $expat->{_currenttree}->Pop(); } sub Text { my $expat = shift; my $text = $_; return $expat->finish() if $expat->{_done}; my @Requests = @{$expat->{_requests}}; my $current = $expat->{_currenttree}; foreach (0..$#Requests) { if (!$Requests[$_]->Attrib) { # Not looking for an attrib # warn "Comparing : ", $Requests[$_]->Path, " : ", $expat->{_currenttree}->Path, "\n"; if ($Requests[$_]->isEqual($current)) { found($expat, $Requests[$_], $text); splice(@{$expat->{_requests}}, $_, 1) unless $Requests[$_]->isRepeat; $expat->{_done} = 1 if (@Requests == 0); return; } } } } sub found { my $expat = shift; my ($request, $found) = @_; #warn "Found: ", $request->Path, " : $found\n"; if ($request->Path =~ /\.\*/) { # Request path contains a regexp my $match = $request->Path; $match =~ s/\[(.*?)\]/\\\[$1\\\]/g; # warn "Regexp: ", $expat->{_currenttree}->Path, " =~ |$match|\n"; $expat->{_currenttree}->Path =~ /$match/; push @{$expat->{_parseresults}}, $&, $found; } else { push @{$expat->{_parseresults}}, $request->Path, $found; } } sub EndDocument { my $expat = shift; delete $expat->{_done}; delete $expat->{_currenttree}; delete $expat->{_requests}; return $expat->{_parseresults}; } sub formatElement($$) { # Properly formats elements whether opening or closing. my $cgi = shift; my $open = shift; my $element = shift; my $level = shift; $element =~ s/&slash;/\//g; $element =~ /^(.*?)(\[(.*)\])?$/; my $output = $1; my $attribs = $3 || ""; if (!$open) { if (!$cgi->{'.closetags'}) { $cgi->{'.closetags'} = $level; return "\n"; } else { return ("\t" x --$cgi->{'.closetags'}) . "\n"; } } # If we have attributes while ($attribs =~ /\@(\w+?)=([\"\'])(.*?)\2(\s+and\s+)?/g) { $output .= " $1=\"$3\""; } my $save = $cgi->{'.closetags'}; $cgi->{'.closetags'} = 0; return ($save ? '' : "\n") . ("\t" x $level) . "<$output>"; } sub ToXML { shift()->toXML(@_); } sub toXML { my $self = shift; my $filename = shift; if (defined $filename) { local *OUTPUT; open(OUTPUT, ">$filename") or die "Can't open $filename for output: $!"; print OUTPUT $self->{".xml"}; close OUTPUT; } defined wantarray && return $self->{".xml"}; } sub parse_params { my($self,$tosplit) = @_; my(@pairs) = split('&',$tosplit); my($param,$value); my $output = ""; my @prevStack; my @stack; my @rawParams; my $relative; $self->{'.closetags'} = 0; foreach (@pairs) { ($param,$value) = split('=',$_,2); $param = $self->unescape($param); $value = $self->unescape($value); $self->add_parameter($param); push (@{$self->{$param}},$value); next if $param =~ /^xmlcgi:ignore/; next if $param =~ /^\.\w/; # Skip CGI.pm ".submit" and other buttons push @rawParams, $param, $value; # Encode values $value =~ s/&/&/g; $value =~ s//>/g; $value =~ s/'/'/g; $value =~ s/"/"/g; $value =~ s/\//\&slash;/g; # We decode this later... $param =~ s/\[(.*?)\/(.*?)\]/\[$1\&slash;$2\]/g; # Here we make the attribute into an internal attrib # so that tree compares work properly my $attrib = 0; if($param =~ s/(\])?\/(\@\w+)$/(($1 && " and ")||"[").qq($2="$value"])/e) { $attrib = 1; } # Do work here if ($param =~ s/^\///) { # If starts with a slash it's a root element @stack = split /\//, $param; $relative = 0; } else { # Otherwise it's a relative path # - We don't need to do this, but it's here commented out # to show what we're implying. # @stack = @prevStack; # We don't want the last element if the previous param # was also a relative param. my $top = pop @stack if ($relative); foreach ( split(/\//, $param)) { if ($_ eq "..") { if ($top) { $output .= $self->formatElement(0, $top, scalar @stack); $top = ''; pop @prevStack; } $output .= $self->formatElement(0, pop(@stack), scalar @stack); pop @prevStack; } else { push @stack, $_; } } $relative++; } # print STDERR "Prev Stack: ", join(", ", @prevStack), "\n"; # print STDERR "New Stack: ", join(", ", @stack), "\n----------\n"; foreach my $i (0..$#stack) { if (defined $prevStack[$i]) { # We've travelled along this branch of the tree before. if (($i == $#stack) || ($prevStack[$i] ne $stack[$i])) { # If we've reached the end of the branch, or the branch has changed... while ($i <= $#prevStack) { # Close the previous branch $output .= $self->formatElement(0, pop(@prevStack), scalar @prevStack); } # And add this new branch $output .= $self->formatElement(1, $stack[$i], scalar @prevStack); push @prevStack, $stack[$i]; } } else { # here we're traversing out into the tree where we've not travelled before. $output .= $self->formatElement(1, $stack[$i], scalar @prevStack); push @prevStack, $stack[$i]; } } # Finally, we output the contents of the form field, unless it's an attribute form field if (!$attrib) { $output .= $value; } # Store the previous stack. @prevStack = @stack; } # Finish by completely popping the stack off. while (@prevStack) { $output .= $self->formatElement(0, pop(@prevStack), scalar @prevStack); } $self->{".xml"} = $output; $self->{rawParams} = \@rawParams; 1; } 1; __END__ =head1 NAME CGI::XMLForm - Extension of CGI.pm which reads/generates formated XML. NB: This is a subclass of CGI.pm, so can be used in it's place. =head1 SYNOPSIS use CGI::XMLForm; my $cgi = new CGI::XMLForm; if ($cgi->param) { print $cgi->header, $cgi->pre($cgi->escapeHTML($cgi->toXML)); } else { open(FILE, "test.xml") or die "Can't open: $!"; my @queries = ('/a', '/a/b*', '/a/b/c*', /a/d'); print $cgi->header, $cgi->pre($cgi->escapeHTML( join "\n", $cgi->readXML(*FILE, @queries))); } =head1 DESCRIPTION This module can either create form field values from XML based on XQL/XSL style queries (full XQL is _not_ supported - this module is designed for speed), or it can create XML from form values. There are 2 key functions: toXML and readXML. =head2 toXML The module takes form fields given in a specialised format, and outputs them to XML based on that format. The idea is that you can create forms that define the resulting XML at the back end. The format for the form elements is: which creates the following XML:

It's the user's responsibility to design appropriate forms to make use of this module. Details of how come below... Also supported are attribute form items, that allow creation of element attributes. The syntax for this is: Which creates the following XML:

Also possible are relative paths. So the following form elements: Will create the following XML:
value1 value2
value3
=head1 SYNTAX The following is a brief syntax guideline Full paths start with a "/" : "/table/tr/td" Relative paths start with either ".." or just a tag name. "../tr/td" "td" B This seems confusing at first (you might expect it to always go at the level above the previous element), but it makes your form easier to design. Take the following example: You have a timesheet (see the example supplied in the archive) that has monday,tuesday,etc. Our form can look like this: ... Rather than: ... If unsure I recommend using full paths, relative paths are great for repeating groups of data, but weak for heavily structured data. Picture the following paths: /timesheet/employee/name/forename ../surname title ../department This actually creates the following XML: val1 val2 val3> val4 Confusing eh? Far better to say: /timesheet/employee/name/forename /timesheet/employee/name/surname /timesheet/employee/name/title /timesheet/employee/department Or alternatively, better still: /timesheet/employee/name (Make hidden and no value) forename surname title ../department Attributes go in square brackets. Attribute names are preceded with an "@", and attribute values follow an "=" sign and are enclosed in quotes. Multiple attributes are separated with " and ". /table[@bgcolor="blue" and @width="100%"]/tr/td If setting an attribute, it follows after the tag that it is associated with, after a "/" and it's name is preceded with an "@". /table/@bgcolor =head2 readXML readXML takes either a file handle or text as the first parameter and a list of queries following that. The XML is searched for the queries and it returns a list of tuples that are the query and the match. It's easier to demonstrate this with an example. Given the following XML: Foo Bar Fred Blogs Red Barbara Cartland Food And the following queries: /a /a/b* c* /a/d it returns the following result as a list: /a Foo /a/b Bar c Fred c Blogs /a/b Red c Barbara c Cartland /a/d Food (NB: This is slightly incorrect - for /a and /a/b it will return "Foo\n " and "Bar\n " respectively). The queries support relative paths like toXML (including parent paths), and they also support wildcards using ".*" or ".*?" (preferably ".*?" as it's probably a better match). If a wildcard is specified the results will have the actual value substituted with the wildcard. Wildcards are a bit experimental, so be careful ;-) =head2 Caveats There are a few caveats to using this module: =over =item * Parameters must be on the form in the order they will appear in the XML. =item * There is no support for multiple attribute setting (i.e. you can only set one attribute for an element at a time). =item * You can't set an attribute B a value for that element, it's one or the other. =item * You can use this module in place of CGI.pm, since it's a subclass. =item * There are bound to be lots of bugs! Although it's in production use right now - just watch CPAN for regular updates. =back =head1 AUTHOR Matt Sergeant msergeant@ndirect.co.uk, sergeant@geocities.com Based on an original concept, and discussions with, Jonathan Eisenzopf. Thanks to the Perl-XML mailing list for suggesting the XSL syntax. Special thanks to Francois Belanger (francois@sitepak.com) for his mentoring and help with the syntax design. =head1 SEE ALSO CGI(1), CGI::XML =cut libcgi-xmlform-perl-0.10.orig/example.html0100664000175000017500000000577307014567614017252 0ustar ardoardo Timesheet

Timesheet details on : Wed Dec 30 11:10:49 1998



Timesheet entry form
Project name sunday monday tuesday wednesday thursday friday saturday Sub total
30.75
7.75
Summary 0 7.75 7.75 8.75 7.75 6.5 0 38.5
Basic hours 0.00 7.75 7.75 7.75 7.75 6.50 0.00 37.5
Overtime 0 0 0 1 0 0 0 1


libcgi-xmlform-perl-0.10.orig/example.pl0100775000175000017500000000116207014567614016710 0ustar ardoardo#!/usr/bin/perl -w # CGI script that simply displays the XML use strict; use CGI::XMLForm; my $cgi = new CGI::XMLForm; print $cgi->header; # Output HTML Body if ($cgi->param) { print $cgi->start_html('CGI::XMLForm'), $cgi->h1("Form gave us the following params:"), $cgi->hr; print $cgi->pre($cgi->escapeHTML(join "\n", split '&', $cgi->query_string)); my $xml = $cgi->ToXML(); print $cgi->hr; print $cgi->pre($cgi->escapeHTML($xml)), $cgi->br, $cgi->hr; } else { print $cgi->start_html('error'), $cgi->h1("Error: "), $cgi->h2("FATAL ERROR : Expecting parameters - please execute from correct source"); } libcgi-xmlform-perl-0.10.orig/example2.html0100664000175000017500000000046107014567614017321 0ustar ardoardo Table test Table test
libcgi-xmlform-perl-0.10.orig/test.pl0100664000175000017500000000122107014567614016225 0ustar ardoardo# Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl test.pl' ######################### We start with some black magic to print on failure. # Change 1..1 below to 1..last_test_to_print . # (It may become useful if the test is moved to ./t subdirectory.) BEGIN { $| = 1; print "1..1\n"; } END {print "not ok 1\n" unless $loaded;} use CGI::XMLForm; $loaded = 1; print "ok 1\n"; ######################### End of black magic. # Insert your test code below (better if it prints "ok 13" # (correspondingly "not ok 13") depending on the success of chunk 13 # of the test code):