XML created from JSON is not correctly nested using perl

Question

I'm trying to convert JSON data to XML using perl script. But the JSON when converted is not having the expected tags. Below is the input, code I used and output I received

{"status": "Success",
 "output":
     {"product_artifacts":
         [
             {"variant_name": "test_var",
 "artifacts":
                  [
                      {"artifact_created": "10-25-19 15:52:02",
 "artifact_download_link": "http://abc:rt/ ",
 "artifact_digital_size": 123,
 "artifact_number": "123/234",
 "artifact_revision": "AB1"}
                  ]
              }
         ]
      },
 "message":
     []
 }

Above Json when passed to the below Perl script, is not creating the XML as expected: Perl Script :

#!/app/perl/5.16.2/LMWP3/bin/perl

use strict;
use warnings;

binmode STDOUT, ":utf8";
use utf8;



use JSON;
use XML::Simple;

# Read input file in json format
my $json = '
{"status": "Success",
 "output":
     {"product_artifacts":
         [
             {"variant_name": "test_var",
 "artifacts":
                  [
                      {"artifact_created": "10-25-19 15:52:02",
 "artifact_download_link": "http://abc:rt/ ",
 "artifact_digital_size": 123,
 "artifact_number": "123/234",
 "artifact_revision": "AB1"}
                  ]
              }
         ]
      },
 "message":
     []
 }';

# Convert JSON format to perl structures
my $data = decode_json($json);

# Output as XML
print "<?xml version=\"1.0\" encoding=\"UTF-8\" ?>\n";
print XMLout($data);
print "\n";

Actual Output:

 <?xml version="1.0" encoding="UTF-8" standalone="yes"?>
<opt status="Success">
  <output>
    <product_artifacts variant_name="test_var">
      <artifacts artifact_created="10-25-19 15:52:02" artifact_digital_size="9293792" artifact_download_link="http://abc:rt " artifact_number="123/234" artifact_revision="AC" />
    </product_artifacts>
  </output>
</opt>

Expected output:

<?xml version="1.0" encoding="UTF-8" ?>
<root>
  <status>Success</status>
  <output>
    <product_artifacts>
      <variant_name>test_var</variant_name>
      <artifacts>
        <artifact_created>10-25-19 15:52:02</artifact_created>
        <artifact_download_link>http://asd:rt </artifact_download_link>
        <artifact_digital_size>123</artifact_digital_size>
        <artifact_number>1234</artifact_number>
        <artifact_revision>AC</artifact_revision>
      </artifacts>
    </product_artifacts>
  </output>
  <message/>
</root>

Can someone help where I'm going wrong

XML::Simple is terrible. It isn't consistent and its documentation discourages from using it. — simbabque
– simbabque, Commented Feb 25, 2020 at 9:21

Grinnz · Accepted Answer · 2020-02-25 23:23:56Z

Perl data structures do not directly map to XML. A hashref at a certain position for instance could be represented by attributes on a tag, or nested tags, which themselves might have attributes, tags, or text. So to get the output formatted the way you want, one way is to use templating to define the structure you want, such as with Mojo::Template.

use strict;
use warnings;
use Mojo::Template;

my $tmpl = <<'TMPL';
<?xml version="1.0" encoding="UTF-8" ?>
<root>
  <status><%= $data->{status} %></status>
  <output>
    <product_artifacts>
    % foreach my $variant (@{$data->{output}{product_artifacts}}) {
      <variant_name><%= $variant->{variant_name} %></variant_name>
      <artifacts>
      % foreach my $artifact (@{$variant->{artifacts}}) {
        % foreach my $key (sort keys %$artifact) {
          <<%= $key %>><%= $artifact->{$key} %></<%= $key %>>
        % }
      % }
      </artifacts>
    % }
    </product_artifacts>
  </output>
  <message/>
</root>
TMPL

my $t = Mojo::Template->new(auto_escape => 1, vars => 1);
my $xml = $t->render($tmpl, {data => $data});

Your expected format is still somewhat unclear - for example, consider how it should be laid out should you get multiple variants or artifacts in those arrays. These are some of the reasons automatic conversion is unlikely to do what you need.

