Add new xml option to constructor

This allows using the XML tag without having to define strict conformance. This
allows us to use XML::Generator like so:

    use XML::Generator;
    my $gen = XML::Generator->new('conformance' => loose, xml => { version =>
    "1.0", enconding => 'UTF-8');
    $gen->xml($gen->foo);

which returns

    <?xml version="1.0" encoding="UTF-8" standalone="yes"?><foo />

Signed-off-by: Wesley Schwengle <waterkip@cpan.org>

Author: waterkip

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<conformance> is set to C<loose>,
+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 <!DOCTYPE ...> 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$version$encoding$standalone?>";
-  $xml .= "\n$doctype" if $doctype;
-
-  $xml = "$xml\n";
-
-  return $xml;
+  my @xml = ("<?xml$version$encoding$standalone?>");
+  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

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, '<!-- test -->');
 $x = new XML::Generator 'conformance' => 'strict',
 			'version' => '1.1',
 			'encoding' => 'iso-8859-2';
+
 $xml = $x->xmldecl();
 ok($xml, qq(<?xml version="1.1" encoding="iso-8859-2" standalone="yes"?>\n));
 
@@ -137,6 +138,41 @@ $xml = $x->foo(['bar' => 'bam'], {'baz:foo' => 'qux', 'fob' => 'gux'});
 ok($xml eq '<bar:foo xmlns:bar="bam" baz:foo="qux" fob="gux" />' ||
    $xml eq '<bar:foo xmlns:bar="bam" fob="gux" baz:foo="qux" />', 1, $xml);
 
+$x = XML::Generator->new(
+    conformance => 'loose',
+    xml         => { version => "1.0", encoding => 'UTF-8' },
+);
+
+ok(
+    $x->xml($x->foo),
+    join("\n",
+        '<?xml version="1.0" encoding="UTF-8" standalone="yes"?>',
+        '<foo />'),
+    "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",
+        '<?xml version="1.0" encoding="UTF-8" standalone="no"?>',
+        '<!DOCTYPE foo>',
+        '<foo />'),
+    "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, '<xml />');