lukka1 has asked for the wisdom of the Perl Monks concerning the following question:

Hi experts,

I need to read a few columns from a database table and write out the result in a specified xml format.

For e.g say the table (called SKU) has the following data

#ITEM, LOC--->column headers

011-5000, DLSDC

011-5100, FRMNT

I need this to be written out in the following xml-format in a file say sku.xml. Since i did not know how the xml-formatting would come out in this message, i enclosed the desired/actual xml-format within code tags (though this is not actually code)

Desired_xml_format

=================

  <metadata>
    <field name="ITEM" alias="a1"/>
    <field name="LOC" alias="a2"/>
  </metadata>
  <data>
    <rec>
      <a1>011-5000</a1>
      <a2>DLSDC</a2>
    </rec>
    <rec>
      <a1>011-5100</a1>
      <a2>FRMNT</a2>
    </rec>
  </data>

[download]

I tried the following code to write this out in xml format. (since i am a newbie, i tried to search the perl monks/google repository and did a cut/paste of an example using modules like DBI; XML::Generator::DBI; XML::Handler::YAWriter; as follows. But this obviously gives me an output using the standard xml format (which is different from the desired output)

use strict;
use DBI;
use XML::Generator::DBI;
use XML::Handler::YAWriter;
my $dbh = DBI->connect ("dbi:Oracle:host=myhostname;sid=mysid;port=152
+1",
            "userid", "pwd",
      { RaiseError => 0, AutoCommit => 0,ora_envhp=> 0}); 

my $out = XML::Handler::YAWriter->new (AsFile => "sku.xml");
   my $gen = XML::Generator::DBI->new (
                                   Handler => $out,
                                   dbh => $dbh,
                                   Indent  => 1
                               );
   $gen->execute ("SELECT ITEM,LOC FROM SKU");
   $dbh->disconnect ();

[download]

The actual output i get using the above script is as follows

Actual_xml_format

=================

<?xml version="1.0" encoding="UTF-8"?><database>
 <select>
  <row>
   <ITEM>011-5000</ITEM>
   <LOC>DLSDC</LOC>
  </row>
  <row>
   <ITEM>011-5100</ITEM>
   <LOC>FRMNT</LOC>
  </row>
  <row>
 </select>
</database>

[download]

Can you point out what i need to do to get the output in the desired xml format. Are there some easy ways to get this done? (e.g. some other modules i need to use which give output using an aliased xml output similar to the desired output)?

Thank you in advance

Replies are listed 'Best First'.
Re: perl xml format question
by tobyink (Canon) on Jan 28, 2013 at 17:14 UTC 
    use strict;
use warnings;

use DBI;
use XML::LibXML 2;
use XML::LibXML::PrettyPrint qw(print_xml);

my $dbh = DBI->connect("dbi:SQLite:dbname=:memory:","","");

# Create demo data...
$dbh->do("CREATE TABLE sku (item text, loc text)");
$dbh->do("INSERT INTO sku VALUES ('011-5000', 'DLSDC')");
$dbh->do("INSERT INTO sku VALUES ('011-5100', 'FRMNT')");

my $xml  = XML::LibXML::Document->new();
my $root = XML::LibXML::Element->new('results');
$xml->setDocumentElement($root);

my $metadata = $root->addNewChild(undef, 'metadata');
my $data     = $root->addNewChild(undef, 'data');

my $sth = $dbh->prepare("SELECT * FROM sku");
my $meta_done = 0;  # false

$sth->execute;
while (my @row = $sth->fetchrow_array)
{
    unless ($meta_done)
    {
        my $alias_num = 0;
        for my $col (@{$sth->{NAME_uc}})
        {
            my $field = $metadata->addNewChild(undef, 'field');
            %$field = (
                name  => $col,
                alias => "a".++$alias_num,
            );
        }
        $meta_done = 1;
    }
    
    my $rec = $data->addNewChild(undef, 'rec');
    for my $i (1 .. @row)
    {
        $rec->addNewChild(undef, "a$i")->appendText($row[$i-1]);
    }
}


my $pretty = XML::LibXML::PrettyPrint->new(
    element => { compact => sub { ($_[0]->localname||'') =~ /^a[0-9]+$
+/ } },
);
$pretty->pretty_print($xml);
print $xml->toString;

    [download]
    package Cow { use Moo; has name => (is => 'lazy', default => sub { 'Mooington' }) } say Cow->new->name
[reply]
[d/l]

      Hi Tobyink, Thank you for your super-prompt and helpful response. I was getting the following error when i tried to use the code 

                  my $field = $metadata->addNewChild(undef, 'field');
            %$field = (
                name  => $col,
                alias => "a".++$alias_num,
            );

      [download]

      I got the error "Not a HASH reference at test1_perlmonk_suggestion.pl line 52". Any idea what i need to change to avoid this error

      I also got the following error "Issuing rollback() due to DESTROY without explicit disconnect() of DBD::Oracle::db handle (DESCRIPTION=(ADDRESS=(HOST=IN1NPDVMPMT02)(PROTOCOL=tcp)(PORT=1521))"

[reply]
[d/l]

        Are you using an oldish version of XML::LibXML perhaps?

        The ability to handle an element's attributes like a hash was only added in 1.91 IIRC.

        You can use setAttribute in older versions.

        package Cow { use Moo; has name => (is => 'lazy', default => sub { 'Mooington' }) } say Cow->new->name
[reply]
[d/l]

Back to Seekers of Perl Wisdom