Another approach is to use an XML traversal tool to build the XML appropriately, which is a bit more tedious but means you don't need to manually write tags, Mojo::DOM can be used for this purpose.

use strict;
use warnings;
use Mojo::DOM;

my $dom = Mojo::DOM->new->xml(1)->parse('<?xml version="1.0" encoding="UTF-8" ?><root/>');

my $root = $dom->at('root');
$root->append_content($dom->new_tag('status', $data->{status}));
$root->append_content($dom->new_tag('output'));
my $output = $root->at('output');
$output->append_content($dom->new_tag('product_artifacts'));
my $product_artifacts = $output->at('product_artifacts');
foreach my $variant (@{$data->{output}{product_artifacts}}) {
  $product_artifacts->append_content($dom->new_tag('variant_name', $variant->{variant_name}));
  $product_artifacts->append_content($dom->new_tag('artifacts'));
  my $artifacts = $product_artifacts->at('artifacts');
  foreach my $artifact (@{$variant->{artifacts}}) {
    foreach my $key (sort keys %$artifact) {
      $artifacts->append_content($dom->new_tag($key, $artifact->{$key}));
    }
  }
}
$root->append_content($dom->new_tag('message', $data->{message}));

my $xml = $dom->to_string;

These examples both result in the XML as characters; it should be encoded to UTF-8 when output to a file or otherwise.

Polar Bear · Accepted Answer · 2020-02-25 11:27:10Z

0

As of this moment no solution was offered.

Let me offer one of possible simple solution without use of any perl modules.

use strict;
use warnings;
use feature 'say';

use JSON;

binmode STDOUT, ":utf8";
use utf8;

my $json = '
{"status": "Success",
 "output":
    { "product_artifacts":
         [
            {
                "variant_name": "test_var",
                "artifacts":
                    [
                        {
                            "artifact_created": "10-25-19 15:52:02",
                            "artifact_download_link": "http://abc:rt/ ",
                            "artifact_digital_size": 123,
                            "artifact_number": "123/234",
                            "artifact_revision": "AB1"
                        }
                    ]
            }
         ]
    },
    "message":[]
 }';

# Convert JSON format to perl structures
my $data = decode_json($json);

say json2xml($data);

sub json2xml {
    my $data  = shift;

    my $xml = "<?xml version=\"1.0\" encoding=\"UTF-8\" ?>\n";

    $xml .= "<root>\n";
    $xml .= j2x($data,1);
    $xml .= "</root>\n";

    return $xml;
}

sub j2x {
    my $json  = shift;
    my $depth = shift;

    my $xml;
    my $indent = 2;
    my $space = ' ' x ($depth*$indent);

    while( my($k,$v) = each %{$json} ) {
        if( ref $v eq 'HASH' ) {
            $xml .= $space . "<$k>\n";
            $xml .= j2x($v,$depth+1);
            $xml .= $space . "</$k>\n";
        } elsif ( ref $v eq 'ARRAY' ) {
            $xml .= $space . "<$k>\n";
            foreach my $e (@{$v}) {
                $xml .= j2x($e,$depth+1);
            }
            $xml .= $space . "</$k>\n";
        } else {
            $xml .= $space . "<$k>$v</$k>\n";
        }
    }

    return $xml;
}

Output slightly different from desired as the code do not take into account empty xml element (empty JSON array in this particular case)

<?xml version="1.0" encoding="UTF-8" ?>
<root>
  <status>Success</status>
  <output>
    <product_artifacts>
      <variant_name>test_var</variant_name>
      <artifacts>
        <artifact_number>123/234</artifact_number>
        <artifact_created>10-25-19 15:52:02</artifact_created>
        <artifact_revision>AB1</artifact_revision>
        <artifact_digital_size>123</artifact_digital_size>
        <artifact_download_link>http://abc:rt/ </artifact_download_link>
      </artifacts>
    </product_artifacts>
  </output>
  <message>
  </message>
</root>

NOTE: In OP's post JSON and desired output does not match, due this reason produced output is representation of JSON data given in the post

edited Feb 25, 2020 at 11:27

