r9533 - in /trunk/libhtml-selector-xpath-perl: Changes META.yml debian/changelog debian/control inc/Test/Builder.pm inc/Test/Builder/Module.pm inc/Test/More.pm lib/HTML/Selector/XPath.pm t/01_xpath.t t/02_html.t
gregoa-guest at users.alioth.debian.org
gregoa-guest at users.alioth.debian.org
Sat Nov 17 20:49:39 UTC 2007
Author: gregoa-guest
Date: Sat Nov 17 20:49:39 2007
New Revision: 9533
URL: http://svn.debian.org/wsvn/?sc=1&rev=9533
Log:
New upstream release.
Modified:
trunk/libhtml-selector-xpath-perl/Changes
trunk/libhtml-selector-xpath-perl/META.yml
trunk/libhtml-selector-xpath-perl/debian/changelog
trunk/libhtml-selector-xpath-perl/debian/control
trunk/libhtml-selector-xpath-perl/inc/Test/Builder.pm
trunk/libhtml-selector-xpath-perl/inc/Test/Builder/Module.pm
trunk/libhtml-selector-xpath-perl/inc/Test/More.pm
trunk/libhtml-selector-xpath-perl/lib/HTML/Selector/XPath.pm
trunk/libhtml-selector-xpath-perl/t/01_xpath.t
trunk/libhtml-selector-xpath-perl/t/02_html.t
Modified: trunk/libhtml-selector-xpath-perl/Changes
URL: http://svn.debian.org/wsvn/trunk/libhtml-selector-xpath-perl/Changes?rev=9533&op=diff
==============================================================================
--- trunk/libhtml-selector-xpath-perl/Changes (original)
+++ trunk/libhtml-selector-xpath-perl/Changes Sat Nov 17 20:49:39 2007
@@ -1,8 +1,11 @@
Revision history for Perl extension HTML::Selector::XPath
- 0.02 Tue Oct 3 22:43:39 JST 2006
- * Added support for :not() without XPath 2.0
+0.03 Sat Nov 10 20:26:47 PST 2007
+ * Added nth-child() support (Thanks to Tokuhiro Matsuno)
+
+0.02 Tue Oct 3 22:43:39 JST 2006
+ * Added support for :not() without XPath 2.0
(Thanks to Aristotle Pegaltzis)
- 0.01 Sun Sep 24 20:10:35 2006
- - original version
+0.01 Sun Sep 24 20:10:35 2006
+ - original version
Modified: trunk/libhtml-selector-xpath-perl/META.yml
URL: http://svn.debian.org/wsvn/trunk/libhtml-selector-xpath-perl/META.yml?rev=9533&op=diff
==============================================================================
--- trunk/libhtml-selector-xpath-perl/META.yml (original)
+++ trunk/libhtml-selector-xpath-perl/META.yml Sat Nov 17 20:49:39 2007
@@ -10,4 +10,4 @@
directory:
- inc
- t
-version: 0.02
+version: 0.03
Modified: trunk/libhtml-selector-xpath-perl/debian/changelog
URL: http://svn.debian.org/wsvn/trunk/libhtml-selector-xpath-perl/debian/changelog?rev=9533&op=diff
==============================================================================
--- trunk/libhtml-selector-xpath-perl/debian/changelog (original)
+++ trunk/libhtml-selector-xpath-perl/debian/changelog Sat Nov 17 20:49:39 2007
@@ -1,3 +1,9 @@
+libhtml-selector-xpath-perl (0.03-1) UNRELEASED; urgency=low
+
+ * New upstream release.
+
+ -- gregor herrmann <gregor+debian at comodo.priv.at> Sat, 17 Nov 2007 21:48:04 +0100
+
libhtml-selector-xpath-perl (0.02-1) unstable; urgency=low
* Initial Release. (closes: #442005 );
Modified: trunk/libhtml-selector-xpath-perl/debian/control
URL: http://svn.debian.org/wsvn/trunk/libhtml-selector-xpath-perl/debian/control?rev=9533&op=diff
==============================================================================
--- trunk/libhtml-selector-xpath-perl/debian/control (original)
+++ trunk/libhtml-selector-xpath-perl/debian/control Sat Nov 17 20:49:39 2007
@@ -4,7 +4,8 @@
Build-Depends: debhelper (>= 5.0.0)
Build-Depends-Indep: perl (>= 5.8.8-7), libtest-pod-perl
Maintainer: Debian Perl Group <pkg-perl-maintainers at lists.alioth.debian.org>
-Uploaders: Jeremiah C. Foster <jeremiah at jeremiahfoster.com>
+Uploaders: Jeremiah C. Foster <jeremiah at jeremiahfoster.com>,
+ gregor herrmann <gregor+debian at comodo.priv.at>
Standards-Version: 3.7.2
Homepage: http://search.cpan.org/dist/HTML-Selector-XPath/
Vcs-Svn: svn://svn.debian.org/pkg-perl/trunk/libhtml-selector-xpath-perl/
Modified: trunk/libhtml-selector-xpath-perl/inc/Test/Builder.pm
URL: http://svn.debian.org/wsvn/trunk/libhtml-selector-xpath-perl/inc/Test/Builder.pm?rev=9533&op=diff
==============================================================================
--- trunk/libhtml-selector-xpath-perl/inc/Test/Builder.pm (original)
+++ trunk/libhtml-selector-xpath-perl/inc/Test/Builder.pm Sat Nov 17 20:49:39 2007
@@ -9,14 +9,15 @@
use strict;
use vars qw($VERSION);
-$VERSION = '0.33';
+$VERSION = '0.72';
$VERSION = eval $VERSION; # make the alpha version come out as a number
# Make Test::Builder thread-safe for ithreads.
BEGIN {
use Config;
- # Load threads::shared when threads are turned on
- if( $] >= 5.008 && $Config{useithreads} && $INC{'threads.pm'}) {
+ # Load threads::shared when threads are turned on.
+ # 5.8.0's threads are so busted we no longer support them.
+ if( $] >= 5.008001 && $Config{useithreads} && $INC{'threads.pm'}) {
require threads::shared;
# Hack around YET ANOTHER threads::shared bug. It would
@@ -36,7 +37,7 @@
$$data = ${$_[0]};
}
else {
- die "Unknown type: ".$type;
+ die("Unknown type: ".$type);
}
$_[0] = &threads::shared::share($_[0]);
@@ -51,14 +52,14 @@
${$_[0]} = $$data;
}
else {
- die "Unknown type: ".$type;
+ die("Unknown type: ".$type);
}
return $_[0];
};
}
- # 5.8.0's threads::shared is busted when threads are off.
- # We emulate it here.
+ # 5.8.0's threads::shared is busted when threads are off
+ # and earlier Perls just don't have that module at all.
else {
*share = sub { return $_[0] };
*lock = sub { 0 };
@@ -66,7 +67,7 @@
}
-#line 127
+#line 128
my $Test = Test::Builder->new;
sub new {
@@ -76,7 +77,7 @@
}
-#line 149
+#line 150
sub create {
my $class = shift;
@@ -87,7 +88,7 @@
return $self;
}
-#line 168
+#line 169
use vars qw($Level);
@@ -122,7 +123,7 @@
return undef;
}
-#line 220
+#line 221
sub exported_to {
my($self, $pack) = @_;
@@ -133,16 +134,17 @@
return $self->{Exported_To};
}
-#line 242
+#line 243
sub plan {
my($self, $cmd, $arg) = @_;
return unless $cmd;
+ local $Level = $Level + 1;
+
if( $self->{Have_Plan} ) {
- die sprintf "You tried to plan twice! Second plan at %s line %d\n",
- ($self->caller)[1,2];
+ $self->croak("You tried to plan twice");
}
if( $cmd eq 'no_plan' ) {
@@ -153,33 +155,32 @@
}
elsif( $cmd eq 'tests' ) {
if( $arg ) {
+ local $Level = $Level + 1;
return $self->expected_tests($arg);
}
elsif( !defined $arg ) {
- die "Got an undefined number of tests. Looks like you tried to ".
- "say how many tests you plan to run but made a mistake.\n";
+ $self->croak("Got an undefined number of tests");
}
elsif( !$arg ) {
- die "You said to run 0 tests! You've got to run something.\n";
+ $self->croak("You said to run 0 tests");
}
}
else {
- require Carp;
my @args = grep { defined } ($cmd, $arg);
- Carp::croak("plan() doesn't understand @args");
+ $self->croak("plan() doesn't understand @args");
}
return 1;
}
-#line 289
+#line 290
sub expected_tests {
my $self = shift;
my($max) = @_;
if( @_ ) {
- die "Number of tests must be a postive integer. You gave it '$max'.\n"
+ $self->croak("Number of tests must be a positive integer. You gave it '$max'")
unless $max =~ /^\+?\d+$/ and $max > 0;
$self->{Expected_Tests} = $max;
@@ -191,7 +192,7 @@
}
-#line 314
+#line 315
sub no_plan {
my $self = shift;
@@ -200,7 +201,7 @@
$self->{Have_Plan} = 1;
}
-#line 329
+#line 330
sub has_plan {
my $self = shift;
@@ -211,7 +212,7 @@
};
-#line 347
+#line 348
sub skip_all {
my($self, $reason) = @_;
@@ -226,7 +227,7 @@
exit(0);
}
-#line 380
+#line 382
sub ok {
my($self, $test, $name) = @_;
@@ -235,10 +236,7 @@
# store, so we turn it into a boolean.
$test = $test ? 1 : 0;
- unless( $self->{Have_Plan} ) {
- require Carp;
- Carp::croak("You tried to run a test without a plan! Gotta have a plan.");
- }
+ $self->_plan_check;
lock $self->{Curr_Test};
$self->{Curr_Test}++;
@@ -300,10 +298,10 @@
if( defined $name ) {
$self->diag(qq[ $msg test '$name'\n]);
- $self->diag(qq[ in $file at line $line.\n]);
+ $self->diag(qq[ at $file line $line.\n]);
}
else {
- $self->diag(qq[ $msg test in $file at line $line.\n]);
+ $self->diag(qq[ $msg test at $file line $line.\n]);
}
}
@@ -315,26 +313,22 @@
my $self = shift;
my $type = shift;
- local($@,$!);
-
- eval { require overload } || return;
+ $self->_try(sub { require overload } ) || return;
foreach my $thing (@_) {
- eval {
- if( _is_object($$thing) ) {
- if( my $string_meth = overload::Method($$thing, $type) ) {
- $$thing = $$thing->$string_meth();
- }
+ if( $self->_is_object($$thing) ) {
+ if( my $string_meth = overload::Method($$thing, $type) ) {
+ $$thing = $$thing->$string_meth();
}
- };
+ }
}
}
sub _is_object {
- my $thing = shift;
-
- return eval { ref $thing && $thing->isa('UNIVERSAL') } ? 1 : 0;
+ my($self, $thing) = @_;
+
+ return $self->_try(sub { ref $thing && $thing->isa('UNIVERSAL') }) ? 1 : 0;
}
@@ -367,7 +361,7 @@
-#line 535
+#line 530
sub is_eq {
my($self, $got, $expect, $name) = @_;
@@ -431,7 +425,7 @@
}
-#line 613
+#line 608
sub isnt_eq {
my($self, $got, $dont_expect, $name) = @_;
@@ -466,7 +460,7 @@
}
-#line 665
+#line 660
sub like {
my($self, $this, $regex, $name) = @_;
@@ -482,74 +476,8 @@
$self->_regex_ok($this, $regex, '!~', $name);
}
-#line 706
-
-
-sub maybe_regex {
- my ($self, $regex) = @_;
- my $usable_regex = undef;
-
- return $usable_regex unless defined $regex;
-
- my($re, $opts);
-
- # Check for qr/foo/
- if( ref $regex eq 'Regexp' ) {
- $usable_regex = $regex;
- }
- # Check for '/foo/' or 'm,foo,'
- elsif( ($re, $opts) = $regex =~ m{^ /(.*)/ (\w*) $ }sx or
- (undef, $re, $opts) = $regex =~ m,^ m([^\w\s]) (.+) \1 (\w*) $,sx
- )
- {
- $usable_regex = length $opts ? "(?$opts)$re" : $re;
- }
-
- return $usable_regex;
-};
-
-sub _regex_ok {
- my($self, $this, $regex, $cmp, $name) = @_;
-
- my $ok = 0;
- my $usable_regex = $self->maybe_regex($regex);
- unless (defined $usable_regex) {
- $ok = $self->ok( 0, $name );
- $self->diag(" '$regex' doesn't look much like a regex to me.");
- return $ok;
- }
-
- {
- my $test;
- my $code = $self->_caller_context;
-
- local($@, $!);
-
- # Yes, it has to look like this or 5.4.5 won't see the #line directive.
- # Don't ask me, man, I just work here.
- $test = eval "
-$code" . q{$test = $this =~ /$usable_regex/ ? 1 : 0};
-
- $test = !$test if $cmp eq '!~';
-
- local $Level = $Level + 1;
- $ok = $self->ok( $test, $name );
- }
-
- unless( $ok ) {
- $this = defined $this ? "'$this'" : 'undef';
- my $match = $cmp eq '=~' ? "doesn't match" : "matches";
- $self->diag(sprintf <<DIAGNOSTIC, $this, $match, $regex);
- %s
- %13s '%s'
-DIAGNOSTIC
-
- }
-
- return $ok;
-}
-
-#line 781
+
+#line 685
my %numeric_cmps = map { ($_, 1) }
@@ -568,8 +496,7 @@
my $test;
{
- local($@,$!); # don't interfere with $@
- # eval() sometimes resets $!
+ local($@,$!,$SIG{__DIE__}); # isolate eval
my $code = $self->_caller_context;
@@ -617,8 +544,7 @@
return $code;
}
-
-#line 860
+#line 771
sub BAIL_OUT {
my($self, $reason) = @_;
@@ -628,22 +554,19 @@
exit 255;
}
-#line 873
+#line 784
*BAILOUT = \&BAIL_OUT;
-#line 885
+#line 796
sub skip {
my($self, $why) = @_;
$why ||= '';
$self->_unoverload_str(\$why);
- unless( $self->{Have_Plan} ) {
- require Carp;
- Carp::croak("You tried to run tests without a plan! Gotta have a plan.");
- }
+ $self->_plan_check;
lock($self->{Curr_Test});
$self->{Curr_Test}++;
@@ -668,16 +591,13 @@
}
-#line 930
+#line 838
sub todo_skip {
my($self, $why) = @_;
$why ||= '';
- unless( $self->{Have_Plan} ) {
- require Carp;
- Carp::croak("You tried to run tests without a plan! Gotta have a plan.");
- }
+ $self->_plan_check;
lock($self->{Curr_Test});
$self->{Curr_Test}++;
@@ -700,7 +620,107 @@
}
-#line 1001
+#line 916
+
+
+sub maybe_regex {
+ my ($self, $regex) = @_;
+ my $usable_regex = undef;
+
+ return $usable_regex unless defined $regex;
+
+ my($re, $opts);
+
+ # Check for qr/foo/
+ if( ref $regex eq 'Regexp' ) {
+ $usable_regex = $regex;
+ }
+ # Check for '/foo/' or 'm,foo,'
+ elsif( ($re, $opts) = $regex =~ m{^ /(.*)/ (\w*) $ }sx or
+ (undef, $re, $opts) = $regex =~ m,^ m([^\w\s]) (.+) \1 (\w*) $,sx
+ )
+ {
+ $usable_regex = length $opts ? "(?$opts)$re" : $re;
+ }
+
+ return $usable_regex;
+};
+
+sub _regex_ok {
+ my($self, $this, $regex, $cmp, $name) = @_;
+
+ my $ok = 0;
+ my $usable_regex = $self->maybe_regex($regex);
+ unless (defined $usable_regex) {
+ $ok = $self->ok( 0, $name );
+ $self->diag(" '$regex' doesn't look much like a regex to me.");
+ return $ok;
+ }
+
+ {
+ my $test;
+ my $code = $self->_caller_context;
+
+ local($@, $!, $SIG{__DIE__}); # isolate eval
+
+ # Yes, it has to look like this or 5.4.5 won't see the #line directive.
+ # Don't ask me, man, I just work here.
+ $test = eval "
+$code" . q{$test = $this =~ /$usable_regex/ ? 1 : 0};
+
+ $test = !$test if $cmp eq '!~';
+
+ local $Level = $Level + 1;
+ $ok = $self->ok( $test, $name );
+ }
+
+ unless( $ok ) {
+ $this = defined $this ? "'$this'" : 'undef';
+ my $match = $cmp eq '=~' ? "doesn't match" : "matches";
+ $self->diag(sprintf <<DIAGNOSTIC, $this, $match, $regex);
+ %s
+ %13s '%s'
+DIAGNOSTIC
+
+ }
+
+ return $ok;
+}
+
+
+# I'm not ready to publish this. It doesn't deal with array return
+# values from the code or context.
+
+#line 1000
+
+sub _try {
+ my($self, $code) = @_;
+
+ local $!; # eval can mess up $!
+ local $@; # don't set $@ in the test
+ local $SIG{__DIE__}; # don't trip an outside DIE handler.
+ my $return = eval { $code->() };
+
+ return wantarray ? ($return, $@) : $return;
+}
+
+#line 1022
+
+sub is_fh {
+ my $self = shift;
+ my $maybe_fh = shift;
+ return 0 unless defined $maybe_fh;
+
+ return 1 if ref $maybe_fh eq 'GLOB'; # its a glob ref
+ return 1 if ref \$maybe_fh eq 'GLOB'; # its a glob
+
+ return eval { $maybe_fh->isa("IO::Handle") } ||
+ # 5.5.4's tied() and can() doesn't like getting undef
+ eval { (tied($maybe_fh) || '')->can('TIEHANDLE') };
+}
+
+
+#line 1067
sub level {
my($self, $level) = @_;
@@ -712,7 +732,7 @@
}
-#line 1036
+#line 1100
sub use_numbers {
my($self, $use_nums) = @_;
@@ -724,7 +744,7 @@
}
-#line 1070
+#line 1134
foreach my $attribute (qw(No_Header No_Ending No_Diag)) {
my $method = lc $attribute;
@@ -743,7 +763,7 @@
}
-#line 1124
+#line 1188
sub diag {
my($self, @msgs) = @_;
@@ -770,7 +790,7 @@
return 0;
}
-#line 1161
+#line 1225
sub _print {
my($self, @msgs) = @_;
@@ -794,8 +814,7 @@
print $fh $msg;
}
-
-#line 1192
+#line 1259
sub _print_diag {
my $self = shift;
@@ -805,13 +824,13 @@
print $fh @_;
}
-#line 1229
+#line 1296
sub output {
my($self, $fh) = @_;
if( defined $fh ) {
- $self->{Out_FH} = _new_fh($fh);
+ $self->{Out_FH} = $self->_new_fh($fh);
}
return $self->{Out_FH};
}
@@ -820,7 +839,7 @@
my($self, $fh) = @_;
if( defined $fh ) {
- $self->{Fail_FH} = _new_fh($fh);
+ $self->{Fail_FH} = $self->_new_fh($fh);
}
return $self->{Fail_FH};
}
@@ -829,41 +848,28 @@
my($self, $fh) = @_;
if( defined $fh ) {
- $self->{Todo_FH} = _new_fh($fh);
+ $self->{Todo_FH} = $self->_new_fh($fh);
}
return $self->{Todo_FH};
}
sub _new_fh {
+ my $self = shift;
my($file_or_fh) = shift;
my $fh;
- if( _is_fh($file_or_fh) ) {
+ if( $self->is_fh($file_or_fh) ) {
$fh = $file_or_fh;
}
else {
$fh = do { local *FH };
- open $fh, ">$file_or_fh" or
- die "Can't open test output log $file_or_fh: $!";
+ open $fh, ">$file_or_fh" or
+ $self->croak("Can't open test output log $file_or_fh: $!");
_autoflush($fh);
}
return $fh;
-}
-
-
-sub _is_fh {
- my $maybe_fh = shift;
- return 0 unless defined $maybe_fh;
-
- return 1 if ref \$maybe_fh eq 'GLOB'; # its a glob
-
- return UNIVERSAL::isa($maybe_fh, 'GLOB') ||
- UNIVERSAL::isa($maybe_fh, 'IO::Handle') ||
-
- # 5.5.4's tied() and can() doesn't like getting undef
- UNIVERSAL::can((tied($maybe_fh) || ''), 'TIEHANDLE');
}
@@ -904,7 +910,36 @@
}
-#line 1347
+#line 1396
+
+sub _message_at_caller {
+ my $self = shift;
+
+ local $Level = $Level + 1;
+ my($pack, $file, $line) = $self->caller;
+ return join("", @_) . " at $file line $line.\n";
+}
+
+sub carp {
+ my $self = shift;
+ warn $self->_message_at_caller(@_);
+}
+
+sub croak {
+ my $self = shift;
+ die $self->_message_at_caller(@_);
+}
+
+sub _plan_check {
+ my $self = shift;
+
+ unless( $self->{Have_Plan} ) {
+ local $Level = $Level + 2;
+ $self->croak("You tried to run a test without a plan");
+ }
+}
+
+#line 1444
sub current_test {
my($self, $num) = @_;
@@ -912,8 +947,7 @@
lock($self->{Curr_Test});
if( defined $num ) {
unless( $self->{Have_Plan} ) {
- require Carp;
- Carp::croak("Can't change the current test number without a plan!");
+ $self->croak("Can't change the current test number without a plan!");
}
$self->{Curr_Test} = $num;
@@ -941,7 +975,7 @@
}
-#line 1393
+#line 1489
sub summary {
my($self) = shift;
@@ -949,14 +983,14 @@
return map { $_->{'ok'} } @{ $self->{Test_Results} };
}
-#line 1448
+#line 1544
sub details {
my $self = shift;
return @{ $self->{Test_Results} };
}
-#line 1473
+#line 1569
sub todo {
my($self, $pack) = @_;
@@ -969,7 +1003,7 @@
: 0;
}
-#line 1494
+#line 1590
sub caller {
my($self, $height) = @_;
@@ -979,34 +1013,35 @@
return wantarray ? @caller : $caller[0];
}
-#line 1506
-
-#line 1520
+#line 1602
+
+#line 1616
#'#
sub _sanity_check {
my $self = shift;
- _whoa($self->{Curr_Test} < 0, 'Says here you ran a negative number of tests!');
- _whoa(!$self->{Have_Plan} and $self->{Curr_Test},
+ $self->_whoa($self->{Curr_Test} < 0, 'Says here you ran a negative number of tests!');
+ $self->_whoa(!$self->{Have_Plan} and $self->{Curr_Test},
'Somehow your tests ran without a plan!');
- _whoa($self->{Curr_Test} != @{ $self->{Test_Results} },
+ $self->_whoa($self->{Curr_Test} != @{ $self->{Test_Results} },
'Somehow you got a different number of results than tests ran!');
}
-#line 1541
+#line 1637
sub _whoa {
- my($check, $desc) = @_;
+ my($self, $check, $desc) = @_;
if( $check ) {
- die <<WHOA;
+ local $Level = $Level + 1;
+ $self->croak(<<"WHOA");
WHOA! $desc
This should never happen! Please contact the author immediately!
WHOA
}
}
-#line 1562
+#line 1659
sub _my_exit {
$? = $_[0];
@@ -1015,7 +1050,7 @@
}
-#line 1575
+#line 1672
$SIG{__DIE__} = sub {
# We don't want to muck with death in an eval, but $^S isn't
@@ -1135,6 +1170,6 @@
$Test->_ending if defined $Test and !$Test->no_ending;
}
-#line 1747
+#line 1847
1;
Modified: trunk/libhtml-selector-xpath-perl/inc/Test/Builder/Module.pm
URL: http://svn.debian.org/wsvn/trunk/libhtml-selector-xpath-perl/inc/Test/Builder/Module.pm?rev=9533&op=diff
==============================================================================
--- trunk/libhtml-selector-xpath-perl/inc/Test/Builder/Module.pm (original)
+++ trunk/libhtml-selector-xpath-perl/inc/Test/Builder/Module.pm Sat Nov 17 20:49:39 2007
@@ -6,7 +6,7 @@
require Exporter;
@ISA = qw(Exporter);
-$VERSION = '0.03';
+$VERSION = '0.72';
use strict;
Modified: trunk/libhtml-selector-xpath-perl/inc/Test/More.pm
URL: http://svn.debian.org/wsvn/trunk/libhtml-selector-xpath-perl/inc/Test/More.pm?rev=9533&op=diff
==============================================================================
--- trunk/libhtml-selector-xpath-perl/inc/Test/More.pm (original)
+++ trunk/libhtml-selector-xpath-perl/inc/Test/More.pm Sat Nov 17 20:49:39 2007
@@ -17,7 +17,7 @@
use vars qw($VERSION @ISA @EXPORT %EXPORT_TAGS $TODO);
-$VERSION = '0.64';
+$VERSION = '0.72';
$VERSION = eval $VERSION; # make the alpha version come out as a number
use Test::Builder::Module;
@@ -144,9 +144,7 @@
my @nok = ();
foreach my $method (@methods) {
- local($!, $@); # don't interfere with caller's $@
- # eval sometimes resets $!
- eval { $proto->can($method) } || push @nok, $method;
+ $tb->_try(sub { $proto->can($method) }) or push @nok, $method;
}
my $name;
@@ -160,7 +158,7 @@
return $ok;
}
-#line 525
+#line 523
sub isa_ok ($$;$) {
my($object, $class, $obj_name) = @_;
@@ -177,10 +175,10 @@
}
else {
# We can't use UNIVERSAL::isa because we want to honor isa() overrides
- local($@, $!); # eval sometimes resets $!
- my $rslt = eval { $object->isa($class) };
- if( $@ ) {
- if( $@ =~ /^Can't call method "isa" on unblessed reference/ ) {
+ my($rslt, $error) = $tb->_try(sub { $object->isa($class) });
+ if( $error ) {
+ if( $error =~ /^Can't call method "isa" on unblessed reference/ ) {
+ # Its an unblessed reference
if( !UNIVERSAL::isa($object, $class) ) {
my $ref = ref $object;
$diag = "$obj_name isn't a '$class' it's a '$ref'";
@@ -188,9 +186,8 @@
} else {
die <<WHOA;
WHOA! I tried to call ->isa on your object and got some weird error.
-This should never happen. Please contact the author immediately.
Here's the error.
-$@
+$error
WHOA
}
}
@@ -215,7 +212,7 @@
}
-#line 595
+#line 592
sub pass (;$) {
my $tb = Test::More->builder;
@@ -227,7 +224,7 @@
$tb->ok(0, @_);
}
-#line 656
+#line 653
sub use_ok ($;@) {
my($module, @imports) = @_;
@@ -236,7 +233,7 @@
my($pack,$filename,$line) = caller;
- local($@,$!); # eval sometimes interferes with $!
+ local($@,$!,$SIG{__DIE__}); # isolate eval
if( @imports == 1 and $imports[0] =~ /^\d+(?:\.\d+)?$/ ) {
# probably a version check. Perl needs to see the bare number
@@ -269,7 +266,7 @@
return $ok;
}
-#line 705
+#line 702
sub require_ok ($) {
my($module) = shift;
@@ -281,7 +278,8 @@
# Module names must be barewords, files not.
$module = qq['$module'] unless _is_module_name($module);
- local($!, $@); # eval sometimes interferes with $!
+ local($!, $@, $SIG{__DIE__}); # isolate eval
+ local $SIG{__DIE__};
eval <<REQUIRE;
package $pack;
require $module;
@@ -312,10 +310,16 @@
$module =~ /^[a-zA-Z]\w*$/;
}
-#line 781
+#line 779
use vars qw(@Data_Stack %Refs_Seen);
my $DNE = bless [], 'Does::Not::Exist';
+
+sub _dne {
+ ref $_[0] eq ref $DNE;
+}
+
+
sub is_deeply {
my $tb = Test::More->builder;
@@ -332,21 +336,21 @@
return $tb->ok(0);
}
- my($this, $that, $name) = @_;
-
- $tb->_unoverload_str(\$that, \$this);
+ my($got, $expected, $name) = @_;
+
+ $tb->_unoverload_str(\$expected, \$got);
my $ok;
- if( !ref $this and !ref $that ) { # neither is a reference
- $ok = $tb->is_eq($this, $that, $name);
- }
- elsif( !ref $this xor !ref $that ) { # one's a reference, one isn't
+ if( !ref $got and !ref $expected ) { # neither is a reference
+ $ok = $tb->is_eq($got, $expected, $name);
+ }
+ elsif( !ref $got xor !ref $expected ) { # one's a reference, one isn't
$ok = $tb->ok(0, $name);
- $tb->diag( _format_stack({ vals => [ $this, $that ] }) );
+ $tb->diag( _format_stack({ vals => [ $got, $expected ] }) );
}
else { # both references
local @Data_Stack = ();
- if( _deep_check($this, $that) ) {
+ if( _deep_check($got, $expected) ) {
$ok = $tb->ok(1, $name);
}
else {
@@ -388,8 +392,8 @@
foreach my $idx (0..$#vals) {
my $val = $vals[$idx];
$vals[$idx] = !defined $val ? 'undef' :
- $val eq $DNE ? "Does not exist" :
- ref $val ? "$val" :
+ _dne($val) ? "Does not exist" :
+ ref $val ? "$val" :
"'$val'";
}
@@ -413,7 +417,7 @@
return '';
}
-#line 921
+#line 925
sub diag {
my $tb = Test::More->builder;
@@ -422,7 +426,7 @@
}
-#line 990
+#line 994
#'#
sub skip {
@@ -450,7 +454,7 @@
}
-#line 1077
+#line 1081
sub todo_skip {
my($why, $how_many) = @_;
@@ -471,7 +475,7 @@
last TODO;
}
-#line 1130
+#line 1134
sub BAIL_OUT {
my $reason = shift;
@@ -480,7 +484,7 @@
$tb->BAIL_OUT($reason);
}
-#line 1169
+#line 1173
#'#
sub eq_array {
@@ -538,7 +542,7 @@
if( defined $e1 xor defined $e2 ) {
$ok = 0;
}
- elsif ( $e1 == $DNE xor $e2 == $DNE ) {
+ elsif ( _dne($e1) xor _dne($e2) ) {
$ok = 0;
}
elsif ( $same_ref and ($e1 eq $e2) ) {
@@ -604,7 +608,7 @@
}
-#line 1300
+#line 1304
sub eq_hash {
local @Data_Stack;
@@ -637,7 +641,7 @@
return $ok;
}
-#line 1357
+#line 1361
sub eq_set {
my($a1, $a2) = @_;
@@ -663,6 +667,6 @@
);
}
-#line 1545
+#line 1551
1;
Modified: trunk/libhtml-selector-xpath-perl/lib/HTML/Selector/XPath.pm
URL: http://svn.debian.org/wsvn/trunk/libhtml-selector-xpath-perl/lib/HTML/Selector/XPath.pm?rev=9533&op=diff
==============================================================================
--- trunk/libhtml-selector-xpath-perl/lib/HTML/Selector/XPath.pm (original)
+++ trunk/libhtml-selector-xpath-perl/lib/HTML/Selector/XPath.pm Sat Nov 17 20:49:39 2007
@@ -1,11 +1,13 @@
package HTML::Selector::XPath;
use strict;
-our $VERSION = '0.02';
+our $VERSION = '0.03';
require Exporter;
our @EXPORT_OK = qw(selector_to_xpath);
*import = \&Exporter::import;
+
+use Carp;
sub selector_to_xpath {
__PACKAGE__->new(shift)->to_xpath;
@@ -19,7 +21,7 @@
# attribute value match
attr2 => qr/^\[\s*([^~\|=\s]+)\s*([~\|]?=)\s*"([^"]+)"\s*\]/i,
attrN => qr/^:not\((.*?)\)/i,
- pseudo => qr/^:([()a-z_-]+)/i,
+ pseudo => qr/^:([()a-z0-9_-]+)/i,
# adjacency/direct descendance
combinator => qr/^(\s*[>+\s])/i,
# rule separator
@@ -85,10 +87,8 @@
} else { # exact match
push @parts, "[\@$1='$3']";
}
- } else {
- if ($rule =~ s/$reg->{attr1}//) {
- push @parts, "[\@$1]";
- }
+ } elsif ($rule =~ s/$reg->{attr1}//) {
+ push @parts, "[\@$1]";
}
# Match negation
@@ -104,6 +104,8 @@
}
} elsif ($sub_rule =~ s/$reg->{attr1}//) {
push @parts, "[not(\@$1)]";
+ } else {
+ Carp::croak "Can't translate '$sub_rule' inside :not()";
}
}
@@ -113,6 +115,10 @@
$parts[$#parts] = '*[1]/self::' . $parts[$#parts];
} elsif ($1 =~ /^lang\(([\w\-]+)\)$/) {
push @parts, "[\@xml:lang='$1' or starts-with(\@xml:lang, '$1-')]";
+ } elsif ($1 =~ /^nth-child\((\d+)\)$/) {
+ push @parts, "[count(preceding-sibling::*) = @{[ $1 - 1 ]}]";
+ } else {
+ Carp::croak "Can't translate '$1' pseudo-class";
}
}
Modified: trunk/libhtml-selector-xpath-perl/t/01_xpath.t
URL: http://svn.debian.org/wsvn/trunk/libhtml-selector-xpath-perl/t/01_xpath.t?rev=9533&op=diff
==============================================================================
--- trunk/libhtml-selector-xpath-perl/t/01_xpath.t (original)
+++ trunk/libhtml-selector-xpath-perl/t/01_xpath.t Sat Nov 17 20:49:39 2007
@@ -119,3 +119,9 @@
foo.bar, bar
--- xpath
//foo[contains(concat(' ', @class, ' '), ' bar ')] | //bar
+
+===
+--- selector
+E:nth-child(1)
+--- xpath
+//E[count(preceding-sibling::*) = 0]
Modified: trunk/libhtml-selector-xpath-perl/t/02_html.t
URL: http://svn.debian.org/wsvn/trunk/libhtml-selector-xpath-perl/t/02_html.t?rev=9533&op=diff
==============================================================================
--- trunk/libhtml-selector-xpath-perl/t/02_html.t (original)
+++ trunk/libhtml-selector-xpath-perl/t/02_html.t Sat Nov 17 20:49:39 2007
@@ -118,3 +118,40 @@
--- expected
<div>foo</div>
+===
+--- SKIP
+--- input
+<p>foo</p>
+<div class="foo">baz</div>
+--- selector
+*:not(p)
+--- expected
+<div class="foo">baz</div>
+
+===
+--- input
+<p class="pastoral blue aqua marine">foo</p>
+<p class="pastoral blue">bar</p>
+--- selector
+p.pastoral.marine
+--- expected
+<p class="pastoral blue aqua marine">foo</p>
+
+===
+--- input
+<p>foo</p>
+<p>bar</p>
+--- selector
+p:nth-child(1)
+--- expected
+<p>foo</p>
+
+===
+--- input
+<p>foo</p>
+<p>bar</p>
+--- selector
+p:nth-child(2)
+--- expected
+<p>bar</p>
+
More information about the Pkg-perl-cvs-commits
mailing list