diff --git a/lib/XML/Generator.pm b/lib/XML/Generator.pm index 6f8c7e8..97ab756 100644 --- a/lib/XML/Generator.pm +++ b/lib/XML/Generator.pm @@ -435,6 +435,12 @@ Sets the default encoding for use in XML declarations. Specify the dtd. The value should be an array reference with three values; the type, the name and the uri. +=head2 xml + +This is an hash ref value that should contain the version, encoding and dtd +values (same as above). This is used in case C is set to C, +but you still want to use the xml declaration or prolog. + =head1 IMPORT ARGUMENTS use XML::Generator ':option'; @@ -620,6 +626,10 @@ sub new { $options{'escape'} = 0; } + if ($options{'xml'} && ref $options{'xml'} ne 'HASH') { + Carp::croak("XML arguments must be a hash"); + } + if (ref $options{'namespace'} eq 'ARRAY') { if (@{ $options{'namespace'} } > 2 && (@{ $options{'namespace'} } % 2) != 0) { Carp::croak "odd number of arguments for namespace"; @@ -768,23 +778,38 @@ explicitly provide undef as the value. =cut +sub _allow_xml_cmd { + my $this = shift; + return 1 if $this->{conformance} eq 'strict'; + return 1 if defined $this->{xml}; + return 0; +} + + sub xmldecl { - my($this, @args) = @_; + my $this = shift; - return $this->XML::Generator::util::tag('xmldecl', @_) - unless $this->{conformance} eq 'strict'; + return $this->XML::Generator::util::tag('xmldecl', @_) unless $this->{conformance} eq 'strict'; + return $this->_xmldecl(@_); +} + +sub _xmldecl { + my $this = shift; + my @args = @_; - my $version = $this->{'version'} || '1.0'; + return unless $this->_allow_xml_cmd; + + my $version = $this->{xml}{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'}; + my $encoding = $this->{xml}{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 $doctype = $this->xmldtd($this->{xml}{dtd} // $this->{dtd}); my $standalone = $doctype ? "no" : "yes"; for (my $i = 0; $i < $#args; $i += 2) { @@ -807,12 +832,9 @@ sub xmldecl { $version ||= ''; $standalone ||= ''; - my $xml = ""; - $xml .= "\n$doctype" if $doctype; - - $xml = "$xml\n"; - - return $xml; + my @xml = (""); + push(@xml, $doctype) if $doctype; + return join("\n", @xml, ""); } =head2 xmldtd @@ -883,7 +905,7 @@ sub xml { my $this = shift; return $this->XML::Generator::util::tag('xml', @_) - unless $this->{conformance} eq 'strict'; + unless $this->_allow_xml_cmd; unless (@_) { Carp::croak "usage: object->xml( (COMMENT | PI)* XML (COMMENT | PI)* )"; @@ -903,7 +925,7 @@ sub xml { } } - return XML::Generator::final->new([$this->xmldecl(), @_]); + return XML::Generator::final->new([$this->_xmldecl(), @_]); } =head1 CREATING A SUBCLASS diff --git a/t/Generator.t b/t/Generator.t index 684ec59..b8d0325 100644 --- a/t/Generator.t +++ b/t/Generator.t @@ -3,7 +3,7 @@ use Test; use utf8; -BEGIN { $| = 1; plan tests => 105; } +BEGIN { $| = 1; plan tests => 108; } use XML::Generator (); ok(1); @@ -90,6 +90,7 @@ ok($xml, ''); $x = new XML::Generator 'conformance' => 'strict', 'version' => '1.1', 'encoding' => 'iso-8859-2'; + $xml = $x->xmldecl(); ok($xml, qq(\n)); @@ -137,6 +138,41 @@ $xml = $x->foo(['bar' => 'bam'], {'baz:foo' => 'qux', 'fob' => 'gux'}); ok($xml eq '' || $xml eq '', 1, $xml); +$x = XML::Generator->new( + conformance => 'loose', + xml => { version => "1.0", encoding => 'UTF-8' }, +); + +ok( + $x->xml($x->foo), + join("\n", + '', + ''), + "Correct XML tag" +); + +$x = XML::Generator->new( + conformance => 'loose', + xml => { version => "1.0", encoding => 'UTF-8', dtd => [ 'foo' ] }, +); + +ok( + $x->xml($x->foo), + join("\n", + '', + '', + ''), + "Correct XML tag with doctype" +); + +eval { + XML::Generator->new( + conformance => 'loose', + xml => [], + ); +}; +ok $@ =~ qr/XML arguments must be a hash/; + $x = new XML::Generator; $xml = $x->xml(); ok($xml, '');