From: Simon Wistow Date: Tue, 22 Apr 2008 18:00:55 +0000 (+0000) Subject: Load XML-Feed-0.11 into trunk. X-Git-Tag: v0.11^0 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=4679cf3fa820399f83096e0f73025877583092f0;hp=4f6ca997973829c250e1070249f27d65c66f7eae;p=catagits%2FXML-Feed.git Load XML-Feed-0.11 into trunk. --- diff --git a/Changes b/Changes index c0d02cf..1ee7ede 100644 --- a/Changes +++ b/Changes @@ -1,7 +1,12 @@ -# $Id: Changes 1948 2006-07-17 16:06:18Z btrott $ +# $Id: Changes 1956 2006-08-08 04:34:54Z btrott $ Revision history for XML::Feed +0.11 2006.08.07 + - Fixed a bug in XML::Feed::Atom where entry->link and feed->link didn't + return the proper link element if the "rel" attribute wasn't defined for + a tag. Thanks to Tatsuhiko Miyagawa for the patch. + 0.10 2006.07.17 - Oops, an Atom test in 01-parse.t was previously succeeding only because of a bug in XML::Atom. Now that that bug is fixed, this one is now diff --git a/MANIFEST b/MANIFEST index 9e1a4f2..71baa1d 100644 --- a/MANIFEST +++ b/MANIFEST @@ -15,6 +15,7 @@ inc/Module/Install/Makefile.pm inc/Module/Install/Metadata.pm inc/Module/Install/Win32.pm inc/Module/Install/WriteAll.pm +inc/Test/More.pm lib/XML/Feed.pm lib/XML/Feed/Atom.pm lib/XML/Feed/Content.pm @@ -28,6 +29,8 @@ t/00-compile.t t/01-parse.t t/02-create.t t/04-splice.t +t/05-atom10-link.t +t/samples/atom-10-example.xml t/samples/atom.xml t/samples/rss10-invalid-date.xml t/samples/rss10.xml diff --git a/META.yml b/META.yml index 4c6bfd3..5cdbf06 100644 --- a/META.yml +++ b/META.yml @@ -3,6 +3,7 @@ author: Six Apart build_requires: HTML::TokeParser: 0 LWP: 0 + Test::More: 0 distribution_type: module generated_by: Module::Install version 0.61 license: perl @@ -22,4 +23,4 @@ requires: URI::Fetch: 0 XML::Atom: 0.08 XML::RSS: 1.01 -version: 0.10 +version: 0.11 diff --git a/Makefile.PL b/Makefile.PL index 0333712..9d431f9 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -1,4 +1,4 @@ -# $Id: Makefile.PL 1925 2006-03-03 17:37:50Z btrott $ +# $Id: Makefile.PL 1955 2006-08-02 05:59:58Z btrott $ use inc::Module::Install; @@ -23,6 +23,7 @@ requires('DateTime::Format::W3CDTF'); requires('List::Util'); build_requires('LWP'); build_requires('HTML::TokeParser'); +build_requires('Test::More'); auto_include(); auto_install(); diff --git a/inc/Test/More.pm b/inc/Test/More.pm new file mode 100644 index 0000000..471ede9 --- /dev/null +++ b/inc/Test/More.pm @@ -0,0 +1,657 @@ +#line 1 +package Test::More; + +use 5.004; + +use strict; + + +# Can't use Carp because it might cause use_ok() to accidentally succeed +# even though the module being used forgot to use Carp. Yes, this +# actually happened. +sub _carp { + my($file, $line) = (caller(1))[1,2]; + warn @_, " at $file line $line\n"; +} + + + +use vars qw($VERSION @ISA @EXPORT %EXPORT_TAGS $TODO); +$VERSION = '0.62'; +$VERSION = eval $VERSION; # make the alpha version come out as a number + +use Test::Builder::Module; +@ISA = qw(Test::Builder::Module); +@EXPORT = qw(ok use_ok require_ok + is isnt like unlike is_deeply + cmp_ok + skip todo todo_skip + pass fail + eq_array eq_hash eq_set + $TODO + plan + can_ok isa_ok + diag + BAIL_OUT + ); + + +#line 157 + +sub plan { + my $tb = Test::More->builder; + + $tb->plan(@_); +} + + +# This implements "use Test::More 'no_diag'" but the behavior is +# deprecated. +sub import_extra { + my $class = shift; + my $list = shift; + + my @other = (); + my $idx = 0; + while( $idx <= $#{$list} ) { + my $item = $list->[$idx]; + + if( defined $item and $item eq 'no_diag' ) { + $class->builder->no_diag(1); + } + else { + push @other, $item; + } + + $idx++; + } + + @$list = @other; +} + + +#line 257 + +sub ok ($;$) { + my($test, $name) = @_; + my $tb = Test::More->builder; + + $tb->ok($test, $name); +} + +#line 324 + +sub is ($$;$) { + my $tb = Test::More->builder; + + $tb->is_eq(@_); +} + +sub isnt ($$;$) { + my $tb = Test::More->builder; + + $tb->isnt_eq(@_); +} + +*isn't = \&isnt; + + +#line 369 + +sub like ($$;$) { + my $tb = Test::More->builder; + + $tb->like(@_); +} + + +#line 385 + +sub unlike ($$;$) { + my $tb = Test::More->builder; + + $tb->unlike(@_); +} + + +#line 425 + +sub cmp_ok($$$;$) { + my $tb = Test::More->builder; + + $tb->cmp_ok(@_); +} + + +#line 461 + +sub can_ok ($@) { + my($proto, @methods) = @_; + my $class = ref $proto || $proto; + my $tb = Test::More->builder; + + unless( @methods ) { + my $ok = $tb->ok( 0, "$class->can(...)" ); + $tb->diag(' can_ok() called with no methods'); + return $ok; + } + + my @nok = (); + foreach my $method (@methods) { + local($!, $@); # don't interfere with caller's $@ + # eval sometimes resets $! + eval { $proto->can($method) } || push @nok, $method; + } + + my $name; + $name = @methods == 1 ? "$class->can('$methods[0]')" + : "$class->can(...)"; + + my $ok = $tb->ok( !@nok, $name ); + + $tb->diag(map " $class->can('$_') failed\n", @nok); + + return $ok; +} + +#line 519 + +sub isa_ok ($$;$) { + my($object, $class, $obj_name) = @_; + my $tb = Test::More->builder; + + my $diag; + $obj_name = 'The object' unless defined $obj_name; + my $name = "$obj_name isa $class"; + if( !defined $object ) { + $diag = "$obj_name isn't defined"; + } + elsif( !ref $object ) { + $diag = "$obj_name isn't a reference"; + } + 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/ ) { + if( !UNIVERSAL::isa($object, $class) ) { + my $ref = ref $object; + $diag = "$obj_name isn't a '$class' it's a '$ref'"; + } + } else { + die <isa on your object and got some weird error. +This should never happen. Please contact the author immediately. +Here's the error. +$@ +WHOA + } + } + elsif( !$rslt ) { + my $ref = ref $object; + $diag = "$obj_name isn't a '$class' it's a '$ref'"; + } + } + + + + my $ok; + if( $diag ) { + $ok = $tb->ok( 0, $name ); + $tb->diag(" $diag\n"); + } + else { + $ok = $tb->ok( 1, $name ); + } + + return $ok; +} + + +#line 589 + +sub pass (;$) { + my $tb = Test::More->builder; + $tb->ok(1, @_); +} + +sub fail (;$) { + my $tb = Test::More->builder; + $tb->ok(0, @_); +} + +#line 650 + +sub use_ok ($;@) { + my($module, @imports) = @_; + @imports = () unless @imports; + my $tb = Test::More->builder; + + my($pack,$filename,$line) = caller; + + local($@,$!); # eval sometimes interferes with $! + + if( @imports == 1 and $imports[0] =~ /^\d+(?:\.\d+)?$/ ) { + # probably a version check. Perl needs to see the bare number + # for it to work with non-Exporter based modules. + eval <ok( !$@, "use $module;" ); + + unless( $ok ) { + chomp $@; + $@ =~ s{^BEGIN failed--compilation aborted at .*$} + {BEGIN failed--compilation aborted at $filename line $line.}m; + $tb->diag(<builder; + + my $pack = caller; + + # Try to deterine if we've been given a module name or file. + # Module names must be barewords, files not. + $module = qq['$module'] unless _is_module_name($module); + + local($!, $@); # eval sometimes interferes with $! + eval <ok( !$@, "require $module;" ); + + unless( $ok ) { + chomp $@; + $tb->diag(<builder; + + unless( @_ == 2 or @_ == 3 ) { + my $msg = <ok(0); + } + + my($this, $that, $name) = @_; + + $tb->_unoverload_str(\$that, \$this); + + 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 + $ok = $tb->ok(0, $name); + $tb->diag( _format_stack({ vals => [ $this, $that ] }) ); + } + else { # both references + local @Data_Stack = (); + if( _deep_check($this, $that) ) { + $ok = $tb->ok(1, $name); + } + else { + $ok = $tb->ok(0, $name); + $tb->diag(_format_stack(@Data_Stack)); + } + } + + return $ok; +} + +sub _format_stack { + my(@Stack) = @_; + + my $var = '$FOO'; + my $did_arrow = 0; + foreach my $entry (@Stack) { + my $type = $entry->{type} || ''; + my $idx = $entry->{'idx'}; + if( $type eq 'HASH' ) { + $var .= "->" unless $did_arrow++; + $var .= "{$idx}"; + } + elsif( $type eq 'ARRAY' ) { + $var .= "->" unless $did_arrow++; + $var .= "[$idx]"; + } + elsif( $type eq 'REF' ) { + $var = "\${$var}"; + } + } + + my @vals = @{$Stack[-1]{vals}}[0,1]; + my @vars = (); + ($vars[0] = $var) =~ s/\$FOO/ \$got/; + ($vars[1] = $var) =~ s/\$FOO/\$expected/; + + my $out = "Structures begin differing at:\n"; + foreach my $idx (0..$#vals) { + my $val = $vals[$idx]; + $vals[$idx] = !defined $val ? 'undef' : + $val eq $DNE ? "Does not exist" : + ref $val ? "$val" : + "'$val'"; + } + + $out .= "$vars[0] = $vals[0]\n"; + $out .= "$vars[1] = $vals[1]\n"; + + $out =~ s/^/ /msg; + return $out; +} + + +sub _type { + my $thing = shift; + + return '' if !ref $thing; + + for my $type (qw(ARRAY HASH REF SCALAR GLOB CODE Regexp)) { + return $type if UNIVERSAL::isa($thing, $type); + } + + return ''; +} + +#line 915 + +sub diag { + my $tb = Test::More->builder; + + $tb->diag(@_); +} + + +#line 984 + +#'# +sub skip { + my($why, $how_many) = @_; + my $tb = Test::More->builder; + + unless( defined $how_many ) { + # $how_many can only be avoided when no_plan is in use. + _carp "skip() needs to know \$how_many tests are in the block" + unless $tb->has_plan eq 'no_plan'; + $how_many = 1; + } + + for( 1..$how_many ) { + $tb->skip($why); + } + + local $^W = 0; + last SKIP; +} + + +#line 1066 + +sub todo_skip { + my($why, $how_many) = @_; + my $tb = Test::More->builder; + + unless( defined $how_many ) { + # $how_many can only be avoided when no_plan is in use. + _carp "todo_skip() needs to know \$how_many tests are in the block" + unless $tb->has_plan eq 'no_plan'; + $how_many = 1; + } + + for( 1..$how_many ) { + $tb->todo_skip($why); + } + + local $^W = 0; + last TODO; +} + +#line 1119 + +sub BAIL_OUT { + my $reason = shift; + my $tb = Test::More->builder; + + $tb->BAIL_OUT($reason); +} + +#line 1158 + +#'# +sub eq_array { + local @Data_Stack; + _deep_check(@_); +} + +sub _eq_array { + my($a1, $a2) = @_; + + if( grep !_type($_) eq 'ARRAY', $a1, $a2 ) { + warn "eq_array passed a non-array ref"; + return 0; + } + + return 1 if $a1 eq $a2; + + my $ok = 1; + my $max = $#$a1 > $#$a2 ? $#$a1 : $#$a2; + for (0..$max) { + my $e1 = $_ > $#$a1 ? $DNE : $a1->[$_]; + my $e2 = $_ > $#$a2 ? $DNE : $a2->[$_]; + + push @Data_Stack, { type => 'ARRAY', idx => $_, vals => [$e1, $e2] }; + $ok = _deep_check($e1,$e2); + pop @Data_Stack if $ok; + + last unless $ok; + } + + return $ok; +} + +sub _deep_check { + my($e1, $e2) = @_; + my $tb = Test::More->builder; + + my $ok = 0; + + # Effectively turn %Refs_Seen into a stack. This avoids picking up + # the same referenced used twice (such as [\$a, \$a]) to be considered + # circular. + local %Refs_Seen = %Refs_Seen; + + { + # Quiet uninitialized value warnings when comparing undefs. + local $^W = 0; + + $tb->_unoverload_str(\$e1, \$e2); + + # Either they're both references or both not. + my $same_ref = !(!ref $e1 xor !ref $e2); + my $not_ref = (!ref $e1 and !ref $e2); + + if( defined $e1 xor defined $e2 ) { + $ok = 0; + } + elsif ( $e1 == $DNE xor $e2 == $DNE ) { + $ok = 0; + } + elsif ( $same_ref and ($e1 eq $e2) ) { + $ok = 1; + } + elsif ( $not_ref ) { + push @Data_Stack, { type => '', vals => [$e1, $e2] }; + $ok = 0; + } + else { + if( $Refs_Seen{$e1} ) { + return $Refs_Seen{$e1} eq $e2; + } + else { + $Refs_Seen{$e1} = "$e2"; + } + + my $type = _type($e1); + $type = 'DIFFERENT' unless _type($e2) eq $type; + + if( $type eq 'DIFFERENT' ) { + push @Data_Stack, { type => $type, vals => [$e1, $e2] }; + $ok = 0; + } + elsif( $type eq 'ARRAY' ) { + $ok = _eq_array($e1, $e2); + } + elsif( $type eq 'HASH' ) { + $ok = _eq_hash($e1, $e2); + } + elsif( $type eq 'REF' ) { + push @Data_Stack, { type => $type, vals => [$e1, $e2] }; + $ok = _deep_check($$e1, $$e2); + pop @Data_Stack if $ok; + } + elsif( $type eq 'SCALAR' ) { + push @Data_Stack, { type => 'REF', vals => [$e1, $e2] }; + $ok = _deep_check($$e1, $$e2); + pop @Data_Stack if $ok; + } + elsif( $type ) { + push @Data_Stack, { type => $type, vals => [$e1, $e2] }; + $ok = 0; + } + else { + _whoa(1, "No type in _deep_check"); + } + } + } + + return $ok; +} + + +sub _whoa { + my($check, $desc) = @_; + if( $check ) { + die < keys %$a2 ? $a1 : $a2; + foreach my $k (keys %$bigger) { + my $e1 = exists $a1->{$k} ? $a1->{$k} : $DNE; + my $e2 = exists $a2->{$k} ? $a2->{$k} : $DNE; + + push @Data_Stack, { type => 'HASH', idx => $k, vals => [$e1, $e2] }; + $ok = _deep_check($e1, $e2); + pop @Data_Stack if $ok; + + last unless $ok; + } + + return $ok; +} + +#line 1346 + +sub eq_set { + my($a1, $a2) = @_; + return 0 unless @$a1 == @$a2; + + # There's faster ways to do this, but this is easiest. + local $^W = 0; + + # It really doesn't matter how we sort them, as long as both arrays are + # sorted with the same algorithm. + # + # Ensure that references are not accidentally treated the same as a + # string containing the reference. + # + # Have to inline the sort routine due to a threading/sort bug. + # See [rt.cpan.org 6782] + # + # I don't know how references would be sorted so we just don't sort + # them. This means eq_set doesn't really work with refs. + return eq_array( + [grep(ref, @$a1), sort( grep(!ref, @$a1) )], + [grep(ref, @$a2), sort( grep(!ref, @$a2) )], + ); +} + +#line 1534 + +1; diff --git a/lib/XML/Feed.pm b/lib/XML/Feed.pm index b669458..a84ca92 100644 --- a/lib/XML/Feed.pm +++ b/lib/XML/Feed.pm @@ -1,4 +1,4 @@ -# $Id: Feed.pm 1948 2006-07-17 16:06:18Z btrott $ +# $Id: Feed.pm 1956 2006-08-08 04:34:54Z btrott $ package XML::Feed; use strict; @@ -8,7 +8,7 @@ use Feed::Find; use URI::Fetch; use Carp; -our $VERSION = '0.10'; +our $VERSION = '0.11'; sub new { my $class = shift; diff --git a/lib/XML/Feed/Atom.pm b/lib/XML/Feed/Atom.pm index b0d5e24..29fc2b0 100644 --- a/lib/XML/Feed/Atom.pm +++ b/lib/XML/Feed/Atom.pm @@ -1,4 +1,4 @@ -# $Id: Atom.pm 1924 2006-03-03 17:34:15Z btrott $ +# $Id: Atom.pm 1955 2006-08-02 05:59:58Z btrott $ package XML::Feed::Atom; use strict; @@ -34,7 +34,7 @@ sub link { $feed->{atom}->add_link({ rel => 'alternate', href => $_[0], type => 'text/html', }); } else { - my $l = first { $_->rel eq 'alternate' } $feed->{atom}->link; + my $l = first { !defined $_->rel || $_->rel eq 'alternate' } $feed->{atom}->link; $l ? $l->href : undef; } } @@ -101,7 +101,7 @@ sub link { $entry->{entry}->add_link({ rel => 'alternate', href => $_[0], type => 'text/html', }); } else { - my $l = first { $_->rel eq 'alternate' } $entry->{entry}->link; + my $l = first { !defined $_->rel || $_->rel eq 'alternate' } $entry->{entry}->link; $l ? $l->href : undef; } } diff --git a/t/05-atom10-link.t b/t/05-atom10-link.t new file mode 100644 index 0000000..0277ee2 --- /dev/null +++ b/t/05-atom10-link.t @@ -0,0 +1,13 @@ +use strict; +use XML::Feed; + +use Test::More; +plan tests => 3; + +my $feed = XML::Feed->parse("t/samples/atom-10-example.xml"); +is $feed->title, 'Example Feed'; +is $feed->link, 'http://example.org/', "link without rel"; + +my $e = ($feed->entries)[0]; +ok $e->link, 'entry link without rel'; + diff --git a/t/samples/atom-10-example.xml b/t/samples/atom-10-example.xml new file mode 100644 index 0000000..18ab87a --- /dev/null +++ b/t/samples/atom-10-example.xml @@ -0,0 +1,20 @@ + + + + Example Feed + + 2003-12-13T18:30:02Z + + John Doe + + urn:uuid:60a76c80-d399-11d9-b93C-0003939e0af6 + + + Atom-Powered Robots Run Amok + + urn:uuid:1225c695-cfb8-4ebb-aaaa-80da344efa6a + 2003-12-13T18:30:02Z + Some text. + + +