http://www.perlmonks.org?node_id=1015740


in reply to perl xml format question

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

Replies are listed 'Best First'.
Re^2: perl xml format question
by lukka1 (Initiate) on Jan 29, 2013 at 08:56 UTC

    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]

        Thanks, i was using an older version since ppm was only able to find/install the older version (XML::LibXML 1.7). After using setAttribute i was able to get the desired output. My database error is also gone. Thank you Tobyink

[reply]

In Section Seekers of Perl Wisdom