answered Feb 25, 2020 at 11:16

Polar Bear

6,8061 gold badge8 silver badges13 bronze badges

2 Comments

Grinnz Over a year ago

Please do not offer a solution just because nobody has. This solution does not XML-escape values. A correct solution would be using an XML renderer or XML templater (my recommendation is Text::Xslate or Mojo::Template).

Polar Bear Over a year ago

@Grinnz -- post your solution for review. I am not very well versed on XML-escape values. I see input and desired output, mix in a little bit imagination and code is born to transfer input into output in simple easy way for educational purpose (those who is learning perl). This code is not intended for public CPAN module in any way -- for me it just a small brain exercise.

Sorin · Accepted Answer · 2020-02-28 20:18:51Z

Note that XML::Simple is deprecated, and the author himself recommends using other modules. However, I'm not aware of a module can be used to easily dump data structures into XML (except maybe XML::Dumper, but it has a very different output structure) without "manually" constructing the data structure.

For the desired output format, one needs to set the following options to the XMLOut function:

print XMLout($data,NoAttr => 1, RootName => 'root');

However, that will still leave the "message" tag, which is an empty array, and XML::Simple seems to silently discard it (yay!).

<root>
  <output>
    <product_artifacts>
      <artifacts>
        <artifact_created>10-25-19 15:52:02</artifact_created>
        <artifact_digital_size>123</artifact_digital_size>
        <artifact_download_link>http://abc:rt/ </artifact_download_link>
        <artifact_number>123/234</artifact_number>
        <artifact_revision>AB1</artifact_revision>
      </artifacts>
      <variant_name>test_var</variant_name>
    </product_artifacts>
  </output>
  <status>Success</status>
</root>

A crude workaround for that would be to set it to undef, and set the SuppressEmpty parameter to undef, but that would still not generate an identical output, since XML::Simple doesn't seem to generate empty tags.

See: https://ideone.com/kwqZzo for a demo and complete code.

Alternatively, you can construct the xml by hand using XML::Writer, but that strongly depends on the data. You may try a recursive approach, but that's going to be brittle. For the exact json and output in the question you might use something like this:

#!/app/perl/5.16.2/LMWP3/bin/perl

use strict;
use warnings;

binmode STDOUT, ":utf8";
use utf8;



use JSON;

use XML::Writer;

# Read input file in json format
my $json = qq(
{
  "status": "Success",
  "output": {
    "product_artifacts": [
      {
        "variant_name": "test_var",
        "artifacts": [
          {
            "artifact_created": "10-25-19 15:52:02",
            "artifact_download_link": "http://abc:rt/ ",
            "artifact_digital_size": 123,
            "artifact_number": "123/234",
            "artifact_revision": "AB1"
          }
        ]
      }
    ]
  },
  "message": []
}
);
my $data = decode_json($json);
my $writer = XML::Writer->new( OUTPUT => 'self',DATA_MODE => 1, DATA_INDENT => 4);

$writer->xmlDecl("UTF-8");
$writer->startTag('root');
    $writer->dataElement(status => $data->{status});
    $writer->startTag('output');
       for my $p (@{$data->{output}{product_artifacts}}) {
           $writer->startTag('product_artifacts');
           $writer->dataElement($_ => $p->{$_}) for qw(variant_name);
           for my $a (@{$p->{artifacts}}) {
               $writer->startTag('artifacts');
               $writer->dataElement($_ => $a->{$_}) for qw(artifact_created
                                                       artifact_download_link
                                                       artifact_digital_size
                                                       artifact_number
                                                       artifact_revision);
               $writer->endTag('artifacts');
           }
           $writer->endTag('product_artifacts');
       }
    $writer->endTag('output');
    $writer->emptyTag('message');
$writer->endTag('root');

print $writer->to_string();
print "\n";

Collectives™ on Stack Overflow

XML created from JSON is not correctly nested using perl

3 Answers 3

Comments

2 Comments

Comments

Your Answer

Linked

Hot Network Questions

Collectives™ on Stack Overflow

3 Answers 3

Comments

2 Comments

Comments

Your Answer

Sign up or log in

Post as a guest

Linked

Related