view release on metacpan or  search on metacpan

t/01-options.t  view on Meta::CPAN

is(  `$XML_GREP2 -q $foo $DATA`, '', '-q no hit');
ok(  system( "$XML_GREP2 -q $foo $DATA"), '-q no hit (exit code)');
is(  `$XML_GREP2 -q -c $foo $DATA`, '', '-q -c no hit');
ok(  system( "$XML_GREP2 -q -c $foo $DATA"), '-q -c no hit (exit code)');
is(  `$XML_GREP2 -q -t $foo $DATA`, '', '-q -c no hit');
ok(  system( "$XML_GREP2 -q -t $foo $DATA"), '-q -c no hit (exit code)');

is(  `$XML_GREP2 -q -v $xel2 $DATA`, '', '-q -v');
is(  system( "$XML_GREP2 -q $xel2 $DATA"), 0, '-q -v (exit code)');
is(  `$XML_GREP2 -q -v $xdoc $DATA`, '', '-q -v on doc');
ok(  system( "$XML_GREP2 -q -v $xdoc $DATA"), '-q -v on doc (exit code)');
is(  `$XML_GREP2 -q -v $xdocument $DATA`, '', '-q -v entire document');
ok(  system( "$XML_GREP2 -q -v $xdocument $DATA"), '-q -v entire document (exit code)');
is(  `$XML_GREP2 -q -v $foo $DATA`, '', '-q -v regular hit');
is(  system( "$XML_GREP2 -q -v $foo $DATA"), 0, '-q -v regular hit (exit code)');

like( `$XML_GREP2 $RECURSE -c $xdoc $TEST_DIR 2>&1`, 
    qr{xml_grep2: t/malformed.xml:2: parser error : Premature end of data in tag doc line 1\n},
    'malformed XML'
  );
is( `$XML_GREP2 $RECURSE -c -s $xdoc $TEST_DIR 2>&1`, "t/test.xml:1\n", 'malformed XML (-s)');

is( `$XML_GREP2 $RECURSE -q $xdoc $TEST_DIR 2>&1`, '', '-q with malformed XML');
is(  system( "$XML_GREP2 $RECURSE -q $xdoc $TEST_DIR 2>&1"), 0, '-q with malformed XML (exit code)');
is( `$XML_GREP2 $RECURSE -q $foo $TEST_DIR 2>&1`, '', '-q with malformed XML, no hit');
ok(  system( "$XML_GREP2 $RECURSE -q $foo $TEST_DIR 2>&1"), '-q with malformed XML, no hit (exit code)');

like( `$XML_GREP2 -v $foo $MALFORMED 2>&1`, qr{xml_grep2: t/malformed.xml:2: parser error : Premature end of data in tag doc line 1}, '-v on malformed data');
is( `$XML_GREP2 -v -s $foo $MALFORMED 2>&1`, '', '-v -s on malformed data');

is( `$CAT $DATA | $XML_GREP2 -v $xdoc`, '', '-v on entire doc');
like( `$CAT $DATA | $XML_GREP2 -v $xs1`, qr{<\?xml[^>]*>\s*<doc>\s*</doc>\s*$}, '-v on entire doc');

like( `$XML_GREP2 -v -X $xs1 $DATA`, qr{<\?xml version="1.0" encoding="UTF-8"\?>\s*<xg2:result_set xmlns:xg2="http://xmltwig.org/tools/xml_grep2/">\s*<doc>\s*</doc>\s*</xg2:result_set>\s*}, '-v -X');
is(  `$XML_GREP2 -v $xdocument $DATA`, '', '-q entire document');

test_encoding( "$XML_GREP2 -t $xs1 $LATIN1",    "été\n", "utf-8", "-t latin1 input, utf8 output");
test_encoding( "$XML_GREP2 -t -o $xs1 $LATIN1", "été\n", "iso-8859-1", "-t latin1 input, latin1 output");

test_encoding( "$XML_GREP2    $xs1 $LATIN1", wrapped( "<s1>été</s1>"), 'UTF-8', "latin1 input, utf8 output");
test_encoding( "$XML_GREP2 -o $xs1 $LATIN1", wrapped( "<s1>été</s1>", 'ISO-8859-1'), 'ISO-8859-1', "latin1 input, latin1 output");
test_encoding( "$XML_GREP2 -H -o $xs1 $LATIN1", wrapped( file_wrapped( qq{<s1>été</s1>}, $LATIN1), 'ISO-8859-1'), 'ISO-8859-1', "-H -o latin1");
test_encoding( "$XML_GREP2 -f 1 -H -o $xs1 $LATIN1", wrapped( file_wrapped( qq{    <s1>été</s1>}, $LATIN1), 'ISO-8859-1'), 'ISO-8859-1', "-H -o -f 1 latin1");

my $mode= 0000; chmod $mode, $MALFORMED or die "cannot chmod $mode $MALFORMED: $!";
is( `$XML_GREP2 $RECURSE $foo $TEST_DIR 2>&1`, "xml_grep2: $MALFORMED: Permission denied\n", 'test on unreadable file');
$mode= 0644; chmod $mode, $MALFORMED or die "cannot chmod $mode $MALFORMED: $!";

# prepare the catalog (make uri absolute)
system "$PERL -p -e$Q use Cwd; s{PWD}{cwd()}ge;$Q t/catalog.templ > t/catalog";
is( `$XML_GREP2 -t -C $TEST_DIR/catalog $xs1 $TEST_DIR/with_cat.cxml`, "entity c \n", "-C");

is( `$XML_GREP2 --html -t $xp $HTML`, "bar\n", '--html');
is( `$CAT $HTML | $XML_GREP2 --html -t $xp `, "bar\n", '--html (from STDIN)');



my $version= `$XML_GREP2 -V 1 2>&1`;
chomp $version;
like( `$XML_GREP2 -V 1 2>&1`, qr{xml_grep2 version \d+\.\d+$}, "version '$version' looks ok");


sub test_encoding
  { my( $command, $expected, $encoding, $message)= @_;
    unlink $TMP if -f $TMP;
    system( "$command > $TMP") && die "grep error: $@";
    binmode STDIN; 
    my $got= do { undef $/; open( my $in, "<:encoding($encoding)", $TMP) or die "error opening $TMP: $!"; <$in>; };
    is_fuzzy ( $got, $expected, $message);
    binmode STDIN, ':utf8'; 
   }



sub wrapped
  { my( $result, $encoding)= @_;
    return xmldecl( $encoding) . qq{<xg2:result_set xmlns:xg2="http://xmltwig.org/tools/xml_grep2/">$result</xg2:result_set>\n};
  }

sub xmldecl
  { my($encoding)= @_;
    $encoding ||= 'UTF-8';
    return qq{<?xml version="1.0" encoding="$encoding"?>};
  }

sub file_wrapped
  { my( $to_wrap, $file)= @_;
    $file ||= $DATA; 
    return qq{<xg2:file xg2:filename="$file">$to_wrap</xg2:file>};
  }

sub trace
  { my $command= join( ' ', @_);
    if( grep /-v/, $ARGV[0]) { warn "$command\n"; }
    return `$command`;
  }

sub is_fuzzy($$$)
  { my( $got, $expected, $message)= @_;
    (my $stripped_expected= $expected)=~ s{\s}{}g;
    (my $stripped_got= $got)=~ s{\s}{}g;
    if( $stripped_got eq $stripped_expected)
      { ok( 1, $message); }
    else
      { ok( 0, $message);
        warn "  got     : $got\n  expected:$expected\n";
        #warn "  got     : $stripped_got\n  expected: $stripped_expected\n";
      }
  }