view release on metacpan or  search on metacpan

t/2_XMLout.t  view on Meta::CPAN

like($_, qr{
  ^<(\w+)>\s*
    <dirs>\s*
      <dir
        (?:
          \s+first="/usr/bin"
         |\s+second="/usr/local/bin"
        ){2}\s*
      />\s*
    </dirs>\s*
  </\1>$
}x, 'Failed to unwrap/group stripped content - as expected');


# Check 'NoIndent' option

$ref = {
  nest   => [ qw(one two three) ]
};

# Expect:
#
# <opt><nest>one</nest><nest>two</nest><nest>three</nest></opt>
#

$_ = XMLout($ref, NoIndent => 1);

is_deeply(XMLin($_), $ref, 'parses ok');
is($_, '<opt><nest>one</nest><nest>two</nest><nest>three</nest></opt>',
'NoIndent worked ok');


# Check 'NoIndent' works with KeyAttr

$ref = {
  person => {
    bob  => { age => 25 },
    kate => { age => 22 },
  },
};

# Expect:
#
# <opt><person name="bob" age="25"><person name="kate" age="22"></opt>
#

$_ = XMLout($ref, NoIndent => 1, KeyAttr => {person => 'name'});

is_deeply(XMLin($_), $ref, 'parses ok');
like($_, qr{
  <opt>
    (
    <person(\s+name="bob"|\s+age="25"){2}\s*/>
    |<person(\s+name="kate"|\s+age="22"){2}\s*/>
    ){2}
  </opt>
}sx,
'NoIndent worked ok with KeyAttr');


# Try the 'AttrIndent' option (assume NoSort defaults to off)

$ref = {
  beta => '2',
  gamma => '3',
  alpha => '1',
  colours => {
    red => '#ff0000',
    green => '#00ff00',
  }
};

$_ = XMLout($ref, AttrIndent => 1, RootName => 'opt');

is($_, '<opt alpha="1"
     beta="2"
     gamma="3">
  <colours green="#00ff00"
           red="#ff0000" />
</opt>
', 'AttrIndent seems to work');


# Test the attribute/element sorting algorithm

$xml = q{
<opt>
  <test id="beta"  animal="elephant" vegetable="carrot" />
  <test id="gamma" animal="tiger"    vegetable="turnip" />
  <test id="alpha" animal="giraffe"  vegetable="pumpkin" />
  <box size="small" key="a" />
  <box size="medium" id="b" />
</opt>
};

$ref = XMLin($xml);

$_ = XMLout($ref, RootName => 'opt');

is($_, qq(<opt>\n) .
       qq(  <box name="a" size="small" />\n) .
       qq(  <box name="b" size="medium" />\n) .
       qq(  <test name="alpha" animal="giraffe" vegetable="pumpkin" />\n) .
       qq(  <test name="beta" animal="elephant" vegetable="carrot" />\n) .
       qq(  <test name="gamma" animal="tiger" vegetable="turnip" />\n) .
       qq(</opt>\n),
'sorting by default key attribute works');


# Try again but with specific key fields:

$ref = XMLin($xml, KeyAttr => {test => 'vegetable', box => 'size'});

$_ = XMLout($ref,
  RootName => 'opt',
  KeyAttr => {test => 'vegetable', box => 'size'}
);

is($_, qq(<opt>\n) .
       qq(  <box size="medium" id="b" />\n) .
       qq(  <box size="small" key="a" />\n) .
       qq(  <test vegetable="carrot" animal="elephant" id="beta" />\n) .
       qq(  <test vegetable="pumpkin" animal="giraffe" id="alpha" />\n) .
       qq(  <test vegetable="turnip" animal="tiger" id="gamma" />\n) .
       qq(</opt>\n),
'sorting by specified key attributes works');


# Try again but with no key fields:

$ref = XMLin($xml, KeyAttr => {});

$_ = XMLout($ref, RootName => 'opt', KeyAttr => {});

like($_, qr{^<opt>\s*
  (
    (
      <test\s+animal="elephant"\s+id="beta"\s+vegetable="carrot"\s*/>\s*
      <test\s+animal="tiger"\s+id="gamma"\s+vegetable="turnip"\s*/>\s*
      <test\s+animal="giraffe"\s+id="alpha"\s+vegetable="pumpkin"\s*/>\s*
    )