diff -Nru libxml-generator-perl-1.04/Changes libxml-generator-perl-1.09/Changes --- libxml-generator-perl-1.04/Changes 2011-07-15 12:36:44.000000000 +0000 +++ libxml-generator-perl-1.09/Changes 2022-02-19 03:06:28.000000000 +0000 @@ -1,5 +1,45 @@ Revision history for Perl extension XML::Generator. +1.09 -- Fri Feb 18 23:06:27 AST 2022 + + - b31c19f Increment version + - 1a3fa9e Fix RT 49038: Doc bug - escaping + - d398d9c Fix dependency info + +1.08 -- Thu Feb 17 20:00:24 AST 2022 + + [Significant Updates since 1.04] + + - Fix RT 77323: escape all characters outside the normal ASCII range + - Fix RT 80273 v1.04 incorrectly escaping stringified inner tags + - Fix RT 70986 and provides test + - Move to Dist::Zilla to build + + [Changes since 1.07] + + - 6258a3b Update version number for release + - c9a09d4 v1.07 + +1.07 -- Thu Feb 17 16:58:42 AST 2022 + + - c70c220 Add .gitignore + - 124e36a Update version and Dist::Zilla settings + - 0f6ccd0 Fix some pod issues + +1.06 -- Thu Feb 17 08:04:38 AST 2022 + + - 7c9d6d5 v1.06 + - a676ff3 Merge pull request #1 from perl-net-saml2/distzilla + - d565282 Move to Dist::Zilla + +1.05 Wed Feb 16 22:00:00 2022 + + - 1eb746e (tag: 1.05) Update for new release + - 0e895a0 Add github action + - f636f4b Fix RT 77323: escape all characters outside the normal ASCII range + - 423c2cf Fix RT 80273 v1.04 incorrectly escaping stringified inner tags + - 8ef1c52 Fixes RT 70986 and provides test + 1.04 Fri Jul 15 08:35:00 2011 - Added the filter_invalid_chars option, which is turned on by default under strict mode. diff -Nru libxml-generator-perl-1.04/cpanfile libxml-generator-perl-1.09/cpanfile --- libxml-generator-perl-1.04/cpanfile 1970-01-01 00:00:00.000000000 +0000 +++ libxml-generator-perl-1.09/cpanfile 2022-02-19 03:06:28.000000000 +0000 @@ -0,0 +1,23 @@ +# This file is generated by Dist::Zilla::Plugin::CPANFile v6.022 +# Do not edit this file directly. To change prereqs, edit the `dist.ini` file. + +requires "perl" => "5.008"; +recommends "XML::DOM" => "1.46"; +suggests "Tie::IxHash" => "0"; + +on 'test' => sub { + requires "Test" => "0"; +}; + +on 'test' => sub { + recommends "XML::DOM" => "1.46"; +}; + +on 'configure' => sub { + requires "ExtUtils::MakeMaker" => "0"; +}; + +on 'develop' => sub { + requires "Test::Pod" => "1.41"; + requires "Test::Spelling" => "0.12"; +}; diff -Nru libxml-generator-perl-1.04/debian/changelog libxml-generator-perl-1.09/debian/changelog --- libxml-generator-perl-1.04/debian/changelog 2018-01-27 12:55:15.000000000 +0000 +++ libxml-generator-perl-1.09/debian/changelog 2022-02-19 16:34:24.000000000 +0000 @@ -1,3 +1,28 @@ +libxml-generator-perl (1.09-1) unstable; urgency=medium + + [ Salvatore Bonaccorso ] + * Update Vcs-* headers for switch to salsa.debian.org + + [ gregor herrmann ] + * debian/watch: use uscan version 4. + + [ Debian Janitor ] + * Trim trailing whitespace. + * Bump debhelper from old 10 to 12. + * Set debhelper-compat version in Build-Depends. + * Bump debhelper from old 12 to 13. + + [ gregor herrmann ] + * Import upstream version 1.09. + * Add debian/upstream/metadata. + * Drop 01-fix_manpages_section.patch, not needed anymore. + * Update years of upstream and packaging copyright. + * Declare compliance with Debian Policy 4.6.0. + * Annotate test-only build dependencies with . + * Add (empty) debian/tests/pkg-perl/syntax-skip for autopkgtests. + + -- gregor herrmann Sat, 19 Feb 2022 17:34:24 +0100 + libxml-generator-perl (1.04-2) unstable; urgency=medium * Team upload. @@ -224,7 +249,7 @@ * New upstream release * debian/control: upgraded to Debian Policy 3.2.1 - + -- Ardo van Rangelrooij Wed, 27 Dec 2000 15:09:17 +0200 libxml-generator-perl (0.9-1) unstable; urgency=low diff -Nru libxml-generator-perl-1.04/debian/compat libxml-generator-perl-1.09/debian/compat --- libxml-generator-perl-1.04/debian/compat 2018-01-27 12:54:28.000000000 +0000 +++ libxml-generator-perl-1.09/debian/compat 1970-01-01 00:00:00.000000000 +0000 @@ -1 +0,0 @@ -10 diff -Nru libxml-generator-perl-1.04/debian/control libxml-generator-perl-1.09/debian/control --- libxml-generator-perl-1.04/debian/control 2018-01-27 12:54:49.000000000 +0000 +++ libxml-generator-perl-1.09/debian/control 2022-02-19 16:34:24.000000000 +0000 @@ -4,16 +4,16 @@ Angel Abad Section: perl Testsuite: autopkgtest-pkg-perl -Rules-Requires-Root: no Priority: optional -Build-Depends: debhelper (>= 10) -Build-Depends-Indep: libtie-ixhash-perl, - libxml-dom-perl, +Build-Depends: debhelper-compat (= 13) +Build-Depends-Indep: libtie-ixhash-perl , + libxml-dom-perl , perl -Standards-Version: 4.1.3 -Vcs-Browser: https://anonscm.debian.org/cgit/pkg-perl/packages/libxml-generator-perl.git -Vcs-Git: https://anonscm.debian.org/git/pkg-perl/packages/libxml-generator-perl.git +Standards-Version: 4.6.0 +Vcs-Browser: https://salsa.debian.org/perl-team/modules/packages/libxml-generator-perl +Vcs-Git: https://salsa.debian.org/perl-team/modules/packages/libxml-generator-perl.git Homepage: https://metacpan.org/release/XML-Generator +Rules-Requires-Root: no Package: libxml-generator-perl Architecture: all diff -Nru libxml-generator-perl-1.04/debian/copyright libxml-generator-perl-1.09/debian/copyright --- libxml-generator-perl-1.04/debian/copyright 2018-01-27 12:46:18.000000000 +0000 +++ libxml-generator-perl-1.09/debian/copyright 2022-02-19 16:34:24.000000000 +0000 @@ -4,14 +4,14 @@ Source: https://metacpan.org/release/XML-Generator Files: * -Copyright: 1999-2011, Benjamin Holzman +Copyright: 1999-2022, Benjamin Holzman License: Artistic or GPL-1+ Files: debian/* Copyright: 1999-2003, Ardo van Rangelrooij 2004, Jay Bonci 2008, Roberto C. Sanchez - 2008, gregor herrmann + 2008-2022, gregor herrmann 2009, Ryan Niebur 2011, Angel Abad License: Artistic or GPL-1+ diff -Nru libxml-generator-perl-1.04/debian/patches/01-fix_manpages_section.patch libxml-generator-perl-1.09/debian/patches/01-fix_manpages_section.patch --- libxml-generator-perl-1.04/debian/patches/01-fix_manpages_section.patch 2018-01-27 12:46:18.000000000 +0000 +++ libxml-generator-perl-1.09/debian/patches/01-fix_manpages_section.patch 1970-01-01 00:00:00.000000000 +0000 @@ -1,17 +0,0 @@ -Description: added to fix the manpages section from "3" to "3pm" -Forwarded: no -Author: David Paleino -Last-Update: 2011-08-01 - ---- a/Makefile.PL -+++ b/Makefile.PL -@@ -5,7 +5,7 @@ WriteMakefile( - 'NAME' => 'XML::Generator', - 'PM' => { 'Generator.pm' => '$(INST_LIBDIR)/Generator.pm', - 'DOM.pm' => '$(INST_LIBDIR)/Generator/DOM.pm' }, -- 'MAN3PODS' => { 'Generator.pm' => '$(INST_MAN3DIR)/XML::Generator.3', -- 'DOM.pm' => '$(INST_MAN3DIR)/XML::Generator::DOM.3' }, -+ 'MAN3PODS' => { 'Generator.pm' => '$(INST_MAN3DIR)/XML::Generator.3pm', -+ 'DOM.pm' => '$(INST_MAN3DIR)/XML::Generator::DOM.3pm' }, - 'VERSION_FROM' => 'Generator.pm', # finds $VERSION - ); diff -Nru libxml-generator-perl-1.04/debian/patches/series libxml-generator-perl-1.09/debian/patches/series --- libxml-generator-perl-1.04/debian/patches/series 2018-01-27 12:46:18.000000000 +0000 +++ libxml-generator-perl-1.09/debian/patches/series 1970-01-01 00:00:00.000000000 +0000 @@ -1 +0,0 @@ -01-fix_manpages_section.patch diff -Nru libxml-generator-perl-1.04/debian/tests/pkg-perl/syntax-skip libxml-generator-perl-1.09/debian/tests/pkg-perl/syntax-skip --- libxml-generator-perl-1.04/debian/tests/pkg-perl/syntax-skip 1970-01-01 00:00:00.000000000 +0000 +++ libxml-generator-perl-1.09/debian/tests/pkg-perl/syntax-skip 2022-02-19 16:34:24.000000000 +0000 @@ -0,0 +1 @@ +# Empty file to check everything despite Suggests diff -Nru libxml-generator-perl-1.04/debian/upstream/metadata libxml-generator-perl-1.09/debian/upstream/metadata --- libxml-generator-perl-1.04/debian/upstream/metadata 1970-01-01 00:00:00.000000000 +0000 +++ libxml-generator-perl-1.09/debian/upstream/metadata 2022-02-19 16:34:24.000000000 +0000 @@ -0,0 +1,6 @@ +--- +Archive: CPAN +Bug-Database: https://github.com/perl-net-saml2/perl-XML-Generator/issues +Bug-Submit: https://github.com/perl-net-saml2/perl-XML-Generator/issues/new +Repository: https://github.com/perl-net-saml2/perl-XML-Generator.git +Repository-Browse: https://github.com/perl-net-saml2/perl-XML-Generator diff -Nru libxml-generator-perl-1.04/debian/watch libxml-generator-perl-1.09/debian/watch --- libxml-generator-perl-1.04/debian/watch 2018-01-27 12:46:18.000000000 +0000 +++ libxml-generator-perl-1.09/debian/watch 2022-02-19 16:34:24.000000000 +0000 @@ -1,2 +1,2 @@ -version=3 -https://metacpan.org/release/XML-Generator .*/XML-Generator-v?(\d[\d.]+)\.(?:tar(?:\.gz|\.bz2)?|tgz|zip) +version=4 +https://metacpan.org/release/XML-Generator .*/XML-Generator-v?@ANY_VERSION@@ARCHIVE_EXT@$ diff -Nru libxml-generator-perl-1.04/dist.ini libxml-generator-perl-1.09/dist.ini --- libxml-generator-perl-1.04/dist.ini 1970-01-01 00:00:00.000000000 +0000 +++ libxml-generator-perl-1.09/dist.ini 2022-02-19 03:06:28.000000000 +0000 @@ -0,0 +1,99 @@ +name = XML-Generator +author = Benjamin Holzman +license = Perl_5 +copyright_holder = Benjamin Holzman +copyright_year = 1998 - 2022 + +[Meta::Maintainers] +maintainer = Timothy Legge + +[@Filter] +-bundle = @Basic +-remove = Readme +-remove = GatherDir + +[Prereqs / RuntimeRequires] +perl = 5.008 + +[Prereqs / RuntimeRecommends] +XML::DOM = 1.46 + +[Prereqs / RuntimeSuggests] +Tie::IxHash = 0 + +[Prereqs / TestRequires] +Test = 0 + +[Prereqs / TestRecommends] +XML::DOM = 1.46 + +[MetaProvides::Package] +[MetaJSON] +[Pod2Readme] +[CPANFile] +[ManifestSkip] +[NextRelease] +format = %v -- %{EEE MMM dd HH:mm:ss VVV yyyy}d +filename = Changes + +[PodSyntaxTests] +[Test::PodSpelling] +stopword = Bron +stopword = CDATA +stopword = DTD +stopword = Gondwana +stopword = RDF +stopword = STACKABLE +stopword = Wiger +stopword = allowedXMLTags +stopword = apos +stopword = atributes +stopword = declartion +stopword = desireable +stopword = doctype +stopword = dtd +stopword = eg +stopword = filterInvalidChars +stopword = qualifiedAttributes +stopword = xml +stopword = xmlcdata +stopword = xmlcmnt +stopword = xmldecl +stopword = xmldtd +stopword = xmlns +stopword = xmlpi + +[CopyFilesFromBuild::Filtered] +copy = cpanfile +copy = Makefile.PL +copy = README + +[CopyFilesFromRelease] +copy = cpanfile, Makefile.PL, README + +[Repository] +git_remote = origin + +[Git::NextVersion] +first_version = 1.07 ; this is the default +version_by_branch = 0 ; this is the default +version_regexp = ^(1.\d+)$ ; this is the default +[WriteVersion] +[Git::GatherDir] +exclude_filename = cpanfile +exclude_filename = Makefile.PL +exclude_filename = MANIFEST +exclude_filename = README + +;[Git::Tag] +;tag_format = %V ; this is the default +;tag_message = %V ; this is the default + +[@Git] +changelog = Changes ; this is the default +tag_format = %V ; Don't proceed tags with "v" +tag_message = %V ; this is the default +push_to = origin ; see Git::Push + +[Signature] +[SignReleaseNotes] diff -Nru libxml-generator-perl-1.04/DOM.pm libxml-generator-perl-1.09/DOM.pm --- libxml-generator-perl-1.04/DOM.pm 2004-03-23 15:39:37.000000000 +0000 +++ libxml-generator-perl-1.09/DOM.pm 1970-01-01 00:00:00.000000000 +0000 @@ -1,254 +0,0 @@ -package XML::Generator::DOM; - -=head1 NAME - -XML::Generator::DOM - XML::Generator subclass for producing DOM trees instead of strings. - -=head1 SYNOPSIS - - use XML::Generator::DOM; - - my $dg = XML::Generator::DOM->new(); - my $doc = $dg->xml($dg->xmlcmnt("Test document."), - $dg->foo({'baz' => 'bam'}, 42)); - print $doc->toString; - -yields: - - - - 42 - -=head1 DESCRIPTION - -XML::Generator::DOM subclasses XML::Generator in order to produce DOM -trees instead of strings (see L and L). This -module is still experimental and its semantics might change. - -Essentially, tag methods return XML::DOM::DocumentFragment objects, -constructed either from a DOM document passed into the constructor or -a default document that XML::Generator::DOM will automatically construct. - -Calling the xml() method will return this automatically constructed -document and cause a fresh one to be constructed for future tag method -calls. If you passed in your own document, you may not call the xml() -method. - -Below, we just note the remaining differences in semantics between -XML::Generator methods and XML::Generator::DOM methods. - -=cut - -use strict; -use Carp; -use XML::Generator (); -use base 'XML::Generator'; -use XML::DOM; - -use vars qw( $AUTOLOAD $VERSION ); - -$VERSION = '0.2'; - -=head1 CONSTRUCTOR - -These configuration options are accepted but have no effect on the -semantics of the returned object: escape, pretty, conformance and -empty. - -=head1 TAG METHODS - -Subsequently, tag method semantics are somewhat different for -this module compared to XML::Generator. The primary difference is -that tag method return XML::DOM::DocumentFragment objects. Namespace -and attribute processing remains the same, but remaining arguments to -tag methods must either be text or other XML::DOM::DocumentFragment -objects. No escape processing, syntax checking, or output control is -done; this is all left up to XML::DOM. - -=cut - -sub new { - my $class = shift; - - my $dom; - for (my $i = 0; $i < $#_; $i+=2) { - if ($_[$i] eq 'dom_document') { - $dom = $_[$i+1]; - unless (UNIVERSAL::isa($dom, 'XML::DOM::Document')) { - croak "argument to 'dom' option not an XML::DOM::Document object"; - } - splice @_, $i, 2; - last; - } - } - - if (ref $class) { - $AUTOLOAD = 'new'; - return $class->AUTOLOAD(@_); - } - - my $this = $class->SUPER::new(@_); - - $this->{'dom'} = $dom || XML::Generator::DOM::util::new_dom_root(); - return $this; -} - -=head1 SPECIAL TAGS - -All special tags are available by default with XML::Generator::DOM; you don't -need to use 'conformance' => 'strict'. - -=head2 xmlpi(@args) - -Arguments will simply be concatenated and passed as the data to -the XML::DOM::ProcessingInstruction object that is returned. - -=cut - -sub xmlpi { - my $this = shift; - my $root = $this->{dom}; - my $tgt = shift; - return $root->createProcessingInstruction($tgt, join '', @_); -} - -=head2 xmlcmnt - -Escaping of '--' is done by XML::DOM::Comment, which replaces both -hyphens with '-'. An XML::DOM::Comment object is returned. - -=cut - -sub xmlcmnt { - my $this = shift; - my $root = $this->{dom}; - my $xml = join '', @_; - return $root->createComment($xml); -} - -my $config = 'XML::Generator::util::config'; - -=head2 xmldecl - -Returns an XML::DOM::XMLDecl object. Respects 'version', 'encoding' -and 'dtd' settings in the object. - -=cut - -sub xmldecl { - my $this = shift; - my $root = $this->{dom}; - - my $version = $this->$config('version') || '1.0'; - my $encoding = $this->$config('encoding') || undef; - - my $standalone = $this->xmldtd($this->$config('dtd')) - ? "no" : "yes"; - - return $root->createXMLDecl($version, $encoding, $standalone) -} - -=head2 xmldecl - -Returns an XML::DOM::DocumentType object. - -=cut - -sub xmldtd { - my($this, $dtd) = @_; - my $root = $this->{dom}; - $dtd ||= $this->$config('dtd'); - return unless $dtd && ref($dtd) eq "ARRAY"; - - return $root->createDocumentType(@{ $dtd }); -} - -=head2 xmlcdata - -Returns an XML::DOM::CDATASection object. - -=cut - -sub xmlcdata { - my $this = shift; - my $data = join '', @_; - my $root = $this->{dom}; - return $root->createCDATASection($data); -} - -=head2 xml - -As described above, xml() can only be used when dom_document was not -set in the object. The automatically created document will have its XML -Declaration set and the arguments to xml() will be appended to it. Then -a new DOM document is automatically generated and the old one is -returned. This is the only way to get a DOM document from this module. - -=cut - -sub xml { - my $this = shift; - my $root = $this->{dom}; - - if ($root != $XML::Generator::DOM::util::root) { - croak "xml() method not allowed when dom_document option specified"; - } - - $this->{dom} = XML::Generator::DOM::util::new_dom_root(); - - $root->setXMLDecl($this->xmldecl()); - - $root->appendChild($_) for @_; - return $root; -} - -sub AUTOLOAD { - my $this = shift; - - (my $tag = $AUTOLOAD) =~ s/.*:://;; - - my $root = $this->{'dom'}; - - my($namespace, $attr, @args) = $this->XML::Generator::util::parse_args(@_); - - $namespace = $namespace->[1] ? $namespace->[1] . ':' : ''; - - my $xml = $root->createDocumentFragment(); - - my $node = $xml->appendChild($root->createElement("$namespace$tag")); - - if ($attr) { - while (my($k, $v) = each %$attr) { - unless ($k =~ /^[^:]+:/) { - $k = "$namespace$k"; - } - $node->setAttribute($k, $v); - } - } - - for (@args) { - if (UNIVERSAL::isa($_, 'XML::DOM::Node')) { - $node->appendChild($_); - } else { - $node->appendChild($root->createTextNode($_)); - } - } - - return $xml; -} - -package XML::Generator::DOM::util; - -use XML::DOM; -use vars qw($root $parser); - -$parser = XML::DOM::Parser->new; - -sub new_dom_root { - $root = $parser->parse('<_/>'); - $root->removeChild($root->getFirstChild); - - return $root; -} - -1; diff -Nru libxml-generator-perl-1.04/Generator.pm libxml-generator-perl-1.09/Generator.pm --- libxml-generator-perl-1.04/Generator.pm 2011-07-15 12:45:30.000000000 +0000 +++ libxml-generator-perl-1.09/Generator.pm 1970-01-01 00:00:00.000000000 +0000 @@ -1,1570 +0,0 @@ -package XML::Generator; - -use strict; -use Carp; -use vars qw/$VERSION $AUTOLOAD/; - -$VERSION = '1.04'; - -=head1 NAME - -XML::Generator - Perl extension for generating XML - -=head1 SYNOPSIS - - use XML::Generator ':pretty'; - - print foo(bar({ baz => 3 }, bam()), - bar([ 'qux' => 'http://qux.com/' ], - "Hey there, world")); - - # OR - - require XML::Generator; - - my $X = XML::Generator->new(':pretty'); - - print $X->foo($X->bar({ baz => 3 }, $X->bam()), - $X->bar([ 'qux' => 'http://qux.com/' ], - "Hey there, world")); - -Either of the above yield: - - - - - - Hey there, world - - -=head1 DESCRIPTION - -In general, once you have an XML::Generator object, you then simply call -methods on that object named for each XML tag you wish to generate. - -XML::Generator can also arrange for undefined subroutines in the caller's -package to generate the corresponding XML, by exporting an C -subroutine to your package. Just supply an ':import' argument to -your C call. If you already have an C -defined then XML::Generator can be configured to cooperate with it. -See L<"STACKABLE AUTOLOADs">. - -Say you want to generate this XML: - - - Bob - 34 - Accountant - - -Here's a snippet of code that does the job, complete with pretty printing: - - use XML::Generator; - my $gen = XML::Generator->new(':pretty'); - print $gen->person( - $gen->name("Bob"), - $gen->age(34), - $gen->job("Accountant") - ); - -The only problem with this is if you want to use a tag name that -Perl's lexer won't understand as a method name, such as "shoe-size". -Fortunately, since you can store the name of a method in a variable, -there's a simple work-around: - - my $shoe_size = "shoe-size"; - $xml = $gen->$shoe_size("12 1/2"); - -Which correctly generates: - - 12 1/2 - -You can use a hash ref as the first parameter if the tag should include -atributes. Normally this means that the order of the attributes will be -unpredictable, but if you have the L module, you can use it -to get the order you want, like this: - - use Tie::IxHash; - tie my %attr, 'Tie::IxHash'; - - %attr = (name => 'Bob', - age => 34, - job => 'Accountant', - 'shoe-size' => '12 1/2'); - - print $gen->person(\%attr); - -This produces - - - -An array ref can also be supplied as the first argument to indicate -a namespace for the element and the attributes. - -If there is one element in the array, it is considered the URI of -the default namespace, and the tag will have an xmlns="URI" attribute -added automatically. If there are two elements, the first should be -the tag prefix to use for the namespace and the second element should -be the URI. In this case, the prefix will be used for the tag and an -xmlns:PREFIX attribute will be automatically added. Prior to version -0.99, this prefix was also automatically added to each attribute name. -Now, the default behavior is to leave the attributes alone (although you -may always explicitly add a prefix to an attribute name). If the prior -behavior is desired, use the constructor option C. - -If you specify more than two elements, then each pair should correspond -to a tag prefix and the corresponding URL. An xmlns:PREFIX attribute -will be added for each pair, and the prefix from the first such pair -will be used as the tag's namespace. If you wish to specify a default -namespace, use '#default' for the prefix. If the default namespace is -first, then the tag will use the default namespace itself. - -If you want to specify a namespace as well as attributes, you can make -the second argument a hash ref. If you do it the other way around, -the array ref will simply get stringified and included as part of the -content of the tag. - -Here's an example to show how the attribute and namespace parameters work: - - $xml = $gen->account( - $gen->open(['transaction'], 2000), - $gen->deposit(['transaction'], { date => '1999.04.03'}, 1500) - ); - -This generates: - - - 2000 - 1500 - - -Because default namespaces inherit, XML::Generator takes care to output -the xmlns="URI" attribute as few times as strictly necessary. For example, - - $xml = $gen->account( - $gen->open(['transaction'], 2000), - $gen->deposit(['transaction'], { date => '1999.04.03'}, - $gen->amount(['transaction'], 1500) - ) - ); - -This generates: - - - 2000 - - 1500 - - - -Notice how C was left out of the C<> tag. - -Here is an example that uses the two-argument form of the namespace: - - $xml = $gen->widget(['wru' => 'http://www.widgets-r-us.com/xml/'], - {'id' => 123}, $gen->contents()); - - - - - -Here is an example that uses multiple namespaces. It generates the -first example from the RDF primer (L). - - my $contactNS = [contact => "http://www.w3.org/2000/10/swap/pim/contact#"]; - $xml = $gen->xml( - $gen->RDF([ rdf => "http://www.w3.org/1999/02/22-rdf-syntax-ns#", - @$contactNS ], - $gen->Person($contactNS, { 'rdf:about' => "http://www.w3.org/People/EM/contact#me" }, - $gen->fullName($contactNS, 'Eric Miller'), - $gen->mailbox($contactNS, {'rdf:resource' => "mailto:em@w3.org"}), - $gen->personalTitle($contactNS, 'Dr.')))); - - - - - Eric Miller - - Dr. - - - -=head1 CONSTRUCTOR - -XML::Generator-Enew(':option', ...); - -XML::Generator-Enew(option => 'value', ...); - -(Both styles may be combined) - -The following options are available: - -=head2 :std, :standard - -Equivalent to - - escape => 'always', - conformance => 'strict', - -=head2 :strict - -Equivalent to - - conformance => 'strict', - -=head2 :pretty[=N] - -Equivalent to - - escape => 'always', - conformance => 'strict', - pretty => N # N defaults to 2 - -=head2 namespace - -This value of this option must be an array reference containing one or -two values. If the array contains one value, it should be a URI and will -be the value of an 'xmlns' attribute in the top-level tag. If there are -two or more elements, the first of each pair should be the namespace -tag prefix and the second the URI of the namespace. This will enable -behavior similar to the namespace behavior in previous versions; the tag -prefix will be applied to each tag. In addition, an xmlns:NAME="URI" -attribute will be added to the top-level tag. Prior to version 0.99, -the tag prefix was also automatically added to each attribute name, -unless overridden with an explicit prefix. Now, the attribute names are -left alone, but if the prior behavior is desired, use the constructor -option C. - -The value of this option is used as the global default namespace. -For example, - - my $html = XML::Generator->new( - pretty => 2, - namespace => [HTML => "http://www.w3.org/TR/REC-html40"]); - print $html->html( - $html->body( - $html->font({ face => 'Arial' }, - "Hello, there"))); - -would yield - - - - Hello, there - - - -Here is the same example except without all the prefixes: - - my $html = XML::Generator->new( - pretty => 2, - namespace => ["http://www.w3.org/TR/REC-html40"]); - print $html->html( - $html->body( - $html->font({ 'face' => 'Arial' }, - "Hello, there"))); - -would yield - - - - Hello, there - - - -=head2 qualifiedAttributes, qualified_attributes - -Set this to a true value to emulate the attribute prefixing behavior of -XML::Generator prior to version 0.99. Here is an example: - - my $foo = XML::Generator->new( - namespace => [foo => "http://foo.com/"], - qualifiedAttributes => 1); - print $foo->bar({baz => 3}); - -yields - - - -=head2 escape - -The contents and the values of each attribute have any illegal XML -characters escaped if this option is supplied. If the value is 'always', -then &, < and > (and " within attribute values) will be converted into -the corresponding XML entity, although & will not be converted if it looks -like it could be part of a valid entity (but see below). If the value is -'unescaped', then the escaping will be turned off character-by- character -if the character in question is preceded by a backslash, or for the -entire string if it is supplied as a scalar reference. So, for example, - - use XML::Generator escape => 'always'; - - one('<'); # < - two('\&'); # \& - three(\'>'); # > (scalar refs always allowed) - four('<'); # < (looks like an entity) - five('"'); # " (looks like an entity) - -but - - use XML::Generator escape => 'unescaped'; - - one('<'); # < - two('\&'); # & - three(\'>'); # > (aiee!) - four('<'); # &lt; (no special case for entities) - -By default, high-bit data will be passed through unmodified, so that -UTF-8 data can be generated with pre-Unicode perls. If you know that -your data is ASCII, use the value 'high-bit' for the escape option -and bytes with the high bit set will be turned into numeric entities. -You can combine this functionality with the other escape options by -comma-separating the values: - - my $a = XML::Generator->new(escape => 'always,high-bit'); - print $a->foo("<\242>"); - -yields - - <¢> - -Because XML::Generator always uses double quotes ("") around attribute -values, it does not escape single quotes. If you want single quotes -inside attribute values to be escaped, use the value 'apos' along with -'always' or 'unescaped' for the escape option. For example: - - my $gen = XML::Generator->new(escape => 'always,apos'); - print $gen->foo({'bar' => "It's all good"}); - - - -If you actually want & to be converted to & even if it looks like it -could be part of a valid entity, use the value 'even-entities' along with -'always'. Supplying 'even-entities' to the 'unescaped' option is meaningless -as entities are already escaped with that option. - -=head2 pretty - -To have nice pretty printing of the output XML (great for config files -that you might also want to edit by hand), supply an integer for the -number of spaces per level of indenting, eg. - - my $gen = XML::Generator->new(pretty => 2); - print $gen->foo($gen->bar('baz'), - $gen->qux({ tricky => 'no'}, 'quux')); - -would yield - - - baz - quux - - -You may also supply a non-numeric string as the argument to 'pretty', in -which case the indents will consist of repetitions of that string. So if -you want tabbed indents, you would use: - - my $gen = XML::Generator->new(pretty => "\t"); - -Pretty printing does not apply to CDATA sections or Processing Instructions. - -=head2 conformance - -If the value of this option is 'strict', a number of syntactic -checks are performed to ensure that generated XML conforms to the -formal XML specification. In addition, since entity names beginning -with 'xml' are reserved by the W3C, inclusion of this option enables -several special tag names: xmlpi, xmlcmnt, xmldecl, xmldtd, xmlcdata, -and xml to allow generation of processing instructions, comments, XML -declarations, DTD's, character data sections and "final" XML documents, -respectively. - -Invalid characters (http://www.w3.org/TR/xml11/#charsets) will be filtered -out. To disable this behavior, supply the 'filter_invalid_chars' option with -the value 0. - -See L<"XML CONFORMANCE"> and L<"SPECIAL TAGS"> for more information. - -=head2 filterInvalidChars, filter_invalid_chars - -Set this to a 1 to enable filtering of invalid characters, or to 0 to disable -the filtering. See http://www.w3.org/TR/xml11/#charsets for the set of valid -characters. - -=head2 allowedXMLTags, allowed_xml_tags - -If you have specified 'conformance' => 'strict' but need to use tags -that start with 'xml', you can supply a reference to an array containing -those tags and they will be accepted without error. It is not an error -to supply this option if 'conformance' => 'strict' is not supplied, -but it will have no effect. - -=head2 empty - -There are 5 possible values for this option: - - self - create empty tags as (default) - compact - create empty tags as - close - close empty tags as - ignore - don't do anything (non-compliant!) - args - use count of arguments to decide between and - -Many web browsers like the 'self' form, but any one of the forms besides -'ignore' is acceptable under the XML standard. - -'ignore' is intended for subclasses that deal with HTML and other -SGML subsets which allow atomic tags. It is an error to specify both -'conformance' => 'strict' and 'empty' => 'ignore'. - -'args' will produce if there are no arguments at all, or if there -is just a single undef argument, and otherwise. - -=head2 version - -Sets the default XML version for use in XML declarations. -See L<"xmldecl"> below. - -=head2 encoding - -Sets the default encoding for use in XML declarations. - -=head2 dtd - -Specify the dtd. The value should be an array reference with three -values; the type, the name and the uri. - -=head1 IMPORT ARGUMENTS - -use XML::Generator ':option'; - -use XML::Generator option => 'value'; - -(Both styles may be combined) - -=head2 :import - -Cause C to export an C to your package that -makes undefined subroutines generate XML tags corresponding to their name. -Note that if you already have an C defined, it will be overwritten. - -=head2 :stacked - -Implies :import, but if there is already an C defined, the -overriding C will still give it a chance to run. See L<"STACKED -AUTOLOADs">. - -=head2 ANYTHING ELSE - -If you supply any other options, :import is implied and the XML::Generator -object that is created to generate tags will be constructed with those options. - -=cut - -package XML::Generator; - -use strict; -require Carp; - -# If no value is provided for these options, they will be set to '' - -my @optionsToInit = qw( - allowed_xml_tags - conformance - dtd - escape - namespace - pretty - version - empty - qualified_attributes - filter_invalid_chars -); - -my %tag_factory; - -sub import { - my $type = shift; - - # check for attempt to use tag 'import' - if (ref $type && defined $tag_factory{$type}) { - unshift @_, $type, 'import'; - goto &{ $tag_factory{$type} }; - } - - my $pkg = caller; - - no strict 'refs'; # Let's get serious - - # should we import an AUTOLOAD? - no warnings 'once'; - - if (@_) { - my $STACKED; - - # are we supposed to call their AUTOLOAD first? - if (grep /^:stacked$/, @_) { - $STACKED = \&{"${pkg}::AUTOLOAD"}; - } - - my $this = $type->new(@_); - - no warnings 'redefine'; # No, I mean SERIOUS - - *{"${pkg}::AUTOLOAD"} = - sub { - if ($STACKED) { - ${"${pkg}::AUTOLOAD"} = our $AUTOLOAD; - my @ret = $STACKED->(@_); - return wantarray ? @ret : $ret[0] if @ret; - } - - # The tag is whatever our sub name is. - my($tag) = our $AUTOLOAD =~ /.*::(.*)/; - - # Special-case for xml... tags - if ($tag =~ /^xml/ && $this->{'conformance'} eq 'strict') { - if (my $func = $this->can($tag)) { - unshift @_, $this; - goto &$func; - } - } - - unshift @_, $this, $tag; - - goto &{ $tag_factory{$this} }; - }; - - # convenience feature for stacked autoloads; give them - # an import() that aliases AUTOLOAD. - if ($STACKED && ! defined *{"${pkg}::import"}{CODE}) { - *{"${pkg}::import"} = - sub { - my $p = caller; - *{"${p}::AUTOLOAD"} = \&{"${pkg}::AUTOLOAD"}; - }; - } - } - - return; -} - -# The constructor method - -sub new { - my $class = shift; - - # If we already have a ref in $class, this means that the - # person wants to generate a tag! - return $class->XML::Generator::util::tag('new', @_) if ref $class; - - my %options = - map { - /^:(std|standard) $/x ? ( escape => 'always', - conformance => 'strict' ) - : /^:strict $/x ? ( conformance => 'strict' ) - : /^:pretty(?:=(.+))?$/x ? ( escape => 'always', - conformance => 'strict', - pretty => ( defined $1 ? $1 : 2 ) ) - : /^:(import | - stacked )$/x ? ( do { Carp::carp("Useless use of $_") - unless (caller(1))[3] =~ /::import/; - () } ) - : /^allowedXMLTags$/ ? 'allowed_xml_tags' - : /^qualifiedAttributes$/ ? 'qualified_attributes' - : /^filterInvalidChars$/ ? 'filter_invalid_chars' - : $_ - } @_; - - # We used to only accept certain options, but unfortunately this - # means that subclasses can't extend the list. As such, we now - # just make sure our default options are defined. - for (@optionsToInit) { - if (not defined $options{$_}) { - $options{$_} = ''; - } - } - - if ($options{'dtd'}) { - $options{'dtdtree'} = $class->XML::Generator::util::parse_dtd($options{'dtd'}); - } - - if ($options{'conformance'} eq 'strict' && - $options{'empty'} eq 'ignore') { - Carp::croak "option 'empty' => 'ignore' not allowed while 'conformance' => 'strict'"; - } - - if ($options{'escape'}) { - my $e = $options{'escape'}; - $options{'escape'} = 0; - while ($e =~ /([-\w]+),?/g) { - if ($1 eq 'always') { - $options{'escape'} |= XML::Generator::util::ESCAPE_ALWAYS() - | XML::Generator::util::ESCAPE_GT(); - } elsif ($1 eq 'high-bit') { - $options{'escape'} |= XML::Generator::util::ESCAPE_HIGH_BIT(); - } elsif ($1 eq 'apos') { - $options{'escape'} |= XML::Generator::util::ESCAPE_APOS(); - } elsif ($1 eq 'even-entities') { - $options{'escape'} |= XML::Generator::util::ESCAPE_EVEN_ENTITIES(); - } elsif ($1) { - if ($1 ne 'unescaped') { - Carp::carp "option 'escape' => '$1' deprecated; use 'escape' => 'unescaped'"; - } - $options{'escape'} |= XML::Generator::util::ESCAPE_TRUE() - | XML::Generator::util::ESCAPE_GT(); - } - } - } else { - $options{'escape'} = 0; - } - - if (ref $options{'namespace'} eq 'ARRAY') { - if (@{ $options{'namespace'} } > 2 && (@{ $options{'namespace'} } % 2) != 0) { - Carp::croak "odd number of arguments for namespace"; - } - } elsif ($options{'namespace'}) { - Carp::croak "namespace must be an array reference"; - } - - if ($options{'conformance'} eq 'strict' && - $options{'filter_invalid_chars'} eq '') { - $options{'filter_invalid_chars'} = 1; - } - - my $this = bless \%options, $class; - $tag_factory{$this} = XML::Generator::util::c_tag($this); - return $this; -} - -# We use AUTOLOAD as a front-end to TAG so that we can -# create tags by name at will. - -sub AUTOLOAD { - my $this = shift; - - # The tag is whatever our sub name is, or 'AUTOLOAD' - my ($tag) = defined our $AUTOLOAD ? $AUTOLOAD =~ /.*::(.*)/ : 'AUTOLOAD'; - - undef $AUTOLOAD; # this ensures that future attempts to use tag 'AUTOLOAD' work. - - unshift @_, $this, $tag; - - goto &{ $tag_factory{$this} }; -} - -# I wish there were a way to allow people to use tag 'DESTROY!' -# hmm, maybe xmlDESTROY? -sub DESTROY { delete $tag_factory{$_[0]} } - -=head1 XML CONFORMANCE - -When the 'conformance' => 'strict' option is supplied, a number of -syntactic checks are enabled. All entity and attribute names are -checked to conform to the XML specification, which states that they must -begin with either an alphabetic character or an underscore and may then -consist of any number of alphanumerics, underscores, periods or hyphens. -Alphabetic and alphanumeric are interpreted according to the current -locale if 'use locale' is in effect and according to the Unicode standard -for Perl versions >= 5.6. Furthermore, entity or attribute names are not -allowed to begin with 'xml' (in any case), although a number of special -tags beginning with 'xml' are allowed (see L<"SPECIAL TAGS">). Note -that you can also supply an explicit list of allowed tags with the -'allowed_xml_tags' option. - -Also, the filter_invalid_chars option is automatically set to 1 unless it -is explicitly set to 0. - -=head1 SPECIAL TAGS - -The following special tags are available when running under strict -conformance (otherwise they don't act special): - -=head2 xmlpi - -Processing instruction; first argument is target, remaining arguments -are attribute, value pairs. Attribute names are syntax checked, values -are escaped. - -=cut - -# We handle a few special tags, but only if the conformance -# is 'strict'. If not, we just fall back to XML::Generator::util::tag. - -sub xmlpi { - my $this = shift; - - return $this->XML::Generator::util::tag('xmlpi', @_) - unless $this->{conformance} eq 'strict'; - - my $xml; - my $tgt = shift; - - $this->XML::Generator::util::ck_syntax($tgt); - - $xml = "XML::Generator::util::ck_syntax($k); - XML::Generator::util::escape($v, - XML::Generator::util::ESCAPE_FILTER_INVALID_CHARS() | - XML::Generator::util::ESCAPE_ATTR() | - $this->{'escape'}); - $xml .= qq{ $k="$v"}; - } - } - $xml .= "?>"; - - return XML::Generator::pi->new([$xml]); -} - -=head2 xmlcmnt - -Comment. Arguments are concatenated and placed inside -comment delimiters. Any occurences of '--' in the concatenated arguments -are converted to '--' - -=cut - -sub xmlcmnt { - my $this = shift; - - return $this->XML::Generator::util::tag('xmlcmnt', @_) - unless $this->{conformance} eq 'strict'; - - my $xml = join '', @_; - - # double dashes are illegal; change them to '--' - $xml =~ s/--/--/g; - XML::Generator::util::filter($xml); - $xml = ""; - - return XML::Generator::comment->new([$xml]); -} - -=head2 xmldecl(@args) - -Declaration. This can be used to specify the version, encoding, and -other XML-related declarations (i.e., anything inside the tag). -@args can be used to control what is output, as keyword-value pairs. - -By default, the version is set to the value specified in the constructor, -or to 1.0 if it was not specified. This can be overridden by providing a -'version' key in @args. If you do not want the version at all, explicitly -provide undef as the value in @args. - -By default, the encoding is set to the value specified in the constructor; -if no value was specified, the encoding will be left out altogether. -Provide an 'encoding' key in @args to override this. - -If a dtd was set in the constructor, the standalone attribute of the -declaration will be set to 'no' and the doctype declaration will be -appended to the XML declartion, otherwise the standalone attribute will -be set to 'yes'. This can be overridden by providing a 'standalone' -key in @args. If you do not want the standalone attribute to show up, -explicitly provide undef as the value. - -=cut - -sub xmldecl { - my($this, @args) = @_; - - return $this->XML::Generator::util::tag('xmldecl', @_) - unless $this->{conformance} eq 'strict'; - - my $version = $this->{'version'} || '1.0'; - - # there's no explicit support for encodings yet, but at the - # least we can know to put it in the declaration - my $encoding = $this->{'encoding'}; - - # similarly, although we don't do anything with DTDs yet, we - # recognize a 'dtd' => [ ... ] option to the constructor, and - # use it to create a and to indicate that this - # document can't stand alone. - my $doctype = $this->xmldtd($this->{dtd}); - my $standalone = $doctype ? "no" : "yes"; - - for (my $i = 0; $i < $#args; $i += 2) { - if ($args[$i] eq 'version' ) { - $version = $args[$i + 1]; - } elsif ($args[$i] eq 'encoding' ) { - $encoding = $args[$i + 1]; - } elsif ($args[$i] eq 'standalone') { - $standalone = $args[$i + 1]; - } else { - Carp::croak("Unrecognized argument '$args[$i]'"); - } - } - - $version = qq{ version="$version"} if defined $version; - $encoding = qq{ encoding="$encoding"} if defined $encoding; - $standalone = qq{ standalone="$standalone"} if defined $standalone; - - $encoding ||= ''; - $version ||= ''; - $standalone ||= ''; - - my $xml = ""; - $xml .= "\n$doctype" if $doctype; - - $xml = "$xml\n"; - - return $xml; -} - -=head2 xmldtd - -DTD tag creation. The format of this method is different from -others. Since DTD's are global and cannot contain namespace information, -the first argument should be a reference to an array; the elements are -concatenated together to form the DTD: - - print $xml->xmldtd([ 'html', 'PUBLIC', $xhtml_w3c, $xhtml_dtd ]) - -This would produce the following declaration: - - - -Assuming that $xhtml_w3c and $xhtml_dtd had the correct values. - -Note that you can also specify a DTD on creation using the new() method's -dtd option. - -=cut - -sub xmldtd { - my $this = shift; - my $dtd = shift || return undef; - - # return the appropriate thingy - $dtd ? return(qq{}) - : return(''); -} - -=head2 xmlcdata - -Character data section; arguments are concatenated and placed inside - character data section delimiters. Any occurences of -']]>' in the concatenated arguments are converted to ']]>'. - -=cut - -sub xmlcdata { - my $this = shift; - - $this->XML::Generator::util::tag('xmlcdata', @_) - unless $this->{conformance} eq 'strict'; - - my $xml = join '', @_; - - # ]]> is not allowed; change it to ]]> - $xml =~ s/]]>/]]>/g; - XML::Generator::util::filter($xml); - $xml = ""; - - return XML::Generator::cdata->new([$xml]); -} - -=head2 xml - -"Final" XML document. Must be called with one and exactly one -XML::Generator-produced XML document. Any combination of -XML::Generator-produced XML comments or processing instructions may -also be supplied as arguments. Prepends an XML declaration, and -re-blesses the argument into a "final" class that can't be embedded. - -=cut - -sub xml { - my $this = shift; - - return $this->XML::Generator::util::tag('xml', @_) - unless $this->{conformance} eq 'strict'; - - unless (@_) { - Carp::croak "usage: object->xml( (COMMENT | PI)* XML (COMMENT | PI)* )"; - } - - my $got_root = 0; - foreach my $arg (@_) { - next if UNIVERSAL::isa($arg, 'XML::Generator::comment') || - UNIVERSAL::isa($arg, 'XML::Generator::pi'); - if (UNIVERSAL::isa($arg, 'XML::Generator::overload')) { - if ($got_root) { - Carp::croak "arguments to xml() can contain only one XML document"; - } - $got_root = 1; - } else { - Carp::croak "arguments to xml() must be comments, processing instructions or XML documents"; - } - } - - return XML::Generator::final->new([$this->xmldecl(), @_]); -} - -=head1 CREATING A SUBCLASS - -For a simpler way to implement subclass-like behavior, see L<"STACKABLE -AUTOLOADs">. - -At times, you may find it desireable to subclass XML::Generator. For -example, you might want to provide a more application-specific interface -to the XML generation routines provided. Perhaps you have a custom -database application and would really like to say: - - my $dbxml = new XML::Generator::MyDatabaseApp; - print $dbxml->xml($dbxml->custom_tag_handler(@data)); - -Here, custom_tag_handler() may be a method that builds a recursive XML -structure based on the contents of @data. In fact, it may even be named -for a tag you want generated, such as authors(), whose behavior changes -based on the contents (perhaps creating recursive definitions in the -case of multiple elements). - -Creating a subclass of XML::Generator is actually relatively -straightforward, there are just three things you have to remember: - - 1. All of the useful utilities are in XML::Generator::util. - - 2. To construct a tag you simply have to call SUPER::tagname, - where "tagname" is the name of your tag. - - 3. You must fully-qualify the methods in XML::Generator::util. - -So, let's assume that we want to provide a custom HTML table() method: - - package XML::Generator::CustomHTML; - use base 'XML::Generator'; - - sub table { - my $self = shift; - - # parse our args to get namespace and attribute info - my($namespace, $attr, @content) = - $self->XML::Generator::util::parse_args(@_) - - # check for strict conformance - if ( $self->XML::Generator::util::config('conformance') eq 'strict' ) { - # ... special checks ... - } - - # ... special formatting magic happens ... - - # construct our custom tags - return $self->SUPER::table($attr, $self->tr($self->td(@content))); - } - -That's pretty much all there is to it. We have to explicitly call -SUPER::table() since we're inside the class's table() method. The others -can simply be called directly, assuming that we don't have a tr() in the -current package. - -If you want to explicitly create a specific tag by name, or just want a -faster approach than AUTOLOAD provides, you can use the tag() method -directly. So, we could replace that last line above with: - - # construct our custom tags - return $self->XML::Generator::util::tag('table', $attr, ...); - -Here, we must explicitly call tag() with the tag name itself as its first -argument so it knows what to generate. These are the methods that you might -find useful: - -=over 4 - -=item XML::Generator::util::parse_args() - -This parses the argument list and returns the namespace (arrayref), attributes -(hashref), and remaining content (array), in that order. - -=item XML::Generator::util::tag() - -This does the work of generating the appropriate tag. The first argument must -be the name of the tag to generate. - -=item XML::Generator::util::config() - -This retrieves options as set via the new() method. - -=item XML::Generator::util::escape() - -This escapes any illegal XML characters. - -=back - -Remember that all of these methods must be fully-qualified with the -XML::Generator::util package name. This is because AUTOLOAD is used by -the main XML::Generator package to create tags. Simply calling parse_args() -will result in a set of XML tags called . - -Finally, remember that since you are subclassing XML::Generator, you do -not need to provide your own new() method. The one from XML::Generator -is designed to allow you to properly subclass it. - -=head1 STACKABLE AUTOLOADs - -As a simpler alternative to traditional subclassing, the C -that C exports can be configured to work with a -pre-defined C with the ':stacked' option. Simply ensure that -your C is defined before C -executes. The C will get a chance to run first; the subroutine -name will be in your C<$AUTOLOAD> as normal. Return an empty list to let -the default XML::Generator C run or any other value to abort it. -This value will be returned as the result of the original method call. - -If there is no C defined, XML::Generator will create one. -All that this C does is export AUTOLOAD, but that lets your -package be used as if it were a subclass of XML::Generator. - -An example will help: - - package MyGenerator; - - my %entities = ( copy => '©', - nbsp => ' ', ... ); - - sub AUTOLOAD { - my($tag) = our $AUTOLOAD =~ /.*::(.*)/; - - return $entities{$tag} if defined $entities{$tag}; - return; - } - - use XML::Generator qw(:pretty :stacked); - -This lets someone do: - - use MyGenerator; - - print html(head(title("My Title", copy()))); - -Producing: - - - - My Title© - - - -=cut - -package XML::Generator::util; - -# The ::util package space actually has all the utilities -# that do all the work. It must be separate from the -# main XML::Generator package space since named subs will -# interfere with the workings of AUTOLOAD otherwise. - -use strict; -use Carp; - -use constant ESCAPE_TRUE => 1; -use constant ESCAPE_ALWAYS => 1<<1; -use constant ESCAPE_HIGH_BIT => 1<<2; -use constant ESCAPE_APOS => 1<<3; -use constant ESCAPE_ATTR => 1<<4; -use constant ESCAPE_GT => 1<<5; -use constant ESCAPE_EVEN_ENTITIES => 1<<6; -use constant ESCAPE_FILTER_INVALID_CHARS => 1<<7; - -sub parse_args { - # this parses the args and returns a namespace and attr - # if either were specified, with the remainer of the - # arguments (the content of the tag) in @args. call as: - # - # ($namespace, $attr, @args) = parse_args(@args); - - my($this, @args) = @_; - - my($namespace); - my($attr) = (''); - - # check for supplied namespace - if (ref $args[0] eq 'ARRAY') { - $namespace = [ map { defined $_ && $_ eq '#default' ? undef : $_ } @{shift @args} ]; - if (@$namespace > 2 && (@$namespace % 2) != 0) { - croak "odd number of arguments for namespace"; - } - } - - # get globally-set namespace (from new) - unless ($namespace) { - $namespace = [ map { defined $_ && $_ eq '#default' ? undef : $_ } @{ $this->{'namespace'} || [] } ]; - } - - if (@$namespace == 1) { unshift @$namespace, undef } - - # check for supplied attributes - if (ref $args[0] eq 'HASH') { - $attr = shift @args; - if ($this->{conformance} eq 'strict') { - $this->XML::Generator::util::ck_syntax($_) - for map split(/:/), keys %$attr; - } - } - - return ($namespace, $attr, @args); -} - -# This routine is what handles all the automatic tag creation. -# We maintain it as a separate method so that subclasses can -# override individual tags and then call SUPER::tag() to create -# the tag automatically. This is not possible if only AUTOLOAD -# is used, since there is no way to then pass in the name of -# the tag. - -sub tag { - my $sub = XML::Generator::util::c_tag($_[0]); - goto &{ $sub } if $sub; -} - -# Generate a closure that encapsulates all the behavior to generate a tag -sub c_tag { - my $arg = shift; - - my $strict = $arg->{'conformance'} eq 'strict'; - my $escape = $arg->{'escape'}; - my $empty = $arg->{'empty'}; - my $indent = $arg->{'pretty'} =~ /^[^0-9]/ - ? $arg->{'pretty'} - : $arg->{'pretty'} - ? " " x $arg->{'pretty'} - : ""; - if ($arg->{'filter_invalid_chars'}) { - $escape |= ESCAPE_FILTER_INVALID_CHARS; - } - - my $blessClass = $indent ? 'XML::Generator::pretty' : 'XML::Generator::overload'; - - return sub { - my $this = shift; - my $tag = shift || return undef; # catch for bad usage - - # parse our argument list to check for hashref/arrayref properties - my($namespace, $attr, @args) = $this->XML::Generator::util::parse_args(@_); - - $this->XML::Generator::util::ck_syntax($tag) if $strict; - - # check for attempt to embed "final" document - for (@args) { - if (UNIVERSAL::isa($_, 'XML::Generator::final')) { - croak("cannot embed XML document"); - } - } - - # Deal with escaping if required - if ($escape) { - if ($attr) { - foreach my $key (keys %{$attr}) { - next unless defined($attr->{$key}); - XML::Generator::util::escape($attr->{$key}, ESCAPE_ATTR() | $escape); - } - } - for (@args) { - next unless defined($_); - - # perform escaping, except on sub-documents or simple scalar refs - if (ref $_ eq "SCALAR") { - # un-ref it - $_ = $$_; - } elsif (! UNIVERSAL::isa($_, 'XML::Generator::overload') ) { - XML::Generator::util::escape($_, $escape); - } - } - } else { - # un-ref simple scalar refs - for (@args) { - $_ = $$_ if ref $_ eq "SCALAR"; - } - } - - my $prefix = ''; - $prefix = $namespace->[0] . ":" if $namespace && defined $namespace->[0]; - my $xml = "<$prefix$tag"; - - if ($attr) { - while (my($k, $v) = each %$attr) { - next unless defined $k and defined $v; - if ($strict) { - # allow supplied namespace in attribute names - if ($k =~ s/^([^:]+)://) { - $this->XML::Generator::util::ck_syntax($k); - $k = "$1:$k"; - } elsif ($prefix && $this->{'qualified_attributes'}) { - $this->XML::Generator::util::ck_syntax($k); - $k = "$prefix$k"; - } else { - $this->XML::Generator::util::ck_syntax($k); - } - } elsif ($this->{'qualified_attributes'}) { - if ($k !~ /^[^:]+:/) { - $k = "$prefix$k"; - } - } - $xml .= qq{ $k="$v"}; - } - } - - my @xml; - - if (@args || $empty eq 'close') { - if ($empty eq 'args' && @args == 1 && ! defined $args[0]) { - @xml = ($xml .= ' />'); - } else { - $xml .= '>'; - if ($indent) { - my $prettyend = ''; - - foreach my $arg (@args) { - next unless defined $arg; - if ( UNIVERSAL::isa($arg, 'XML::Generator::cdata' ) ) { - my $copy = $xml; - push @xml, $copy, $arg; - $xml = ''; - } else { - if ( UNIVERSAL::isa($arg, 'XML::Generator::overload') && - ! UNIVERSAL::isa($arg, 'XML::Generator::pi') ) { - $xml .= "\n$indent"; - $prettyend = "\n"; - XML::Generator::util::_fixupNS($namespace, $arg) if ref $arg->[0]; - - my @cdata; - for my $i (0..$#$arg) { - if (UNIVERSAL::isa($arg->[$i], 'XML::Generator::cdata')) { - push @cdata, $arg->[$i]; - $arg->[$i] = "\001"; - } - } - - $arg =~ s/\n/\n$indent/gs; - - if (@cdata) { - my @pieces = split "\001", $arg; - - my $copy = $xml; - push @xml, $copy; - $xml = ''; - $arg = ''; - - for my $i (0..$#pieces) { - if (defined $cdata[$i]) { - push @xml, $pieces[$i], $cdata[$i]; - } else { - push @xml, $pieces[$i]; - } - } - } - } - $xml .= "$arg"; - } - } - $xml .= $prettyend; - push @xml, ($xml, ""); - } else { - @xml = $xml; - foreach my $arg (grep defined, @args) { - if ( UNIVERSAL::isa($arg, 'XML::Generator::overload') && - (! ( UNIVERSAL::isa($arg, 'XML::Generator::cdata' ) || - UNIVERSAL::isa($arg, 'XML::Generator::pi' )))) { - XML::Generator::util::_fixupNS($namespace, $arg) if ref $arg->[0]; - } - push @xml, $arg; - } - push @xml, ""; - } - } - } elsif ($empty eq 'ignore') { - @xml = ($xml .= '>'); - } elsif ($empty eq 'compact') { - @xml = ($xml .= '/>'); - } else { - @xml = ($xml .= ' />'); - } - - unshift @xml, $namespace if $namespace; - - return $blessClass->new(\@xml); - }; -} - -sub _fixupNS { - # remove namespaces - # if prefix - # if prefix and uri match one we have, remove them from child - # if prefix does not match one we have, remove it and uri - # from child and add them to us - # no prefix - # if we have an explicit default namespace and the child has the - # same one, remove it from the child - # if we have an explicit default namespace and the child has a - # different one, leave it alone - # if we have an explicit default namespace and the child has none, - # add an empty default namespace to child - my($namespace, $o) = @_; - my @n = @{$o->[0]}; - my $sawDefault = 0; - for (my $i = 0; $i < $#n; $i+=2) { - if (defined $n[$i]) { # namespace w/ prefix - my $flag = 0; - for (my $j = 0; $j < $#$namespace; $j+=2) { - next unless defined $namespace->[$j]; - if ($namespace->[$j] eq $n[$i]) { - $flag = 1; - if ($namespace->[$j+1] ne $n[$i+1]) { - $flag = 2; - } - last; - } - } - if (!$flag) { - push @$namespace, splice @n, $i, 2; - $i-=2; - } elsif ($flag == 1) { - splice @n, $i, 2; - $i-=2; - } - } elsif (defined $n[$i+1]) { # default namespace - $sawDefault = 1; - for (my $j = 0; $j < $#$namespace; $j+=2) { - next if defined $namespace->[$j]; - if ($namespace->[$j+1] eq $n[$i+1]) { - splice @n, $i, 2; - $i-=2; - } - } - } - } - - # check to see if we need to add explicit default namespace of "" to child - if (! @{ $o->[0] } && - ! $sawDefault && - grep { defined $namespace->[$_ * 2 + 1] && - ! defined $namespace->[$_ * 2 ] } 0..($#$namespace/2)) { - push @n, undef, ""; - } - - if (@n) { - $o->[0] = [@n]; - } else { - splice @$o, 0, 1; - } -} - -# Fetch and store config values (those set via new()) -# This is only here for subclasses - -sub config { - my $this = shift; - my $key = shift || return undef; - @_ ? $this->{$key} = $_[0] - : $this->{$key}; -} - -# Collect all escaping into one place -sub escape { - # $_[0] is the argument, $_[1] are the flags - return unless defined $_[0]; - - my $f = $_[1]; - if ($f & ESCAPE_ALWAYS) { - if ($f & ESCAPE_EVEN_ENTITIES) { - $_[0] =~ s/&/&/g; - } else { - $_[0] =~ s/&(?!(?:#[0-9]+|#x[0-9a-fA-F]+|\w+);)/&/g; - } - - $_[0] =~ s//>/g if $f & ESCAPE_GT; - $_[0] =~ s/"/"/g if $f & ESCAPE_ATTR; - $_[0] =~ s/'/'/g if $f & ESCAPE_ATTR && $f & ESCAPE_APOS; - } else { - $_[0] =~ s/([^\\]|^)&/$1&/g; - $_[0] =~ s/\\&/&/g; - $_[0] =~ s/([^\\]|^)/$1>/g; - $_[0] =~ s/\\>/>/g; - } - if ($f & ESCAPE_ATTR) { - $_[0] =~ s/([^\\]|^)"/$1"/g; - $_[0] =~ s/\\"/"/g; - if ($f & ESCAPE_APOS) { - $_[0] =~ s/([^\\]|^)'/$1'/g; - $_[0] =~ s/\\'/'/g; - } - } - } - if ($f & ESCAPE_HIGH_BIT) { - $_[0] =~ s/([\200-\377])/'&#'.ord($1).';'/ge; - } - if ($f & ESCAPE_FILTER_INVALID_CHARS) { - filter($_[0]); - } -} - -sub filter { $_[0] =~ tr/\x00\x01\x02\x03\x04\x05\x06\x07\x08\x0B\x0C\x0E\x0F\x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\x1A\x1B\x1C\x1D\x1E\x1F\x7F\x80\x81\x82\x83\x84\x86\x87\x88\x89\x8A\x8B\x8C\x8D\x8E\x8F\x90\x91\x92\x93\x94\x95\x96\x97\x98\x99\x9A\x9B\x9C\x9D\x9E\x9F//d } - -# verify syntax of supplied name; croak if it's not valid. -# rules: 1. name must begin with a letter or an underscore -# 2. name may contain any number of letters, numbers, hyphens, -# periods or underscores -# 3. name cannot begin with "xml" in any case -sub ck_syntax { - my($this, $name) = @_; - # use \w and \d so that everything works under "use locale" and - # "use utf8" - if ($name =~ /^\w[\w\-\.]*$/) { - if ($name =~ /^\d/) { - croak "name [$name] may not begin with a number"; - } - } else { - croak "name [$name] contains illegal character(s)"; - } - if ($name =~ /^xml/i) { - if (!$this->{'allowed_xml_tags'} || ! grep { $_ eq $name } @{ $this->{'allowed_xml_tags'} }) { - croak "names beginning with 'xml' are reserved by the W3C"; - } - } -} - -my %DTDs; -my $DTD; - -sub parse_dtd { - my $this = shift; - my($dtd) = @_; - - my($root, $type, $name, $uri); - - croak "DTD must be supplied as an array ref" unless (ref $dtd eq 'ARRAY'); - croak "DTD must have at least 3 elements" unless (@{$dtd} >= 3); - - ($root, $type) = @{$dtd}[0,1]; - if ($type eq 'PUBLIC') { - ($name, $uri) = @{$dtd}[2,3]; - } elsif ($type eq 'SYSTEM') { - $uri = $dtd->[2]; - } else { - croak "unknown dtd type [$type]"; - } - return $DTDs{$uri} if $DTDs{$uri}; - - # parse DTD into $DTD (not implemented yet) - my $dtd_text = get_dtd($uri); - - return $DTDs{$uri} = $DTD; -} - -sub get_dtd { - my($uri) = @_; - return; -} - -# This package is needed so that embedded tags are correctly -# interpreted as such and handled properly. Otherwise, you'd -# get "<inner />" - -package XML::Generator::overload; - -use overload '""' => sub { $_[0]->stringify }, - '0+' => sub { $_[0]->stringify }, - 'bool' => sub { $_[0]->stringify }, - 'eq' => sub { (ref $_[0] ? $_[0]->stringify : $_[0]) eq - (ref $_[1] ? $_[1]->stringify : $_[1])}; - -sub new { - my($class, $xml) = @_; - return bless $xml, $class; -} - -sub stringify { - return $_[0] unless UNIVERSAL::isa($_[0], 'XML::Generator::overload'); - if (ref($_[0]->[0])) { # namespace - my $n = shift @{$_[0]}; - for (my $i = ($#$n - 1); $i >= 0; $i-=2) { - my($prefix, $uri) = @$n[$i,$i+1]; - XML::Generator::util::escape($uri, XML::Generator::util::ESCAPE_ATTR | - XML::Generator::util::ESCAPE_ALWAYS| - XML::Generator::util::ESCAPE_GT); - if (defined $prefix) { - $_[0]->[0] =~ s/^([^ \/>]+)/$1 xmlns:$prefix="$uri"/; - } else { - $uri ||= ''; - $_[0]->[0] =~ s/^([^ \/>]+)/$1 xmlns="$uri"/; - } - } - } - - join $, || "", @{$_[0]} -} - -sub DESTROY { } - -package XML::Generator::pretty; - -use base 'XML::Generator::overload'; - -sub stringify { - my $this = shift; - my $string = $this->SUPER::stringify(); - - $string =~ s{^((\s*<(?:\w+:)?\w[-.\w]* )[^ "]+"[^"]+")( .{40,})} - { my($a,$b,$c) = ($1, $2, $3); - $c =~ s{ ((?:\w+:)?\w+="[^\"]+")}{"\n" . (' 'x(length $b)) . $1}ge; - "$a$c" }gem; - - return $string; -} - -package XML::Generator::final; - -use base 'XML::Generator::overload'; - -package XML::Generator::comment; - -use base 'XML::Generator::overload'; - -package XML::Generator::pi; - -use base 'XML::Generator::overload'; - -package XML::Generator::cdata; - -use base 'XML::Generator::overload'; - -1; -__END__ - -=head1 AUTHORS - -=over 4 - -=item Benjamin Holzman - -Original author and maintainer - -=item Bron Gondwana - -First modular version - -=item Nathan Wiger - -Modular rewrite to enable subclassing - -=back - -=head1 SEE ALSO - -=over 4 - -=item The XML::Writer module - -http://search.cpan.org/search?mode=module&query=XML::Writer - -=back - -=cut diff -Nru libxml-generator-perl-1.04/lib/XML/Generator/DOM.pm libxml-generator-perl-1.09/lib/XML/Generator/DOM.pm --- libxml-generator-perl-1.04/lib/XML/Generator/DOM.pm 1970-01-01 00:00:00.000000000 +0000 +++ libxml-generator-perl-1.09/lib/XML/Generator/DOM.pm 2022-02-19 03:06:28.000000000 +0000 @@ -0,0 +1,260 @@ +package XML::Generator::DOM; + +=head1 NAME + +XML::Generator::DOM - XML::Generator subclass for producing DOM trees instead of strings. + +=head1 SYNOPSIS + + use XML::Generator::DOM; + + my $dg = XML::Generator::DOM->new(); + my $doc = $dg->xml($dg->xmlcmnt("Test document."), + $dg->foo({'baz' => 'bam'}, 42)); + print $doc->toString; + +yields: + + + + 42 + +=head1 DESCRIPTION + +XML::Generator::DOM subclasses XML::Generator in order to produce DOM +trees instead of strings (see L and L). This +module is still experimental and its semantics might change. + +Essentially, tag methods return XML::DOM::DocumentFragment objects, +constructed either from a DOM document passed into the constructor or +a default document that XML::Generator::DOM will automatically construct. + +Calling the xml() method will return this automatically constructed +document and cause a fresh one to be constructed for future tag method +calls. If you passed in your own document, you may not call the xml() +method. + +Below, we just note the remaining differences in semantics between +XML::Generator methods and XML::Generator::DOM methods. + +=head1 LICENSE + +This library is free software, you can redistribute it and/or modify +it under the same terms as Perl itself. + +=cut + +use strict; +use warnings; +use Carp; +use XML::Generator (); +use base 'XML::Generator'; +use XML::DOM; + +use vars qw( $AUTOLOAD $VERSION ); + +our $VERSION = '1.09'; + +=head1 CONSTRUCTOR + +These configuration options are accepted but have no effect on the +semantics of the returned object: escape, pretty, conformance and +empty. + +=head1 TAG METHODS + +Subsequently, tag method semantics are somewhat different for +this module compared to XML::Generator. The primary difference is +that tag method return XML::DOM::DocumentFragment objects. Namespace +and attribute processing remains the same, but remaining arguments to +tag methods must either be text or other XML::DOM::DocumentFragment +objects. No escape processing, syntax checking, or output control is +done; this is all left up to XML::DOM. + +=cut + +sub new { + my $class = shift; + + my $dom; + for (my $i = 0; $i < $#_; $i+=2) { + if ($_[$i] eq 'dom_document') { + $dom = $_[$i+1]; + unless (UNIVERSAL::isa($dom, 'XML::DOM::Document')) { + croak "argument to 'dom' option not an XML::DOM::Document object"; + } + splice @_, $i, 2; + last; + } + } + + if (ref $class) { + $AUTOLOAD = 'new'; + return $class->AUTOLOAD(@_); + } + + my $this = $class->SUPER::new(@_); + + $this->{'dom'} = $dom || XML::Generator::DOM::util::new_dom_root(); + return $this; +} + +=head1 SPECIAL TAGS + +All special tags are available by default with XML::Generator::DOM; you don't +need to use 'conformance' => 'strict'. + +=head2 xmlpi(@args) + +Arguments will simply be concatenated and passed as the data to +the XML::DOM::ProcessingInstruction object that is returned. + +=cut + +sub xmlpi { + my $this = shift; + my $root = $this->{dom}; + my $tgt = shift; + return $root->createProcessingInstruction($tgt, join '', @_); +} + +=head2 xmlcmnt + +Escaping of '--' is done by XML::DOM::Comment, which replaces both +hyphens with '-'. An XML::DOM::Comment object is returned. + +=cut + +sub xmlcmnt { + my $this = shift; + my $root = $this->{dom}; + my $xml = join '', @_; + return $root->createComment($xml); +} + +my $config = 'XML::Generator::util::config'; + +=head2 xmldecl + +Returns an XML::DOM::XMLDecl object. Respects 'version', 'encoding' +and 'dtd' settings in the object. + +=cut + +sub xmldecl { + my $this = shift; + my $root = $this->{dom}; + + my $version = $this->$config('version') || '1.0'; + my $encoding = $this->$config('encoding') || undef; + + my $standalone = $this->xmldtd($this->$config('dtd')) + ? "no" : "yes"; + + return $root->createXMLDecl($version, $encoding, $standalone) +} + +=head2 xmldecl + +Returns an XML::DOM::DocumentType object. + +=cut + +sub xmldtd { + my($this, $dtd) = @_; + my $root = $this->{dom}; + $dtd ||= $this->$config('dtd'); + return unless $dtd && ref($dtd) eq "ARRAY"; + + return $root->createDocumentType(@{ $dtd }); +} + +=head2 xmlcdata + +Returns an XML::DOM::CDATASection object. + +=cut + +sub xmlcdata { + my $this = shift; + my $data = join '', @_; + my $root = $this->{dom}; + return $root->createCDATASection($data); +} + +=head2 xml + +As described above, xml() can only be used when dom_document was not +set in the object. The automatically created document will have its XML +Declaration set and the arguments to xml() will be appended to it. Then +a new DOM document is automatically generated and the old one is +returned. This is the only way to get a DOM document from this module. + +=cut + +sub xml { + my $this = shift; + my $root = $this->{dom}; + + if ($root != $XML::Generator::DOM::util::root) { + croak "xml() method not allowed when dom_document option specified"; + } + + $this->{dom} = XML::Generator::DOM::util::new_dom_root(); + + $root->setXMLDecl($this->xmldecl()); + + $root->appendChild($_) for @_; + return $root; +} + +sub AUTOLOAD { + my $this = shift; + + (my $tag = $AUTOLOAD) =~ s/.*:://;; + + my $root = $this->{'dom'}; + + my($namespace, $attr, @args) = $this->XML::Generator::util::parse_args(@_); + + $namespace = $namespace->[1] ? $namespace->[1] . ':' : ''; + + my $xml = $root->createDocumentFragment(); + + my $node = $xml->appendChild($root->createElement("$namespace$tag")); + + if ($attr) { + while (my($k, $v) = each %$attr) { + unless ($k =~ /^[^:]+:/) { + $k = "$namespace$k"; + } + $node->setAttribute($k, $v); + } + } + + for (@args) { + if (UNIVERSAL::isa($_, 'XML::DOM::Node')) { + $node->appendChild($_); + } else { + $node->appendChild($root->createTextNode($_)); + } + } + + return $xml; +} + +package XML::Generator::DOM::util; + +use XML::DOM; +use vars qw($root $parser); + +$parser = XML::DOM::Parser->new; + +sub new_dom_root { + $root = $parser->parse('<_/>'); + $root->removeChild($root->getFirstChild); + + return $root; +} + +1; diff -Nru libxml-generator-perl-1.04/lib/XML/Generator.pm libxml-generator-perl-1.09/lib/XML/Generator.pm --- libxml-generator-perl-1.04/lib/XML/Generator.pm 1970-01-01 00:00:00.000000000 +0000 +++ libxml-generator-perl-1.09/lib/XML/Generator.pm 2022-02-19 03:06:28.000000000 +0000 @@ -0,0 +1,1573 @@ +package XML::Generator; + +use strict; +use warnings; +use Carp; +use vars qw/$VERSION $AUTOLOAD/; + +our $VERSION = '1.09'; + +=head1 NAME + +XML::Generator - Perl extension for generating XML + +=head1 SYNOPSIS + + use XML::Generator ':pretty'; + + print foo(bar({ baz => 3 }, bam()), + bar([ 'qux' => 'http://qux.com/' ], + "Hey there, world")); + + # OR + + require XML::Generator; + + my $X = XML::Generator->new(':pretty'); + + print $X->foo($X->bar({ baz => 3 }, $X->bam()), + $X->bar([ 'qux' => 'http://qux.com/' ], + "Hey there, world")); + +Either of the above yield: + + + + + + Hey there, world + + +=head1 DESCRIPTION + +In general, once you have an XML::Generator object, you then simply call +methods on that object named for each XML tag you wish to generate. + +XML::Generator can also arrange for undefined subroutines in the caller's +package to generate the corresponding XML, by exporting an C +subroutine to your package. Just supply an ':import' argument to +your C call. If you already have an C +defined then XML::Generator can be configured to cooperate with it. +See L<"STACKABLE AUTOLOADs">. + +Say you want to generate this XML: + + + Bob + 34 + Accountant + + +Here's a snippet of code that does the job, complete with pretty printing: + + use XML::Generator; + my $gen = XML::Generator->new(':pretty'); + print $gen->person( + $gen->name("Bob"), + $gen->age(34), + $gen->job("Accountant") + ); + +The only problem with this is if you want to use a tag name that +Perl's lexer won't understand as a method name, such as "shoe-size". +Fortunately, since you can store the name of a method in a variable, +there's a simple work-around: + + my $shoe_size = "shoe-size"; + $xml = $gen->$shoe_size("12 1/2"); + +Which correctly generates: + + 12 1/2 + +You can use a hash ref as the first parameter if the tag should include +atributes. Normally this means that the order of the attributes will be +unpredictable, but if you have the L module, you can use it +to get the order you want, like this: + + use Tie::IxHash; + tie my %attr, 'Tie::IxHash'; + + %attr = (name => 'Bob', + age => 34, + job => 'Accountant', + 'shoe-size' => '12 1/2'); + + print $gen->person(\%attr); + +This produces + + + +An array ref can also be supplied as the first argument to indicate +a namespace for the element and the attributes. + +If there is one element in the array, it is considered the URI of +the default namespace, and the tag will have an xmlns="URI" attribute +added automatically. If there are two elements, the first should be +the tag prefix to use for the namespace and the second element should +be the URI. In this case, the prefix will be used for the tag and an +xmlns:PREFIX attribute will be automatically added. Prior to version +0.99, this prefix was also automatically added to each attribute name. +Now, the default behavior is to leave the attributes alone (although you +may always explicitly add a prefix to an attribute name). If the prior +behavior is desired, use the constructor option C. + +If you specify more than two elements, then each pair should correspond +to a tag prefix and the corresponding URL. An xmlns:PREFIX attribute +will be added for each pair, and the prefix from the first such pair +will be used as the tag's namespace. If you wish to specify a default +namespace, use '#default' for the prefix. If the default namespace is +first, then the tag will use the default namespace itself. + +If you want to specify a namespace as well as attributes, you can make +the second argument a hash ref. If you do it the other way around, +the array ref will simply get stringified and included as part of the +content of the tag. + +Here's an example to show how the attribute and namespace parameters work: + + $xml = $gen->account( + $gen->open(['transaction'], 2000), + $gen->deposit(['transaction'], { date => '1999.04.03'}, 1500) + ); + +This generates: + + + 2000 + 1500 + + +Because default namespaces inherit, XML::Generator takes care to output +the xmlns="URI" attribute as few times as strictly necessary. For example, + + $xml = $gen->account( + $gen->open(['transaction'], 2000), + $gen->deposit(['transaction'], { date => '1999.04.03'}, + $gen->amount(['transaction'], 1500) + ) + ); + +This generates: + + + 2000 + + 1500 + + + +Notice how C was left out of the C<> tag. + +Here is an example that uses the two-argument form of the namespace: + + $xml = $gen->widget(['wru' => 'http://www.widgets-r-us.com/xml/'], + {'id' => 123}, $gen->contents()); + + + + + +Here is an example that uses multiple namespaces. It generates the +first example from the RDF primer (L). + + my $contactNS = [contact => "http://www.w3.org/2000/10/swap/pim/contact#"]; + $xml = $gen->xml( + $gen->RDF([ rdf => "http://www.w3.org/1999/02/22-rdf-syntax-ns#", + @$contactNS ], + $gen->Person($contactNS, { 'rdf:about' => "http://www.w3.org/People/EM/contact#me" }, + $gen->fullName($contactNS, 'Eric Miller'), + $gen->mailbox($contactNS, {'rdf:resource' => "mailto:em@w3.org"}), + $gen->personalTitle($contactNS, 'Dr.')))); + + + + + Eric Miller + + Dr. + + + +=head1 CONSTRUCTOR + +XML::Generator-Enew(':option', ...); + +XML::Generator-Enew(option => 'value', ...); + +(Both styles may be combined) + +The following options are available: + +=head2 :std, :standard + +Equivalent to + + escape => 'always', + conformance => 'strict', + +=head2 :strict + +Equivalent to + + conformance => 'strict', + +=head2 :pretty[=N] + +Equivalent to + + escape => 'always', + conformance => 'strict', + pretty => N # N defaults to 2 + +=head2 namespace + +This value of this option must be an array reference containing one or +two values. If the array contains one value, it should be a URI and will +be the value of an 'xmlns' attribute in the top-level tag. If there are +two or more elements, the first of each pair should be the namespace +tag prefix and the second the URI of the namespace. This will enable +behavior similar to the namespace behavior in previous versions; the tag +prefix will be applied to each tag. In addition, an xmlns:NAME="URI" +attribute will be added to the top-level tag. Prior to version 0.99, +the tag prefix was also automatically added to each attribute name, +unless overridden with an explicit prefix. Now, the attribute names are +left alone, but if the prior behavior is desired, use the constructor +option C. + +The value of this option is used as the global default namespace. +For example, + + my $html = XML::Generator->new( + pretty => 2, + namespace => [HTML => "http://www.w3.org/TR/REC-html40"]); + print $html->html( + $html->body( + $html->font({ face => 'Arial' }, + "Hello, there"))); + +would yield + + + + Hello, there + + + +Here is the same example except without all the prefixes: + + my $html = XML::Generator->new( + pretty => 2, + namespace => ["http://www.w3.org/TR/REC-html40"]); + print $html->html( + $html->body( + $html->font({ 'face' => 'Arial' }, + "Hello, there"))); + +would yield + + + + Hello, there + + + +=head2 qualifiedAttributes, qualified_attributes + +Set this to a true value to emulate the attribute prefixing behavior of +XML::Generator prior to version 0.99. Here is an example: + + my $foo = XML::Generator->new( + namespace => [foo => "http://foo.com/"], + qualifiedAttributes => 1); + print $foo->bar({baz => 3}); + +yields + + + +=head2 escape + +The contents and the values of each attribute have any illegal XML +characters escaped if this option is supplied. If the value is 'always', +then &, < and > (and " within attribute values) will be converted into +the corresponding XML entity, although & will not be converted if it looks +like it could be part of a valid entity (but see below). If the value is +'unescaped', then the escaping will be turned off character-by-character +if the character in question is preceded by a backslash, or for the +entire string if it is supplied as a scalar reference. So, for example, + + use XML::Generator escape => 'always'; + + one('<'); # < + two('\&'); # \& + three(\''); # (scalar refs always allowed) + four('<'); # < (looks like an entity) + five('"'); # " (looks like an entity) + +but + + use XML::Generator escape => 'unescaped'; + + one('<'); # < + two('\&'); # & + three(\'');# (scalar refs always allowed) + four('<'); # &lt; (no special case for entities) + +By default, high-bit data will be passed through unmodified, so that +UTF-8 data can be generated with pre-Unicode perls. If you know that +your data is ASCII, use the value 'high-bit' for the escape option +and bytes with the high bit set will be turned into numeric entities. +You can combine this functionality with the other escape options by +comma-separating the values: + + my $a = XML::Generator->new(escape => 'always,high-bit'); + print $a->foo("<\242>"); + +yields + + <¢> + +Because XML::Generator always uses double quotes ("") around attribute +values, it does not escape single quotes. If you want single quotes +inside attribute values to be escaped, use the value 'apos' along with +'always' or 'unescaped' for the escape option. For example: + + my $gen = XML::Generator->new(escape => 'always,apos'); + print $gen->foo({'bar' => "It's all good"}); + + + +If you actually want & to be converted to & even if it looks like it +could be part of a valid entity, use the value 'even-entities' along with +'always'. Supplying 'even-entities' to the 'unescaped' option is meaningless +as entities are already escaped with that option. + +=head2 pretty + +To have nice pretty printing of the output XML (great for config files +that you might also want to edit by hand), supply an integer for the +number of spaces per level of indenting, eg. + + my $gen = XML::Generator->new(pretty => 2); + print $gen->foo($gen->bar('baz'), + $gen->qux({ tricky => 'no'}, 'quux')); + +would yield + + + baz + quux + + +You may also supply a non-numeric string as the argument to 'pretty', in +which case the indents will consist of repetitions of that string. So if +you want tabbed indents, you would use: + + my $gen = XML::Generator->new(pretty => "\t"); + +Pretty printing does not apply to CDATA sections or Processing Instructions. + +=head2 conformance + +If the value of this option is 'strict', a number of syntactic +checks are performed to ensure that generated XML conforms to the +formal XML specification. In addition, since entity names beginning +with 'xml' are reserved by the W3C, inclusion of this option enables +several special tag names: xmlpi, xmlcmnt, xmldecl, xmldtd, xmlcdata, +and xml to allow generation of processing instructions, comments, XML +declarations, DTD's, character data sections and "final" XML documents, +respectively. + +Invalid characters (http://www.w3.org/TR/xml11/#charsets) will be filtered +out. To disable this behavior, supply the 'filter_invalid_chars' option with +the value 0. + +See L<"XML CONFORMANCE"> and L<"SPECIAL TAGS"> for more information. + +=head2 filterInvalidChars, filter_invalid_chars + +Set this to a 1 to enable filtering of invalid characters, or to 0 to disable +the filtering. See http://www.w3.org/TR/xml11/#charsets for the set of valid +characters. + +=head2 allowedXMLTags, allowed_xml_tags + +If you have specified 'conformance' => 'strict' but need to use tags +that start with 'xml', you can supply a reference to an array containing +those tags and they will be accepted without error. It is not an error +to supply this option if 'conformance' => 'strict' is not supplied, +but it will have no effect. + +=head2 empty + +There are 5 possible values for this option: + + self - create empty tags as (default) + compact - create empty tags as + close - close empty tags as + ignore - don't do anything (non-compliant!) + args - use count of arguments to decide between and + +Many web browsers like the 'self' form, but any one of the forms besides +'ignore' is acceptable under the XML standard. + +'ignore' is intended for subclasses that deal with HTML and other +SGML subsets which allow atomic tags. It is an error to specify both +'conformance' => 'strict' and 'empty' => 'ignore'. + +'args' will produce if there are no arguments at all, or if there +is just a single undef argument, and otherwise. + +=head2 version + +Sets the default XML version for use in XML declarations. +See L<"xmldecl"> below. + +=head2 encoding + +Sets the default encoding for use in XML declarations. + +=head2 dtd + +Specify the dtd. The value should be an array reference with three +values; the type, the name and the uri. + +=head1 IMPORT ARGUMENTS + +use XML::Generator ':option'; + +use XML::Generator option => 'value'; + +(Both styles may be combined) + +=head2 :import + +Cause C to export an C to your package that +makes undefined subroutines generate XML tags corresponding to their name. +Note that if you already have an C defined, it will be overwritten. + +=head2 :stacked + +Implies :import, but if there is already an C defined, the +overriding C will still give it a chance to run. See L<"STACKABLE +AUTOLOADs">. + +=head2 ANYTHING ELSE + +If you supply any other options, :import is implied and the XML::Generator +object that is created to generate tags will be constructed with those options. + +=cut + +package XML::Generator; + +use strict; +require Carp; + +# If no value is provided for these options, they will be set to '' + +my @optionsToInit = qw( + allowed_xml_tags + conformance + dtd + escape + namespace + pretty + version + empty + qualified_attributes + filter_invalid_chars +); + +my %tag_factory; + +sub import { + my $type = shift; + + # check for attempt to use tag 'import' + if (ref $type && defined $tag_factory{$type}) { + unshift @_, $type, 'import'; + goto &{ $tag_factory{$type} }; + } + + my $pkg = caller; + + no strict 'refs'; # Let's get serious + + # should we import an AUTOLOAD? + no warnings 'once'; + + if (@_) { + my $STACKED; + + # are we supposed to call their AUTOLOAD first? + if (grep /^:stacked$/, @_) { + $STACKED = \&{"${pkg}::AUTOLOAD"}; + } + + my $this = $type->new(@_); + + no warnings 'redefine'; # No, I mean SERIOUS + + *{"${pkg}::AUTOLOAD"} = + sub { + if ($STACKED) { + ${"${pkg}::AUTOLOAD"} = our $AUTOLOAD; + my @ret = $STACKED->(@_); + return wantarray ? @ret : $ret[0] if @ret; + } + + # The tag is whatever our sub name is. + my($tag) = our $AUTOLOAD =~ /.*::(.*)/; + + # Special-case for xml... tags + if ($tag =~ /^xml/ && $this->{'conformance'} eq 'strict') { + if (my $func = $this->can($tag)) { + unshift @_, $this; + goto &$func; + } + } + + unshift @_, $this, $tag; + + goto &{ $tag_factory{$this} }; + }; + + # convenience feature for stacked autoloads; give them + # an import() that aliases AUTOLOAD. + if ($STACKED && ! defined *{"${pkg}::import"}{CODE}) { + *{"${pkg}::import"} = + sub { + my $p = caller; + *{"${p}::AUTOLOAD"} = \&{"${pkg}::AUTOLOAD"}; + }; + } + } + + return; +} + +# The constructor method + +sub new { + my $class = shift; + + # If we already have a ref in $class, this means that the + # person wants to generate a tag! + return $class->XML::Generator::util::tag('new', @_) if ref $class; + + my %options = + map { + /^:(std|standard) $/x ? ( escape => 'always', + conformance => 'strict' ) + : /^:strict $/x ? ( conformance => 'strict' ) + : /^:pretty(?:=(.+))?$/x ? ( escape => 'always', + conformance => 'strict', + pretty => ( defined $1 ? $1 : 2 ) ) + : /^:(import | + stacked )$/x ? ( do { Carp::carp("Useless use of $_") + unless (caller(1))[3] =~ /::import/; + () } ) + : /^allowedXMLTags$/ ? 'allowed_xml_tags' + : /^qualifiedAttributes$/ ? 'qualified_attributes' + : /^filterInvalidChars$/ ? 'filter_invalid_chars' + : $_ + } @_; + + # We used to only accept certain options, but unfortunately this + # means that subclasses can't extend the list. As such, we now + # just make sure our default options are defined. + for (@optionsToInit) { + if (not defined $options{$_}) { + $options{$_} = ''; + } + } + + if ($options{'dtd'}) { + $options{'dtdtree'} = $class->XML::Generator::util::parse_dtd($options{'dtd'}); + } + + if ($options{'conformance'} eq 'strict' && + $options{'empty'} eq 'ignore') { + Carp::croak "option 'empty' => 'ignore' not allowed while 'conformance' => 'strict'"; + } + + if ($options{'escape'}) { + my $e = $options{'escape'}; + $options{'escape'} = 0; + while ($e =~ /([-\w]+),?/g) { + if ($1 eq 'always') { + $options{'escape'} |= XML::Generator::util::ESCAPE_ALWAYS() + | XML::Generator::util::ESCAPE_GT(); + } elsif ($1 eq 'high-bit') { + $options{'escape'} |= XML::Generator::util::ESCAPE_HIGH_BIT(); + } elsif ($1 eq 'apos') { + $options{'escape'} |= XML::Generator::util::ESCAPE_APOS(); + } elsif ($1 eq 'even-entities') { + $options{'escape'} |= XML::Generator::util::ESCAPE_EVEN_ENTITIES(); + } elsif ($1) { + if ($1 ne 'unescaped') { + Carp::carp "option 'escape' => '$1' deprecated; use 'escape' => 'unescaped'"; + } + $options{'escape'} |= XML::Generator::util::ESCAPE_TRUE() + | XML::Generator::util::ESCAPE_GT(); + } + } + } else { + $options{'escape'} = 0; + } + + if (ref $options{'namespace'} eq 'ARRAY') { + if (@{ $options{'namespace'} } > 2 && (@{ $options{'namespace'} } % 2) != 0) { + Carp::croak "odd number of arguments for namespace"; + } + } elsif ($options{'namespace'}) { + Carp::croak "namespace must be an array reference"; + } + + if ($options{'conformance'} eq 'strict' && + $options{'filter_invalid_chars'} eq '') { + $options{'filter_invalid_chars'} = 1; + } + + my $this = bless \%options, $class; + $tag_factory{$this} = XML::Generator::util::c_tag($this); + return $this; +} + +# We use AUTOLOAD as a front-end to TAG so that we can +# create tags by name at will. + +sub AUTOLOAD { + my $this = shift; + + # The tag is whatever our sub name is, or 'AUTOLOAD' + my ($tag) = defined our $AUTOLOAD ? $AUTOLOAD =~ /.*::(.*)/ : 'AUTOLOAD'; + + undef $AUTOLOAD; # this ensures that future attempts to use tag 'AUTOLOAD' work. + + unshift @_, $this, $tag; + + goto &{ $tag_factory{$this} }; +} + +# I wish there were a way to allow people to use tag 'DESTROY!' +# hmm, maybe xmlDESTROY? +sub DESTROY { delete $tag_factory{$_[0]} } + +=head1 XML CONFORMANCE + +When the 'conformance' => 'strict' option is supplied, a number of +syntactic checks are enabled. All entity and attribute names are +checked to conform to the XML specification, which states that they must +begin with either an alphabetic character or an underscore and may then +consist of any number of alphanumerics, underscores, periods or hyphens. +Alphabetic and alphanumeric are interpreted according to the current +locale if 'use locale' is in effect and according to the Unicode standard +for Perl versions >= 5.6. Furthermore, entity or attribute names are not +allowed to begin with 'xml' (in any case), although a number of special +tags beginning with 'xml' are allowed (see L<"SPECIAL TAGS">). Note +that you can also supply an explicit list of allowed tags with the +'allowed_xml_tags' option. + +Also, the filter_invalid_chars option is automatically set to 1 unless it +is explicitly set to 0. + +=head1 SPECIAL TAGS + +The following special tags are available when running under strict +conformance (otherwise they don't act special): + +=head2 xmlpi + +Processing instruction; first argument is target, remaining arguments +are attribute, value pairs. Attribute names are syntax checked, values +are escaped. + +=cut + +# We handle a few special tags, but only if the conformance +# is 'strict'. If not, we just fall back to XML::Generator::util::tag. + +sub xmlpi { + my $this = shift; + + return $this->XML::Generator::util::tag('xmlpi', @_) + unless $this->{conformance} eq 'strict'; + + my $xml; + my $tgt = shift; + + $this->XML::Generator::util::ck_syntax($tgt); + + $xml = "XML::Generator::util::ck_syntax($k); + XML::Generator::util::escape($v, + XML::Generator::util::ESCAPE_ATTR() | + $this->{'escape'}); + XML::Generator::util::filter($v); + $xml .= qq{ $k="$v"}; + } + } + $xml .= "?>"; + + return XML::Generator::pi->new([$xml]); +} + +=head2 xmlcmnt + +Comment. Arguments are concatenated and placed inside +comment delimiters. Any occurences of '--' in the concatenated arguments +are converted to '--' + +=cut + +sub xmlcmnt { + my $this = shift; + + return $this->XML::Generator::util::tag('xmlcmnt', @_) + unless $this->{conformance} eq 'strict'; + + my $xml = join '', @_; + + # double dashes are illegal; change them to '--' + $xml =~ s/--/--/g; + XML::Generator::util::filter($xml); + $xml = ""; + + return XML::Generator::comment->new([$xml]); +} + +=head2 xmldecl (@args) + +Declaration. This can be used to specify the version, encoding, and +other XML-related declarations (i.e., anything inside the tag). +@args can be used to control what is output, as keyword-value pairs. + +By default, the version is set to the value specified in the constructor, +or to 1.0 if it was not specified. This can be overridden by providing a +'version' key in @args. If you do not want the version at all, explicitly +provide undef as the value in @args. + +By default, the encoding is set to the value specified in the constructor; +if no value was specified, the encoding will be left out altogether. +Provide an 'encoding' key in @args to override this. + +If a dtd was set in the constructor, the standalone attribute of the +declaration will be set to 'no' and the doctype declaration will be +appended to the XML declartion, otherwise the standalone attribute will +be set to 'yes'. This can be overridden by providing a 'standalone' +key in @args. If you do not want the standalone attribute to show up, +explicitly provide undef as the value. + +=cut + +sub xmldecl { + my($this, @args) = @_; + + return $this->XML::Generator::util::tag('xmldecl', @_) + unless $this->{conformance} eq 'strict'; + + my $version = $this->{'version'} || '1.0'; + + # there's no explicit support for encodings yet, but at the + # least we can know to put it in the declaration + my $encoding = $this->{'encoding'}; + + # similarly, although we don't do anything with DTDs yet, we + # recognize a 'dtd' => [ ... ] option to the constructor, and + # use it to create a and to indicate that this + # document can't stand alone. + my $doctype = $this->xmldtd($this->{dtd}); + my $standalone = $doctype ? "no" : "yes"; + + for (my $i = 0; $i < $#args; $i += 2) { + if ($args[$i] eq 'version' ) { + $version = $args[$i + 1]; + } elsif ($args[$i] eq 'encoding' ) { + $encoding = $args[$i + 1]; + } elsif ($args[$i] eq 'standalone') { + $standalone = $args[$i + 1]; + } else { + Carp::croak("Unrecognized argument '$args[$i]'"); + } + } + + $version = qq{ version="$version"} if defined $version; + $encoding = qq{ encoding="$encoding"} if defined $encoding; + $standalone = qq{ standalone="$standalone"} if defined $standalone; + + $encoding ||= ''; + $version ||= ''; + $standalone ||= ''; + + my $xml = ""; + $xml .= "\n$doctype" if $doctype; + + $xml = "$xml\n"; + + return $xml; +} + +=head2 xmldtd + +DTD tag creation. The format of this method is different from +others. Since DTD's are global and cannot contain namespace information, +the first argument should be a reference to an array; the elements are +concatenated together to form the DTD: + + print $xml->xmldtd([ 'html', 'PUBLIC', $xhtml_w3c, $xhtml_dtd ]) + +This would produce the following declaration: + + + +Assuming that $xhtml_w3c and $xhtml_dtd had the correct values. + +Note that you can also specify a DTD on creation using the new() method's +dtd option. + +=cut + +sub xmldtd { + my $this = shift; + my $dtd = shift || return undef; + + # return the appropriate thingy + $dtd ? return(qq{}) + : return(''); +} + +=head2 xmlcdata + +Character data section; arguments are concatenated and placed inside + character data section delimiters. Any occurences of +']]>' in the concatenated arguments are converted to ']]>'. + +=cut + +sub xmlcdata { + my $this = shift; + + $this->XML::Generator::util::tag('xmlcdata', @_) + unless $this->{conformance} eq 'strict'; + + my $xml = join '', @_; + + # ]]> is not allowed; change it to ]]> + $xml =~ s/]]>/]]>/g; + XML::Generator::util::filter($xml); + $xml = ""; + + return XML::Generator::cdata->new([$xml]); +} + +=head2 xml + +"Final" XML document. Must be called with one and exactly one +XML::Generator-produced XML document. Any combination of +XML::Generator-produced XML comments or processing instructions may +also be supplied as arguments. Prepends an XML declaration, and +re-blesses the argument into a "final" class that can't be embedded. + +=cut + +sub xml { + my $this = shift; + + return $this->XML::Generator::util::tag('xml', @_) + unless $this->{conformance} eq 'strict'; + + unless (@_) { + Carp::croak "usage: object->xml( (COMMENT | PI)* XML (COMMENT | PI)* )"; + } + + my $got_root = 0; + foreach my $arg (@_) { + next if UNIVERSAL::isa($arg, 'XML::Generator::comment') || + UNIVERSAL::isa($arg, 'XML::Generator::pi'); + if (UNIVERSAL::isa($arg, 'XML::Generator::overload')) { + if ($got_root) { + Carp::croak "arguments to xml() can contain only one XML document"; + } + $got_root = 1; + } else { + Carp::croak "arguments to xml() must be comments, processing instructions or XML documents"; + } + } + + return XML::Generator::final->new([$this->xmldecl(), @_]); +} + +=head1 CREATING A SUBCLASS + +For a simpler way to implement subclass-like behavior, see L<"STACKABLE +AUTOLOADs">. + +At times, you may find it desireable to subclass XML::Generator. For +example, you might want to provide a more application-specific interface +to the XML generation routines provided. Perhaps you have a custom +database application and would really like to say: + + my $dbxml = new XML::Generator::MyDatabaseApp; + print $dbxml->xml($dbxml->custom_tag_handler(@data)); + +Here, custom_tag_handler() may be a method that builds a recursive XML +structure based on the contents of @data. In fact, it may even be named +for a tag you want generated, such as authors(), whose behavior changes +based on the contents (perhaps creating recursive definitions in the +case of multiple elements). + +Creating a subclass of XML::Generator is actually relatively +straightforward, there are just three things you have to remember: + + 1. All of the useful utilities are in XML::Generator::util. + + 2. To construct a tag you simply have to call SUPER::tagname, + where "tagname" is the name of your tag. + + 3. You must fully-qualify the methods in XML::Generator::util. + +So, let's assume that we want to provide a custom HTML table() method: + + package XML::Generator::CustomHTML; + use base 'XML::Generator'; + + sub table { + my $self = shift; + + # parse our args to get namespace and attribute info + my($namespace, $attr, @content) = + $self->XML::Generator::util::parse_args(@_) + + # check for strict conformance + if ( $self->XML::Generator::util::config('conformance') eq 'strict' ) { + # ... special checks ... + } + + # ... special formatting magic happens ... + + # construct our custom tags + return $self->SUPER::table($attr, $self->tr($self->td(@content))); + } + +That's pretty much all there is to it. We have to explicitly call +SUPER::table() since we're inside the class's table() method. The others +can simply be called directly, assuming that we don't have a tr() in the +current package. + +If you want to explicitly create a specific tag by name, or just want a +faster approach than AUTOLOAD provides, you can use the tag() method +directly. So, we could replace that last line above with: + + # construct our custom tags + return $self->XML::Generator::util::tag('table', $attr, ...); + +Here, we must explicitly call tag() with the tag name itself as its first +argument so it knows what to generate. These are the methods that you might +find useful: + +=over 4 + +=item XML::Generator::util::parse_args() + +This parses the argument list and returns the namespace (arrayref), attributes +(hashref), and remaining content (array), in that order. + +=item XML::Generator::util::tag() + +This does the work of generating the appropriate tag. The first argument must +be the name of the tag to generate. + +=item XML::Generator::util::config() + +This retrieves options as set via the new() method. + +=item XML::Generator::util::escape() + +This escapes any illegal XML characters. + +=back + +Remember that all of these methods must be fully-qualified with the +XML::Generator::util package name. This is because AUTOLOAD is used by +the main XML::Generator package to create tags. Simply calling parse_args() +will result in a set of XML tags called . + +Finally, remember that since you are subclassing XML::Generator, you do +not need to provide your own new() method. The one from XML::Generator +is designed to allow you to properly subclass it. + +=head1 STACKABLE AUTOLOADs + +As a simpler alternative to traditional subclassing, the C +that C exports can be configured to work with a +pre-defined C with the ':stacked' option. Simply ensure that +your C is defined before C +executes. The C will get a chance to run first; the subroutine +name will be in your C<$AUTOLOAD> as normal. Return an empty list to let +the default XML::Generator C run or any other value to abort it. +This value will be returned as the result of the original method call. + +If there is no C defined, XML::Generator will create one. +All that this C does is export AUTOLOAD, but that lets your +package be used as if it were a subclass of XML::Generator. + +An example will help: + + package MyGenerator; + + my %entities = ( copy => '©', + nbsp => ' ', ... ); + + sub AUTOLOAD { + my($tag) = our $AUTOLOAD =~ /.*::(.*)/; + + return $entities{$tag} if defined $entities{$tag}; + return; + } + + use XML::Generator qw(:pretty :stacked); + +This lets someone do: + + use MyGenerator; + + print html(head(title("My Title", copy()))); + +Producing: + + + + My Title© + + + +=cut + +package XML::Generator::util; + +# The ::util package space actually has all the utilities +# that do all the work. It must be separate from the +# main XML::Generator package space since named subs will +# interfere with the workings of AUTOLOAD otherwise. + +use strict; +use Carp; + +use constant ESCAPE_TRUE => 1; +use constant ESCAPE_ALWAYS => 1<<1; +use constant ESCAPE_HIGH_BIT => 1<<2; +use constant ESCAPE_APOS => 1<<3; +use constant ESCAPE_ATTR => 1<<4; +use constant ESCAPE_GT => 1<<5; +use constant ESCAPE_EVEN_ENTITIES => 1<<6; +use constant ESCAPE_FILTER_INVALID_CHARS => 1<<7; + +sub parse_args { + # this parses the args and returns a namespace and attr + # if either were specified, with the remainer of the + # arguments (the content of the tag) in @args. call as: + # + # ($namespace, $attr, @args) = parse_args(@args); + + my($this, @args) = @_; + + my($namespace); + my($attr) = (''); + + # check for supplied namespace + if (ref $args[0] eq 'ARRAY') { + $namespace = [ map { defined $_ && $_ eq '#default' ? undef : $_ } @{shift @args} ]; + if (@$namespace > 2 && (@$namespace % 2) != 0) { + croak "odd number of arguments for namespace"; + } + } + + # get globally-set namespace (from new) + unless ($namespace) { + $namespace = [ map { defined $_ && $_ eq '#default' ? undef : $_ } @{ $this->{'namespace'} || [] } ]; + } + + if (@$namespace == 1) { unshift @$namespace, undef } + + # check for supplied attributes + if (ref $args[0] eq 'HASH') { + $attr = shift @args; + if ($this->{conformance} eq 'strict') { + $this->XML::Generator::util::ck_syntax($_) + for map split(/:/), keys %$attr; + } + } + + return ($namespace, $attr, @args); +} + +# This routine is what handles all the automatic tag creation. +# We maintain it as a separate method so that subclasses can +# override individual tags and then call SUPER::tag() to create +# the tag automatically. This is not possible if only AUTOLOAD +# is used, since there is no way to then pass in the name of +# the tag. + +sub tag { + my $sub = XML::Generator::util::c_tag($_[0]); + goto &{ $sub } if $sub; +} + +# Generate a closure that encapsulates all the behavior to generate a tag +sub c_tag { + my $arg = shift; + + my $strict = $arg->{'conformance'} eq 'strict'; + my $escape = $arg->{'escape'}; + my $empty = $arg->{'empty'}; + my $indent = $arg->{'pretty'} =~ /^[^0-9]/ + ? $arg->{'pretty'} + : $arg->{'pretty'} + ? " " x $arg->{'pretty'} + : ""; + my $filter = $arg->{'filter_invalid_chars'}; + + my $blessClass = $indent ? 'XML::Generator::pretty' : 'XML::Generator::overload'; + + return sub { + my $this = shift; + my $tag = shift || return undef; # catch for bad usage + + # parse our argument list to check for hashref/arrayref properties + my($namespace, $attr, @args) = $this->XML::Generator::util::parse_args(@_); + + $this->XML::Generator::util::ck_syntax($tag) if $strict; + + # check for attempt to embed "final" document + for (@args) { + if (UNIVERSAL::isa($_, 'XML::Generator::final')) { + croak("cannot embed XML document"); + } + } + + # Deal with escaping if required + if ($escape || $filter) { + if ($attr) { + foreach my $key (keys %{$attr}) { + next unless defined($attr->{$key}); + XML::Generator::util::escape($attr->{$key}, ESCAPE_ATTR() | $escape); + XML::Generator::util::filter($attr->{$key}) if ($filter); + } + } + for (@args) { + next unless defined($_); + + # perform escaping, except on sub-documents or simple scalar refs + if (ref $_ eq "SCALAR") { + # un-ref it + $_ = $$_; + } elsif (! UNIVERSAL::isa($_, 'XML::Generator::overload') ) { + XML::Generator::util::escape($_, $escape) if $escape ; + XML::Generator::util::filter($_) if $filter; + } + } + } else { + # un-ref simple scalar refs + for (@args) { + $_ = $$_ if ref $_ eq "SCALAR"; + } + } + + my $prefix = ''; + $prefix = $namespace->[0] . ":" if $namespace && defined $namespace->[0]; + my $xml = "<$prefix$tag"; + + if ($attr) { + while (my($k, $v) = each %$attr) { + next unless defined $k and defined $v; + if ($strict) { + # allow supplied namespace in attribute names + if ($k =~ s/^([^:]+)://) { + $this->XML::Generator::util::ck_syntax($k); + $k = "$1:$k"; + } elsif ($prefix && $this->{'qualified_attributes'}) { + $this->XML::Generator::util::ck_syntax($k); + $k = "$prefix$k"; + } else { + $this->XML::Generator::util::ck_syntax($k); + } + } elsif ($this->{'qualified_attributes'}) { + if ($k !~ /^[^:]+:/) { + $k = "$prefix$k"; + } + } + $xml .= qq{ $k="$v"}; + } + } + + my @xml; + + if (@args || $empty eq 'close') { + if ($empty eq 'args' && @args == 1 && ! defined $args[0]) { + @xml = ($xml .= ' />'); + } else { + $xml .= '>'; + if ($indent) { + my $prettyend = ''; + + foreach my $arg (@args) { + next unless defined $arg; + if ( UNIVERSAL::isa($arg, 'XML::Generator::cdata' ) ) { + my $copy = $xml; + push @xml, $copy, $arg; + $xml = ''; + } else { + if ( UNIVERSAL::isa($arg, 'XML::Generator::overload') && + ! UNIVERSAL::isa($arg, 'XML::Generator::pi') ) { + $xml .= "\n$indent"; + $prettyend = "\n"; + XML::Generator::util::_fixupNS($namespace, $arg) if ref $arg->[0]; + + my @cdata; + for my $i (0..$#$arg) { + if (UNIVERSAL::isa($arg->[$i], 'XML::Generator::cdata')) { + push @cdata, $arg->[$i]; + $arg->[$i] = "\001"; + } + } + + $arg =~ s/\n/\n$indent/gs; + + if (@cdata) { + my @pieces = split "\001", $arg; + + my $copy = $xml; + push @xml, $copy; + $xml = ''; + $arg = ''; + + for my $i (0..$#pieces) { + if (defined $cdata[$i]) { + push @xml, $pieces[$i], $cdata[$i]; + } else { + push @xml, $pieces[$i]; + } + } + } + } + $xml .= "$arg"; + } + } + $xml .= $prettyend; + push @xml, ($xml, ""); + } else { + @xml = $xml; + foreach my $arg (grep defined, @args) { + if ( UNIVERSAL::isa($arg, 'XML::Generator::overload') && + (! ( UNIVERSAL::isa($arg, 'XML::Generator::cdata' ) || + UNIVERSAL::isa($arg, 'XML::Generator::pi' )))) { + XML::Generator::util::_fixupNS($namespace, $arg) if ref $arg->[0]; + } + push @xml, $arg; + } + push @xml, ""; + } + } + } elsif ($empty eq 'ignore') { + @xml = ($xml .= '>'); + } elsif ($empty eq 'compact') { + @xml = ($xml .= '/>'); + } else { + @xml = ($xml .= ' />'); + } + + unshift @xml, $namespace if $namespace; + + return $blessClass->new(\@xml); + }; +} + +sub _fixupNS { + # remove namespaces + # if prefix + # if prefix and uri match one we have, remove them from child + # if prefix does not match one we have, remove it and uri + # from child and add them to us + # no prefix + # if we have an explicit default namespace and the child has the + # same one, remove it from the child + # if we have an explicit default namespace and the child has a + # different one, leave it alone + # if we have an explicit default namespace and the child has none, + # add an empty default namespace to child + my($namespace, $o) = @_; + my @n = @{$o->[0]}; + my $sawDefault = 0; + for (my $i = 0; $i < $#n; $i+=2) { + if (defined $n[$i]) { # namespace w/ prefix + my $flag = 0; + for (my $j = 0; $j < $#$namespace; $j+=2) { + next unless defined $namespace->[$j]; + if ($namespace->[$j] eq $n[$i]) { + $flag = 1; + if ($namespace->[$j+1] ne $n[$i+1]) { + $flag = 2; + } + last; + } + } + if (!$flag) { + push @$namespace, splice @n, $i, 2; + $i-=2; + } elsif ($flag == 1) { + splice @n, $i, 2; + $i-=2; + } + } elsif (defined $n[$i+1]) { # default namespace + $sawDefault = 1; + for (my $j = 0; $j < $#$namespace; $j+=2) { + next if defined $namespace->[$j]; + if ($namespace->[$j+1] eq $n[$i+1]) { + splice @n, $i, 2; + $i-=2; + } + } + } + } + + # check to see if we need to add explicit default namespace of "" to child + if (! @{ $o->[0] } && + ! $sawDefault && + grep { defined $namespace->[$_ * 2 + 1] && + ! defined $namespace->[$_ * 2 ] } 0..($#$namespace/2)) { + push @n, undef, ""; + } + + if (@n) { + $o->[0] = [@n]; + } else { + splice @$o, 0, 1; + } +} + +# Fetch and store config values (those set via new()) +# This is only here for subclasses + +sub config { + my $this = shift; + my $key = shift || return undef; + @_ ? $this->{$key} = $_[0] + : $this->{$key}; +} + +# Collect all escaping into one place +sub escape { + # $_[0] is the argument, $_[1] are the flags + return unless defined $_[0]; + + my $f = $_[1]; + if ($f & ESCAPE_ALWAYS) { + if ($f & ESCAPE_EVEN_ENTITIES) { + $_[0] =~ s/&/&/g; + } else { + $_[0] =~ s/&(?!(?:#[0-9]+|#x[0-9a-fA-F]+|\w+);)/&/g; + } + + $_[0] =~ s//>/g if $f & ESCAPE_GT; + $_[0] =~ s/"/"/g if $f & ESCAPE_ATTR; + $_[0] =~ s/'/'/g if $f & ESCAPE_ATTR && $f & ESCAPE_APOS; + } else { + $_[0] =~ s/([^\\]|^)&/$1&/g; + $_[0] =~ s/\\&/&/g; + $_[0] =~ s/([^\\]|^)/$1>/g; + $_[0] =~ s/\\>/>/g; + } + if ($f & ESCAPE_ATTR) { + $_[0] =~ s/(?{'allowed_xml_tags'} || ! grep { $_ eq $name } @{ $this->{'allowed_xml_tags'} }) { + croak "names beginning with 'xml' are reserved by the W3C"; + } + } +} + +my %DTDs; +my $DTD; + +sub parse_dtd { + my $this = shift; + my($dtd) = @_; + + my($root, $type, $name, $uri); + + croak "DTD must be supplied as an array ref" unless (ref $dtd eq 'ARRAY'); + croak "DTD must have at least 3 elements" unless (@{$dtd} >= 3); + + ($root, $type) = @{$dtd}[0,1]; + if ($type eq 'PUBLIC') { + ($name, $uri) = @{$dtd}[2,3]; + } elsif ($type eq 'SYSTEM') { + $uri = $dtd->[2]; + } else { + croak "unknown dtd type [$type]"; + } + return $DTDs{$uri} if $DTDs{$uri}; + + # parse DTD into $DTD (not implemented yet) + my $dtd_text = get_dtd($uri); + + return $DTDs{$uri} = $DTD; +} + +sub get_dtd { + my($uri) = @_; + return; +} + +# This package is needed so that embedded tags are correctly +# interpreted as such and handled properly. Otherwise, you'd +# get "<inner />" + +package XML::Generator::overload; + +use overload '""' => sub { $_[0]->stringify }, + '0+' => sub { $_[0]->stringify }, + 'bool' => sub { $_[0]->stringify }, + 'eq' => sub { (ref $_[0] ? $_[0]->stringify : $_[0]) eq + (ref $_[1] ? $_[1]->stringify : $_[1])}; + +sub new { + my($class, $xml) = @_; + return bless $xml, $class; +} + +sub stringify { + return $_[0] unless UNIVERSAL::isa($_[0], 'XML::Generator::overload'); + if (ref($_[0]->[0])) { # namespace + my $n = shift @{$_[0]}; + for (my $i = ($#$n - 1); $i >= 0; $i-=2) { + my($prefix, $uri) = @$n[$i,$i+1]; + XML::Generator::util::escape($uri, XML::Generator::util::ESCAPE_ATTR | + XML::Generator::util::ESCAPE_ALWAYS| + XML::Generator::util::ESCAPE_GT); + if (defined $prefix) { + $_[0]->[0] =~ s/^([^ \/>]+)/$1 xmlns:$prefix="$uri"/; + } else { + $uri ||= ''; + $_[0]->[0] =~ s/^([^ \/>]+)/$1 xmlns="$uri"/; + } + } + } + + join $, || "", @{$_[0]} +} + +sub DESTROY { } + +package XML::Generator::pretty; + +use base 'XML::Generator::overload'; + +sub stringify { + my $this = shift; + my $string = $this->SUPER::stringify(); + + $string =~ s{^((\s*<(?:\w+:)?\w[-.\w]* )[^ "]+"[^"]+")( .{40,})} + { my($a,$b,$c) = ($1, $2, $3); + $c =~ s{ ((?:\w+:)?\w+="[^\"]+")}{"\n" . (' 'x(length $b)) . $1}ge; + "$a$c" }gem; + + return $string; +} + +package XML::Generator::final; + +use base 'XML::Generator::overload'; + +package XML::Generator::comment; + +use base 'XML::Generator::overload'; + +package XML::Generator::pi; + +use base 'XML::Generator::overload'; + +package XML::Generator::cdata; + +use base 'XML::Generator::overload'; + +1; +__END__ + +=head1 AUTHORS + +=over 4 + +=item Benjamin Holzman + +Original author and maintainer + +=item Bron Gondwana + +First modular version + +=item Nathan Wiger + +Modular rewrite to enable subclassing + +=back + +=head1 LICENSE + +This library is free software, you can redistribute it and/or modify +it under the same terms as Perl itself. + +=head1 SEE ALSO + +=over 4 + +=item The XML::Writer module + +http://search.cpan.org/search?mode=module&query=XML::Writer + +=back + +=cut diff -Nru libxml-generator-perl-1.04/LICENSE libxml-generator-perl-1.09/LICENSE --- libxml-generator-perl-1.04/LICENSE 1970-01-01 00:00:00.000000000 +0000 +++ libxml-generator-perl-1.09/LICENSE 2022-02-19 03:06:28.000000000 +0000 @@ -0,0 +1,379 @@ +This software is copyright (c) 1998 - 2022 by Benjamin Holzman. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +Terms of the Perl programming language system itself + +a) the GNU General Public License as published by the Free + Software Foundation; either version 1, or (at your option) any + later version, or +b) the "Artistic License" + +--- The GNU General Public License, Version 1, February 1989 --- + +This software is Copyright (c) 1998 - 2022 by Benjamin Holzman. + +This is free software, licensed under: + + The GNU General Public License, Version 1, February 1989 + + GNU GENERAL PUBLIC LICENSE + Version 1, February 1989 + + Copyright (C) 1989 Free Software Foundation, Inc. + 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA + + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + Preamble + + The license agreements of most software companies try to keep users +at the mercy of those companies. By contrast, our General Public +License is intended to guarantee your freedom to share and change free +software--to make sure the software is free for all its users. The +General Public License applies to the Free Software Foundation's +software and to any other program whose authors commit to using it. +You can use it for your programs, too. + + When we speak of free software, we are referring to freedom, not +price. Specifically, the General Public License is designed to make +sure that you have the freedom to give away or sell copies of free +software, that you receive source code or can get it if you want it, +that you can change the software or use pieces of it in new free +programs; and that you know you can do these things. + + To protect your rights, we need to make restrictions that forbid +anyone to deny you these rights or to ask you to surrender the rights. +These restrictions translate to certain responsibilities for you if you +distribute copies of the software, or if you modify it. + + For example, if you distribute copies of a such a program, whether +gratis or for a fee, you must give the recipients all the rights that +you have. You must make sure that they, too, receive or can get the +source code. And you must tell them their rights. + + We protect your rights with two steps: (1) copyright the software, and +(2) offer you this license which gives you legal permission to copy, +distribute and/or modify the software. + + Also, for each author's protection and ours, we want to make certain +that everyone understands that there is no warranty for this free +software. If the software is modified by someone else and passed on, we +want its recipients to know that what they have is not the original, so +that any problems introduced by others will not reflect on the original +authors' reputations. + + The precise terms and conditions for copying, distribution and +modification follow. + + GNU GENERAL PUBLIC LICENSE + TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION + + 0. This License Agreement applies to any program or other work which +contains a notice placed by the copyright holder saying it may be +distributed under the terms of this General Public License. The +"Program", below, refers to any such program or work, and a "work based +on the Program" means either the Program or any work containing the +Program or a portion of it, either verbatim or with modifications. Each +licensee is addressed as "you". + + 1. You may copy and distribute verbatim copies of the Program's source +code as you receive it, in any medium, provided that you conspicuously and +appropriately publish on each copy an appropriate copyright notice and +disclaimer of warranty; keep intact all the notices that refer to this +General Public License and to the absence of any warranty; and give any +other recipients of the Program a copy of this General Public License +along with the Program. You may charge a fee for the physical act of +transferring a copy. + + 2. You may modify your copy or copies of the Program or any portion of +it, and copy and distribute such modifications under the terms of Paragraph +1 above, provided that you also do the following: + + a) cause the modified files to carry prominent notices stating that + you changed the files and the date of any change; and + + b) cause the whole of any work that you distribute or publish, that + in whole or in part contains the Program or any part thereof, either + with or without modifications, to be licensed at no charge to all + third parties under the terms of this General Public License (except + that you may choose to grant warranty protection to some or all + third parties, at your option). + + c) If the modified program normally reads commands interactively when + run, you must cause it, when started running for such interactive use + in the simplest and most usual way, to print or display an + announcement including an appropriate copyright notice and a notice + that there is no warranty (or else, saying that you provide a + warranty) and that users may redistribute the program under these + conditions, and telling the user how to view a copy of this General + Public License. + + d) You may charge a fee for the physical act of transferring a + copy, and you may at your option offer warranty protection in + exchange for a fee. + +Mere aggregation of another independent work with the Program (or its +derivative) on a volume of a storage or distribution medium does not bring +the other work under the scope of these terms. + + 3. You may copy and distribute the Program (or a portion or derivative of +it, under Paragraph 2) in object code or executable form under the terms of +Paragraphs 1 and 2 above provided that you also do one of the following: + + a) accompany it with the complete corresponding machine-readable + source code, which must be distributed under the terms of + Paragraphs 1 and 2 above; or, + + b) accompany it with a written offer, valid for at least three + years, to give any third party free (except for a nominal charge + for the cost of distribution) a complete machine-readable copy of the + corresponding source code, to be distributed under the terms of + Paragraphs 1 and 2 above; or, + + c) accompany it with the information you received as to where the + corresponding source code may be obtained. (This alternative is + allowed only for noncommercial distribution and only if you + received the program in object code or executable form alone.) + +Source code for a work means the preferred form of the work for making +modifications to it. For an executable file, complete source code means +all the source code for all modules it contains; but, as a special +exception, it need not include source code for modules which are standard +libraries that accompany the operating system on which the executable +file runs, or for standard header files or definitions files that +accompany that operating system. + + 4. You may not copy, modify, sublicense, distribute or transfer the +Program except as expressly provided under this General Public License. +Any attempt otherwise to copy, modify, sublicense, distribute or transfer +the Program is void, and will automatically terminate your rights to use +the Program under this License. However, parties who have received +copies, or rights to use copies, from you under this General Public +License will not have their licenses terminated so long as such parties +remain in full compliance. + + 5. By copying, distributing or modifying the Program (or any work based +on the Program) you indicate your acceptance of this license to do so, +and all its terms and conditions. + + 6. Each time you redistribute the Program (or any work based on the +Program), the recipient automatically receives a license from the original +licensor to copy, distribute or modify the Program subject to these +terms and conditions. You may not impose any further restrictions on the +recipients' exercise of the rights granted herein. + + 7. The Free Software Foundation may publish revised and/or new versions +of the General Public License from time to time. Such new versions will +be similar in spirit to the present version, but may differ in detail to +address new problems or concerns. + +Each version is given a distinguishing version number. If the Program +specifies a version number of the license which applies to it and "any +later version", you have the option of following the terms and conditions +either of that version or of any later version published by the Free +Software Foundation. If the Program does not specify a version number of +the license, you may choose any version ever published by the Free Software +Foundation. + + 8. If you wish to incorporate parts of the Program into other free +programs whose distribution conditions are different, write to the author +to ask for permission. For software which is copyrighted by the Free +Software Foundation, write to the Free Software Foundation; we sometimes +make exceptions for this. Our decision will be guided by the two goals +of preserving the free status of all derivatives of our free software and +of promoting the sharing and reuse of software generally. + + NO WARRANTY + + 9. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY +FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN +OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES +PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED +OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF +MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS +TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE +PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, +REPAIR OR CORRECTION. + + 10. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING +WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR +REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, +INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING +OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED +TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY +YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER +PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE +POSSIBILITY OF SUCH DAMAGES. + + END OF TERMS AND CONDITIONS + + Appendix: How to Apply These Terms to Your New Programs + + If you develop a new program, and you want it to be of the greatest +possible use to humanity, the best way to achieve this is to make it +free software which everyone can redistribute and change under these +terms. + + To do so, attach the following notices to the program. It is safest to +attach them to the start of each source file to most effectively convey +the exclusion of warranty; and each file should have at least the +"copyright" line and a pointer to where the full notice is found. + + + Copyright (C) 19yy + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 1, or (at your option) + any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston MA 02110-1301 USA + + +Also add information on how to contact you by electronic and paper mail. + +If the program is interactive, make it output a short notice like this +when it starts in an interactive mode: + + Gnomovision version 69, Copyright (C) 19xx name of author + Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. + This is free software, and you are welcome to redistribute it + under certain conditions; type `show c' for details. + +The hypothetical commands `show w' and `show c' should show the +appropriate parts of the General Public License. Of course, the +commands you use may be called something other than `show w' and `show +c'; they could even be mouse-clicks or menu items--whatever suits your +program. + +You should also get your employer (if you work as a programmer) or your +school, if any, to sign a "copyright disclaimer" for the program, if +necessary. Here a sample; alter the names: + + Yoyodyne, Inc., hereby disclaims all copyright interest in the + program `Gnomovision' (a program to direct compilers to make passes + at assemblers) written by James Hacker. + + , 1 April 1989 + Ty Coon, President of Vice + +That's all there is to it! + + +--- The Artistic License 1.0 --- + +This software is Copyright (c) 1998 - 2022 by Benjamin Holzman. + +This is free software, licensed under: + + The Artistic License 1.0 + +The Artistic License + +Preamble + +The intent of this document is to state the conditions under which a Package +may be copied, such that the Copyright Holder maintains some semblance of +artistic control over the development of the package, while giving the users of +the package the right to use and distribute the Package in a more-or-less +customary fashion, plus the right to make reasonable modifications. + +Definitions: + + - "Package" refers to the collection of files distributed by the Copyright + Holder, and derivatives of that collection of files created through + textual modification. + - "Standard Version" refers to such a Package if it has not been modified, + or has been modified in accordance with the wishes of the Copyright + Holder. + - "Copyright Holder" is whoever is named in the copyright or copyrights for + the package. + - "You" is you, if you're thinking about copying or distributing this Package. + - "Reasonable copying fee" is whatever you can justify on the basis of media + cost, duplication charges, time of people involved, and so on. (You will + not be required to justify it to the Copyright Holder, but only to the + computing community at large as a market that must bear the fee.) + - "Freely Available" means that no fee is charged for the item itself, though + there may be fees involved in handling the item. It also means that + recipients of the item may redistribute it under the same conditions they + received it. + +1. You may make and give away verbatim copies of the source form of the +Standard Version of this Package without restriction, provided that you +duplicate all of the original copyright notices and associated disclaimers. + +2. You may apply bug fixes, portability fixes and other modifications derived +from the Public Domain or from the Copyright Holder. A Package modified in such +a way shall still be considered the Standard Version. + +3. You may otherwise modify your copy of this Package in any way, provided that +you insert a prominent notice in each changed file stating how and when you +changed that file, and provided that you do at least ONE of the following: + + a) place your modifications in the Public Domain or otherwise make them + Freely Available, such as by posting said modifications to Usenet or an + equivalent medium, or placing the modifications on a major archive site + such as ftp.uu.net, or by allowing the Copyright Holder to include your + modifications in the Standard Version of the Package. + + b) use the modified Package only within your corporation or organization. + + c) rename any non-standard executables so the names do not conflict with + standard executables, which must also be provided, and provide a separate + manual page for each non-standard executable that clearly documents how it + differs from the Standard Version. + + d) make other distribution arrangements with the Copyright Holder. + +4. You may distribute the programs of this Package in object code or executable +form, provided that you do at least ONE of the following: + + a) distribute a Standard Version of the executables and library files, + together with instructions (in the manual page or equivalent) on where to + get the Standard Version. + + b) accompany the distribution with the machine-readable source of the Package + with your modifications. + + c) accompany any non-standard executables with their corresponding Standard + Version executables, giving the non-standard executables non-standard + names, and clearly documenting the differences in manual pages (or + equivalent), together with instructions on where to get the Standard + Version. + + d) make other distribution arrangements with the Copyright Holder. + +5. You may charge a reasonable copying fee for any distribution of this +Package. You may charge any fee you choose for support of this Package. You +may not charge a fee for this Package itself. However, you may distribute this +Package in aggregate with other (possibly commercial) programs as part of a +larger (possibly commercial) software distribution provided that you do not +advertise this Package as a product of your own. + +6. The scripts and library files supplied as input to or produced as output +from the programs of this Package do not automatically fall under the copyright +of this Package, but belong to whomever generated them, and may be sold +commercially, and may be aggregated with this Package. + +7. C or perl subroutines supplied by you and linked into this Package shall not +be considered part of this Package. + +8. The name of the Copyright Holder may not be used to endorse or promote +products derived from this software without specific prior written permission. + +9. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED +WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF +MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. + +The End + diff -Nru libxml-generator-perl-1.04/Makefile.PL libxml-generator-perl-1.09/Makefile.PL --- libxml-generator-perl-1.04/Makefile.PL 2004-03-23 15:39:47.000000000 +0000 +++ libxml-generator-perl-1.09/Makefile.PL 2022-02-19 03:06:28.000000000 +0000 @@ -1,11 +1,44 @@ +# This file was automatically generated by Dist::Zilla::Plugin::MakeMaker v6.022. +use strict; +use warnings; + +use 5.008; + use ExtUtils::MakeMaker; -# See lib/ExtUtils/MakeMaker.pm for details of how to influence -# the contents of the Makefile that is written. -WriteMakefile( - 'NAME' => 'XML::Generator', - 'PM' => { 'Generator.pm' => '$(INST_LIBDIR)/Generator.pm', - 'DOM.pm' => '$(INST_LIBDIR)/Generator/DOM.pm' }, - 'MAN3PODS' => { 'Generator.pm' => '$(INST_MAN3DIR)/XML::Generator.3', - 'DOM.pm' => '$(INST_MAN3DIR)/XML::Generator::DOM.3' }, - 'VERSION_FROM' => 'Generator.pm', # finds $VERSION + +my %WriteMakefileArgs = ( + "ABSTRACT" => "Perl extension for generating XML", + "AUTHOR" => "Benjamin Holzman ", + "CONFIGURE_REQUIRES" => { + "ExtUtils::MakeMaker" => 0 + }, + "DISTNAME" => "XML-Generator", + "LICENSE" => "perl", + "MIN_PERL_VERSION" => "5.008", + "NAME" => "XML::Generator", + "PREREQ_PM" => {}, + "TEST_REQUIRES" => { + "Test" => 0 + }, + "VERSION" => "1.09", + "test" => { + "TESTS" => "t/*.t" + } ); + + +my %FallbackPrereqs = ( + "Test" => 0 +); + + +unless ( eval { ExtUtils::MakeMaker->VERSION(6.63_03) } ) { + delete $WriteMakefileArgs{TEST_REQUIRES}; + delete $WriteMakefileArgs{BUILD_REQUIRES}; + $WriteMakefileArgs{PREREQ_PM} = \%FallbackPrereqs; +} + +delete $WriteMakefileArgs{CONFIGURE_REQUIRES} + unless eval { ExtUtils::MakeMaker->VERSION(6.52) }; + +WriteMakefile(%WriteMakefileArgs); diff -Nru libxml-generator-perl-1.04/MANIFEST libxml-generator-perl-1.09/MANIFEST --- libxml-generator-perl-1.04/MANIFEST 2007-06-22 20:48:54.000000000 +0000 +++ libxml-generator-perl-1.09/MANIFEST 2022-02-19 03:06:28.000000000 +0000 @@ -1,9 +1,19 @@ +# This file was automatically generated by Dist::Zilla::Plugin::Manifest v6.022. Changes -Generator.pm -DOM.pm +LICENSE MANIFEST +META.json +META.yml Makefile.PL -t/Generator.t -t/DOM.t README -META.yml Module meta-data (added by MakeMaker) +SIGNATURE +cpanfile +dist.ini +lib/XML/Generator.pm +lib/XML/Generator/DOM.pm +t/DOM.t +t/Generator.t +t/Issue-70986.t +t/Issue-80273.t +t/author-pod-spell.t +t/author-pod-syntax.t diff -Nru libxml-generator-perl-1.04/META.json libxml-generator-perl-1.09/META.json --- libxml-generator-perl-1.04/META.json 1970-01-01 00:00:00.000000000 +0000 +++ libxml-generator-perl-1.09/META.json 2022-02-19 03:06:28.000000000 +0000 @@ -0,0 +1,106 @@ +{ + "abstract" : "Perl extension for generating XML", + "author" : [ + "Benjamin Holzman " + ], + "dynamic_config" : 0, + "generated_by" : "Dist::Zilla version 6.022, CPAN::Meta::Converter version 2.150010", + "license" : [ + "perl_5" + ], + "meta-spec" : { + "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", + "version" : 2 + }, + "name" : "XML-Generator", + "prereqs" : { + "configure" : { + "requires" : { + "ExtUtils::MakeMaker" : "0" + } + }, + "develop" : { + "requires" : { + "Test::Pod" : "1.41", + "Test::Spelling" : "0.12" + } + }, + "runtime" : { + "recommends" : { + "XML::DOM" : "1.46" + }, + "requires" : { + "perl" : "5.008" + }, + "suggests" : { + "Tie::IxHash" : "0" + } + }, + "test" : { + "recommends" : { + "XML::DOM" : "1.46" + }, + "requires" : { + "Test" : "0" + } + } + }, + "provides" : { + "XML::Generator" : { + "file" : "lib/XML/Generator.pm", + "version" : "1.09" + }, + "XML::Generator::DOM" : { + "file" : "lib/XML/Generator/DOM.pm", + "version" : "1.09" + }, + "XML::Generator::DOM::util" : { + "file" : "lib/XML/Generator/DOM.pm", + "version" : "1.09" + }, + "XML::Generator::cdata" : { + "file" : "lib/XML/Generator.pm", + "version" : "1.09" + }, + "XML::Generator::comment" : { + "file" : "lib/XML/Generator.pm", + "version" : "1.09" + }, + "XML::Generator::final" : { + "file" : "lib/XML/Generator.pm", + "version" : "1.09" + }, + "XML::Generator::overload" : { + "file" : "lib/XML/Generator.pm", + "version" : "1.09" + }, + "XML::Generator::pi" : { + "file" : "lib/XML/Generator.pm", + "version" : "1.09" + }, + "XML::Generator::pretty" : { + "file" : "lib/XML/Generator.pm", + "version" : "1.09" + }, + "XML::Generator::util" : { + "file" : "lib/XML/Generator.pm", + "version" : "1.09" + } + }, + "release_status" : "stable", + "resources" : { + "repository" : { + "type" : "git", + "url" : "git://github.com/perl-net-saml2/perl-XML-Generator.git", + "web" : "https://github.com/perl-net-saml2/perl-XML-Generator" + } + }, + "version" : "1.09", + "x_generated_by_perl" : "v5.32.1", + "x_maintainers" : [ + "Timothy Legge " + ], + "x_serialization_backend" : "Cpanel::JSON::XS version 4.27", + "x_spdx_expression" : "Artistic-1.0-Perl OR GPL-1.0-or-later" +} + diff -Nru libxml-generator-perl-1.04/META.yml libxml-generator-perl-1.09/META.yml --- libxml-generator-perl-1.04/META.yml 2011-07-15 12:46:20.000000000 +0000 +++ libxml-generator-perl-1.09/META.yml 2022-02-19 03:06:28.000000000 +0000 @@ -1,20 +1,58 @@ ---- #YAML:1.0 -name: XML-Generator -version: 1.04 -abstract: ~ -author: [] -license: unknown -distribution_type: module -configure_requires: - ExtUtils::MakeMaker: 0 +--- +abstract: 'Perl extension for generating XML' +author: + - 'Benjamin Holzman ' build_requires: - ExtUtils::MakeMaker: 0 -requires: {} -no_index: - directory: - - t - - inc -generated_by: ExtUtils::MakeMaker version 6.55_02 + Test: '0' +configure_requires: + ExtUtils::MakeMaker: '0' +dynamic_config: 0 +generated_by: 'Dist::Zilla version 6.022, CPAN::Meta::Converter version 2.150010' +license: perl meta-spec: - url: http://module-build.sourceforge.net/META-spec-v1.4.html - version: 1.4 + url: http://module-build.sourceforge.net/META-spec-v1.4.html + version: '1.4' +name: XML-Generator +provides: + XML::Generator: + file: lib/XML/Generator.pm + version: '1.09' + XML::Generator::DOM: + file: lib/XML/Generator/DOM.pm + version: '1.09' + XML::Generator::DOM::util: + file: lib/XML/Generator/DOM.pm + version: '1.09' + XML::Generator::cdata: + file: lib/XML/Generator.pm + version: '1.09' + XML::Generator::comment: + file: lib/XML/Generator.pm + version: '1.09' + XML::Generator::final: + file: lib/XML/Generator.pm + version: '1.09' + XML::Generator::overload: + file: lib/XML/Generator.pm + version: '1.09' + XML::Generator::pi: + file: lib/XML/Generator.pm + version: '1.09' + XML::Generator::pretty: + file: lib/XML/Generator.pm + version: '1.09' + XML::Generator::util: + file: lib/XML/Generator.pm + version: '1.09' +recommends: + XML::DOM: '1.46' +requires: + perl: '5.008' +resources: + repository: git://github.com/perl-net-saml2/perl-XML-Generator.git +version: '1.09' +x_generated_by_perl: v5.32.1 +x_maintainers: + - 'Timothy Legge ' +x_serialization_backend: 'YAML::Tiny version 1.73' +x_spdx_expression: 'Artistic-1.0-Perl OR GPL-1.0-or-later' diff -Nru libxml-generator-perl-1.04/README libxml-generator-perl-1.09/README --- libxml-generator-perl-1.04/README 2011-07-15 12:37:41.000000000 +0000 +++ libxml-generator-perl-1.09/README 2022-02-19 03:06:28.000000000 +0000 @@ -1,32 +1,672 @@ -XML::Generator - A module to help in generating XML documents +NAME + XML::Generator - Perl extension for generating XML SYNOPSIS --------- -Lets you do this: + use XML::Generator ':pretty'; - use XML::Generator ':pretty'; - print this(is(a(document()))); + print foo(bar({ baz => 3 }, bam()), + bar([ 'qux' => 'http://qux.com/' ], + "Hey there, world")); -To get this: + # OR + + require XML::Generator; + + my $X = XML::Generator->new(':pretty'); + + print $X->foo($X->bar({ baz => 3 }, $X->bam()), + $X->bar([ 'qux' => 'http://qux.com/' ], + "Hey there, world")); + + Either of the above yield: + + + + + + Hey there, world + + +DESCRIPTION + In general, once you have an XML::Generator object, you then simply call + methods on that object named for each XML tag you wish to generate. + + XML::Generator can also arrange for undefined subroutines in the + caller's package to generate the corresponding XML, by exporting an + "AUTOLOAD" subroutine to your package. Just supply an ':import' argument + to your "use XML::Generator;" call. If you already have an "AUTOLOAD" + defined then XML::Generator can be configured to cooperate with it. See + "STACKABLE AUTOLOADs". + + Say you want to generate this XML: + + + Bob + 34 + Accountant + + + Here's a snippet of code that does the job, complete with pretty + printing: + + use XML::Generator; + my $gen = XML::Generator->new(':pretty'); + print $gen->person( + $gen->name("Bob"), + $gen->age(34), + $gen->job("Accountant") + ); + + The only problem with this is if you want to use a tag name that Perl's + lexer won't understand as a method name, such as "shoe-size". + Fortunately, since you can store the name of a method in a variable, + there's a simple work-around: + + my $shoe_size = "shoe-size"; + $xml = $gen->$shoe_size("12 1/2"); + + Which correctly generates: + + 12 1/2 + + You can use a hash ref as the first parameter if the tag should include + atributes. Normally this means that the order of the attributes will be + unpredictable, but if you have the Tie::IxHash module, you can use it to + get the order you want, like this: + + use Tie::IxHash; + tie my %attr, 'Tie::IxHash'; + + %attr = (name => 'Bob', + age => 34, + job => 'Accountant', + 'shoe-size' => '12 1/2'); + + print $gen->person(\%attr); + + This produces + + + + An array ref can also be supplied as the first argument to indicate a + namespace for the element and the attributes. + + If there is one element in the array, it is considered the URI of the + default namespace, and the tag will have an xmlns="URI" attribute added + automatically. If there are two elements, the first should be the tag + prefix to use for the namespace and the second element should be the + URI. In this case, the prefix will be used for the tag and an + xmlns:PREFIX attribute will be automatically added. Prior to version + 0.99, this prefix was also automatically added to each attribute name. + Now, the default behavior is to leave the attributes alone (although you + may always explicitly add a prefix to an attribute name). If the prior + behavior is desired, use the constructor option "qualified_attributes". + + If you specify more than two elements, then each pair should correspond + to a tag prefix and the corresponding URL. An xmlns:PREFIX attribute + will be added for each pair, and the prefix from the first such pair + will be used as the tag's namespace. If you wish to specify a default + namespace, use '#default' for the prefix. If the default namespace is + first, then the tag will use the default namespace itself. + + If you want to specify a namespace as well as attributes, you can make + the second argument a hash ref. If you do it the other way around, the + array ref will simply get stringified and included as part of the + content of the tag. + + Here's an example to show how the attribute and namespace parameters + work: + + $xml = $gen->account( + $gen->open(['transaction'], 2000), + $gen->deposit(['transaction'], { date => '1999.04.03'}, 1500) + ); + + This generates: + + + 2000 + 1500 + + + Because default namespaces inherit, XML::Generator takes care to output + the xmlns="URI" attribute as few times as strictly necessary. For + example, + + $xml = $gen->account( + $gen->open(['transaction'], 2000), + $gen->deposit(['transaction'], { date => '1999.04.03'}, + $gen->amount(['transaction'], 1500) + ) + ); + + This generates: + + + 2000 + + 1500 + + + + Notice how "xmlns="transaction"" was left out of the " tag. + + Here is an example that uses the two-argument form of the namespace: + + $xml = $gen->widget(['wru' => 'http://www.widgets-r-us.com/xml/'], + {'id' => 123}, $gen->contents()); + + + + + + Here is an example that uses multiple namespaces. It generates the first + example from the RDF primer (). + + my $contactNS = [contact => "http://www.w3.org/2000/10/swap/pim/contact#"]; + $xml = $gen->xml( + $gen->RDF([ rdf => "http://www.w3.org/1999/02/22-rdf-syntax-ns#", + @$contactNS ], + $gen->Person($contactNS, { 'rdf:about' => "http://www.w3.org/People/EM/contact#me" }, + $gen->fullName($contactNS, 'Eric Miller'), + $gen->mailbox($contactNS, {'rdf:resource' => "mailto:em@w3.org"}), + $gen->personalTitle($contactNS, 'Dr.')))); + + + + + Eric Miller + + Dr. + + + +CONSTRUCTOR + XML::Generator->new(':option', ...); + + XML::Generator->new(option => 'value', ...); + + (Both styles may be combined) + + The following options are available: + + :std, :standard + Equivalent to + + escape => 'always', + conformance => 'strict', + + :strict + Equivalent to + + conformance => 'strict', + + :pretty[=N] + Equivalent to + + escape => 'always', + conformance => 'strict', + pretty => N # N defaults to 2 + + namespace + This value of this option must be an array reference containing one or + two values. If the array contains one value, it should be a URI and will + be the value of an 'xmlns' attribute in the top-level tag. If there are + two or more elements, the first of each pair should be the namespace tag + prefix and the second the URI of the namespace. This will enable + behavior similar to the namespace behavior in previous versions; the tag + prefix will be applied to each tag. In addition, an xmlns:NAME="URI" + attribute will be added to the top-level tag. Prior to version 0.99, the + tag prefix was also automatically added to each attribute name, unless + overridden with an explicit prefix. Now, the attribute names are left + alone, but if the prior behavior is desired, use the constructor option + "qualified_attributes". + + The value of this option is used as the global default namespace. For + example, + + my $html = XML::Generator->new( + pretty => 2, + namespace => [HTML => "http://www.w3.org/TR/REC-html40"]); + print $html->html( + $html->body( + $html->font({ face => 'Arial' }, + "Hello, there"))); + + would yield + + + + Hello, there + + + + Here is the same example except without all the prefixes: + + my $html = XML::Generator->new( + pretty => 2, + namespace => ["http://www.w3.org/TR/REC-html40"]); + print $html->html( + $html->body( + $html->font({ 'face' => 'Arial' }, + "Hello, there"))); + + would yield + + + + Hello, there + + + + qualifiedAttributes, qualified_attributes + Set this to a true value to emulate the attribute prefixing behavior of + XML::Generator prior to version 0.99. Here is an example: + + my $foo = XML::Generator->new( + namespace => [foo => "http://foo.com/"], + qualifiedAttributes => 1); + print $foo->bar({baz => 3}); + + yields + + + + escape + The contents and the values of each attribute have any illegal XML + characters escaped if this option is supplied. If the value is 'always', + then &, < and > (and " within attribute values) will be converted into + the corresponding XML entity, although & will not be converted if it + looks like it could be part of a valid entity (but see below). If the + value is 'unescaped', then the escaping will be turned off + character-by-character if the character in question is preceded by a + backslash, or for the entire string if it is supplied as a scalar + reference. So, for example, + + use XML::Generator escape => 'always'; + + one('<'); # < + two('\&'); # \& + three(\''); # (scalar refs always allowed) + four('<'); # < (looks like an entity) + five('"'); # " (looks like an entity) + + but + + use XML::Generator escape => 'unescaped'; + + one('<'); # < + two('\&'); # & + three(\'');# (scalar refs always allowed) + four('<'); # &lt; (no special case for entities) + + By default, high-bit data will be passed through unmodified, so that + UTF-8 data can be generated with pre-Unicode perls. If you know that + your data is ASCII, use the value 'high-bit' for the escape option and + bytes with the high bit set will be turned into numeric entities. You + can combine this functionality with the other escape options by + comma-separating the values: + + my $a = XML::Generator->new(escape => 'always,high-bit'); + print $a->foo("<\242>"); + + yields + + <¢> + + Because XML::Generator always uses double quotes ("") around attribute + values, it does not escape single quotes. If you want single quotes + inside attribute values to be escaped, use the value 'apos' along with + 'always' or 'unescaped' for the escape option. For example: + + my $gen = XML::Generator->new(escape => 'always,apos'); + print $gen->foo({'bar' => "It's all good"}); + + + + If you actually want & to be converted to & even if it looks like it + could be part of a valid entity, use the value 'even-entities' along + with 'always'. Supplying 'even-entities' to the 'unescaped' option is + meaningless as entities are already escaped with that option. + + pretty + To have nice pretty printing of the output XML (great for config files + that you might also want to edit by hand), supply an integer for the + number of spaces per level of indenting, eg. + + my $gen = XML::Generator->new(pretty => 2); + print $gen->foo($gen->bar('baz'), + $gen->qux({ tricky => 'no'}, 'quux')); + + would yield + + + baz + quux + + + You may also supply a non-numeric string as the argument to 'pretty', in + which case the indents will consist of repetitions of that string. So if + you want tabbed indents, you would use: + + my $gen = XML::Generator->new(pretty => "\t"); + + Pretty printing does not apply to CDATA sections or Processing + Instructions. + + conformance + If the value of this option is 'strict', a number of syntactic checks + are performed to ensure that generated XML conforms to the formal XML + specification. In addition, since entity names beginning with 'xml' are + reserved by the W3C, inclusion of this option enables several special + tag names: xmlpi, xmlcmnt, xmldecl, xmldtd, xmlcdata, and xml to allow + generation of processing instructions, comments, XML declarations, + DTD's, character data sections and "final" XML documents, respectively. + + Invalid characters (http://www.w3.org/TR/xml11/#charsets) will be + filtered out. To disable this behavior, supply the + 'filter_invalid_chars' option with the value 0. + + See "XML CONFORMANCE" and "SPECIAL TAGS" for more information. + + filterInvalidChars, filter_invalid_chars + Set this to a 1 to enable filtering of invalid characters, or to 0 to + disable the filtering. See http://www.w3.org/TR/xml11/#charsets for the + set of valid characters. + + allowedXMLTags, allowed_xml_tags + If you have specified 'conformance' => 'strict' but need to use tags + that start with 'xml', you can supply a reference to an array containing + those tags and they will be accepted without error. It is not an error + to supply this option if 'conformance' => 'strict' is not supplied, but + it will have no effect. + + empty + There are 5 possible values for this option: + + self - create empty tags as (default) + compact - create empty tags as + close - close empty tags as + ignore - don't do anything (non-compliant!) + args - use count of arguments to decide between and + + Many web browsers like the 'self' form, but any one of the forms besides + 'ignore' is acceptable under the XML standard. + + 'ignore' is intended for subclasses that deal with HTML and other SGML + subsets which allow atomic tags. It is an error to specify both + 'conformance' => 'strict' and 'empty' => 'ignore'. + + 'args' will produce if there are no arguments at all, or if there + is just a single undef argument, and otherwise. + + version + Sets the default XML version for use in XML declarations. See "xmldecl" + below. + + encoding + Sets the default encoding for use in XML declarations. + + dtd + Specify the dtd. The value should be an array reference with three + values; the type, the name and the uri. + +IMPORT ARGUMENTS + use XML::Generator ':option'; + + use XML::Generator option => 'value'; + + (Both styles may be combined) + + :import + Cause "use XML::Generator;" to export an "AUTOLOAD" to your package that + makes undefined subroutines generate XML tags corresponding to their + name. Note that if you already have an "AUTOLOAD" defined, it will be + overwritten. + + :stacked + Implies :import, but if there is already an "AUTOLOAD" defined, the + overriding "AUTOLOAD" will still give it a chance to run. See "STACKABLE + AUTOLOADs". + + ANYTHING ELSE + If you supply any other options, :import is implied and the + XML::Generator object that is created to generate tags will be + constructed with those options. + +XML CONFORMANCE + When the 'conformance' => 'strict' option is supplied, a number of + syntactic checks are enabled. All entity and attribute names are checked + to conform to the XML specification, which states that they must begin + with either an alphabetic character or an underscore and may then + consist of any number of alphanumerics, underscores, periods or hyphens. + Alphabetic and alphanumeric are interpreted according to the current + locale if 'use locale' is in effect and according to the Unicode + standard for Perl versions >= 5.6. Furthermore, entity or attribute + names are not allowed to begin with 'xml' (in any case), although a + number of special tags beginning with 'xml' are allowed (see "SPECIAL + TAGS"). Note that you can also supply an explicit list of allowed tags + with the 'allowed_xml_tags' option. + + Also, the filter_invalid_chars option is automatically set to 1 unless + it is explicitly set to 0. + +SPECIAL TAGS + The following special tags are available when running under strict + conformance (otherwise they don't act special): + + xmlpi + Processing instruction; first argument is target, remaining arguments + are attribute, value pairs. Attribute names are syntax checked, values + are escaped. + + xmlcmnt + Comment. Arguments are concatenated and placed inside + comment delimiters. Any occurences of '--' in the concatenated arguments + are converted to '--' + + xmldecl (@args) + Declaration. This can be used to specify the version, encoding, and + other XML-related declarations (i.e., anything inside the tag). + @args can be used to control what is output, as keyword-value pairs. + + By default, the version is set to the value specified in the + constructor, or to 1.0 if it was not specified. This can be overridden + by providing a 'version' key in @args. If you do not want the version at + all, explicitly provide undef as the value in @args. + + By default, the encoding is set to the value specified in the + constructor; if no value was specified, the encoding will be left out + altogether. Provide an 'encoding' key in @args to override this. + + If a dtd was set in the constructor, the standalone attribute of the + declaration will be set to 'no' and the doctype declaration will be + appended to the XML declartion, otherwise the standalone attribute will + be set to 'yes'. This can be overridden by providing a 'standalone' key + in @args. If you do not want the standalone attribute to show up, + explicitly provide undef as the value. + + xmldtd + DTD tag creation. The format of this method is different from + others. Since DTD's are global and cannot contain namespace information, + the first argument should be a reference to an array; the elements are + concatenated together to form the DTD: + + print $xml->xmldtd([ 'html', 'PUBLIC', $xhtml_w3c, $xhtml_dtd ]) + + This would produce the following declaration: + + + + Assuming that $xhtml_w3c and $xhtml_dtd had the correct values. + + Note that you can also specify a DTD on creation using the new() + method's dtd option. + + xmlcdata + Character data section; arguments are concatenated and placed inside + character data section delimiters. Any occurences of + ']]>' in the concatenated arguments are converted to ']]>'. + + xml + "Final" XML document. Must be called with one and exactly one + XML::Generator-produced XML document. Any combination of + XML::Generator-produced XML comments or processing instructions may also + be supplied as arguments. Prepends an XML declaration, and re-blesses + the argument into a "final" class that can't be embedded. + +CREATING A SUBCLASS + For a simpler way to implement subclass-like behavior, see "STACKABLE + AUTOLOADs". + + At times, you may find it desireable to subclass XML::Generator. For + example, you might want to provide a more application-specific interface + to the XML generation routines provided. Perhaps you have a custom + database application and would really like to say: + + my $dbxml = new XML::Generator::MyDatabaseApp; + print $dbxml->xml($dbxml->custom_tag_handler(@data)); + + Here, custom_tag_handler() may be a method that builds a recursive XML + structure based on the contents of @data. In fact, it may even be named + for a tag you want generated, such as authors(), whose behavior changes + based on the contents (perhaps creating recursive definitions in the + case of multiple elements). + + Creating a subclass of XML::Generator is actually relatively + straightforward, there are just three things you have to remember: + + 1. All of the useful utilities are in XML::Generator::util. + + 2. To construct a tag you simply have to call SUPER::tagname, + where "tagname" is the name of your tag. + + 3. You must fully-qualify the methods in XML::Generator::util. + + So, let's assume that we want to provide a custom HTML table() method: + + package XML::Generator::CustomHTML; + use base 'XML::Generator'; + + sub table { + my $self = shift; + + # parse our args to get namespace and attribute info + my($namespace, $attr, @content) = + $self->XML::Generator::util::parse_args(@_) + + # check for strict conformance + if ( $self->XML::Generator::util::config('conformance') eq 'strict' ) { + # ... special checks ... + } + + # ... special formatting magic happens ... + + # construct our custom tags + return $self->SUPER::table($attr, $self->tr($self->td(@content))); + } + + That's pretty much all there is to it. We have to explicitly call + SUPER::table() since we're inside the class's table() method. The others + can simply be called directly, assuming that we don't have a tr() in the + current package. + + If you want to explicitly create a specific tag by name, or just want a + faster approach than AUTOLOAD provides, you can use the tag() method + directly. So, we could replace that last line above with: + + # construct our custom tags + return $self->XML::Generator::util::tag('table', $attr, ...); + + Here, we must explicitly call tag() with the tag name itself as its + first argument so it knows what to generate. These are the methods that + you might find useful: + + XML::Generator::util::parse_args() + This parses the argument list and returns the namespace (arrayref), + attributes (hashref), and remaining content (array), in that order. + + XML::Generator::util::tag() + This does the work of generating the appropriate tag. The first + argument must be the name of the tag to generate. + + XML::Generator::util::config() + This retrieves options as set via the new() method. + + XML::Generator::util::escape() + This escapes any illegal XML characters. + + Remember that all of these methods must be fully-qualified with the + XML::Generator::util package name. This is because AUTOLOAD is used by + the main XML::Generator package to create tags. Simply calling + parse_args() will result in a set of XML tags called . + + Finally, remember that since you are subclassing XML::Generator, you do + not need to provide your own new() method. The one from XML::Generator + is designed to allow you to properly subclass it. + +STACKABLE AUTOLOADs + As a simpler alternative to traditional subclassing, the "AUTOLOAD" that + "use XML::Generator;" exports can be configured to work with a + pre-defined "AUTOLOAD" with the ':stacked' option. Simply ensure that + your "AUTOLOAD" is defined before "use XML::Generator ':stacked';" + executes. The "AUTOLOAD" will get a chance to run first; the subroutine + name will be in your $AUTOLOAD as normal. Return an empty list to let + the default XML::Generator "AUTOLOAD" run or any other value to abort + it. This value will be returned as the result of the original method + call. + + If there is no "import" defined, XML::Generator will create one. All + that this "import" does is export AUTOLOAD, but that lets your package + be used as if it were a subclass of XML::Generator. + + An example will help: + + package MyGenerator; + + my %entities = ( copy => '©', + nbsp => ' ', ... ); + + sub AUTOLOAD { + my($tag) = our $AUTOLOAD =~ /.*::(.*)/; + + return $entities{$tag} if defined $entities{$tag}; + return; + } + + use XML::Generator qw(:pretty :stacked); + + This lets someone do: + + use MyGenerator; + + print html(head(title("My Title", copy()))); + + Producing: + + + + My Title© + + + +AUTHORS + Benjamin Holzman + Original author and maintainer + + Bron Gondwana + First modular version + + Nathan Wiger + Modular rewrite to enable subclassing + +LICENSE + This library is free software, you can redistribute it and/or modify it + under the same terms as Perl itself. + +SEE ALSO + The XML::Writer module + http://search.cpan.org/search?mode=module&query=XML::Writer - - - - - - - - -RECENT CHANGES ------- ------- - -1.04 Fri Jul 15 08:35:00 2011 - - Added the filter_invalid_chars option, which is turned on by default - under strict mode. - - -COPYRIGHT ---------- -Copyright 1999-2011 Benjamin Holzman. All rights reserved. -This program is free software; you can redistribute it and/or -modify it under the same terms as Perl itself. diff -Nru libxml-generator-perl-1.04/SIGNATURE libxml-generator-perl-1.09/SIGNATURE --- libxml-generator-perl-1.04/SIGNATURE 1970-01-01 00:00:00.000000000 +0000 +++ libxml-generator-perl-1.09/SIGNATURE 2022-02-19 03:06:28.000000000 +0000 @@ -0,0 +1,49 @@ +This file contains message digests of all files listed in MANIFEST, +signed via the Module::Signature module, version 0.87. + +To verify the content in this distribution, first make sure you have +Module::Signature installed, then type: + + % cpansign -v + +It will check each file's integrity, as well as the signature's +validity. If "==> Signature verified OK! <==" is not displayed, +the distribution may already have been compromised, and you should +not run its Makefile.PL or Build.PL. + +-----BEGIN PGP SIGNED MESSAGE----- +Hash: RIPEMD160 + +SHA256 09df2573b370bbb510a6cfc8fc2e8e231c4f84c0bc7bcd3aaef3f5cf6f5849fc Changes +SHA256 b88b789137c6fd25a9bdf5ae029e85fc6791e74836ed86a17cdf1d4cc2b1b5e6 LICENSE +SHA256 1cf8cb7bc4a2947a85c8abb61ee6500f45e69692d082a3b4d0e4f4fb0f6ecb60 MANIFEST +SHA256 e45faa4463a7955ab34bfb3ed97b265b6e2ef5e48c9b2c52e56a9952da02fae7 META.json +SHA256 eec85a3956f09a91500343c7762b65280d037c4fbdd697adea5ea9b985d263d1 META.yml +SHA256 ae49438960793cc2a2d4b312f20aeebb1c7be5a94c2d6de4fa2b8b367f715b22 Makefile.PL +SHA256 24a10e8d13fb97b639ede7ed0160a89547078560a92673008de2ceb2b6318e67 README +SHA256 7ec602fef233659ba0ee4a50452c862f1861a38f9efa1b35b27c44bd77a536ed cpanfile +SHA256 a0936681ffe8be1668a169a5c738553f1c9d3a784148253a745f60aaea828529 dist.ini +SHA256 b495d2f722c7c59a0e1f4d47dd295c451adf32d72e68f3a9959bdb4ef8a8780b lib/XML/Generator.pm +SHA256 49e2f78818c3889b932e1b78cd9ca255d29cc1312059e392b988b6f1a628053f lib/XML/Generator/DOM.pm +SHA256 7df7002f3564227c578941eb38261186a00f48ced00eb51eb9e3cd7962855cea t/DOM.t +SHA256 074441a89b9be524727453ff2222b55fc65bde45aedff4eec9a5c9f397cad4b0 t/Generator.t +SHA256 e9f306660ec98b16b525dbe0aeb85ad9bef881e7cf01b7ca9528aed24ebacad5 t/Issue-70986.t +SHA256 fb0fa5c911eed07be6b0ac4ec3fe2df9401c1e47b1148f8ed38ec5c9e166f5b8 t/Issue-80273.t +SHA256 5a08af3d3cd7f85780e9fe2422d142fd6c8551f22d09bd3097cee8ced7c56d7b t/author-pod-spell.t +SHA256 305c657c6b73f10767a0ea286b8a73d693940f4cbb8b6a0a4d34e2b5a1c04635 t/author-pod-syntax.t +-----BEGIN PGP SIGNATURE----- + +iQIzBAEBAwAdFiEEMguXHBCUSzAt6mNu1fh7LgYGpfkFAmIQXrQACgkQ1fh7LgYG +pfkydxAApLPxmK6sLtx2c23hKzUo4/eos/O8ihgJO/PuH4lEqZgxIMntGdUGilwh +JHpbAMuL5QD9qtGYhF+pQZSyZqv3N/bOBhct9S99AyqVxH/MhIRjBCMyF3XJanju +nCQiUQ5pW476htxRlOvkXJ/blovf5SvU5xI+uUkVk/ZPjfkHO4ALXi1Q7gFri58d +4aWUGJNDN9O7xSuhHY4egD5NVC8bkszvNcnyg9oGmUgq/rWlESXbL7LU3vsLy6Gy +SsWlrro8uKRY7QwkQfCD8N5zB7/KpFJyJCykiWcy+h+Elxeo2XJ7bjXRqy/hCFLr +epSHrmbIB02xTey3Z6oHi5SBhPT2ty6lh+51oPkQAt0OTVXNzLVMt5Dz5DnsVDoE +/fwGSSDXORkjbNqMAjbe1rHNeMENXVTu0p7PwBoYdduNZ+UeY0Qn781+I3JUix/j +uIj6ndHHqTOtF5r1alPhf50y+bFWXVG9M+R6MIZz/6ezusJ4IHcZPelatE+89yWR +e338TFYkJA2DayV9wgGTTyY1xzZDkiOKBkwYRvQVWTsQlQ46uX8kjvmKxASFstDZ +7OK6ciY/ClxXbVCX4+Hr3T/mfN+4+mE4oqiEHCzmrC8XnHKCmsi2YKsHO/SIsBad +b/yY+jTxiCa7EmFtQTTUm+8Ob3Ng86NSMLieiTY4znHarakI89E= +=rHIz +-----END PGP SIGNATURE----- diff -Nru libxml-generator-perl-1.04/t/author-pod-spell.t libxml-generator-perl-1.09/t/author-pod-spell.t --- libxml-generator-perl-1.04/t/author-pod-spell.t 1970-01-01 00:00:00.000000000 +0000 +++ libxml-generator-perl-1.09/t/author-pod-spell.t 2022-02-19 03:06:28.000000000 +0000 @@ -0,0 +1,51 @@ + +BEGIN { + unless ($ENV{AUTHOR_TESTING}) { + print qq{1..0 # SKIP these tests are for testing by the author\n}; + exit + } +} + +use strict; +use warnings; +use Test::More; + +# generated by Dist::Zilla::Plugin::Test::PodSpelling 2.007005 +use Test::Spelling 0.12; +use Pod::Wordlist; + + +add_stopwords(); +all_pod_files_spelling_ok( qw( bin lib ) ); +__DATA__ +Benjamin +Bron +CDATA +DOM +DTD +Generator +Gondwana +Holzman +RDF +STACKABLE +Wiger +XML +allowedXMLTags +apos +atributes +bholzman +declartion +desireable +doctype +dtd +eg +filterInvalidChars +lib +qualifiedAttributes +xml +xmlcdata +xmlcmnt +xmldecl +xmldtd +xmlns +xmlpi diff -Nru libxml-generator-perl-1.04/t/author-pod-syntax.t libxml-generator-perl-1.09/t/author-pod-syntax.t --- libxml-generator-perl-1.04/t/author-pod-syntax.t 1970-01-01 00:00:00.000000000 +0000 +++ libxml-generator-perl-1.09/t/author-pod-syntax.t 2022-02-19 03:06:28.000000000 +0000 @@ -0,0 +1,15 @@ +#!perl + +BEGIN { + unless ($ENV{AUTHOR_TESTING}) { + print qq{1..0 # SKIP these tests are for testing by the author\n}; + exit + } +} + +# This file was automatically generated by Dist::Zilla::Plugin::PodSyntaxTests. +use strict; use warnings; +use Test::More; +use Test::Pod 1.41; + +all_pod_files_ok(); diff -Nru libxml-generator-perl-1.04/t/DOM.t libxml-generator-perl-1.09/t/DOM.t --- libxml-generator-perl-1.04/t/DOM.t 2004-03-23 15:39:36.000000000 +0000 +++ libxml-generator-perl-1.09/t/DOM.t 2022-02-19 03:06:28.000000000 +0000 @@ -7,7 +7,7 @@ exit; } -plan tests => 35; +plan tests => 36; require XML::Generator::DOM; @@ -23,6 +23,9 @@ $xml = $x->baz({'foo'=>3}); ok($xml->toString, ''); +$xml = $x->password('パスワードをお忘れの方'); +ok($xml->toString, 'パスワードをお忘れの方'); + $xml = $x->bam({'bar'=>42},$x->foo(),"qux"); ok($xml->toString, 'qux'); diff -Nru libxml-generator-perl-1.04/t/Generator.t libxml-generator-perl-1.09/t/Generator.t --- libxml-generator-perl-1.04/t/Generator.t 2011-07-15 12:38:30.000000000 +0000 +++ libxml-generator-perl-1.09/t/Generator.t 2022-02-19 03:06:28.000000000 +0000 @@ -1,8 +1,9 @@ #!/usr/bin/perl -w use Test; +use utf8; -BEGIN { $| = 1; plan tests => 100; } +BEGIN { $| = 1; plan tests => 105; } use XML::Generator (); ok(1); @@ -260,10 +261,26 @@ '); +$x = XML::Generator->new(); +$xml = $x->foo('パスワードをお忘れの方'); +ok($xml, 'パスワードをお忘れの方'); + +$x = XML::Generator->new(':strict'); +$xml = $x->foo('パスワードをお忘れの方'); +ok($xml, 'パスワードをお忘れの方'); +ok($xml, "\x{30D1}\x{30B9}\x{30EF}\x{30FC}\x{30C9}\x{3092}\x{304A}\x{5FD8}\x{308C}\x{306E}\x{65B9}"); + +$x = XML::Generator->new(':strict', escape => 'high-bit'); +$xml = $x->foo('パスワードをお忘れの方'); +ok($xml, 'パスワードをお忘れの方'); + $x = XML::Generator->new(':strict', escape => 'high-bit'); $xml = $x->foo("\\<\242", $x->xmlpi('g')); ok($xml, '<¢'); +$xml = $x->foo("\\<\x{2603}", $x->xmlpi('g')); +ok($xml, '<☃'); + { my $w; local $SIG{__WARN__} = sub { $w .= $_[0] }; $x = XML::Generator->new(':import'); ok($w =~ /Useless use of/, 1); $w = ''; diff -Nru libxml-generator-perl-1.04/t/Issue-70986.t libxml-generator-perl-1.09/t/Issue-70986.t --- libxml-generator-perl-1.04/t/Issue-70986.t 1970-01-01 00:00:00.000000000 +0000 +++ libxml-generator-perl-1.09/t/Issue-70986.t 2022-02-19 03:06:28.000000000 +0000 @@ -0,0 +1,42 @@ +use Test::More qw/ tests 12 /; + +use XML::Generator; +$s=XML::Generator->new( qw/ escape unescaped conformance strict pretty 2 /); + +my $xml = $s->testme({ message => 'x"y'}); +ok($xml eq ''); + +$xml = $s->testme({ message => 'x\"y'}); +ok($xml eq ''); + +$xml = $s->testme({ message => 'x""y' }); +ok($xml eq ''); + +$xml = $s->testme({ message => '"x""y' }); +ok($xml eq ''); + +$xml = $s->testme({message => 'x"\"y'}); +ok($xml eq ''); + +$xml = $s->testme({message => 'x\"\"y'}); +ok($xml eq ''); + +$s=XML::Generator->new( qw/ escape always conformance strict pretty 2 /); +$xml = $s->testme({ message => 'x"y'}); +ok($xml eq ''); + +$xml = $s->testme({ message => 'x\"y'}); +ok($xml eq ''); + +$xml = $s->testme({ message => 'x""y' }); +ok($xml eq ''); + +$xml = $s->testme({ message => '"x""y' }); +ok($xml eq ''); + +$xml = $s->testme({message => 'x"\"y'}); +ok($xml eq ''); + +$xml = $s->testme({message => 'x\"\"y'}); +ok($xml eq ''); +done_testing; diff -Nru libxml-generator-perl-1.04/t/Issue-80273.t libxml-generator-perl-1.09/t/Issue-80273.t --- libxml-generator-perl-1.04/t/Issue-80273.t 1970-01-01 00:00:00.000000000 +0000 +++ libxml-generator-perl-1.09/t/Issue-80273.t 2022-02-19 03:06:28.000000000 +0000 @@ -0,0 +1,80 @@ +use strict; + +use Test::More qw/ tests 1 /; + +use XML::Generator; + +my $XML = XML::Generator->new(conformance => "strict"); + +my $result = $XML->record(join "\n", map { my ($k, $v) = @{$_}; $XML->$k($v); } + ( + [threat => 1], + [desc => "godzilla"], + [value => "http://y.ahoooooooooo.it/0weifjwef"], + [detected => "2012-10-16 00:00:00"] + )); + +my $expected_result = '1 +godzilla +http://y.ahoooooooooo.it/0weifjwef +2012-10-16 00:00:00'; + +ok($result eq $expected_result, 'Got expected results'); +exit; +$XML = XML::Generator->new(); + +$result = $XML->record( + join "\n", map { my ($k, $v) = @{$_}; $XML->$k($v); } + ( + [threat => 1], + [desc => "gozdilla"], + [value => "http://y.ahoooooooooo.it/0weifjwef"], + [detected => "2012-10-16 00:00:00"] + )); + +$expected_result = '1 +gozdilla +http://y.ahoooooooooo.it/0weifjwef +2012-10-16 00:00:00'; + +ok($result eq $expected_result, 'Got expected results'); + +my $XML = XML::Generator->new(conformance => "strict", pretty => 1); + +$result = $XML->record( + map { my ($k, $v) = @{$_}; $XML->$k($v); } + ( + [threat => 1], + [desc => "godzilla"], + [value => "http://y.ahoooooooooo.it/0weifjwef"], + [detected => "2012-10-16 00:00:00"] + )); + +$expected_result = ' + 1 + godzilla + http://y.ahoooooooooo.it/0weifjwef + 2012-10-16 00:00:00 +'; + +ok($result eq $expected_result, 'Got expected results'); + +$XML = XML::Generator->new(conformance => "strict", pretty => 1); + +$result = $XML->record( + map { my ($k, $v) = @{$_}; $XML->$k($v); } + ( + [threat => 1], + [desc => "godzilla"], + [value => "http://y.ahoooooooooo.it/0weifjwef"], + [detected => "2012-10-16 00:00:00"] + )); + +$expected_result = ' + 1 + godzilla + http://y.ahoooooooooo.it/0weifjwef + 2012-10-16 00:00:00 +'; + +ok($result eq $expected_result, 'Got expected results');