view release on metacpan or  search on metacpan

t/10XMLin.t  view on Meta::CPAN

  $opt = XMLin($xitems, keyattr => { item => 'name' }, @cont_key);
  is_deeply($opt, $items, "did not fold when element missing key attribute");
  like($last_warning, qr{^<item> element has no 'name' key attribute},
    'expected warning issued');

  $last_warning = '';
  $^W = 0;
  $opt = XMLin($xitems, keyattr => { item => 'name' }, @cont_key);
  is_deeply($opt, $items, "same again");
  is($last_warning, '', 'but with no warning this time');

  $last_warning = '';
  $^W = 1;
  $xitems = q(<opt>
    <item name="color">red</item>
    <item name="mass">heavy</item>
    <item name="disposition">ornery</item>
    <item name="color">green</item>
  </opt>);
  $items = {
    'item' => {
      'color'       => 'green',
      'mass'        => 'heavy',
      'disposition' => 'ornery',
    }
  };
  $opt = XMLin($xitems, keyattr => { item => 'name' }, @cont_key);
  is_deeply($opt, $items, "folded elements despite non-unique key attribute");
  like($last_warning, qr{^<item> element has non-unique value in 'name' key attribute: color},
    'expected warning issued');

  $last_warning = '';
  $opt = XMLin($xitems, keyattr => [ 'name' ], @cont_key);
  is_deeply($opt, $items, "same again but with keyattr as array");
  like($last_warning, qr{^<item> element has non-unique value in 'name' key attribute: color},
    'expected warning issued');

  $last_warning = '';
  $^W = 0;
  $opt = XMLin($xitems, keyattr => { item => 'name' }, @cont_key);
  is_deeply($opt, $items, "same again");
  is($last_warning, '', 'but with no warning this time');
}


# Make sure that the root element name is preserved if we ask for it

$target = XMLin("<opt>$xml</opt>", forcearray => 1,
                keyattr => { 'car' => '+license', 'option' => '-pn' },
                @cont_key);

$opt    = XMLin(      $xml,        forcearray => 1, keeproot => 1,
                keyattr => { 'car' => '+license', 'option' => '-pn' }, 
                @cont_key);

is_deeply($opt, $target, 'keeproot option works');


# confirm that CDATA sections parse correctly

$xml = q{<opt><cdata><![CDATA[<greeting>Hello, world!</greeting>]]></cdata></opt>};
$opt = XMLin($xml, @cont_key);
is_deeply($opt, {
  'cdata' => '<greeting>Hello, world!</greeting>'
}, 'CDATA section parsed correctly');

$xml = q{<opt><x><![CDATA[<y>one</y>]]><![CDATA[<y>two</y>]]></x></opt>};
$opt = XMLin($xml, @cont_key);
is_deeply($opt, {
  'x' => '<y>one</y><y>two</y>'
}, 'CDATA section containing markup characters parsed correctly');


# Try parsing a named external file

$@ = '';
$opt = eval{ XMLin($XMLFile); };
is($@, '', "XMLin didn't choke on named external file");
is_deeply($opt, {
  location => 't/test1.xml'
}, 'and contents parsed as expected');


# Try parsing default external file (scriptname.xml in script directory)

$@ = '';
$opt = eval { XMLin(); };
is($@, '', "XMLin didn't choke on un-named (default) external file");
is_deeply($opt, {location => 't/10XMLin.xml'}, 'and contents parsed as expected');

# Try parsing named file in a directory in the searchpath

$@ = '';
$opt = eval {
  XMLin('test2.xml', searchpath => [
    'dir1', 'dir2', File::Spec->catdir('t', 'subdir'), @cont_key
  ] );

};
is($@, '', 'XMLin found file using searchpath');
is_deeply($opt, {
  location => 't/subdir/test2.xml' 
}, 'and contents parsed as expected');


# Ensure we get expected result if file does not exist

$@ = '';
$opt = undef;
$opt = eval {
  XMLin('bogusfile.xml', searchpath => 't' ); # should 'die'
};
is($opt, undef, 'XMLin choked on nonexistant file');
like($@, qr/^data source bogusfile.xml not/, 'with the expected message');


# same again, but with no searchpath

$@ = '';
$opt = undef;
$opt = eval { XMLin('bogusfile.xml'); };
is($opt, undef, 'nonexistant file not found in current directory');
like($@, qr/data source bogusfile.xml not/, 'with the expected message');