#!/usr/bin/perl
#
# xml2json.pl - converts an XML file to JSON using XML::LibXML + JSON::PP.
# No Node.js dependency. JSON::PP is a Perl core module since 5.14.
#
# Usage: perl xml2json.pl input.xml > output.json
#
# Conversion convention (matches the node-based xml2json output):
#   - XML attributes become plain JSON keys (no prefix), listed first
#   - An element with only text and no attributes becomes a plain string
#   - An element with attributes and/or child elements becomes an object;
#     its text content, if any, goes into the key "$t"
#   - A repeated child element name becomes a JSON array (placed at the
#     position of its first occurrence); a single occurrence stays a
#     plain nested value
#   - Keys keep document order (JSON::PP cannot do that, so the small
#     ordered encoder below is used instead)
#   - The root element name is kept as the single top-level key
#   - An attribute and a child element with the same name would collide
#     without a prefix; the script dies with a message in that case
#     instead of silently losing data
#
use strict;
use warnings;
use XML::LibXML;
use JSON::PP;
# JSON::PP is only used to encode single strings (escaping, quoting)
my $jp = JSON::PP->new->allow_nonref;
my $path = shift @ARGV or die "Usage: $0 input.xml > output.json\n";
my $dom = XML::LibXML->load_xml( location => $path );
my $root = $dom->documentElement();
my $top = new_obj();
obj_add( $top, $root->nodeName(), node_to_value( $root ) );
binmode( STDOUT, ':encoding(UTF-8)' );
print encode_value( $top, 0 ), "\n";

# ordered object: keys in insertion order plus a lookup hash
sub new_obj {
  return { order => [], data => {} };
}

sub obj_add {
  my ( $obj, $key, $value ) = @_;
  die "Key collision on '$key' (attribute and child element share a name)\n" if exists $obj->{data}{$key};
  push @{ $obj->{order} }, $key;
  $obj->{data}{$key} = $value;
  return;
}

# returns a plain string (text-only element) or an ordered object
sub node_to_value {
  my ( $node ) = @_;
  my $obj = new_obj();
  my $text = '';
  my %groups;
  my @group_order;
  for my $attr ( $node->attributes() ) {
    obj_add( $obj, $attr->nodeName(), $attr->value() );
  }
  for my $child ( $node->childNodes() ) {
    my $type = $child->nodeType();
    if ( $type == XML_ELEMENT_NODE ) {
      my $name = $child->nodeName();
      push @group_order, $name unless exists $groups{$name};
      push @{ $groups{$name} }, node_to_value( $child );
    } elsif ( $type == XML_TEXT_NODE || $type == XML_CDATA_SECTION_NODE ) {
      $text .= $child->textContent();
    }
  }
  $text =~ s/^\s+|\s+$//g;
  # text-only element without attributes collapses to a plain string
  return $text if !@{ $obj->{order} } && !@group_order && length($text);
  obj_add( $obj, '$t', $text ) if length($text);
  for my $name ( @group_order ) {
    my $group = $groups{$name};
    obj_add( $obj, $name, ( scalar(@$group) == 1 ) ? $group->[0] : $group );
  }
  return $obj;
}

# pretty printer, 2-space indentation, same layout as JSON::PP->pretty
sub encode_value {
  my ( $v, $level ) = @_;
  my $pad = '  ' x ( $level + 1 );
  my $close = '  ' x $level;
  my @items;
  if ( ref($v) eq 'ARRAY' ) {
    return '[]' unless @$v;
    for my $elem ( @$v ) {
      push @items, $pad . encode_value( $elem, $level + 1 );
    }
    return "[\n" . join( ",\n", @items ) . "\n" . $close . ']';
  }
  if ( ref($v) eq 'HASH' ) {
    return '{}' unless @{ $v->{order} };
    for my $key ( @{ $v->{order} } ) {
      push @items, $pad . $jp->encode( $key ) . ': ' . encode_value( $v->{data}{$key}, $level + 1 );
    }
    return "{\n" . join( ",\n", @items ) . "\n" . $close . '}';
  }
  return $jp->encode( "$v" );
}