view release on metacpan or  search on metacpan

t/1_XMLin.t  view on Meta::CPAN

      'id' => 1,
      'make' => 'Ford',
      'option' => {
	  '6389733317-12' => { 'key' => 1, 'desc' => 'Electric Windows' },
	  '3735498158-01' => { 'key' => 2, 'desc' => 'Leather Seats' },
	  '5776155953-25' => { 'key' => 3, 'desc' => 'Sun Roof' }
      }
    }
  }
};

$opt = XMLin($xml, forcearray => 1, keyattr => { 'car' => 'license', 'option' => 'pn' });
ok(22, DataCompare($opt, $target));


# Now try leaving the keys in place

$target = {
  'car' => {
    'LW1804' => {
      'id' => 2,
      'make' => 'GM',
      'option' => {
	  '9926543-1167' => { 'key' => 1, 'desc' => 'Steering Wheel',
	                      '-pn' => '9926543-1167' }
      },
      license => 'LW1804'
    },
    'SH6673' => {
      'id' => 1,
      'make' => 'Ford',
      'option' => {
	  '6389733317-12' => { 'key' => 1, 'desc' => 'Electric Windows',
	                       '-pn' => '6389733317-12' },
	  '3735498158-01' => { 'key' => 2, 'desc' => 'Leather Seats',
	                       '-pn' => '3735498158-01' },
	  '5776155953-25' => { 'key' => 3, 'desc' => 'Sun Roof',
	                       '-pn' => '5776155953-25' }
      },
      license => 'SH6673'
    }
  }
};
$opt = XMLin($xml, forcearray => 1, keyattr => { 'car' => '+license', 'option' => '-pn' });
ok(23, DataCompare($opt, $target));


# 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' });

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

ok(24, DataCompare($opt, $target));


# confirm that CDATA sections parse correctly

$xml = q{<opt><cdata><![CDATA[<greeting>Hello, world!</greeting>]]></cdata></opt>};
$opt = XMLin($xml);
ok(25, DataCompare($opt, {
  'cdata' => '<greeting>Hello, world!</greeting>'
}));

$xml = q{<opt><x><![CDATA[<y>one</y>]]><![CDATA[<y>two</y>]]></x></opt>};
$opt = XMLin($xml);
ok(26, DataCompare($opt, {
  'x' => '<y>one</y><y>two</y>'
}));


# Try parsing a named external file

$opt = eval{ XMLin($XMLFile); };
ok(27, !$@);                                  # XMLin didn't die
print STDERR $@ if($@);
ok(28, DataCompare($opt, {
  location => 't/test1.xml'
}));


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

$opt = eval { XMLin(); };
print STDERR $@ if($@);
ok(29, !$@);                                  # XMLin didn't die
ok(30, DataCompare($opt, {
  location => 't/1_XMLin.xml'
}));


# Try parsing named file in a directory in the searchpath

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

};
print STDERR $@ if($@);
ok(31, !$@);                                  # XMLin didn't die
ok(32, DataCompare($opt, { location => 't/subdir/test2.xml' }));


# Ensure we get expected result if file does not exist

$opt = eval {
  XMLin('bogusfile.xml', searchpath => [qw(. ./t)] ); # should 'die'
};
ok(33, !defined($opt));                          # XMLin failed
ok(34, $@ =~ /Could not find bogusfile.xml in/); # with the expected message


# Try parsing from an IO::Handle

my $fh = new IO::File;
$XMLFile = File::Spec->catfile('t', '1_XMLin.xml');  # t/1_XMLin.xml
$fh->open($XMLFile) || die "$!";
$opt = XMLin($fh);
ok(35, 1);                                      # XMLin didn't die
ok(36, $opt->{location}, 't/1_XMLin.xml');      # and it parsed the right file