# $Id: 4_workout.t,v 1.3 2005/04/20 20:03:53 grantm Exp $
use strict;
use Test::More;
BEGIN { # Seems to be required by older Perls
unless(eval { require XML::SAX::Writer }) {
plan skip_all => 'XML::SAX::Writer not installed';
}
unless(eval { require XML::SAX::ParserFactory }) {
plan skip_all => 'XML::SAX::ParserFactory not installed';
}
unless(eval { require XML::SAX::Machines }) {
plan skip_all => 'XML::SAX::Machines not installed';
}
}
plan tests => 26;
use XML::Filter::Sort;
use XML::SAX::Machines qw( :all );
$^W = 1;
my(@opts, $xmlin, $xmlout, $sorter);
##############################################################################
# Global used to flag disk rather than memory buffering
#
@main::TempOpts = () unless(@main::TempOpts);
##############################################################################
# Sort using full text content as key (including leading digits)
#
$xmlin = q(<list>
<person>1<firstname>Zebedee</firstname></person>
<person>2<firstname>Yorick</firstname></person>
<person>3<firstname>Wayne</firstname></person>
<person>4<firstname>Xavier</firstname></person>
</list>);
$xmlout = '';
@opts = (Record => 'person');
push @opts, @main::TempOpts;
$sorter = Pipeline(
XML::Filter::Sort->new(@opts) => \$xmlout
);
$sorter->parse_string($xmlin);
fix_xml($xmlout);
is($xmlout, $xmlin, 'Default key to full text content, alpha, asc');
##############################################################################
# Sort using text content of specified child element as a key
#
$xmlout = '';
@opts = (
Record => 'person',
Keys => 'firstname',
);
push @opts, @main::TempOpts;
$sorter = Pipeline(XML::Filter::Sort->new(@opts) => \$xmlout);
$sorter->parse_string($xmlin);
fix_xml($xmlout);
is($xmlout, q(<list>
<person>3<firstname>Wayne</firstname></person>
<person>4<firstname>Xavier</firstname></person>
<person>2<firstname>Yorick</firstname></person>
<person>1<firstname>Zebedee</firstname></person>
</list>), 'Parsed key from string and extracted element content');
##############################################################################
# Check that a 'foreign' element in the middle of a sequence of records
# causes the records before and the records after to be sorted as two
# independent lists.
#
$xmlin = q(<list>
<person>1<firstname>Zebedee</firstname></person>
<person>2<firstname>Yorick</firstname></person>
<snackfood>popcorn</snackfood>
<person>3<firstname>Wayne</firstname></person>
<person>4<firstname>Xavier</firstname></person>
<trailer>0</trailer>
</list>);
$xmlout = '';
@opts = (
Record => 'person',
Keys => 'firstname',
);
push @opts, @main::TempOpts;
$sorter = Pipeline(XML::Filter::Sort->new(@opts) => \$xmlout);
$sorter->parse_string($xmlin);
fix_xml($xmlout);
is($xmlout, q(<list>
<person>2<firstname>Yorick</firstname></person>
<person>1<firstname>Zebedee</firstname></person>
<snackfood>popcorn</snackfood>
<person>3<firstname>Wayne</firstname></person>
<person>4<firstname>Xavier</firstname></person>
<trailer>0</trailer>
</list>), 'Sorted two independent lists (element between)');
##############################################################################
# Check that non-whitespace text causes the same effect.
#
$xmlin = q(<list>
<person>1<firstname>Zebedee</firstname></person>
<person>2<firstname>Yorick</firstname></person>
popcorn
<person>3<firstname>Wayne</firstname></person>
<person>4<firstname>Xavier</firstname></person>
</list>);
$xmlout = '';
@opts = (
Record => 'person',
Keys => 'firstname',
);
push @opts, @main::TempOpts;
$sorter = Pipeline(XML::Filter::Sort->new(@opts) => \$xmlout);
$sorter->parse_string($xmlin);
fix_xml($xmlout);
is($xmlout, q(<list>
<person>2<firstname>Yorick</firstname></person>
<person>1<firstname>Zebedee</firstname></person>
popcorn
<person>3<firstname>Wayne</firstname></person>
<person>4<firstname>Xavier</firstname></person>
</list>), 'Sorted two independent lists (text between - easy case)');
##############################################################################
# Repeat that last test with slightly different input data to expose a flaw
# which probably ought to be fixed.
#
$xmlin = q(<list>
<person>1<firstname>Zebedee</firstname></person>
<person>2<firstname>Yorick</firstname></person>
popcorn
<person>4<firstname>Xavier</firstname></person>
<person>3<firstname>Wayne</firstname></person>
</list>);
$xmlout = '';
@opts = (
Record => 'person',
Keys => 'firstname',
);
push @opts, @main::TempOpts;
$sorter = Pipeline(XML::Filter::Sort->new(@opts) => \$xmlout);
$sorter->parse_string($xmlin);
fix_xml($xmlout);
TODO: { local $TODO = 'Trailing whitespace on leading text not quite done';
is($xmlout, q(<list>
<person>2<firstname>Yorick</firstname></person>
<person>1<firstname>Zebedee</firstname></person>
popcorn
<person>3<firstname>Wayne</firstname></person>
<person>4<firstname>Xavier</firstname></person>
</list>), 'Sorted two independent lists (text between - pathological case)');
}
##############################################################################
# Now do a similar test with a comment separating the two record lists.
#
$xmlin = q(<list>
<person>1<firstname>Zebedee</firstname></person>
<person>2<firstname>Yorick</firstname></person>
<!-- popcorn -->
<person>4<firstname>Xavier</firstname></person>
<person>3<firstname>Wayne</firstname></person>
</list>);
$xmlout = '';
@opts = (
Record => 'person',
Keys => 'firstname',
);
push @opts, @main::TempOpts;
$sorter = Pipeline(XML::Filter::Sort->new(@opts) => \$xmlout);
$sorter->parse_string($xmlin);
fix_xml($xmlout);
is($xmlout, q(<list>
<person>2<firstname>Yorick</firstname></person>
<person>1<firstname>Zebedee</firstname></person>
<!-- popcorn -->
<person>3<firstname>Wayne</firstname></person>
<person>4<firstname>Xavier</firstname></person>
</list>), 'Sorted two independent lists (comment between)');
##############################################################################
# Same again but with a processing instruction separating the two record lists.
#
$xmlin = q(<list>
<person>1<firstname>Zebedee</firstname></person>
<person>2<firstname>Yorick</firstname></person>
<?snackfood what='popcorn'?>
<person>4<firstname>Xavier</firstname></person>
<person>3<firstname>Wayne</firstname></person>
</list>);
$xmlout = '';
@opts = (
Record => 'person',
Keys => 'firstname',
);
push @opts, @main::TempOpts;
$sorter = Pipeline(XML::Filter::Sort->new(@opts) => \$xmlout);
$sorter->parse_string($xmlin);
fix_xml($xmlout);
is($xmlout, q(<list>
<person>2<firstname>Yorick</firstname></person>
<person>1<firstname>Zebedee</firstname></person>
<?snackfood what='popcorn'?>
<person>3<firstname>Wayne</firstname></person>
<person>4<firstname>Xavier</firstname></person>
</list>), 'Sorted two independent lists (PI between)');
##############################################################################
# Check that as each record is buffered, reordered and spat back out, it
# retains its own leading whitespace.
#
$xmlin = q(<list>
<person><firstname>Zebedee</firstname></person>
<person><firstname>Yorick</firstname></person>
<person><firstname>Wayne</firstname></person>
<person><firstname>Xavier</firstname></person>
</list>);
$xmlout = '';
@opts = (
Record => 'person',
Keys => 'firstname',
);
push @opts, @main::TempOpts;
$sorter = Pipeline(XML::Filter::Sort->new(@opts) => \$xmlout);
$sorter->parse_string($xmlin);
fix_xml($xmlout);
is($xmlout, q(<list>
<person><firstname>Wayne</firstname></person>
<person><firstname>Xavier</firstname></person>
<person><firstname>Yorick</firstname></person>
<person><firstname>Zebedee</firstname></person>
</list>), 'Funky indentation preserved');
##############################################################################
# Throw a namespace definition into the mix and confirm it is ignored.
#
$xmlin = q(<list xmlns:bob='bob.com'>
<person>1<firstname>Zebedee</firstname></person>
<bob:person>2<firstname>Yorick</firstname></bob:person>
<person>3<firstname>Wayne</firstname></person>
<person>4<firstname>Xavier</firstname></person>
</list>);
$xmlout = '';
@opts = (
Record => 'person',
Keys => 'firstname',
);
push @opts, @main::TempOpts;
$sorter = Pipeline(XML::Filter::Sort->new(@opts) => \$xmlout);
$sorter->parse_string($xmlin);
fix_xml($xmlout);
is($xmlout, q(<list xmlns:bob='bob.com'>
<person>3<firstname>Wayne</firstname></person>
<person>4<firstname>Xavier</firstname></person>
<bob:person>2<firstname>Yorick</firstname></bob:person>
<person>1<firstname>Zebedee</firstname></person>
</list>), 'Record selection with optional namespace works');
##############################################################################
# Now sort only the records with no namespace
#
$xmlin = q(<list xmlns:bob='bob.com'>
<bob:person>1<firstname>Zebedee</firstname></bob:person>
<person>2<firstname>Yorick</firstname></person>
<person>3<firstname>Wayne</firstname></person>
<person xmlns='kate.com'>4<firstname>Xavier</firstname></person>
<person>5<firstname>Vernon</firstname></person>
<person>6<firstname>Trevor</firstname></person>
<person>7<firstname>Ulbrecht</firstname></person>
</list>);
$xmlout = '';
@opts = (
Record => '{}person',
Keys => 'firstname',
);
push @opts, @main::TempOpts;
$sorter = Pipeline(XML::Filter::Sort->new(@opts) => \$xmlout);
$sorter->parse_string($xmlin);
fix_xml($xmlout);
is($xmlout, q(<list xmlns:bob='bob.com'>
<bob:person>1<firstname>Zebedee</firstname></bob:person>
<person>3<firstname>Wayne</firstname></person>
<person>2<firstname>Yorick</firstname></person>
<person xmlns='kate.com'>4<firstname>Xavier</firstname></person>
<person>6<firstname>Trevor</firstname></person>
<person>7<firstname>Ulbrecht</firstname></person>
<person>5<firstname>Vernon</firstname></person>
</list>), 'Record selection with no namespace works');
##############################################################################
# Now sort only the records with specified namespace
#
$xmlin = q(<list xmlns:bob='bob.com'>
<bob:person>1<firstname>Zebedee</firstname></bob:person>
<bob:person>2<firstname>Yorick</firstname></bob:person>
<bob:person>3<firstname>Wayne</firstname></bob:person>
<person>4<firstname>Xavier</firstname></person>
<person>5<firstname>Vernon</firstname></person>
<person>6<firstname>Trevor</firstname></person>
<person>7<firstname>Ulbrecht</firstname></person>
</list>);
$xmlout = '';
@opts = (
Record => '{bob.com}person',
Keys => 'firstname',
);
push @opts, @main::TempOpts;
$sorter = Pipeline(XML::Filter::Sort->new(@opts) => \$xmlout);
$sorter->parse_string($xmlin);
fix_xml($xmlout);
is($xmlout, q(<list xmlns:bob='bob.com'>
<bob:person>3<firstname>Wayne</firstname></bob:person>
<bob:person>2<firstname>Yorick</firstname></bob:person>
<bob:person>1<firstname>Zebedee</firstname></bob:person>
<person>4<firstname>Xavier</firstname></person>
<person>5<firstname>Vernon</firstname></person>
<person>6<firstname>Trevor</firstname></person>
<person>7<firstname>Ulbrecht</firstname></person>
</list>), 'Record selection with specific namespace works');
##############################################################################
# Put some comments into the mix and confirm they are handled correctly.
#
$xmlin = q(<list>
<person>
<!-- three -->
<firstname>Zebedee</firstname>
</person>
<person>
<!-- one -->
<firstname>Xavier</firstname>
</person>
<person>
<!-- two -->
<firstname>Yorick</firstname>
</person>
</list>);
$xmlout = '';
@opts = (
Record => 'person',
Keys => 'firstname',
);
push @opts, @main::TempOpts;
$sorter = Pipeline(XML::Filter::Sort->new(@opts) => \$xmlout);
$sorter->parse_string($xmlin);
fix_xml($xmlout);
is($xmlout, q(<list>
<person>
<!-- one -->
<firstname>Xavier</firstname>
</person>
<person>
<!-- two -->
<firstname>Yorick</firstname>
</person>
<person>
<!-- three -->
<firstname>Zebedee</firstname>
</person>
</list>), 'Buffering of comments works');
##############################################################################
# Do the same with processing instructions.
#
$xmlin = q(<list>
<person>
<?pagebreak three?>
<firstname>Zebedee</firstname>
</person>
<person>
<?pagebreak one?>
<firstname>Xavier</firstname>
</person>
<person>
<?pagebreak two?>
<firstname>Yorick</firstname>
</person>
</list>);
$xmlout = '';
@opts = (
Record => 'person',
Keys => 'firstname',
);
push @opts, @main::TempOpts;
$sorter = Pipeline(XML::Filter::Sort->new(@opts) => \$xmlout);
$sorter->parse_string($xmlin);
fix_xml($xmlout);
is($xmlout, q(<list>
<person>
<?pagebreak one?>
<firstname>Xavier</firstname>
</person>
<person>
<?pagebreak two?>
<firstname>Yorick</firstname>
</person>
<person>
<?pagebreak three?>
<firstname>Zebedee</firstname>
</person>
</list>), 'Buffering of PIs works');
##############################################################################
# Run a multi-key sort - two alpha keys.
#
$xmlin = q(<directory>
<title>This is a list of names & ages</title>
<person age='35'>
<firstname>Zebedee</firstname>
<lastname>Boozle</lastname>
</person>
<person age='4'>
<firstname>Yorick</firstname>
<lastname>Cabbage</lastname>
</person>
<person age='39'>
<firstname>Yorick</firstname>
<lastname>Cabbage</lastname>
</person>
<person age='19'>
<firstname>Xavier</firstname>
<lastname>Aardvark</lastname>
</person>
<footer>The End!</footer>
</directory>);
$xmlout = '';
@opts = (
Record => 'person',
Keys => '
lastname
firstname
@age
',
);
push @opts, @main::TempOpts;
$sorter = Pipeline(XML::Filter::Sort->new(@opts) => \$xmlout);
$sorter->parse_string($xmlin);
fix_xml($xmlout);
is($xmlout, q(<directory>
<title>This is a list of names & ages</title>
<person age='19'>
<firstname>Xavier</firstname>
<lastname>Aardvark</lastname>
</person>
<person age='35'>
<firstname>Zebedee</firstname>
<lastname>Boozle</lastname>
</person>
<person age='39'>
<firstname>Yorick</firstname>
<lastname>Cabbage</lastname>
</person>
<person age='4'>
<firstname>Yorick</firstname>
<lastname>Cabbage</lastname>
</person>
<footer>The End!</footer>
</directory>), 'Multi-element records and multi-key sort OK');
##############################################################################
# Introduce a third sort key - numeric.
#
$xmlout = '';
@opts = (
Record => 'person',
Keys => '
lastname, alpha, asc
firstname, alpha, asc
@age, num, asc
',
);
push @opts, @main::TempOpts;
$sorter = Pipeline(XML::Filter::Sort->new(@opts) => \$xmlout);
$sorter->parse_string($xmlin);
fix_xml($xmlout);
is($xmlout, q(<directory>
<title>This is a list of names & ages</title>
<person age='19'>
<firstname>Xavier</firstname>
<lastname>Aardvark</lastname>
</person>
<person age='35'>
<firstname>Zebedee</firstname>
<lastname>Boozle</lastname>
</person>
<person age='4'>
<firstname>Yorick</firstname>
<lastname>Cabbage</lastname>
</person>
<person age='39'>
<firstname>Yorick</firstname>
<lastname>Cabbage</lastname>
</person>
<footer>The End!</footer>
</directory>), 'Numeric sort key OK');
##############################################################################
# Check that descending order works for both alpha and numeric sorts
#
$xmlout = '';
@opts = (
Record => 'person',
Keys => '
firstname, alpha, desc
lastname, alpha, asc
@age, num, desc
',
);
push @opts, @main::TempOpts;
$sorter = Pipeline(XML::Filter::Sort->new(@opts) => \$xmlout);
$sorter->parse_string($xmlin);
fix_xml($xmlout);
is($xmlout, q(<directory>
<title>This is a list of names & ages</title>
<person age='35'>
<firstname>Zebedee</firstname>
<lastname>Boozle</lastname>
</person>
<person age='39'>
<firstname>Yorick</firstname>
<lastname>Cabbage</lastname>
</person>
<person age='4'>
<firstname>Yorick</firstname>
<lastname>Cabbage</lastname>
</person>
<person age='19'>
<firstname>Xavier</firstname>
<lastname>Aardvark</lastname>
</person>
<footer>The End!</footer>
</directory>), 'Descending order OK');
##############################################################################
# Use a code reference rather than alpha or numeric comparator
#
$xmlin = q(<list>
<part>QX54763</part>
<part>AS87645</part>
<part>YT19895</part>
<part>RS04198</part>
</list>);
$xmlout = '';
@opts = (
Record => 'part',
Keys => [
[ '.' => sub {
my @nums = map { /(\d+)/ } @_;
$nums[0] <=> $nums[1];
} ]
]
);
push @opts, @main::TempOpts;
$sorter = Pipeline(XML::Filter::Sort->new(@opts) => \$xmlout);
$sorter->parse_string($xmlin);
fix_xml($xmlout);
is($xmlout, q(<list>
<part>RS04198</part>
<part>YT19895</part>
<part>QX54763</part>
<part>AS87645</part>
</list>), 'Coderef comparator OK');
##############################################################################
# Test that by default case of keys is significant
#
$xmlin = q(<options>
<colour>red</colour>
<colour>Green</colour>
<colour>blue</colour>
</options>);
$xmlout = '';
@opts = (
Record => 'colour',
);
push @opts, @main::TempOpts;
$sorter = Pipeline(XML::Filter::Sort->new(@opts) => \$xmlout);
$sorter->parse_string($xmlin);
fix_xml($xmlout);
is($xmlout, q(<options>
<colour>Green</colour>
<colour>blue</colour>
<colour>red</colour>
</options>), 'Case is significant by default');
##############################################################################
# But the IgnoreCase option fixes that
#
$xmlout = '';
@opts = (
Record => 'colour',
IgnoreCase => 1,
);
push @opts, @main::TempOpts;
$sorter = Pipeline(XML::Filter::Sort->new(@opts) => \$xmlout);
$sorter->parse_string($xmlin);
fix_xml($xmlout);
is($xmlout, q(<options>
<colour>blue</colour>
<colour>Green</colour>
<colour>red</colour>
</options>), 'IgnoreCase makes case insignificant');
##############################################################################
# Test that by default space in keys is significant
#
$xmlin = q(<options>
<colour id='7'> red</colour>
<colour id='2'>green</colour>
<colour id='1'> blue</colour>
<colour id='3'> light blue</colour>
<colour id='4'>light blue</colour>
<colour id='5'> light blue </colour>
<colour id='6'> light blue</colour>
</options>);
$xmlout = '';
@opts = (
Record => 'colour',
);
push @opts, @main::TempOpts;
$sorter = Pipeline(XML::Filter::Sort->new(@opts) => \$xmlout);
$sorter->parse_string($xmlin);
fix_xml($xmlout);
is($xmlout, q(<options>
<colour id='1'> blue</colour>
<colour id='6'> light blue</colour>
<colour id='5'> light blue </colour>
<colour id='3'> light blue</colour>
<colour id='7'> red</colour>
<colour id='2'>green</colour>
<colour id='4'>light blue</colour>
</options>), 'Space is significant by default');
##############################################################################
# But the NormaliseKeySpace option fixes that
#
$xmlout = '';
@opts = (
Record => 'colour',
NormaliseKeySpace => 1,
);
push @opts, @main::TempOpts;
$sorter = Pipeline(XML::Filter::Sort->new(@opts) => \$xmlout);
$sorter->parse_string($xmlin);
fix_xml($xmlout);
is($xmlout, q(<options>
<colour id='1'> blue</colour>
<colour id='2'>green</colour>
<colour id='3'> light blue</colour>
<colour id='4'>light blue</colour>
<colour id='5'> light blue </colour>
<colour id='6'> light blue</colour>
<colour id='7'> red</colour>
</options>), 'NormaliseKeySpace makes spaces insignificant');
##############################################################################
# And it fixes it for Americanz too
#
$xmlout = '';
$xmlin = q(<options>
<color id='7'> red</color>
<color id='2'>green</color>
<color id='1'> blue</color>
<color id='3'> light blue</color>
<color id='4'>light blue</color>
<color id='5'> light blue </color>
<color id='6'> light blue</color>
</options>);
$xmlout = '';
@opts = (
Record => 'color',
NormalizeKeySpace => 1,
# ^======= this is the bit we're testing
);
push @opts, @main::TempOpts;
$sorter = Pipeline(XML::Filter::Sort->new(@opts) => \$xmlout);
$sorter->parse_string($xmlin);
fix_xml($xmlout);
is($xmlout, q(<options>
<color id='1'> blue</color>
<color id='2'>green</color>
<color id='3'> light blue</color>
<color id='4'>light blue</color>
<color id='5'> light blue </color>
<color id='6'> light blue</color>
<color id='7'> red</color>
</options>), 'And it works for Americanz too');
##############################################################################
# Now try out the KeyFilterSub option.
#
$xmlout = '';
$xmlin = q(<options>
<color>red</color>
<color>green</color>
<color>orange</color>
<color>pink</color>
<color>blue</color>
</options>);
$xmlout = '';
@opts = (
Record => 'color',
KeyFilterSub => sub { map { scalar reverse($_) } @_; },
);
push @opts, @main::TempOpts;
$sorter = Pipeline(XML::Filter::Sort->new(@opts) => \$xmlout);
$sorter->parse_string($xmlin);
fix_xml($xmlout);
is($xmlout, q(<options>
<color>red</color>
<color>orange</color>
<color>blue</color>
<color>pink</color>
<color>green</color>
</options>), 'KeyFilterSub does its job');
##############################################################################
# Now try IgnoreCase, NormaliseKeySpace and KeyFilterSub simultaneously (and
# at the same time).
#
$xmlout = '';
$xmlin = q(<options>
<color id='1'>RED</color>
<color id='2'>green</color>
<color id='3'> light blue </color>
<color id='4'> LIGHT BLUE </color>
<color id='5'>orange</color>
<color id='6'>PINK</color>
<color id='7'>blue</color>
</options>);
$xmlout = '';
@opts = (
Record => 'color',
NormaliseKeySpace => 1,
IgnoreCase => 1,
KeyFilterSub => sub { map { scalar reverse($_) } @_; },
);
push @opts, @main::TempOpts;
$sorter = Pipeline(XML::Filter::Sort->new(@opts) => \$xmlout);
$sorter->parse_string($xmlin);
fix_xml($xmlout);
is($xmlout, q(<options>
<color id='1'>RED</color>
<color id='5'>orange</color>
<color id='7'>blue</color>
<color id='3'> light blue </color>
<color id='4'> LIGHT BLUE </color>
<color id='6'>PINK</color>
<color id='2'>green</color>
</options>), 'IgnoreCase, NormaliseKeySpace & KeyFilterSub play nicely');
##############################################################################
# Slightly unusual version of KeyFilterSub which combine multiple keys
# into one.
#
$xmlout = '';
$xmlin = q(<options>
<color prime='2'>red</color>
<color prime='23'>green</color>
<color prime='5'>orange</color>
<color prime='7'>BLUE</color>
<color prime='4'>RED</color>
<color prime='23'>Green</color>
<color prime='23'>orange</color>
<color prime='19'>blue</color>
</options>);
$xmlout = '';
@opts = (
Record => 'color',
Keys => '@prime, asc, desc; .',
IgnoreCase => 1,
KeyFilterSub => sub { sprintf("%02u%s", @_); },
);
push @opts, @main::TempOpts;
$sorter = Pipeline(XML::Filter::Sort->new(@opts) => \$xmlout);
$sorter->parse_string($xmlin);
fix_xml($xmlout);
is($xmlout, q(<options>
<color prime='23'>orange</color>
<color prime='23'>green</color>
<color prime='23'>Green</color>
<color prime='19'>blue</color>
<color prime='7'>BLUE</color>
<color prime='5'>orange</color>
<color prime='4'>RED</color>
<color prime='2'>red</color>
</options>), 'Synthetic key generation via KeyFilterSub');
##############################################################################
# Test that text content of '0' doesn't give us grief (any more).
#
$xmlin = q(<list>
<prefix>0</prefix>
<item>9</item>
<item>5</item>
<item>0</item>
<item>7</item>
<suffix>0</suffix>
</list>);
$xmlout = '';
@opts = (Record => 'item', Keys => '., num, asc');
push @opts, @main::TempOpts;
$sorter = Pipeline(
XML::Filter::Sort->new(@opts) => \$xmlout
);
$sorter->parse_string($xmlin);
fix_xml($xmlout);
is($xmlout, q(<list>
<prefix>0</prefix>
<item>0</item>
<item>5</item>
<item>7</item>
<item>9</item>
<suffix>0</suffix>
</list>), 'No problem with text content of "0" even in sort key');
##############################################################################
# S U B R O U T I N E S
##############################################################################
##############################################################################
# Sometimes the output from the SAX pipeline may not be exactly what we're
# expecting - for benign reasons. This routine strips the initial XML
# declaration which gets added by LibXML but not by other parsers. It also
# changes attribute double quotes to single.
#
sub fix_xml {
$_[0] =~ s{^<\?xml\s.*?\?>\s*}{}s;
$_[0] =~ s{(\w+)="([^>]*?)"}{$1='$2'}sg;
}