libxml-rss-libxml-perl-0.3102+dfsg.orig/0000755000175000017500000000000011637345541020171 5ustar nicholasnicholaslibxml-rss-libxml-perl-0.3102+dfsg.orig/Makefile.PL0000755000175000017500000000061611633751314022144 0ustar nicholasnicholas#!perl use strict; use inc::Module::Install; name('XML-RSS-LibXML'); all_from('lib/XML/RSS/LibXML.pm'); requires 'Class::Accessor::Fast'; requires 'DateTime::Format::Mail'; requires 'DateTime::Format::W3CDTF'; requires 'Encode'; requires 'UNIVERSAL::require'; requires 'XML::LibXML', '1.66'; requires 'XML::LibXML::XPathContext'; auto_set_repository; tests 't/*.t'; author_tests 'xt'; WriteAll; libxml-rss-libxml-perl-0.3102+dfsg.orig/META.yml0000644000175000017500000000144411633756753021454 0ustar nicholasnicholas--- abstract: 'XML::RSS with XML::LibXML' author: - '-2007 Daisuke Maki , Tatsuhiko Miyagawa . All rights reserved.' build_requires: ExtUtils::MakeMaker: 6.42 configure_requires: ExtUtils::MakeMaker: 6.42 distribution_type: module generated_by: 'Module::Install version 1.01' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: XML-RSS-LibXML no_index: directory: - inc - t - xt requires: Class::Accessor::Fast: 0 DateTime::Format::Mail: 0 DateTime::Format::W3CDTF: 0 Encode: 0 UNIVERSAL::require: 0 XML::LibXML: 1.66 XML::LibXML::XPathContext: 0 resources: license: http://dev.perl.org/licenses/ repository: git://github.com/lestrrat/XML-RSS-LibXML.git version: 0.3102 libxml-rss-libxml-perl-0.3102+dfsg.orig/inc/0000755000175000017500000000000011637345541020742 5ustar nicholasnicholaslibxml-rss-libxml-perl-0.3102+dfsg.orig/inc/Module/0000755000175000017500000000000011633756770022175 5ustar nicholasnicholaslibxml-rss-libxml-perl-0.3102+dfsg.orig/inc/Module/Install.pm0000644000175000017500000003013511633756752024143 0ustar nicholasnicholas#line 1 package Module::Install; # For any maintainers: # The load order for Module::Install is a bit magic. # It goes something like this... # # IF ( host has Module::Install installed, creating author mode ) { # 1. Makefile.PL calls "use inc::Module::Install" # 2. $INC{inc/Module/Install.pm} set to installed version of inc::Module::Install # 3. The installed version of inc::Module::Install loads # 4. inc::Module::Install calls "require Module::Install" # 5. The ./inc/ version of Module::Install loads # } ELSE { # 1. Makefile.PL calls "use inc::Module::Install" # 2. $INC{inc/Module/Install.pm} set to ./inc/ version of Module::Install # 3. The ./inc/ version of Module::Install loads # } use 5.005; use strict 'vars'; use Cwd (); use File::Find (); use File::Path (); use vars qw{$VERSION $MAIN}; BEGIN { # All Module::Install core packages now require synchronised versions. # This will be used to ensure we don't accidentally load old or # different versions of modules. # This is not enforced yet, but will be some time in the next few # releases once we can make sure it won't clash with custom # Module::Install extensions. $VERSION = '1.01'; # Storage for the pseudo-singleton $MAIN = undef; *inc::Module::Install::VERSION = *VERSION; @inc::Module::Install::ISA = __PACKAGE__; } sub import { my $class = shift; my $self = $class->new(@_); my $who = $self->_caller; #------------------------------------------------------------- # all of the following checks should be included in import(), # to allow "eval 'require Module::Install; 1' to test # installation of Module::Install. (RT #51267) #------------------------------------------------------------- # Whether or not inc::Module::Install is actually loaded, the # $INC{inc/Module/Install.pm} is what will still get set as long as # the caller loaded module this in the documented manner. # If not set, the caller may NOT have loaded the bundled version, and thus # they may not have a MI version that works with the Makefile.PL. This would # result in false errors or unexpected behaviour. And we don't want that. my $file = join( '/', 'inc', split /::/, __PACKAGE__ ) . '.pm'; unless ( $INC{$file} ) { die <<"END_DIE" } Please invoke ${\__PACKAGE__} with: use inc::${\__PACKAGE__}; not: use ${\__PACKAGE__}; END_DIE # This reportedly fixes a rare Win32 UTC file time issue, but # as this is a non-cross-platform XS module not in the core, # we shouldn't really depend on it. See RT #24194 for detail. # (Also, this module only supports Perl 5.6 and above). eval "use Win32::UTCFileTime" if $^O eq 'MSWin32' && $] >= 5.006; # If the script that is loading Module::Install is from the future, # then make will detect this and cause it to re-run over and over # again. This is bad. Rather than taking action to touch it (which # is unreliable on some platforms and requires write permissions) # for now we should catch this and refuse to run. if ( -f $0 ) { my $s = (stat($0))[9]; # If the modification time is only slightly in the future, # sleep briefly to remove the problem. my $a = $s - time; if ( $a > 0 and $a < 5 ) { sleep 5 } # Too far in the future, throw an error. my $t = time; if ( $s > $t ) { die <<"END_DIE" } Your installer $0 has a modification time in the future ($s > $t). This is known to create infinite loops in make. Please correct this, then run $0 again. END_DIE } # Build.PL was formerly supported, but no longer is due to excessive # difficulty in implementing every single feature twice. if ( $0 =~ /Build.PL$/i ) { die <<"END_DIE" } Module::Install no longer supports Build.PL. It was impossible to maintain duel backends, and has been deprecated. Please remove all Build.PL files and only use the Makefile.PL installer. END_DIE #------------------------------------------------------------- # To save some more typing in Module::Install installers, every... # use inc::Module::Install # ...also acts as an implicit use strict. $^H |= strict::bits(qw(refs subs vars)); #------------------------------------------------------------- unless ( -f $self->{file} ) { foreach my $key (keys %INC) { delete $INC{$key} if $key =~ /Module\/Install/; } local $^W; require "$self->{path}/$self->{dispatch}.pm"; File::Path::mkpath("$self->{prefix}/$self->{author}"); $self->{admin} = "$self->{name}::$self->{dispatch}"->new( _top => $self ); $self->{admin}->init; @_ = ($class, _self => $self); goto &{"$self->{name}::import"}; } local $^W; *{"${who}::AUTOLOAD"} = $self->autoload; $self->preload; # Unregister loader and worker packages so subdirs can use them again delete $INC{'inc/Module/Install.pm'}; delete $INC{'Module/Install.pm'}; # Save to the singleton $MAIN = $self; return 1; } sub autoload { my $self = shift; my $who = $self->_caller; my $cwd = Cwd::cwd(); my $sym = "${who}::AUTOLOAD"; $sym->{$cwd} = sub { my $pwd = Cwd::cwd(); if ( my $code = $sym->{$pwd} ) { # Delegate back to parent dirs goto &$code unless $cwd eq $pwd; } unless ($$sym =~ s/([^:]+)$//) { # XXX: it looks like we can't retrieve the missing function # via $$sym (usually $main::AUTOLOAD) in this case. # I'm still wondering if we should slurp Makefile.PL to # get some context or not ... my ($package, $file, $line) = caller; die <<"EOT"; Unknown function is found at $file line $line. Execution of $file aborted due to runtime errors. If you're a contributor to a project, you may need to install some Module::Install extensions from CPAN (or other repository). If you're a user of a module, please contact the author. EOT } my $method = $1; if ( uc($method) eq $method ) { # Do nothing return; } elsif ( $method =~ /^_/ and $self->can($method) ) { # Dispatch to the root M:I class return $self->$method(@_); } # Dispatch to the appropriate plugin unshift @_, ( $self, $1 ); goto &{$self->can('call')}; }; } sub preload { my $self = shift; unless ( $self->{extensions} ) { $self->load_extensions( "$self->{prefix}/$self->{path}", $self ); } my @exts = @{$self->{extensions}}; unless ( @exts ) { @exts = $self->{admin}->load_all_extensions; } my %seen; foreach my $obj ( @exts ) { while (my ($method, $glob) = each %{ref($obj) . '::'}) { next unless $obj->can($method); next if $method =~ /^_/; next if $method eq uc($method); $seen{$method}++; } } my $who = $self->_caller; foreach my $name ( sort keys %seen ) { local $^W; *{"${who}::$name"} = sub { ${"${who}::AUTOLOAD"} = "${who}::$name"; goto &{"${who}::AUTOLOAD"}; }; } } sub new { my ($class, %args) = @_; delete $INC{'FindBin.pm'}; { # to suppress the redefine warning local $SIG{__WARN__} = sub {}; require FindBin; } # ignore the prefix on extension modules built from top level. my $base_path = Cwd::abs_path($FindBin::Bin); unless ( Cwd::abs_path(Cwd::cwd()) eq $base_path ) { delete $args{prefix}; } return $args{_self} if $args{_self}; $args{dispatch} ||= 'Admin'; $args{prefix} ||= 'inc'; $args{author} ||= ($^O eq 'VMS' ? '_author' : '.author'); $args{bundle} ||= 'inc/BUNDLES'; $args{base} ||= $base_path; $class =~ s/^\Q$args{prefix}\E:://; $args{name} ||= $class; $args{version} ||= $class->VERSION; unless ( $args{path} ) { $args{path} = $args{name}; $args{path} =~ s!::!/!g; } $args{file} ||= "$args{base}/$args{prefix}/$args{path}.pm"; $args{wrote} = 0; bless( \%args, $class ); } sub call { my ($self, $method) = @_; my $obj = $self->load($method) or return; splice(@_, 0, 2, $obj); goto &{$obj->can($method)}; } sub load { my ($self, $method) = @_; $self->load_extensions( "$self->{prefix}/$self->{path}", $self ) unless $self->{extensions}; foreach my $obj (@{$self->{extensions}}) { return $obj if $obj->can($method); } my $admin = $self->{admin} or die <<"END_DIE"; The '$method' method does not exist in the '$self->{prefix}' path! Please remove the '$self->{prefix}' directory and run $0 again to load it. END_DIE my $obj = $admin->load($method, 1); push @{$self->{extensions}}, $obj; $obj; } sub load_extensions { my ($self, $path, $top) = @_; my $should_reload = 0; unless ( grep { ! ref $_ and lc $_ eq lc $self->{prefix} } @INC ) { unshift @INC, $self->{prefix}; $should_reload = 1; } foreach my $rv ( $self->find_extensions($path) ) { my ($file, $pkg) = @{$rv}; next if $self->{pathnames}{$pkg}; local $@; my $new = eval { local $^W; require $file; $pkg->can('new') }; unless ( $new ) { warn $@ if $@; next; } $self->{pathnames}{$pkg} = $should_reload ? delete $INC{$file} : $INC{$file}; push @{$self->{extensions}}, &{$new}($pkg, _top => $top ); } $self->{extensions} ||= []; } sub find_extensions { my ($self, $path) = @_; my @found; File::Find::find( sub { my $file = $File::Find::name; return unless $file =~ m!^\Q$path\E/(.+)\.pm\Z!is; my $subpath = $1; return if lc($subpath) eq lc($self->{dispatch}); $file = "$self->{path}/$subpath.pm"; my $pkg = "$self->{name}::$subpath"; $pkg =~ s!/!::!g; # If we have a mixed-case package name, assume case has been preserved # correctly. Otherwise, root through the file to locate the case-preserved # version of the package name. if ( $subpath eq lc($subpath) || $subpath eq uc($subpath) ) { my $content = Module::Install::_read($subpath . '.pm'); my $in_pod = 0; foreach ( split //, $content ) { $in_pod = 1 if /^=\w/; $in_pod = 0 if /^=cut/; next if ($in_pod || /^=cut/); # skip pod text next if /^\s*#/; # and comments if ( m/^\s*package\s+($pkg)\s*;/i ) { $pkg = $1; last; } } } push @found, [ $file, $pkg ]; }, $path ) if -d $path; @found; } ##################################################################### # Common Utility Functions sub _caller { my $depth = 0; my $call = caller($depth); while ( $call eq __PACKAGE__ ) { $depth++; $call = caller($depth); } return $call; } # Done in evals to avoid confusing Perl::MinimumVersion eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@; sub _read { local *FH; open( FH, '<', $_[0] ) or die "open($_[0]): $!"; my $string = do { local $/; }; close FH or die "close($_[0]): $!"; return $string; } END_NEW sub _read { local *FH; open( FH, "< $_[0]" ) or die "open($_[0]): $!"; my $string = do { local $/; }; close FH or die "close($_[0]): $!"; return $string; } END_OLD sub _readperl { my $string = Module::Install::_read($_[0]); $string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg; $string =~ s/(\n)\n*__(?:DATA|END)__\b.*\z/$1/s; $string =~ s/\n\n=\w+.+?\n\n=cut\b.+?\n+/\n\n/sg; return $string; } sub _readpod { my $string = Module::Install::_read($_[0]); $string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg; return $string if $_[0] =~ /\.pod\z/; $string =~ s/(^|\n=cut\b.+?\n+)[^=\s].+?\n(\n=\w+|\z)/$1$2/sg; $string =~ s/\n*=pod\b[^\n]*\n+/\n\n/sg; $string =~ s/\n*=cut\b[^\n]*\n+/\n\n/sg; $string =~ s/^\n+//s; return $string; } # Done in evals to avoid confusing Perl::MinimumVersion eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@; sub _write { local *FH; open( FH, '>', $_[0] ) or die "open($_[0]): $!"; foreach ( 1 .. $#_ ) { print FH $_[$_] or die "print($_[0]): $!"; } close FH or die "close($_[0]): $!"; } END_NEW sub _write { local *FH; open( FH, "> $_[0]" ) or die "open($_[0]): $!"; foreach ( 1 .. $#_ ) { print FH $_[$_] or die "print($_[0]): $!"; } close FH or die "close($_[0]): $!"; } END_OLD # _version is for processing module versions (eg, 1.03_05) not # Perl versions (eg, 5.8.1). sub _version ($) { my $s = shift || 0; my $d =()= $s =~ /(\.)/g; if ( $d >= 2 ) { # Normalise multipart versions $s =~ s/(\.)(\d{1,3})/sprintf("$1%03d",$2)/eg; } $s =~ s/^(\d+)\.?//; my $l = $1 || 0; my @v = map { $_ . '0' x (3 - length $_) } $s =~ /(\d{1,3})\D?/g; $l = $l . '.' . join '', @v if @v; return $l + 0; } sub _cmp ($$) { _version($_[0]) <=> _version($_[1]); } # Cloned from Params::Util::_CLASS sub _CLASS ($) { ( defined $_[0] and ! ref $_[0] and $_[0] =~ m/^[^\W\d]\w*(?:::\w+)*\z/s ) ? $_[0] : undef; } 1; # Copyright 2008 - 2011 Adam Kennedy. libxml-rss-libxml-perl-0.3102+dfsg.orig/inc/Module/Install/0000755000175000017500000000000011637345541023575 5ustar nicholasnicholaslibxml-rss-libxml-perl-0.3102+dfsg.orig/inc/Module/Install/WriteAll.pm0000644000175000017500000000237611633756753025675 0ustar nicholasnicholas#line 1 package Module::Install::WriteAll; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.01'; @ISA = qw{Module::Install::Base}; $ISCORE = 1; } sub WriteAll { my $self = shift; my %args = ( meta => 1, sign => 0, inline => 0, check_nmake => 1, @_, ); $self->sign(1) if $args{sign}; $self->admin->WriteAll(%args) if $self->is_admin; $self->check_nmake if $args{check_nmake}; unless ( $self->makemaker_args->{PL_FILES} ) { # XXX: This still may be a bit over-defensive... unless ($self->makemaker(6.25)) { $self->makemaker_args( PL_FILES => {} ) if -f 'Build.PL'; } } # Until ExtUtils::MakeMaker support MYMETA.yml, make sure # we clean it up properly ourself. $self->realclean_files('MYMETA.yml'); if ( $args{inline} ) { $self->Inline->write; } else { $self->Makefile->write; } # The Makefile write process adds a couple of dependencies, # so write the META.yml files after the Makefile. if ( $args{meta} ) { $self->Meta->write; } # Experimental support for MYMETA if ( $ENV{X_MYMETA} ) { if ( $ENV{X_MYMETA} eq 'JSON' ) { $self->Meta->write_mymeta_json; } else { $self->Meta->write_mymeta_yaml; } } return 1; } 1; libxml-rss-libxml-perl-0.3102+dfsg.orig/inc/Module/Install/Fetch.pm0000644000175000017500000000462711633756753025204 0ustar nicholasnicholas#line 1 package Module::Install::Fetch; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.01'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } sub get_file { my ($self, %args) = @_; my ($scheme, $host, $path, $file) = $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return; if ( $scheme eq 'http' and ! eval { require LWP::Simple; 1 } ) { $args{url} = $args{ftp_url} or (warn("LWP support unavailable!\n"), return); ($scheme, $host, $path, $file) = $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return; } $|++; print "Fetching '$file' from $host... "; unless (eval { require Socket; Socket::inet_aton($host) }) { warn "'$host' resolve failed!\n"; return; } return unless $scheme eq 'ftp' or $scheme eq 'http'; require Cwd; my $dir = Cwd::getcwd(); chdir $args{local_dir} or return if exists $args{local_dir}; if (eval { require LWP::Simple; 1 }) { LWP::Simple::mirror($args{url}, $file); } elsif (eval { require Net::FTP; 1 }) { eval { # use Net::FTP to get past firewall my $ftp = Net::FTP->new($host, Passive => 1, Timeout => 600); $ftp->login("anonymous", 'anonymous@example.com'); $ftp->cwd($path); $ftp->binary; $ftp->get($file) or (warn("$!\n"), return); $ftp->quit; } } elsif (my $ftp = $self->can_run('ftp')) { eval { # no Net::FTP, fallback to ftp.exe require FileHandle; my $fh = FileHandle->new; local $SIG{CHLD} = 'IGNORE'; unless ($fh->open("|$ftp -n")) { warn "Couldn't open ftp: $!\n"; chdir $dir; return; } my @dialog = split(/\n/, <<"END_FTP"); open $host user anonymous anonymous\@example.com cd $path binary get $file $file quit END_FTP foreach (@dialog) { $fh->print("$_\n") } $fh->close; } } else { warn "No working 'ftp' program available!\n"; chdir $dir; return; } unless (-f $file) { warn "Fetching failed: $@\n"; chdir $dir; return; } return if exists $args{size} and -s $file != $args{size}; system($args{run}) if exists $args{run}; unlink($file) if $args{remove}; print(((!exists $args{check_for} or -e $args{check_for}) ? "done!" : "failed! ($!)"), "\n"); chdir $dir; return !$?; } 1; libxml-rss-libxml-perl-0.3102+dfsg.orig/inc/Module/Install/Win32.pm0000644000175000017500000000340311633756753025044 0ustar nicholasnicholas#line 1 package Module::Install::Win32; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.01'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } # determine if the user needs nmake, and download it if needed sub check_nmake { my $self = shift; $self->load('can_run'); $self->load('get_file'); require Config; return unless ( $^O eq 'MSWin32' and $Config::Config{make} and $Config::Config{make} =~ /^nmake\b/i and ! $self->can_run('nmake') ); print "The required 'nmake' executable not found, fetching it...\n"; require File::Basename; my $rv = $self->get_file( url => 'http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe', ftp_url => 'ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe', local_dir => File::Basename::dirname($^X), size => 51928, run => 'Nmake15.exe /o > nul', check_for => 'Nmake.exe', remove => 1, ); die <<'END_MESSAGE' unless $rv; ------------------------------------------------------------------------------- Since you are using Microsoft Windows, you will need the 'nmake' utility before installation. It's available at: http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe or ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe Please download the file manually, save it to a directory in %PATH% (e.g. C:\WINDOWS\COMMAND\), then launch the MS-DOS command line shell, "cd" to that directory, and run "Nmake15.exe" from there; that will create the 'nmake.exe' file needed by this module. You may then resume the installation process described in README. ------------------------------------------------------------------------------- END_MESSAGE } 1; libxml-rss-libxml-perl-0.3102+dfsg.orig/inc/Module/Install/AuthorTests.pm0000644000175000017500000000221511633756753026427 0ustar nicholasnicholas#line 1 package Module::Install::AuthorTests; use 5.005; use strict; use Module::Install::Base; use Carp (); #line 16 use vars qw{$VERSION $ISCORE @ISA}; BEGIN { $VERSION = '0.002'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } #line 42 sub author_tests { my ($self, @dirs) = @_; _add_author_tests($self, \@dirs, 0); } #line 56 sub recursive_author_tests { my ($self, @dirs) = @_; _add_author_tests($self, \@dirs, 1); } sub _wanted { my $href = shift; sub { /\.t$/ and -f $_ and $href->{$File::Find::dir} = 1 } } sub _add_author_tests { my ($self, $dirs, $recurse) = @_; return unless $Module::Install::AUTHOR; my @tests = $self->tests ? (split / /, $self->tests) : 't/*.t'; # XXX: pick a default, later -- rjbs, 2008-02-24 my @dirs = @$dirs ? @$dirs : Carp::confess "no dirs given to author_tests"; @dirs = grep { -d } @dirs; if ($recurse) { require File::Find; my %test_dir; File::Find::find(_wanted(\%test_dir), @dirs); $self->tests( join ' ', @tests, map { "$_/*.t" } sort keys %test_dir ); } else { $self->tests( join ' ', @tests, map { "$_/*.t" } sort @dirs ); } } #line 107 1; libxml-rss-libxml-perl-0.3102+dfsg.orig/inc/Module/Install/Metadata.pm0000644000175000017500000004312311633756753025665 0ustar nicholasnicholas#line 1 package Module::Install::Metadata; use strict 'vars'; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.01'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } my @boolean_keys = qw{ sign }; my @scalar_keys = qw{ name module_name abstract version distribution_type tests installdirs }; my @tuple_keys = qw{ configure_requires build_requires requires recommends bundles resources }; my @resource_keys = qw{ homepage bugtracker repository }; my @array_keys = qw{ keywords author }; *authors = \&author; sub Meta { shift } sub Meta_BooleanKeys { @boolean_keys } sub Meta_ScalarKeys { @scalar_keys } sub Meta_TupleKeys { @tuple_keys } sub Meta_ResourceKeys { @resource_keys } sub Meta_ArrayKeys { @array_keys } foreach my $key ( @boolean_keys ) { *$key = sub { my $self = shift; if ( defined wantarray and not @_ ) { return $self->{values}->{$key}; } $self->{values}->{$key} = ( @_ ? $_[0] : 1 ); return $self; }; } foreach my $key ( @scalar_keys ) { *$key = sub { my $self = shift; return $self->{values}->{$key} if defined wantarray and !@_; $self->{values}->{$key} = shift; return $self; }; } foreach my $key ( @array_keys ) { *$key = sub { my $self = shift; return $self->{values}->{$key} if defined wantarray and !@_; $self->{values}->{$key} ||= []; push @{$self->{values}->{$key}}, @_; return $self; }; } foreach my $key ( @resource_keys ) { *$key = sub { my $self = shift; unless ( @_ ) { return () unless $self->{values}->{resources}; return map { $_->[1] } grep { $_->[0] eq $key } @{ $self->{values}->{resources} }; } return $self->{values}->{resources}->{$key} unless @_; my $uri = shift or die( "Did not provide a value to $key()" ); $self->resources( $key => $uri ); return 1; }; } foreach my $key ( grep { $_ ne "resources" } @tuple_keys) { *$key = sub { my $self = shift; return $self->{values}->{$key} unless @_; my @added; while ( @_ ) { my $module = shift or last; my $version = shift || 0; push @added, [ $module, $version ]; } push @{ $self->{values}->{$key} }, @added; return map {@$_} @added; }; } # Resource handling my %lc_resource = map { $_ => 1 } qw{ homepage license bugtracker repository }; sub resources { my $self = shift; while ( @_ ) { my $name = shift or last; my $value = shift or next; if ( $name eq lc $name and ! $lc_resource{$name} ) { die("Unsupported reserved lowercase resource '$name'"); } $self->{values}->{resources} ||= []; push @{ $self->{values}->{resources} }, [ $name, $value ]; } $self->{values}->{resources}; } # Aliases for build_requires that will have alternative # meanings in some future version of META.yml. sub test_requires { shift->build_requires(@_) } sub install_requires { shift->build_requires(@_) } # Aliases for installdirs options sub install_as_core { $_[0]->installdirs('perl') } sub install_as_cpan { $_[0]->installdirs('site') } sub install_as_site { $_[0]->installdirs('site') } sub install_as_vendor { $_[0]->installdirs('vendor') } sub dynamic_config { my $self = shift; unless ( @_ ) { warn "You MUST provide an explicit true/false value to dynamic_config\n"; return $self; } $self->{values}->{dynamic_config} = $_[0] ? 1 : 0; return 1; } sub perl_version { my $self = shift; return $self->{values}->{perl_version} unless @_; my $version = shift or die( "Did not provide a value to perl_version()" ); # Normalize the version $version = $self->_perl_version($version); # We don't support the reall old versions unless ( $version >= 5.005 ) { die "Module::Install only supports 5.005 or newer (use ExtUtils::MakeMaker)\n"; } $self->{values}->{perl_version} = $version; } sub all_from { my ( $self, $file ) = @_; unless ( defined($file) ) { my $name = $self->name or die( "all_from called with no args without setting name() first" ); $file = join('/', 'lib', split(/-/, $name)) . '.pm'; $file =~ s{.*/}{} unless -e $file; unless ( -e $file ) { die("all_from cannot find $file from $name"); } } unless ( -f $file ) { die("The path '$file' does not exist, or is not a file"); } $self->{values}{all_from} = $file; # Some methods pull from POD instead of code. # If there is a matching .pod, use that instead my $pod = $file; $pod =~ s/\.pm$/.pod/i; $pod = $file unless -e $pod; # Pull the different values $self->name_from($file) unless $self->name; $self->version_from($file) unless $self->version; $self->perl_version_from($file) unless $self->perl_version; $self->author_from($pod) unless @{$self->author || []}; $self->license_from($pod) unless $self->license; $self->abstract_from($pod) unless $self->abstract; return 1; } sub provides { my $self = shift; my $provides = ( $self->{values}->{provides} ||= {} ); %$provides = (%$provides, @_) if @_; return $provides; } sub auto_provides { my $self = shift; return $self unless $self->is_admin; unless (-e 'MANIFEST') { warn "Cannot deduce auto_provides without a MANIFEST, skipping\n"; return $self; } # Avoid spurious warnings as we are not checking manifest here. local $SIG{__WARN__} = sub {1}; require ExtUtils::Manifest; local *ExtUtils::Manifest::manicheck = sub { return }; require Module::Build; my $build = Module::Build->new( dist_name => $self->name, dist_version => $self->version, license => $self->license, ); $self->provides( %{ $build->find_dist_packages || {} } ); } sub feature { my $self = shift; my $name = shift; my $features = ( $self->{values}->{features} ||= [] ); my $mods; if ( @_ == 1 and ref( $_[0] ) ) { # The user used ->feature like ->features by passing in the second # argument as a reference. Accomodate for that. $mods = $_[0]; } else { $mods = \@_; } my $count = 0; push @$features, ( $name => [ map { ref($_) ? ( ref($_) eq 'HASH' ) ? %$_ : @$_ : $_ } @$mods ] ); return @$features; } sub features { my $self = shift; while ( my ( $name, $mods ) = splice( @_, 0, 2 ) ) { $self->feature( $name, @$mods ); } return $self->{values}->{features} ? @{ $self->{values}->{features} } : (); } sub no_index { my $self = shift; my $type = shift; push @{ $self->{values}->{no_index}->{$type} }, @_ if $type; return $self->{values}->{no_index}; } sub read { my $self = shift; $self->include_deps( 'YAML::Tiny', 0 ); require YAML::Tiny; my $data = YAML::Tiny::LoadFile('META.yml'); # Call methods explicitly in case user has already set some values. while ( my ( $key, $value ) = each %$data ) { next unless $self->can($key); if ( ref $value eq 'HASH' ) { while ( my ( $module, $version ) = each %$value ) { $self->can($key)->($self, $module => $version ); } } else { $self->can($key)->($self, $value); } } return $self; } sub write { my $self = shift; return $self unless $self->is_admin; $self->admin->write_meta; return $self; } sub version_from { require ExtUtils::MM_Unix; my ( $self, $file ) = @_; $self->version( ExtUtils::MM_Unix->parse_version($file) ); # for version integrity check $self->makemaker_args( VERSION_FROM => $file ); } sub abstract_from { require ExtUtils::MM_Unix; my ( $self, $file ) = @_; $self->abstract( bless( { DISTNAME => $self->name }, 'ExtUtils::MM_Unix' )->parse_abstract($file) ); } # Add both distribution and module name sub name_from { my ($self, $file) = @_; if ( Module::Install::_read($file) =~ m/ ^ \s* package \s* ([\w:]+) \s* ; /ixms ) { my ($name, $module_name) = ($1, $1); $name =~ s{::}{-}g; $self->name($name); unless ( $self->module_name ) { $self->module_name($module_name); } } else { die("Cannot determine name from $file\n"); } } sub _extract_perl_version { if ( $_[0] =~ m/ ^\s* (?:use|require) \s* v? ([\d_\.]+) \s* ; /ixms ) { my $perl_version = $1; $perl_version =~ s{_}{}g; return $perl_version; } else { return; } } sub perl_version_from { my $self = shift; my $perl_version=_extract_perl_version(Module::Install::_read($_[0])); if ($perl_version) { $self->perl_version($perl_version); } else { warn "Cannot determine perl version info from $_[0]\n"; return; } } sub author_from { my $self = shift; my $content = Module::Install::_read($_[0]); if ($content =~ m/ =head \d \s+ (?:authors?)\b \s* ([^\n]*) | =head \d \s+ (?:licen[cs]e|licensing|copyright|legal)\b \s* .*? copyright .*? \d\d\d[\d.]+ \s* (?:\bby\b)? \s* ([^\n]*) /ixms) { my $author = $1 || $2; # XXX: ugly but should work anyway... if (eval "require Pod::Escapes; 1") { # Pod::Escapes has a mapping table. # It's in core of perl >= 5.9.3, and should be installed # as one of the Pod::Simple's prereqs, which is a prereq # of Pod::Text 3.x (see also below). $author =~ s{ E<( (\d+) | ([A-Za-z]+) )> } { defined $2 ? chr($2) : defined $Pod::Escapes::Name2character_number{$1} ? chr($Pod::Escapes::Name2character_number{$1}) : do { warn "Unknown escape: E<$1>"; "E<$1>"; }; }gex; } elsif (eval "require Pod::Text; 1" && $Pod::Text::VERSION < 3) { # Pod::Text < 3.0 has yet another mapping table, # though the table name of 2.x and 1.x are different. # (1.x is in core of Perl < 5.6, 2.x is in core of # Perl < 5.9.3) my $mapping = ($Pod::Text::VERSION < 2) ? \%Pod::Text::HTML_Escapes : \%Pod::Text::ESCAPES; $author =~ s{ E<( (\d+) | ([A-Za-z]+) )> } { defined $2 ? chr($2) : defined $mapping->{$1} ? $mapping->{$1} : do { warn "Unknown escape: E<$1>"; "E<$1>"; }; }gex; } else { $author =~ s{E}{<}g; $author =~ s{E}{>}g; } $self->author($author); } else { warn "Cannot determine author info from $_[0]\n"; } } #Stolen from M::B my %license_urls = ( perl => 'http://dev.perl.org/licenses/', apache => 'http://apache.org/licenses/LICENSE-2.0', apache_1_1 => 'http://apache.org/licenses/LICENSE-1.1', artistic => 'http://opensource.org/licenses/artistic-license.php', artistic_2 => 'http://opensource.org/licenses/artistic-license-2.0.php', lgpl => 'http://opensource.org/licenses/lgpl-license.php', lgpl2 => 'http://opensource.org/licenses/lgpl-2.1.php', lgpl3 => 'http://opensource.org/licenses/lgpl-3.0.html', bsd => 'http://opensource.org/licenses/bsd-license.php', gpl => 'http://opensource.org/licenses/gpl-license.php', gpl2 => 'http://opensource.org/licenses/gpl-2.0.php', gpl3 => 'http://opensource.org/licenses/gpl-3.0.html', mit => 'http://opensource.org/licenses/mit-license.php', mozilla => 'http://opensource.org/licenses/mozilla1.1.php', open_source => undef, unrestricted => undef, restrictive => undef, unknown => undef, ); sub license { my $self = shift; return $self->{values}->{license} unless @_; my $license = shift or die( 'Did not provide a value to license()' ); $license = __extract_license($license) || lc $license; $self->{values}->{license} = $license; # Automatically fill in license URLs if ( $license_urls{$license} ) { $self->resources( license => $license_urls{$license} ); } return 1; } sub _extract_license { my $pod = shift; my $matched; return __extract_license( ($matched) = $pod =~ m/ (=head \d \s+ L(?i:ICEN[CS]E|ICENSING)\b.*?) (=head \d.*|=cut.*|)\z /xms ) || __extract_license( ($matched) = $pod =~ m/ (=head \d \s+ (?:C(?i:OPYRIGHTS?)|L(?i:EGAL))\b.*?) (=head \d.*|=cut.*|)\z /xms ); } sub __extract_license { my $license_text = shift or return; my @phrases = ( '(?:under )?the same (?:terms|license) as (?:perl|the perl (?:\d )?programming language)' => 'perl', 1, '(?:under )?the terms of (?:perl|the perl programming language) itself' => 'perl', 1, 'Artistic and GPL' => 'perl', 1, 'GNU general public license' => 'gpl', 1, 'GNU public license' => 'gpl', 1, 'GNU lesser general public license' => 'lgpl', 1, 'GNU lesser public license' => 'lgpl', 1, 'GNU library general public license' => 'lgpl', 1, 'GNU library public license' => 'lgpl', 1, 'GNU Free Documentation license' => 'unrestricted', 1, 'GNU Affero General Public License' => 'open_source', 1, '(?:Free)?BSD license' => 'bsd', 1, 'Artistic license 2\.0' => 'artistic_2', 1, 'Artistic license' => 'artistic', 1, 'Apache (?:Software )?license' => 'apache', 1, 'GPL' => 'gpl', 1, 'LGPL' => 'lgpl', 1, 'BSD' => 'bsd', 1, 'Artistic' => 'artistic', 1, 'MIT' => 'mit', 1, 'Mozilla Public License' => 'mozilla', 1, 'Q Public License' => 'open_source', 1, 'OpenSSL License' => 'unrestricted', 1, 'SSLeay License' => 'unrestricted', 1, 'zlib License' => 'open_source', 1, 'proprietary' => 'proprietary', 0, ); while ( my ($pattern, $license, $osi) = splice(@phrases, 0, 3) ) { $pattern =~ s#\s+#\\s+#gs; if ( $license_text =~ /\b$pattern\b/i ) { return $license; } } return ''; } sub license_from { my $self = shift; if (my $license=_extract_license(Module::Install::_read($_[0]))) { $self->license($license); } else { warn "Cannot determine license info from $_[0]\n"; return 'unknown'; } } sub _extract_bugtracker { my @links = $_[0] =~ m#L<( https?\Q://rt.cpan.org/\E[^>]+| https?\Q://github.com/\E[\w_]+/[\w_]+/issues| https?\Q://code.google.com/p/\E[\w_\-]+/issues/list )>#gx; my %links; @links{@links}=(); @links=keys %links; return @links; } sub bugtracker_from { my $self = shift; my $content = Module::Install::_read($_[0]); my @links = _extract_bugtracker($content); unless ( @links ) { warn "Cannot determine bugtracker info from $_[0]\n"; return 0; } if ( @links > 1 ) { warn "Found more than one bugtracker link in $_[0]\n"; return 0; } # Set the bugtracker bugtracker( $links[0] ); return 1; } sub requires_from { my $self = shift; my $content = Module::Install::_readperl($_[0]); my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+([\d\.]+)/mg; while ( @requires ) { my $module = shift @requires; my $version = shift @requires; $self->requires( $module => $version ); } } sub test_requires_from { my $self = shift; my $content = Module::Install::_readperl($_[0]); my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+([\d\.]+)/mg; while ( @requires ) { my $module = shift @requires; my $version = shift @requires; $self->test_requires( $module => $version ); } } # Convert triple-part versions (eg, 5.6.1 or 5.8.9) to # numbers (eg, 5.006001 or 5.008009). # Also, convert double-part versions (eg, 5.8) sub _perl_version { my $v = $_[-1]; $v =~ s/^([1-9])\.([1-9]\d?\d?)$/sprintf("%d.%03d",$1,$2)/e; $v =~ s/^([1-9])\.([1-9]\d?\d?)\.(0|[1-9]\d?\d?)$/sprintf("%d.%03d%03d",$1,$2,$3 || 0)/e; $v =~ s/(\.\d\d\d)000$/$1/; $v =~ s/_.+$//; if ( ref($v) ) { # Numify $v = $v + 0; } return $v; } sub add_metadata { my $self = shift; my %hash = @_; for my $key (keys %hash) { warn "add_metadata: $key is not prefixed with 'x_'.\n" . "Use appopriate function to add non-private metadata.\n" unless $key =~ /^x_/; $self->{values}->{$key} = $hash{$key}; } } ###################################################################### # MYMETA Support sub WriteMyMeta { die "WriteMyMeta has been deprecated"; } sub write_mymeta_yaml { my $self = shift; # We need YAML::Tiny to write the MYMETA.yml file unless ( eval { require YAML::Tiny; 1; } ) { return 1; } # Generate the data my $meta = $self->_write_mymeta_data or return 1; # Save as the MYMETA.yml file print "Writing MYMETA.yml\n"; YAML::Tiny::DumpFile('MYMETA.yml', $meta); } sub write_mymeta_json { my $self = shift; # We need JSON to write the MYMETA.json file unless ( eval { require JSON; 1; } ) { return 1; } # Generate the data my $meta = $self->_write_mymeta_data or return 1; # Save as the MYMETA.yml file print "Writing MYMETA.json\n"; Module::Install::_write( 'MYMETA.json', JSON->new->pretty(1)->canonical->encode($meta), ); } sub _write_mymeta_data { my $self = shift; # If there's no existing META.yml there is nothing we can do return undef unless -f 'META.yml'; # We need Parse::CPAN::Meta to load the file unless ( eval { require Parse::CPAN::Meta; 1; } ) { return undef; } # Merge the perl version into the dependencies my $val = $self->Meta->{values}; my $perl = delete $val->{perl_version}; if ( $perl ) { $val->{requires} ||= []; my $requires = $val->{requires}; # Canonize to three-dot version after Perl 5.6 if ( $perl >= 5.006 ) { $perl =~ s{^(\d+)\.(\d\d\d)(\d*)}{join('.', $1, int($2||0), int($3||0))}e } unshift @$requires, [ perl => $perl ]; } # Load the advisory META.yml file my @yaml = Parse::CPAN::Meta::LoadFile('META.yml'); my $meta = $yaml[0]; # Overwrite the non-configure dependency hashs delete $meta->{requires}; delete $meta->{build_requires}; delete $meta->{recommends}; if ( exists $val->{requires} ) { $meta->{requires} = { map { @$_ } @{ $val->{requires} } }; } if ( exists $val->{build_requires} ) { $meta->{build_requires} = { map { @$_ } @{ $val->{build_requires} } }; } return $meta; } 1; libxml-rss-libxml-perl-0.3102+dfsg.orig/inc/Module/Install/Base.pm0000644000175000017500000000214711633756753025020 0ustar nicholasnicholas#line 1 package Module::Install::Base; use strict 'vars'; use vars qw{$VERSION}; BEGIN { $VERSION = '1.01'; } # Suspend handler for "redefined" warnings BEGIN { my $w = $SIG{__WARN__}; $SIG{__WARN__} = sub { $w }; } #line 42 sub new { my $class = shift; unless ( defined &{"${class}::call"} ) { *{"${class}::call"} = sub { shift->_top->call(@_) }; } unless ( defined &{"${class}::load"} ) { *{"${class}::load"} = sub { shift->_top->load(@_) }; } bless { @_ }, $class; } #line 61 sub AUTOLOAD { local $@; my $func = eval { shift->_top->autoload } or return; goto &$func; } #line 75 sub _top { $_[0]->{_top}; } #line 90 sub admin { $_[0]->_top->{admin} or Module::Install::Base::FakeAdmin->new; } #line 106 sub is_admin { ! $_[0]->admin->isa('Module::Install::Base::FakeAdmin'); } sub DESTROY {} package Module::Install::Base::FakeAdmin; use vars qw{$VERSION}; BEGIN { $VERSION = $Module::Install::Base::VERSION; } my $fake; sub new { $fake ||= bless(\@_, $_[0]); } sub AUTOLOAD {} sub DESTROY {} # Restore warning handler BEGIN { $SIG{__WARN__} = $SIG{__WARN__}->(); } 1; #line 159 libxml-rss-libxml-perl-0.3102+dfsg.orig/inc/Module/Install/Can.pm0000644000175000017500000000333311633756753024645 0ustar nicholasnicholas#line 1 package Module::Install::Can; use strict; use Config (); use File::Spec (); use ExtUtils::MakeMaker (); use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.01'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } # check if we can load some module ### Upgrade this to not have to load the module if possible sub can_use { my ($self, $mod, $ver) = @_; $mod =~ s{::|\\}{/}g; $mod .= '.pm' unless $mod =~ /\.pm$/i; my $pkg = $mod; $pkg =~ s{/}{::}g; $pkg =~ s{\.pm$}{}i; local $@; eval { require $mod; $pkg->VERSION($ver || 0); 1 }; } # check if we can run some command sub can_run { my ($self, $cmd) = @_; my $_cmd = $cmd; return $_cmd if (-x $_cmd or $_cmd = MM->maybe_command($_cmd)); for my $dir ((split /$Config::Config{path_sep}/, $ENV{PATH}), '.') { next if $dir eq ''; my $abs = File::Spec->catfile($dir, $_[1]); return $abs if (-x $abs or $abs = MM->maybe_command($abs)); } return; } # can we locate a (the) C compiler sub can_cc { my $self = shift; my @chunks = split(/ /, $Config::Config{cc}) or return; # $Config{cc} may contain args; try to find out the program part while (@chunks) { return $self->can_run("@chunks") || (pop(@chunks), next); } return; } # Fix Cygwin bug on maybe_command(); if ( $^O eq 'cygwin' ) { require ExtUtils::MM_Cygwin; require ExtUtils::MM_Win32; if ( ! defined(&ExtUtils::MM_Cygwin::maybe_command) ) { *ExtUtils::MM_Cygwin::maybe_command = sub { my ($self, $file) = @_; if ($file =~ m{^/cygdrive/}i and ExtUtils::MM_Win32->can('maybe_command')) { ExtUtils::MM_Win32->maybe_command($file); } else { ExtUtils::MM_Unix->maybe_command($file); } } } } 1; __END__ #line 156 libxml-rss-libxml-perl-0.3102+dfsg.orig/inc/Module/Install/Repository.pm0000644000175000017500000000425611633756753026330 0ustar nicholasnicholas#line 1 package Module::Install::Repository; use strict; use 5.005; use vars qw($VERSION); $VERSION = '0.06'; use base qw(Module::Install::Base); sub _execute { my ($command) = @_; `$command`; } sub auto_set_repository { my $self = shift; return unless $Module::Install::AUTHOR; my $repo = _find_repo(\&_execute); if ($repo) { $self->repository($repo); } else { warn "Cannot determine repository URL\n"; } } sub _find_repo { my ($execute) = @_; if (-e ".git") { # TODO support remote besides 'origin'? if ($execute->('git remote show -n origin') =~ /URL: (.*)$/m) { # XXX Make it public clone URL, but this only works with github my $git_url = $1; $git_url =~ s![\w\-]+\@([^:]+):!git://$1/!; return $git_url; } elsif ($execute->('git svn info') =~ /URL: (.*)$/m) { return $1; } } elsif (-e ".svn") { if (`svn info` =~ /URL: (.*)$/m) { return $1; } } elsif (-e "_darcs") { # defaultrepo is better, but that is more likely to be ssh, not http if (my $query_repo = `darcs query repo`) { if ($query_repo =~ m!Default Remote: (http://.+)!) { return $1; } } open my $handle, '<', '_darcs/prefs/repos' or return; while (<$handle>) { chomp; return $_ if m!^http://!; } } elsif (-e ".hg") { if ($execute->('hg paths') =~ /default = (.*)$/m) { my $mercurial_url = $1; $mercurial_url =~ s!^ssh://hg\@(bitbucket\.org/)!https://$1!; return $mercurial_url; } } elsif (-e "$ENV{HOME}/.svk") { # Is there an explicit way to check if it's an svk checkout? my $svk_info = `svk info` or return; SVK_INFO: { if ($svk_info =~ /Mirrored From: (.*), Rev\./) { return $1; } if ($svk_info =~ m!Merged From: (/mirror/.*), Rev\.!) { $svk_info = `svk info /$1` or return; redo SVK_INFO; } } return; } } 1; __END__ =encoding utf-8 #line 128 libxml-rss-libxml-perl-0.3102+dfsg.orig/inc/Module/Install/Makefile.pm0000644000175000017500000002703211633756753025663 0ustar nicholasnicholas#line 1 package Module::Install::Makefile; use strict 'vars'; use ExtUtils::MakeMaker (); use Module::Install::Base (); use Fcntl qw/:flock :seek/; use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.01'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } sub Makefile { $_[0] } my %seen = (); sub prompt { shift; # Infinite loop protection my @c = caller(); if ( ++$seen{"$c[1]|$c[2]|$_[0]"} > 3 ) { die "Caught an potential prompt infinite loop ($c[1]|$c[2]|$_[0])"; } # In automated testing or non-interactive session, always use defaults if ( ($ENV{AUTOMATED_TESTING} or -! -t STDIN) and ! $ENV{PERL_MM_USE_DEFAULT} ) { local $ENV{PERL_MM_USE_DEFAULT} = 1; goto &ExtUtils::MakeMaker::prompt; } else { goto &ExtUtils::MakeMaker::prompt; } } # Store a cleaned up version of the MakeMaker version, # since we need to behave differently in a variety of # ways based on the MM version. my $makemaker = eval $ExtUtils::MakeMaker::VERSION; # If we are passed a param, do a "newer than" comparison. # Otherwise, just return the MakeMaker version. sub makemaker { ( @_ < 2 or $makemaker >= eval($_[1]) ) ? $makemaker : 0 } # Ripped from ExtUtils::MakeMaker 6.56, and slightly modified # as we only need to know here whether the attribute is an array # or a hash or something else (which may or may not be appendable). my %makemaker_argtype = ( C => 'ARRAY', CONFIG => 'ARRAY', # CONFIGURE => 'CODE', # ignore DIR => 'ARRAY', DL_FUNCS => 'HASH', DL_VARS => 'ARRAY', EXCLUDE_EXT => 'ARRAY', EXE_FILES => 'ARRAY', FUNCLIST => 'ARRAY', H => 'ARRAY', IMPORTS => 'HASH', INCLUDE_EXT => 'ARRAY', LIBS => 'ARRAY', # ignore '' MAN1PODS => 'HASH', MAN3PODS => 'HASH', META_ADD => 'HASH', META_MERGE => 'HASH', PL_FILES => 'HASH', PM => 'HASH', PMLIBDIRS => 'ARRAY', PMLIBPARENTDIRS => 'ARRAY', PREREQ_PM => 'HASH', CONFIGURE_REQUIRES => 'HASH', SKIP => 'ARRAY', TYPEMAPS => 'ARRAY', XS => 'HASH', # VERSION => ['version',''], # ignore # _KEEP_AFTER_FLUSH => '', clean => 'HASH', depend => 'HASH', dist => 'HASH', dynamic_lib=> 'HASH', linkext => 'HASH', macro => 'HASH', postamble => 'HASH', realclean => 'HASH', test => 'HASH', tool_autosplit => 'HASH', # special cases where you can use makemaker_append CCFLAGS => 'APPENDABLE', DEFINE => 'APPENDABLE', INC => 'APPENDABLE', LDDLFLAGS => 'APPENDABLE', LDFROM => 'APPENDABLE', ); sub makemaker_args { my ($self, %new_args) = @_; my $args = ( $self->{makemaker_args} ||= {} ); foreach my $key (keys %new_args) { if ($makemaker_argtype{$key}) { if ($makemaker_argtype{$key} eq 'ARRAY') { $args->{$key} = [] unless defined $args->{$key}; unless (ref $args->{$key} eq 'ARRAY') { $args->{$key} = [$args->{$key}] } push @{$args->{$key}}, ref $new_args{$key} eq 'ARRAY' ? @{$new_args{$key}} : $new_args{$key}; } elsif ($makemaker_argtype{$key} eq 'HASH') { $args->{$key} = {} unless defined $args->{$key}; foreach my $skey (keys %{ $new_args{$key} }) { $args->{$key}{$skey} = $new_args{$key}{$skey}; } } elsif ($makemaker_argtype{$key} eq 'APPENDABLE') { $self->makemaker_append($key => $new_args{$key}); } } else { if (defined $args->{$key}) { warn qq{MakeMaker attribute "$key" is overriden; use "makemaker_append" to append values\n}; } $args->{$key} = $new_args{$key}; } } return $args; } # For mm args that take multiple space-seperated args, # append an argument to the current list. sub makemaker_append { my $self = shift; my $name = shift; my $args = $self->makemaker_args; $args->{$name} = defined $args->{$name} ? join( ' ', $args->{$name}, @_ ) : join( ' ', @_ ); } sub build_subdirs { my $self = shift; my $subdirs = $self->makemaker_args->{DIR} ||= []; for my $subdir (@_) { push @$subdirs, $subdir; } } sub clean_files { my $self = shift; my $clean = $self->makemaker_args->{clean} ||= {}; %$clean = ( %$clean, FILES => join ' ', grep { length $_ } ($clean->{FILES} || (), @_), ); } sub realclean_files { my $self = shift; my $realclean = $self->makemaker_args->{realclean} ||= {}; %$realclean = ( %$realclean, FILES => join ' ', grep { length $_ } ($realclean->{FILES} || (), @_), ); } sub libs { my $self = shift; my $libs = ref $_[0] ? shift : [ shift ]; $self->makemaker_args( LIBS => $libs ); } sub inc { my $self = shift; $self->makemaker_args( INC => shift ); } sub _wanted_t { } sub tests_recursive { my $self = shift; my $dir = shift || 't'; unless ( -d $dir ) { die "tests_recursive dir '$dir' does not exist"; } my %tests = map { $_ => 1 } split / /, ($self->tests || ''); require File::Find; File::Find::find( sub { /\.t$/ and -f $_ and $tests{"$File::Find::dir/*.t"} = 1 }, $dir ); $self->tests( join ' ', sort keys %tests ); } sub write { my $self = shift; die "&Makefile->write() takes no arguments\n" if @_; # Check the current Perl version my $perl_version = $self->perl_version; if ( $perl_version ) { eval "use $perl_version; 1" or die "ERROR: perl: Version $] is installed, " . "but we need version >= $perl_version"; } # Make sure we have a new enough MakeMaker require ExtUtils::MakeMaker; if ( $perl_version and $self->_cmp($perl_version, '5.006') >= 0 ) { # MakeMaker can complain about module versions that include # an underscore, even though its own version may contain one! # Hence the funny regexp to get rid of it. See RT #35800 # for details. my $v = $ExtUtils::MakeMaker::VERSION =~ /^(\d+\.\d+)/; $self->build_requires( 'ExtUtils::MakeMaker' => $v ); $self->configure_requires( 'ExtUtils::MakeMaker' => $v ); } else { # Allow legacy-compatibility with 5.005 by depending on the # most recent EU:MM that supported 5.005. $self->build_requires( 'ExtUtils::MakeMaker' => 6.42 ); $self->configure_requires( 'ExtUtils::MakeMaker' => 6.42 ); } # Generate the MakeMaker params my $args = $self->makemaker_args; $args->{DISTNAME} = $self->name; $args->{NAME} = $self->module_name || $self->name; $args->{NAME} =~ s/-/::/g; $args->{VERSION} = $self->version or die <<'EOT'; ERROR: Can't determine distribution version. Please specify it explicitly via 'version' in Makefile.PL, or set a valid $VERSION in a module, and provide its file path via 'version_from' (or 'all_from' if you prefer) in Makefile.PL. EOT $DB::single = 1; if ( $self->tests ) { my @tests = split ' ', $self->tests; my %seen; $args->{test} = { TESTS => (join ' ', grep {!$seen{$_}++} @tests), }; } elsif ( $Module::Install::ExtraTests::use_extratests ) { # Module::Install::ExtraTests doesn't set $self->tests and does its own tests via harness. # So, just ignore our xt tests here. } elsif ( -d 'xt' and ($Module::Install::AUTHOR or $ENV{RELEASE_TESTING}) ) { $args->{test} = { TESTS => join( ' ', map { "$_/*.t" } grep { -d $_ } qw{ t xt } ), }; } if ( $] >= 5.005 ) { $args->{ABSTRACT} = $self->abstract; $args->{AUTHOR} = join ', ', @{$self->author || []}; } if ( $self->makemaker(6.10) ) { $args->{NO_META} = 1; #$args->{NO_MYMETA} = 1; } if ( $self->makemaker(6.17) and $self->sign ) { $args->{SIGN} = 1; } unless ( $self->is_admin ) { delete $args->{SIGN}; } if ( $self->makemaker(6.31) and $self->license ) { $args->{LICENSE} = $self->license; } my $prereq = ($args->{PREREQ_PM} ||= {}); %$prereq = ( %$prereq, map { @$_ } # flatten [module => version] map { @$_ } grep $_, ($self->requires) ); # Remove any reference to perl, PREREQ_PM doesn't support it delete $args->{PREREQ_PM}->{perl}; # Merge both kinds of requires into BUILD_REQUIRES my $build_prereq = ($args->{BUILD_REQUIRES} ||= {}); %$build_prereq = ( %$build_prereq, map { @$_ } # flatten [module => version] map { @$_ } grep $_, ($self->configure_requires, $self->build_requires) ); # Remove any reference to perl, BUILD_REQUIRES doesn't support it delete $args->{BUILD_REQUIRES}->{perl}; # Delete bundled dists from prereq_pm, add it to Makefile DIR my $subdirs = ($args->{DIR} || []); if ($self->bundles) { my %processed; foreach my $bundle (@{ $self->bundles }) { my ($mod_name, $dist_dir) = @$bundle; delete $prereq->{$mod_name}; $dist_dir = File::Basename::basename($dist_dir); # dir for building this module if (not exists $processed{$dist_dir}) { if (-d $dist_dir) { # List as sub-directory to be processed by make push @$subdirs, $dist_dir; } # Else do nothing: the module is already present on the system $processed{$dist_dir} = undef; } } } unless ( $self->makemaker('6.55_03') ) { %$prereq = (%$prereq,%$build_prereq); delete $args->{BUILD_REQUIRES}; } if ( my $perl_version = $self->perl_version ) { eval "use $perl_version; 1" or die "ERROR: perl: Version $] is installed, " . "but we need version >= $perl_version"; if ( $self->makemaker(6.48) ) { $args->{MIN_PERL_VERSION} = $perl_version; } } if ($self->installdirs) { warn qq{old INSTALLDIRS (probably set by makemaker_args) is overriden by installdirs\n} if $args->{INSTALLDIRS}; $args->{INSTALLDIRS} = $self->installdirs; } my %args = map { ( $_ => $args->{$_} ) } grep {defined($args->{$_} ) } keys %$args; my $user_preop = delete $args{dist}->{PREOP}; if ( my $preop = $self->admin->preop($user_preop) ) { foreach my $key ( keys %$preop ) { $args{dist}->{$key} = $preop->{$key}; } } my $mm = ExtUtils::MakeMaker::WriteMakefile(%args); $self->fix_up_makefile($mm->{FIRST_MAKEFILE} || 'Makefile'); } sub fix_up_makefile { my $self = shift; my $makefile_name = shift; my $top_class = ref($self->_top) || ''; my $top_version = $self->_top->VERSION || ''; my $preamble = $self->preamble ? "# Preamble by $top_class $top_version\n" . $self->preamble : ''; my $postamble = "# Postamble by $top_class $top_version\n" . ($self->postamble || ''); local *MAKEFILE; open MAKEFILE, "+< $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!"; eval { flock MAKEFILE, LOCK_EX }; my $makefile = do { local $/; }; $makefile =~ s/\b(test_harness\(\$\(TEST_VERBOSE\), )/$1'inc', /; $makefile =~ s/( -I\$\(INST_ARCHLIB\))/ -Iinc$1/g; $makefile =~ s/( "-I\$\(INST_LIB\)")/ "-Iinc"$1/g; $makefile =~ s/^(FULLPERL = .*)/$1 "-Iinc"/m; $makefile =~ s/^(PERL = .*)/$1 "-Iinc"/m; # Module::Install will never be used to build the Core Perl # Sometimes PERL_LIB and PERL_ARCHLIB get written anyway, which breaks # PREFIX/PERL5LIB, and thus, install_share. Blank them if they exist $makefile =~ s/^PERL_LIB = .+/PERL_LIB =/m; #$makefile =~ s/^PERL_ARCHLIB = .+/PERL_ARCHLIB =/m; # Perl 5.005 mentions PERL_LIB explicitly, so we have to remove that as well. $makefile =~ s/(\"?)-I\$\(PERL_LIB\)\1//g; # XXX - This is currently unused; not sure if it breaks other MM-users # $makefile =~ s/^pm_to_blib\s+:\s+/pm_to_blib :: /mg; seek MAKEFILE, 0, SEEK_SET; truncate MAKEFILE, 0; print MAKEFILE "$preamble$makefile$postamble" or die $!; close MAKEFILE or die $!; 1; } sub preamble { my ($self, $text) = @_; $self->{preamble} = $text . $self->{preamble} if defined $text; $self->{preamble}; } sub postamble { my ($self, $text) = @_; $self->{postamble} ||= $self->admin->postamble; $self->{postamble} .= $text if defined $text; $self->{postamble} } 1; __END__ #line 541 libxml-rss-libxml-perl-0.3102+dfsg.orig/MANIFEST0000644000175000017500000000255111637345541021325 0ustar nicholasnicholasChanges inc/Module/Install.pm inc/Module/Install/AuthorTests.pm inc/Module/Install/Base.pm inc/Module/Install/Can.pm inc/Module/Install/Fetch.pm inc/Module/Install/Makefile.pm inc/Module/Install/Metadata.pm inc/Module/Install/Repository.pm inc/Module/Install/Win32.pm inc/Module/Install/WriteAll.pm lib/XML/RSS/LibXML.pm lib/XML/RSS/LibXML/ImplBase.pm lib/XML/RSS/LibXML/MagicElement.pm lib/XML/RSS/LibXML/Namespaces.pm lib/XML/RSS/LibXML/Null.pm lib/XML/RSS/LibXML/V0_9.pm lib/XML/RSS/LibXML/V0_91.pm lib/XML/RSS/LibXML/V0_92.pm lib/XML/RSS/LibXML/V1_0.pm lib/XML/RSS/LibXML/V2_0.pm Makefile.PL MANIFEST This list of files META.yml t/1.0-generate.t t/1.0-parse-exotic.t t/1.0-parse.t t/2.0-generate.t t/2.0-modules.t t/2.0-parse-2.t t/2.0-parse.t t/2.0-wo-title.t t/add-item-insert-vs-append.t t/charset1.t t/data/1.0/rss1.0.exotic.rdf t/data/1.0/with_content.rdf t/data/rss20.xml t/enclosures.t t/enclosures2.t t/encode-output.t t/encoding.t t/generated/1.0-generated.xml t/generated/2.0-generated.xml t/generated/charset1-generated.xml t/guid.t t/items-are-0.t t/load.t t/regress-2.0-namespace.t t/regress-broken-image.t t/regress-content-encoded.t t/regress-namespace-attr.t t/rss2-gt-encoding.t t/synopsis.t t/unsupported.t t/version.t t/xml-header.t tools/benchmark.pl xt/0.9-generate.t xt/0.9-parse.t xt/0.9-strict.t xt/0.91-parse.t xt/0.92-parse.t xt/pod-coverage.t xt/pod.t libxml-rss-libxml-perl-0.3102+dfsg.orig/t/0000755000175000017500000000000011637345541020434 5ustar nicholasnicholaslibxml-rss-libxml-perl-0.3102+dfsg.orig/t/charset1.t0000644000175000017500000000347711401562045022333 0ustar nicholasnicholas#!/usr/bin/perl # This is a regression test for: # http://rt.cpan.org/Public/Bug/Display.html?id=5438 # based on the original script supplied with the report. use strict; use warnings; use XML::RSS::LibXML; use File::Spec; use Test::More; if (eval "require Test::Differences") { Test::Differences->import; plan tests => 2; } else { plan skip_all => 'Test::Differences required'; } { my $dir = File::Spec->catdir("t", "generated"); if (! -d $dir) { mkdir($dir) or die "Could not create directory $dir: $!"; } my $rss_file = File::Spec->catfile($dir, "charset1-generated.xml"); my %rss_new = (version => '1.0', encoding => 'iso-8859-1', output => '1.0'); my $rss = XML::RSS::LibXML->new(%rss_new); # # Add a channel # $rss->channel (title => "Channel Title", link => "http://channel.url/", description => "Channel Description"); # # Add an item with accented characters # $rss->add_item (title => "Item Title", link => "http://item.url/", description => "Item Description (©)"); # # Save RSS content to file. # open (RSS, ">", $rss_file) || die "Unable to open $rss_file."; my $rss1 = $rss->as_string; print RSS $rss1; close (RSS); # # Now read it back in # $rss = XML::RSS::LibXML->new(%rss_new); $rss->parsefile($rss_file); # # save it again # open (RSS, ">", $rss_file) || die "Unable to open $rss_file."; my $rss2 = $rss->as_string; print RSS $rss2; close (RSS); eq_or_diff($rss1, $rss2, 'got the same RSS both times'); # # And read it back in again. # $rss = new XML::RSS::LibXML; $rss->parsefile($rss_file); # Check that no exception was thrown along the way. ok(1); } libxml-rss-libxml-perl-0.3102+dfsg.orig/t/regress-namespace-attr.t0000644000175000017500000000144211401562045025163 0ustar nicholasnicholasuse strict; use Test::More tests => 3; use XML::RSS::LibXML; my $rss = XML::RSS::LibXML->new; eval { $rss->parse(< EORSS }; ok(!$@, "parse check. $@"); is($rss->{channel}{admin}{generatorAgent}{_content}, ''); is($rss->{channel}{admin}{generatorAgent}{admin}, 'http://webns.net/mvcb/'); libxml-rss-libxml-perl-0.3102+dfsg.orig/t/2.0-modules.t0000644000175000017500000000240711633751154022566 0ustar nicholasnicholas#!/usr/bin/perl -w use strict; use Test::More tests => 4; use XML::RSS::LibXML; { my $rss = XML::RSS::LibXML->new( version => '2.0' ); $rss->add_module( prefix => 'content', uri => 'http://purl.org/rss/1.0/modules/content/' ); $rss->add_item( title => 'title', content => { encoded => 'this is content' }, ); # TEST like $rss->as_string, qr/this is content/; } { my $rss = XML::RSS::LibXML->new( version => '2.0' ); eval { $rss->add_module( prefix => 'a/b', uri => 'http://foobar.tld/foo/' ); }; # TEST like ($@, qr{\Aa namespace prefix should look like}, "Testing for invalidty of / as a prefix char"); } { my $rss = XML::RSS::LibXML->new( version => '2.0' ); eval { $rss->add_module( prefix => 'Foobar', uri => 'http://foobar.tld/foo/' ); }; # TEST ok !$@, "Testing for validity of ucfirst prefix"; } { my $rss = XML::RSS::LibXML->new( version => '2.0' ); eval { $rss->add_module( prefix => "myprefix", ); }; # TEST like ($@, qr{\Aa URI must be provided}, "Testing for exception upon an unspecified URI."); } libxml-rss-libxml-perl-0.3102+dfsg.orig/t/data/0000755000175000017500000000000011637345541021345 5ustar nicholasnicholaslibxml-rss-libxml-perl-0.3102+dfsg.orig/t/data/rss20.xml0000644000175000017500000000377211401562045023036 0ustar nicholasnicholas Example 2.0 Channel http://example.com/ To lead by example en-us All content Public Domain, except comments which remains copyright the author editor\@example.com webmaster\@example.com http://backend.userland.com/rss Reference/Libraries/Library_and_Information_Science/Technical_Services/Cataloguing/Metadata/RDF/Applications/RSS/ The Superest Dooperest RSS Generator Mon, 02 Sep 2002 03:19:17 GMT 60 example subject News for September the Second http://example.com/2002/09/02 other things happened today http://example.com/2002/09/02/comments.html joeuser\@example.com Mon, 02 Sep 2002 03:19:00 GMT http://example.com/2002/09/02 News for September the First http://example.com/2002/09/01 something happened today http://example.com/2002/09/01/comments.html joeuser\@example.com Sun, 01 Sep 2002 12:01:00 GMT http://example.com/2002/09/02 libxml-rss-libxml-perl-0.3102+dfsg.orig/t/data/2.0/0000755000175000017500000000000011637345541021644 5ustar nicholasnicholaslibxml-rss-libxml-perl-0.3102+dfsg.orig/t/data/1.0/0000755000175000017500000000000011637345541021643 5ustar nicholasnicholaslibxml-rss-libxml-perl-0.3102+dfsg.orig/t/data/1.0/rss1.0.exotic.rdf0000644000175000017500000000321411401562045024645 0ustar nicholasnicholas Example Site http://example.org/ An example site admin@example.org en-us 2002-11-01T07:16:51-08:00 A Title & An Ampersand A silly description http://example/archives/000001.html Personal kellan 2002-11-01T07:16:51-08:00 libxml-rss-libxml-perl-0.3102+dfsg.orig/t/data/1.0/with_content.rdf0000644000175000017500000000343011401562045025032 0ustar nicholasnicholas First Weblog http://localhost/weblog/ This is a test weblog. en-us Melody 2004-05-29T23:39:57-08:00 Entry Two http://localhost/weblog/2004/05/entry_two.html Hello!... Hello!

]]> Travel Melody 2004-05-29T23:39:25-08:00 Test http://localhost/weblog/2004/05/test.html This is a test. Why don't you come down to our place for a coffee and a chat?... This is a test.

Why don't you come down to our place for a coffee and a chat?

]]> Sports Melody 2004-05-08T23:03:28-08:00 libxml-rss-libxml-perl-0.3102+dfsg.orig/t/rss2-gt-encoding.t0000644000175000017500000000311311401562045023671 0ustar nicholasnicholas#!/usr/bin/perl -w use strict; use Test::More; plan tests => 2; use_ok('XML::RSS::LibXML'); my $rss = XML::RSS::LibXML->new(version => '2.0'); $rss->channel( title => 'freshmeat.net', 'link' => 'http://freshmeat.net', language => 'en', description => 'the one-stop-shop for all your Linux software needs', rating => '(PICS-1.1 "http://www.classify.org/safesurf/" 1 r (SS~~000 1))', copyright => 'Copyright 1999, Freshmeat.net', pubDate => 'Thu, 23 Aug 1999 07:00:00 GMT', lastBuildDate => 'Thu, 23 Aug 1999 16:20:26 GMT', docs => 'http://www.blahblah.org/fm.cdf', managingEditor => 'scoop@freshmeat.net', webMaster => 'scoop@freshmeat.net' ); $rss->add_item( title => "GTKeyboard 0.85", # creates a guid field with permaLink=true permaLink => "http://freshmeat.net/news/1999/06/21/930003829.html", # alternately creates a guid field with permaLink=false # guid => "gtkeyboard-0.85 enclosure => { url=>"http://www.foo.tld/", type=>"application/x-bittorrent" }, description => 'Whoa' ); my ($string) = grep { m/shlomifish/ } split /\n/, $rss->as_string(); # This works differently from XML::RSS my $expected_encoded_html = '<a href="http://www.shlomifish.org/"><span style="color:#658912">Whoa</span></a>'; $string =~ s/^\s+//; $string =~ s/\s+$//; is($string, $expected_encoded_html, "Testing for a correctly encoded HTML"); 1; libxml-rss-libxml-perl-0.3102+dfsg.orig/t/encode-output.t0000644000175000017500000000106011401562045023376 0ustar nicholasnicholas# $Id: encode-output.t,v 1.2 2003/01/18 01:11:33 comdog Exp $ use Test::More tests => 1; use XML::RSS::LibXML; use File::Spec; $|++; my $file = File::Spec->catfile(File::Spec->curdir(), "t", "data", "1.0", "rss1.0.exotic.rdf"); my $rss = new XML::RSS::LibXML(encode_output => 1); eval { $rss->parsefile( $file ); }; # Test 5. # Encode illegal characters (e.g. &) when outputting RSS # my $rss_str = $rss->as_string(); my $rss2 = new XML::RSS::LibXML(); eval { $rss2->parse( $rss_str ); }; unlike ($@, qr/invalid token/, "encode invalid characters" ); libxml-rss-libxml-perl-0.3102+dfsg.orig/t/version.t0000644000175000017500000000167311401562045022302 0ustar nicholasnicholas# $Id: version.t,v 1.2 2004/04/21 02:44:40 kellan Exp $ use Test::More tests => 6; $|++; use XML::RSS::LibXML; { my $rss = XML::RSS::LibXML->new( version => '0.9' ); # TEST isa_ok( $rss, 'XML::RSS::LibXML' ); make_rss( $rss ); # TEST like( $rss->as_string, qr|]*>|, "rdf tag for version 0.9" ); $rss = XML::RSS::LibXML->new( version => '0.91' ); # TEST isa_ok( $rss, 'XML::RSS::LibXML' ); make_rss( $rss ); # TEST like( $rss->as_string, qr//, "rss tag for version 0.91" ); $rss = XML::RSS::LibXML->new( version => '1.0' ); # TEST isa_ok( $rss, 'XML::RSS::LibXML' ); make_rss( $rss ); # TEST like( $rss->as_string, qr|]*>|, "rdf tag for version 1.0" ); } sub make_rss { my $rss = shift; $rss->channel( title => 'Test RSS', link => 'http://www.example.com', ); } libxml-rss-libxml-perl-0.3102+dfsg.orig/t/regress-2.0-namespace.t0000644000175000017500000000126211401562045024510 0ustar nicholasnicholasuse strict; use Test::More tests => 8; use XML::RSS::LibXML; for my $ver (qw( 1.0 2.0 )) { my $feed = XML::RSS::LibXML->new( version => $ver ); $feed->channel(title => "Hello world"); $feed->channel(webMaster => "foobar"); $feed->channel->{dc}{creator} = "foobar"; my $string = $feed->as_string; like $string, qr/xmlns:dc="[^"]+"/, "namespace declaration for $ver"; like $string, qr{foobar}, "actual element for $ver"; $string = $feed->parse($feed->as_string)->as_string; like $string, qr/xmlns:dc="[^"]+"/, "namespace declaration for $ver"; like $string, qr{foobar}, "actual element for $ver"; } libxml-rss-libxml-perl-0.3102+dfsg.orig/t/2.0-parse-2.t0000644000175000017500000000362511401623101022351 0ustar nicholasnicholas#!/usr/bin/perl use strict; use warnings; use Test::More tests => 2; use XML::RSS::LibXML; my $rss = XML::RSS::LibXML->new(); $rss->parse(<<"EOF"); Journalism - Topix.net http://www.topix.net/news/journalism News on Journalism from Topix.net en-us Copyright 2006, Topix.net Topix.net http://www.topix.net/ http://www.topix.net/pics/logo4.gif Gannett Reportedly Mulling Tribune Bid http://topix.net/r/0l1Qq8DEtErajq5wDAIHZ0RavmEQ=2BIyZGBfGjcVwyQpW0DFdgUcy=2FtbxGNgMtYEdbU7ucVOR=2Bw2Bu6K4EDvt9=2B7ILEWB6Q5Zxy64f9JxkGU92am=2FLdMjb=2FCxbmfNuBQX6 Comment]]> The Associated Press on Topix.net Mon, 13 Nov 2006 15:50:44 GMT eQE3vmbXGCzvaHn0deSSyA Journalism - Topix.net Use the text input below to search Topix.net q http://www.topix.net/search/ EOF # TEST is ($rss->{textinput}->{link}, "http://www.topix.net/search/", "Testing for textinput link" ); # TEST is ($rss->{channel}->{link}, "http://www.topix.net/news/journalism", "Testing for channel link" ); libxml-rss-libxml-perl-0.3102+dfsg.orig/t/unsupported.t0000644000175000017500000000051511401562045023177 0ustar nicholasnicholasuse strict; use Test::More (tests => 3); BEGIN { use_ok("XML::RSS::LibXML") } my $xml = XML::RSS::LibXML->new; $xml->{output} = '1.5'; eval { $xml->as_string }; ok($@, "formatting non-supported version 1.5"); delete $xml->{output}; $xml->{version} = '1.5'; eval { $xml->as_string }; ok($@, "formatting non-supported version 1.5");libxml-rss-libxml-perl-0.3102+dfsg.orig/t/2.0-parse.t0000644000175000017500000000610611410004533022211 0ustar nicholasnicholasuse strict; use Test::More; use constant RSS_VERSION => "2.0"; use constant RSS_CHANNEL_TITLE => "Example 2.0 Channel"; use constant RSS_DOCUMENT => qq( Example 2.0 Channel http://example.com/ To lead by example en-us All content Public Domain, except comments which remains copyright the author editor\@example.com webmaster\@example.com http://backend.userland.com/rss Reference/Libraries/Library_and_Information_Science/Technical_Services/Cataloguing/Metadata/RDF/Applications/RSS/ The Superest Dooperest RSS Generator Mon, 02 Sep 2002 03:19:17 GMT 60 News for September the Second http://example.com/2002/09/02 other things happened today http://example.com/2002/09/02/comments.html joeuser\@example.com Mon, 02 Sep 2002 03:19:00 GMT http://example.com/2002/09/02 News for September the First http://example.com/2002/09/01 something happened today http://example.com/2002/09/01/comments.html joeuser\@example.com Sun, 01 Sep 2002 12:01:00 GMT http://example.com/2002/09/02 ); plan tests => 10; use_ok("XML::RSS::LibXML"); my $xml = XML::RSS::LibXML->new(); isa_ok($xml,"XML::RSS::LibXML"); eval { $xml->parse(RSS_DOCUMENT); }; is($@,'',"Parsed RSS feed"); cmp_ok($xml->{'_internal'}->{'version'},"eq",RSS_VERSION,"Is RSS version ".RSS_VERSION); cmp_ok($xml->{channel}->{'title'},"eq",RSS_CHANNEL_TITLE,"Feed title is ".RSS_CHANNEL_TITLE); cmp_ok(ref($xml->{items}),"eq","ARRAY","\$xml->{items} is an ARRAY ref"); cmp_ok($xml->version, 'eq', RSS_VERSION, 'Version attribute should be set'); cmp_ok($xml->encoding, 'eq', 'utf-8', 'Encoding should be set'); cmp_ok($xml->base, 'eq', 'http://foo.com/', 'Base attribute should be set'); my $ok = 1; foreach my $item (@{$xml->{items}}) { my $min = 0; foreach my $el ("title","description") { if (exists $item->{$el}) { $min ||= 1; } } $ok = $min; last if (! $ok); } ok($ok,"All items have either a title or a description element"); __END__ =head1 NAME 2.0-parse.t - tests for parsing RSS 2.0 data with XML::RSS::LibXML.pm =head1 SYNOPSIS use Test::Harness qw (runtests); runtests (./XML-RSS/t/*.t); =head1 DESCRIPTION Tests for parsing RSS 2.0 data with XML::RSS::LibXML.pm =head1 VERSION $Revision: 1.2 $ =head1 DATE $Date: 2002/11/19 23:56:53 $ =head1 AUTHOR Aaron Straup Cope =head1 SEE ALSO http://backend.userland.com/rss2 =cut libxml-rss-libxml-perl-0.3102+dfsg.orig/t/xml-header.t0000644000175000017500000000726711401562045022650 0ustar nicholasnicholas#!/usr/bin/perl use strict; use warnings; use Test::More tests => 8; use XML::RSS::LibXML; sub starts_with { local $Test::Builder::Level = $Test::Builder::Level + 1; my ($rss, $pattern, $msg) = @_; my $rss_output = $rss->as_string(); my $ok = like( $rss_output, $pattern, $msg ); } sub create_rss_1 { my $args = shift; # my $rss = new XML::RSS::LibXML (version => '0.9'); my @style = exists($args->{stylesheet}) ? (stylesheet => $args->{stylesheet}) : () ; my $rss = XML::RSS::LibXML->new( version => $args->{version}, @style ); my $image_link = exists($args->{image_link}) ? $args->{image_link} : "http://freshmeat.net/"; my $extra_image_params = $args->{image_params} || []; $rss->channel( title => "freshmeat.net", link => "http://freshmeat.net", description => "the one-stop-shop for all your Linux software needs", ); $rss->image( title => "freshmeat.net", url => "0", link => $image_link, @{$extra_image_params}, ); $rss->add_item( title => "GTKeyboard 0.85", link => "http://freshmeat.net/news/1999/06/21/930003829.html" ); return $rss; } { # TEST starts_with( create_rss_1({'version' => "0.9"}), qr{^<\?xml version="1\.0" encoding="UTF-8"\?>\s* "0.91"}), qr{^<\?xml version="1\.0" encoding="UTF-8"\?>\s*\s*}, "header of RSS 0.91 without the stylesheet" ); } { # TEST starts_with( create_rss_1({'version' => "1.0"}), qr{^<\?xml version="1\.0" encoding="UTF-8"\?>\s* "2.0"}), qr{^<\?xml version="1\.0" encoding="UTF-8"\?>\s* "0.9", stylesheet => "http://myhost.tld/foo.xsl"}), qr{^<\?xml version="1\.0" encoding="UTF-8"\?>\s*<\?xml-stylesheet (?:type="text/xsl"\s*|href="http://myhost\.tld/foo\.xsl"\s*){2}\?>\s* "0.91", stylesheet => "http://myhost.tld/foo.xsl"}), qr{^<\?xml version="1\.0" encoding="UTF-8"\?>\s*\s*<\?xml-stylesheet (?:type="text/xsl"\s*|href="http://myhost\.tld/foo\.xsl"\s*){2}\?>\s*}, "header of RSS 0.91 with the stylesheet" ); } { # TEST starts_with( create_rss_1({'version' => "1.0", stylesheet => "http://myhost.tld/foo.xsl"}), qr{^<\?xml version="1\.0" encoding="UTF-8"\?>\s*<\?xml-stylesheet (?:type="text/xsl"\s*|href="http://myhost\.tld/foo\.xsl"\s*){2}\?>\s* "2.0", stylesheet => "http://myhost.tld/foo.xsl"}), qr{^<\?xml version="1\.0" encoding="UTF-8"\?>\s*<\?xml-stylesheet (?:type="text/xsl"\s*|href="http://myhost\.tld/foo\.xsl"\s*){2}\?>\s* 2; # TEST use_ok('XML::RSS::LibXML'); my $rss = XML::RSS::LibXML->new(version => '2.0'); $rss->channel( title => 'freshmeat.net', 'link' => 'http://freshmeat.net', language => 'en', description => 'the one-stop-shop for all your Linux software needs', rating => '(PICS-1.1 "http://www.classify.org/safesurf/" 1 r (SS~~000 1))', copyright => 'Copyright 1999, Freshmeat.net', pubDate => 'Thu, 23 Aug 1999 07:00:00 GMT', lastBuildDate => 'Thu, 23 Aug 1999 16:20:26 GMT', docs => 'http://www.blahblah.org/fm.cdf', managingEditor => 'scoop@freshmeat.net', webMaster => 'scoop@freshmeat.net' ); $rss->add_item( # creates a guid field with permaLink=true permaLink => "http://freshmeat.net/news/1999/06/21/930003829.html", # alternately creates a guid field with permaLink=false # guid => "gtkeyboard-0.85 enclosure => { url=>"http://www.foo.tld/", type=>"application/x-bittorrent" }, description => 'My Life Changed Absolutely', ); my $string = $rss->as_string(); # TEST ok ( (index($string, 'My Life Changed Absolutely' ) >= 0 ), "Testing for the item being rendered." ); 1; libxml-rss-libxml-perl-0.3102+dfsg.orig/t/add-item-insert-vs-append.t0000644000175000017500000000361711401562045025476 0ustar nicholasnicholas#!/usr/bin/perl # Test the add_item(mode => "insert") use strict; use warnings; use Test::More tests => 3; use XML::RSS::LibXML; sub contains { local $Test::Builder::Level = $Test::Builder::Level + 1; my ($rss, $pattern, $msg) = @_; my $rss_output = $rss->as_string(); my $ok = like ($rss_output, $pattern, $msg); if (! $ok) { diag("Could not find the substring [$pattern] in:{{{{\n$rss_output\n}}}}\n"); } } sub create_rss { my $rss = XML::RSS::LibXML->new(version => "2.0"); $rss->channel( title => "freshmeat.net", link => "http://freshmeat.net", description => "the one-stop-shop for all your Linux software needs", ); $rss->add_item( title => "GTKeyboard 0.85", link => "http://freshmeat.net/news/1999/06/21/930003829.html" ); return $rss; } { my $rss = create_rss(); $rss->add_item( title => "gcc 10.0.10", link => "http://gcc-compiler.tld/", ); # TEST contains($rss, qr{(?sm)GTKeyboard 0.85.+gcc 10.0.10}, "Checking for second item after first item when add_item without mode." ); } { my $rss = create_rss(); $rss->add_item( mode => "append", title => "gcc 10.0.10", link => "http://gcc-compiler.tld/", ); # TEST contains($rss, qr{(?sm)GTKeyboard 0.85.+gcc 10.0.10}, "Checking for second item after first item when add_item with mode == append." ); } { my $rss = create_rss(); $rss->add_item( mode => "insert", title => "gcc 10.0.10", link => "http://gcc-compiler.tld/", ); # TEST contains($rss, qr{(?sm)gcc 10.0.10.+GTKeyboard 0.85}, "Checking for second item before first item when add_item with mode == insert." ); } libxml-rss-libxml-perl-0.3102+dfsg.orig/t/regress-content-encoded.t0000644000175000017500000000071211604763245025341 0ustar nicholasnicholasuse strict; use Test::More (tests => 2); use XML::RSS::LibXML; for my $version (qw(1.0 2.0)) { my $rss = XML::RSS::LibXML->new(version => "2.0"); $rss->add_module(prefix => "content", uri => "http://purl.org/rss/1.0/modules/content/" ); $rss->add_item( link => 'poo', content => { 'encoded' => 'blah' }, 'title' => 'foo' ); like($rss->as_string, qr//); } 1; libxml-rss-libxml-perl-0.3102+dfsg.orig/t/enclosures.t0000644000175000017500000000403611401562045022773 0ustar nicholasnicholasuse strict; use Test::More; use constant RSS_VERSION => "2.0"; use constant RSS_CHANNEL_TITLE => "Example 2.0 Channel"; use constant RSS_DOCUMENT => qq( Example 2.0 Channel http://example.com/ To lead by example en-us All content Public Domain, except comments which remains copyright the author editor\@example.com webmaster\@example.com http://backend.userland.com/rss Reference/Libraries/Library_and_Information_Science/Technical_Services/Cataloguing/Metadata/RDF/Applications/RSS/ The Superest Dooperest RSS Generator Mon, 02 Sep 2002 03:19:17 GMT 60 News for September the Second http://example.com/2002/09/02 other things happened today http://example.com/2002/09/02/comments.html joeuser\@example.com Mon, 02 Sep 2002 03:19:00 GMT http://example.com/2002/09/02 ); plan tests => 6; use_ok("XML::RSS::LibXML"); my $xml = XML::RSS::LibXML->new(); isa_ok($xml,"XML::RSS::LibXML"); eval { $xml->parse(RSS_DOCUMENT); }; is($@,'',"Parsed RSS feed"); # XXX We can't compare hash structures here, because we have a # XML::RSS::LibXML::MagicElement type here. # is_deeply($xml->{items}->[0]->{enclosure}, { url => "http://example.com/test.mp3", length => "5352283", type => "audio/mpeg" }, "got enclosure"); my $e = $xml->{items}->[0]->{enclosure}; is($e->{url}, "http://example.com/test.mp3", "enclosure url"); is($e->{length}, "5352283", "enclosure length"); is($e->{type}, "audio/mpeg", "enclosure type"); libxml-rss-libxml-perl-0.3102+dfsg.orig/t/1.0-generate.t0000644000175000017500000001033611401562045022677 0ustar nicholasnicholasuse strict; use File::Spec; use Test::More; plan tests => 22; # 1-2 use_ok("XML::RSS::LibXML"); use POSIX; use constant DATE_TEMPLATE_LONG => "%Y-%m-%dT%H:%M:%S%z"; use constant DATE_TEMPLATE_SHORT => "%Y/%m/%d"; use constant DATE_TEMPLATE_PUB => "%c GMT"; my ($current_date, $short_date, $pub_date); BEGIN { $current_date = &POSIX::strftime(DATE_TEMPLATE_LONG, gmtime); $short_date = &POSIX::strftime(DATE_TEMPLATE_SHORT, gmtime); $pub_date = &POSIX::strftime(DATE_TEMPLATE_PUB, gmtime); } use constant BASEDIR => File::Spec->catdir('t', 'generated'); use constant RSS_VERSION => "1.0"; use constant RSS_SAVEAS => File::Spec->catfile(BASEDIR, RSS_VERSION."-generated.xml"); use constant RSS_MOD_PREFIX => "my"; use constant RSS_MOD_URI => 'http://purl.org/my/rss/module/'; use constant RSS_CREATOR => "joeuser\@example.com"; use constant RSS_ITEM_TITLE => "This is an item"; use constant RSS_ITEM_LINK => "http://example.com/$short_date"; use constant RSS_ITEM_DESC => "Yadda & yadda & yadda"; if(! -d BASEDIR) { mkdir(BASEDIR) or die "Could not create dir " . BASEDIR . ": $!" } # 3 ok($current_date,"Current date:$current_date"); # 4 my $rss = XML::RSS::LibXML->new(version => RSS_VERSION); isa_ok($rss,"XML::RSS::LibXML"); # 5 cmp_ok($rss->{'version'},"eq",RSS_VERSION,"Version is ".RSS_VERSION); ok($rss->channel( 'title' => "Test 1.0 Feed", 'link' => "http://example.com/", 'description' => "To lead by example", 'image' => "http://example.com/example.gif", 'textinput' => 'http://example.com/search.pl', 'dc' => { date => $current_date, }, ),"Set RSS channel"); ok($rss->image( 'title' => 'Test Image', 'url' => 'http://example.com/example.gif', 'link' => 'http://example.com/', 'description' => 'Test Image', 'height' => '25', 'weight' => '144', ),"Set RSS image"); ok($rss->textinput( 'title' => 'Search', 'description' => 'Search for an example', 'name' => 'q', 'link' => 'http://example.com/search.pl', ),"Set RSS text input"); ok($rss->add_item( 'title' => RSS_ITEM_TITLE, 'link' => RSS_ITEM_LINK, 'description' => RSS_ITEM_DESC, 'dc' => { creator => RSS_CREATOR, dc => $short_date, }, ),"Set one RSS item"); ok($rss->add_module(prefix=>RSS_MOD_PREFIX,uri=>RSS_MOD_URI), "Added namespace:".RSS_MOD_PREFIX); # Dunno - some degree of weirdness # with the constant that I don't # feel like dealing with... my $uri = RSS_MOD_URI; cmp_ok($rss->{modules}->{$uri}, "eq", RSS_MOD_PREFIX, "Namespace URI is ".RSS_MOD_URI); my $as_string = $rss->as_string(); my $len = length($as_string); ok($len,"RSS feed has '$len' characters"); ok($rss->save(RSS_SAVEAS), "Wrote to disk: ".RSS_SAVEAS); my $file_contents; { local $/; open I, "<", RSS_SAVEAS(); $file_contents = ; close(I); } cmp_ok($file_contents,"eq",$as_string,RSS_SAVEAS." contains the as_string() result"); eval { $rss->parsefile(RSS_SAVEAS)}; is($@,'',"Parsed ".RSS_SAVEAS); # 16 cmp_ok($rss->{channel}->{dc}{date}, "eq", $current_date, "dc:date:".$current_date); # 17 cmp_ok(keys(%{$rss->{namespaces}}), ">=", 1, "RSS feed has atleast one namespace"); # 18 cmp_ok(ref($rss->{'items'}),"eq","ARRAY","RSS object has an array of objects"); # 19 cmp_ok(scalar(@{$rss->{'items'}}),"==",1,"RSS object has one item"); # 20 cmp_ok($rss->{items}->[0]->{title},"eq",RSS_ITEM_TITLE,RSS_ITEM_TITLE); # 21 cmp_ok($rss->{items}->[0]->{link},"eq",RSS_ITEM_LINK,RSS_ITEM_LINK); # 22 cmp_ok($rss->{items}->[0]->{description},"eq",RSS_ITEM_DESC,RSS_ITEM_DESC); # 23 cmp_ok($rss->{items}->[0]->{dc}->{creator},"eq",RSS_CREATOR,RSS_CREATOR); __END__ =head1 NAME 1.0-generate.t - tests for generating RSS 1.0 data with XML::RSS::LibXML.pm =head1 SYNOPSIS use Test::Harness qw (runtests); runtests (./XML-RSS/t/*.t); =head1 DESCRIPTION Tests for generating RSS 1.0 data with XML::RSS::LibXML.pm =head1 VERSION $Revision: 1.5 $ =head1 DATE $Date: 2003/02/20 17:12:45 $ =head1 AUTHOR Aaron Straup Cope =head1 SEE ALSO http://web.resource.org/rss/1.0 =cut libxml-rss-libxml-perl-0.3102+dfsg.orig/t/enclosures2.t0000644000175000017500000000555111401562045023060 0ustar nicholasnicholasuse strict; use Test::More; use constant RSS_VERSION => "2.0"; use constant RSS_ENCLOSURE_URL => qq(http://www.scripting.com/mp3s/weatherReportSuite.mp3); use constant RSS_ENCLOSURE_LENGTH => qq(12216320); use constant RSS_ENCLOSURE_TYPE => qq(audio/mpeg); use constant RSS_DOCUMENT => qq( Example 2.0 Channel with Enclosure sub-element of Item http://example.com/ To lead by example en-us All content Public Domain, except comments which remains copyright the author editor\@example.com webmaster\@example.com http://backend.userland.com/rss Reference/Libraries/Library_and_Information_Science/Technical_Services/Cataloguing/Metadata/RDF/Applications/RSS/ The Superest Dooperest RSS Generator Mon, 02 Sep 2002 03:19:17 GMT 60 News for September the Second http://example.com/2002/09/02 other things happened today http://example.com/2002/09/02/comments.html joeuser\@example.com Mon, 02 Sep 2002 03:19:00 GMT http://example.com/2002/09/02 ); plan tests => 8; use_ok("XML::RSS::LibXML"); my $xml = XML::RSS::LibXML->new(); isa_ok($xml,"XML::RSS::LibXML"); eval { $xml->parse(RSS_DOCUMENT); }; is($@,'',"Parsed RSS feed"); cmp_ok($xml->{'_internal'}->{'version'},"eq",RSS_VERSION,"Is RSS version ".RSS_VERSION); cmp_ok(ref($xml->{items}),"eq","ARRAY","\$xml->{items} is an ARRAY ref"); if($xml->{items} && ref($xml->{items}) eq 'ARRAY'){ my $item = shift @{$xml->{items}}; if($item->{enclosure}){ my $encl = $item->{enclosure}; cmp_ok($encl->{'url'},"eq",RSS_ENCLOSURE_URL, "ENCLOSURE URL is ".RSS_ENCLOSURE_URL); cmp_ok($encl->{'length'},"eq",RSS_ENCLOSURE_LENGTH, "ENCLOSURE URL is ".RSS_ENCLOSURE_LENGTH); cmp_ok($encl->{'type'},"eq",RSS_ENCLOSURE_TYPE, "ENCLOSURE URL is ".RSS_ENCLOSURE_TYPE); }else{ ok(0,"Parsing Enclosure element, sub-element of Item"); } } __END__ =head1 NAME enclosures2.t - tests for parsing RSS 2.0 data with XML::RSS::LibXML.pm =head1 SYNOPSIS use Test::Harness qw (runtests); runtests (./XML-RSS/t/*.t); =head1 DESCRIPTION Tests for parsing RSS 2.0 data with XML::RSS::LibXML.pm L =head1 AUTHOR Aaron Straup Cope =head1 SEE ALSO http://backend.userland.com/rss2 =cut libxml-rss-libxml-perl-0.3102+dfsg.orig/t/1.0-parse-exotic.t0000644000175000017500000000247711401562045023517 0ustar nicholasnicholasuse Test::More tests => 4; use XML::RSS::LibXML; use File::Spec; $|++; my $file = File::Spec->catfile(File::Spec->curdir(), "t", "data", "1.0", "rss1.0.exotic.rdf"); my $rss = new XML::RSS::LibXML(encode_output => 1); eval { $rss->parsefile( $file ); }; # Test 1. # Support for feeds that use a default namespace other then RSS # unlike ($@, qr/invalid version/, "non-default namespace" ); # Test 2. # Make sure modules are parsed and loaded # my $namespaces = { 'rss' => 'http://purl.org/rss/1.0/', 'dc' => 'http://purl.org/dc/elements/1.1/', 'annotate' => 'http://purl.org/rss/1.0/modules/annotate/', 'cp' => 'http://my.theinfo.org/changed/1.0/rss/', 'admin' => 'http://webns.net/mvcb/', 'rdf' => 'http://www.w3.org/1999/02/22-rdf-syntax-ns#', '#default' => 'http://www.w3.org/1999/xhtml' }; ok ( eq_hash( $rss->{namespaces}, $namespaces ), "modules and namespaces" ); # Test 3. # Make sure modules that use rdf:resource are being properly parsed # in channel element # ok ($rss->{'channel'}->{'http://webns.net/mvcb/'}->{'errorReportsTo'} eq 'mailto:admin@example.org', 'parse rdf:resource on channel' ); # Test 4. # rdf:resrouce properly parsed in item # ok ($rss->{'items'}->[0]->{'http://my.theinfo.org/changed/1.0/rss/'}->{'server'} eq "http://example.org/changedPage", 'parse rdf:resource on item' ); libxml-rss-libxml-perl-0.3102+dfsg.orig/t/encoding.t0000644000175000017500000000230211401562045022371 0ustar nicholasnicholas# $Id: encoding.t,v 1.2 2004/04/21 02:44:40 kellan Exp $ use Test::More tests => 18; $|++; use XML::RSS::LibXML; my @versions = qw( 0.9 0.91 1.0 ); foreach my $version ( @versions ) { # default my $rss = XML::RSS::LibXML->new( version => $version ); isa_ok( $rss, 'XML::RSS::LibXML' ); make_rss( $rss ); like( $rss->as_string, qr/^<\?xml version="1.0" encoding="UTF-8"\?>/, "Default encoding for version $version" ); # UTF-8 $rss = XML::RSS::LibXML->new( version => $version, encoding => 'UTF-8' ); isa_ok( $rss, 'XML::RSS::LibXML' ); make_rss( $rss ); like( $rss->as_string, qr/^<\?xml version="1.0" encoding="UTF-8"\?>/, "Default encoding for version $version" ); # home brew # XXX - XML::LibXML is picky about the encoding, so we can't # just use 'Fooey'. Instead we use some commonly found encoding $rss = XML::RSS::LibXML->new( version => $version, encoding => 'EUC-JP' ); isa_ok( $rss, 'XML::RSS::LibXML' ); make_rss( $rss ); like( $rss->as_string, qr/^<\?xml version="1.0" encoding="EUC-JP"\?>/, "Default encoding for version $version" ); } sub make_rss { my $rss = shift; $rss->channel( title => 'Test RSS', link => 'http://www.example.com', ); } libxml-rss-libxml-perl-0.3102+dfsg.orig/t/1.0-parse.t0000644000175000017500000000512611410004533022211 0ustar nicholasnicholasuse strict; use Test::More; use constant RSS_VERSION => "1.0"; use constant RSS_CHANNEL_TITLE => "Example 1.0 Channel"; use constant RSS_DEFAULTNS => "http://purl.org/rss/1.0/"; use constant RSS_DOCUMENT => qq( Example 1.0 Channel http://example.com To lead by example en-us News for September the Second http://example.com/2002/09/02 other things happened today News for September the First http://example.com/2002/09/01 something happened today ); plan tests => 9; use_ok("XML::RSS::LibXML"); my $xml = XML::RSS::LibXML->new(); isa_ok($xml,"XML::RSS::LibXML"); eval { $xml->parse(RSS_DOCUMENT); }; is($@,'',"Parsed RSS feed"); cmp_ok($xml->{'_internal'}->{'version'}, "eq", RSS_VERSION, "Is RSS version ".RSS_VERSION); is $xml->encoding, 'UTF-8', 'Encoding should be UTF-8'; cmp_ok($xml->{namespaces}->{'#default'}, "eq", RSS_DEFAULTNS, RSS_DEFAULTNS); cmp_ok($xml->{channel}->{'title'}, "eq", RSS_CHANNEL_TITLE, "Feed title is ".RSS_CHANNEL_TITLE); cmp_ok(ref($xml->{items}), "eq", "ARRAY", "\$xml->{items} is an ARRAY ref"); my $ok = 1; foreach my $item (@{$xml->{items}}) { foreach my $el ("title","link","description") { if (! exists $item->{$el}) { $ok = 0; last; } } last if (! $ok); } ok($ok,"All items have title,link and description elements"); __END__ =head1 NAME 1.0-parse.t - tests for parsing RSS 1.0 data with XML::RSS::LibXML.pm =head1 SYNOPSIS use Test::Harness qw (runtests); runtests (./XML-RSS/t/*.t); =head1 DESCRIPTION Tests for parsing RSS 1.0 data with XML::RSS::LibXML.pm =head1 VERSION $Revision: 1.2 $ =head1 DATE $Date: 2002/11/19 23:57:20 $ =head1 AUTHOR Aaron Straup Cope =head1 SEE ALSO http://web.resource.org/rss/1.0 =cut libxml-rss-libxml-perl-0.3102+dfsg.orig/t/regress-broken-image.t0000644000175000017500000000123711401562045024621 0ustar nicholasnicholasuse strict; use Test::More; BEGIN { eval { require Test::Exception; require Test::Warn; Test::Exception->import(); Test::Warn->import; }; if ($@) { plan (skip_all => "This test require Test::Exception and Test::Warn"); } else { plan (tests => 2); } } use XML::RSS::LibXML; my $xml =< Broken RSS http://whatever.com/foo.gif EOXML { my $rss = XML::RSS::LibXML->new; lives_ok { $rss->parse($xml) } 'parse generates warning'; ok( ! $rss->{item}->[0]->{image} ); } libxml-rss-libxml-perl-0.3102+dfsg.orig/t/synopsis.t0000644000175000017500000001337311401562045022504 0ustar nicholasnicholas# $Id: synopsis.t 33 2007-03-14 03:06:58Z daisuke $ # # Copyright (c) 2005 Daisuke Maki # All rights reserved. use strict; use Test::More (tests => 14); BEGIN { use_ok("XML::RSS::LibXML"); use_ok("XML::RSS::LibXML::Namespaces", qw(NS_RSS10 NS_RSS20)); }; my $rss = new XML::RSS::LibXML (version => '1.0'); ok($rss->channel( title => "freshmeat.net", link => "http://freshmeat.net", description => "the one-stop-shop for all your Linux software needs", dc => { date => '2000-08-23T07:00+00:00', subject => "Linux Software", creator => 'scoop@freshmeat.net', publisher => 'scoop@freshmeat.net', rights => 'Copyright 1999, Freshmeat.net', language => 'en-us', }, syn => { updatePeriod => "hourly", updateFrequency => "1", updateBase => "1901-01-01T00:00+00:00", }, taxo => [ 'http://dmoz.org/Computers/Internet', 'http://dmoz.org/Computers/PC' ] ), "channel() works"); ok($rss->image( title => "freshmeat.net", url => "http://freshmeat.net/images/fm.mini.jpg", link => "http://freshmeat.net", dc => { creator => "G. Raphics (graphics at freshmeat.net)", }, ), "image() works"); ok($rss->add_item( title => "GTKeyboard 0.85", link => "http://freshmeat.net/news/1999/06/21/930003829.html", description => "GTKeyboard is a graphical keyboard that ...", dc => { subject => "X11/Utilities", creator => "David Allen (s2mdalle at titan.vcu.edu)", }, taxo => [ 'http://dmoz.org/Computers/Internet', 'http://dmoz.org/Computers/PC' ] ), "add_item() works"); ok($rss->textinput( title => "quick finder", description => "Use the text input below to search freshmeat", name => "query", link => "http://core.freshmeat.net/search.php3", ), "textinput() works"); ok($rss->add_module(prefix=>'my', uri=>'http://purl.org/my/rss/module/'), "add_module() works"); ok($rss->add_item( title => "xIrc 2.4pre2", link => "http://freshmeat.net/projects/xirc/", description => "xIrc is an X11-based IRC client which ...", my => { rating => "A+", category => "X11/IRC", }, ), "add_item() with custom module"); reparse($rss); undef $rss; $rss = new XML::RSS::LibXML (version => '2.0'); ok($rss->channel(title => 'freshmeat.net', link => 'http://freshmeat.net', language => 'en', description => 'the one-stop-shop for all your Linux software needs', # XXX - XML::RSS sourcode says it's not supported by RSS 2.0, but # this still exists in the SYNOPSIS # rating => '(PICS-1.1 "http://www.classify.org/safesurf/" 1 r (SS~~000 1))', copyright => 'Copyright 1999, Freshmeat.net', pubDate => 'Thu, 23 Aug 1999 07:00:00 GMT', lastBuildDate => 'Thu, 23 Aug 1999 16:20:26 GMT', docs => 'http://www.blahblah.org/fm.cdf', managingEditor => 'scoop@freshmeat.net', webMaster => 'scoop@freshmeat.net' ), "channel() works"); ok($rss->image(title => 'freshmeat.net', url => 'http://freshmeat.net/images/fm.mini.jpg', link => 'http://freshmeat.net', width => 88, height => 31, description => 'This is the Freshmeat image stupid' ), "image() works"); ok($rss->add_item(title => "GTKeyboard 0.85", # creates a guid field with permaLink=true permaLink => "http://freshmeat.net/news/1999/06/21/930003829.html", # alternately creates a guid field with permaLink=false # guid => "gtkeyboard-0.85 # It would be nice to test this, but overload makes it a bit of a problem # enclosure => XML::RSS::LibXML::MagicElement->new( # attributes => { # url => 'http://example.com/torrent', # type => "application/x-bittorrent" # } # ), description => 'blah blah' ), "add_item() works"); ok($rss->textinput(title => "quick finder", description => "Use the text input below to search freshmeat", name => "query", link => "http://core.freshmeat.net/search.php3" ), "textinput() works"); reparse($rss); sub reparse { my $rss1 = shift; my $rss2 = XML::RSS::LibXML->new(); # print STDERR $rss1->as_string; $rss2->parse($rss1->as_string()); my $version = $rss2->{_internal}{version} || $rss2->{output}; for (grep { /^_/ } (keys %{$rss}, keys %{$rss2})) { delete $rss1->{$_}; delete $rss2->{$_}; } # Also, do not compare $rss->{channel}{image}. It doesn't work when it's # generated via ->image(); Same for textinput for my $p (qw(image textinput textInput items)) { delete $rss1->{channel}{$p}; delete $rss2->{channel}{$p}; } if ($version eq '2.0') { delete $rss1->{items}; delete $rss2->{items}; } # XXX - Namespaces and modules don't necessarily work for our custom # rss20/rss10 namespaces delete $rss1->{modules}{&NS_RSS10}; delete $rss1->{modules}{&NS_RSS20}; delete $rss2->{modules}{&NS_RSS10}; delete $rss2->{modules}{&NS_RSS20}; delete $rss1->{namespaces}{rss10}; delete $rss1->{namespaces}{rss20}; delete $rss2->{namespaces}{rss10}; delete $rss2->{namespaces}{rss20}; # Also, #default namespaces don't count delete $rss1->{namespaces}{'#default'}; delete $rss2->{namespaces}{'#default'}; is_deeply($rss1, $rss2, "Reparsing produces same structure (RSS version = $version)"); } libxml-rss-libxml-perl-0.3102+dfsg.orig/t/items-are-0.t0000644000175000017500000030773311604763245022660 0ustar nicholasnicholas#!/usr/bin/perl use strict; use warnings; use Test::More tests => 502 ; use XML::RSS::LibXML; sub contains { local $Test::Builder::Level = $Test::Builder::Level + 1; my ($rss, $sub_string, $msg) = @_; my $rss_output = $rss->as_string(); my $ok = ok (index ($rss_output, $sub_string) >= 0, $msg ); if (! $ok) { diag("Could not find the substring [$sub_string] in:{{{{\n$rss_output\n}}}}\n"); } } sub not_contains { local $Test::Builder::Level = $Test::Builder::Level + 1; my ($rss, $sub_string, $msg) = @_; ok ((index ($rss->as_string(), $sub_string) < 0), $msg ); } sub create_rss_1 { my $args = shift; my $extra_rss_args = $args->{rss_args} || []; # my $rss = new XML::RSS::LibXML (version => '0.9'); my $rss = new XML::RSS::LibXML (version => $args->{version}, @$extra_rss_args); my $image_link = exists($args->{image_link}) ? $args->{image_link} : "http://freshmeat.net/"; my $extra_image_params = $args->{image_params} || []; $rss->channel( title => "freshmeat.net", link => "http://freshmeat.net", description => "the one-stop-shop for all your Linux software needs", ); $rss->image( title => "freshmeat.net", url => "0", link => $image_link, @{$extra_image_params}, ); $rss->add_item( title => "GTKeyboard 0.85", link => "http://freshmeat.net/news/1999/06/21/930003829.html" ); return $rss; } sub create_no_image_rss { my $args = shift; # my $rss = new XML::RSS::LibXML (version => '0.9'); my $rss = new XML::RSS::LibXML (version => $args->{version}); $rss->channel( title => "freshmeat.net", link => "http://freshmeat.net", description => "the one-stop-shop for all your Linux software needs", ); $rss->add_item( title => "GTKeyboard 0.85", link => "http://freshmeat.net/news/1999/06/21/930003829.html" ); return $rss; } sub create_item_with_0_rss { my $args = shift; # my $rss = new XML::RSS::LibXML (version => '0.9'); my $rss = new XML::RSS::LibXML (version => $args->{version}); my $image_link = exists($args->{image_link}) ? $args->{image_link} : "http://freshmeat.net/"; my $extra_image_params = $args->{image_params} || []; my $extra_item_params = $args->{item_params} || []; $rss->channel( title => "freshmeat.net", link => "http://freshmeat.net", description => "the one-stop-shop for all your Linux software needs", ); $rss->image( title => "freshmeat.net", url => "0", link => $image_link, @{$extra_image_params}, ); $rss->add_item( title => "0", link => "http://rss.mytld/", @{$extra_item_params}, ); return $rss; } sub create_textinput_with_0_rss { my $args = shift; my $rss = new XML::RSS::LibXML (version => $args->{version}); my $image_link = exists($args->{image_link}) ? $args->{image_link} : "http://freshmeat.net/"; my $extra_image_params = $args->{image_params} || []; my $extra_item_params = $args->{item_params} || []; my $extra_textinput_params = $args->{textinput_params} || []; $rss->channel( title => "freshmeat.net", link => "http://freshmeat.net", description => "the one-stop-shop for all your Linux software needs", ); $rss->image( title => "freshmeat.net", url => "0", link => $image_link, @{$extra_image_params}, ); $rss->add_item( title => "0", link => "http://rss.mytld/", @{$extra_item_params}, ); $rss->textinput( (map { $_ => 0 } (qw(link title description name))), @{$extra_textinput_params}, ); return $rss; } sub create_channel_rss { my $args = shift; # my $rss = new XML::RSS::LibXML (version => '0.9'); my $rss = new XML::RSS::LibXML (version => $args->{version}); my $extra_channel_params = $args->{channel_params} || []; my @build_date = ($args->{version} eq "2.0" && !$args->{omit_date}) ? (lastBuildDate => "Sat, 07 Sep 2002 09:42:31 GMT",) : (); $rss->channel( title => "freshmeat.net", link => "http://freshmeat.net", description => "Linux software", @build_date, @{$extra_channel_params}, ); $rss->add_item( title => "GTKeyboard 0.85", link => "http://freshmeat.net/news/1999/06/21/930003829.html" ); return $rss; } sub create_skipHours_rss { my $args = shift; # my $rss = new XML::RSS::LibXML (version => '0.9'); my $rss = new XML::RSS::LibXML (version => $args->{version}); my $extra_channel_params = $args->{channel_params} || []; my $extra_skipHours_params = $args->{skipHours_params} || []; my @build_date = ($args->{version} eq "2.0" && !$args->{omit_date}) ? (lastBuildDate => "Sat, 07 Sep 2002 09:42:31 GMT",) : (); $rss->channel( title => "freshmeat.net", link => "http://freshmeat.net", description => "Linux software", @build_date, @{$extra_channel_params}, ); $rss->add_item( title => "GTKeyboard 0.85", link => "http://freshmeat.net/news/1999/06/21/930003829.html" ); $rss->skipHours(@{$extra_skipHours_params}); return $rss; } sub create_skipDays_rss { my $args = shift; # my $rss = new XML::RSS::LibXML (version => '0.9'); my $rss = new XML::RSS::LibXML (version => $args->{version}); my $extra_channel_params = $args->{channel_params} || []; my $extra_skipDays_params = $args->{skipDays_params} || []; my @build_date = ($args->{version} eq "2.0" && !$args->{omit_date}) ? (lastBuildDate => "Sat, 07 Sep 2002 09:42:31 GMT",) : (); $rss->channel( title => "freshmeat.net", link => "http://freshmeat.net", description => "Linux software", @build_date, @{$extra_channel_params}, ); $rss->add_item( title => "GTKeyboard 0.85", link => "http://freshmeat.net/news/1999/06/21/930003829.html" ); $rss->skipDays(@{$extra_skipDays_params}); return $rss; } sub create_rss_with_image_w_undef_link { my $args = shift; # my $rss = new XML::RSS::LibXML (version => '0.9'); my $rss = new XML::RSS::LibXML (version => $args->{version}); my $extra_image_params = $args->{image_params} || []; $rss->channel( title => "freshmeat.net", link => "http://freshmeat.net", description => "the one-stop-shop for all your Linux software needs", ); $rss->image( title => "freshmeat.net", url => "0", @{$extra_image_params}, ); $rss->add_item( title => "GTKeyboard 0.85", link => "http://freshmeat.net/news/1999/06/21/930003829.html" ); return $rss; } sub create_item_rss { my $args = shift; # my $rss = new XML::RSS::LibXML (version => '0.9'); my $rss = new XML::RSS::LibXML (version => $args->{version}); my $extra_item_params = $args->{item_params} || []; $rss->channel( title => "freshmeat.net", link => "http://freshmeat.net", description => "the one-stop-shop for all your Linux software needs", ); $rss->add_item( title => "Freecell Solver", link => "http://fc-solve.berlios.de/", @$extra_item_params, ); return $rss; } sub create_rss_without_item { my $args = shift; # my $rss = new XML::RSS::LibXML (version => '0.9'); my $rss = new XML::RSS::LibXML (version => $args->{version}); $rss->channel( title => "freshmeat.net", link => "http://freshmeat.net", description => "the one-stop-shop for all your Linux software needs", ); return $rss; } { my $rss = create_no_image_rss({version => "0.9"}); # TEST not_contains($rss, "", "0.9 - if an image was not specified it isn't there." ); } { my $rss = create_no_image_rss({version => "0.91"}); # TEST not_contains($rss, "", "0.91 - if an image was not specified it isn't there." ); } { my $rss = create_no_image_rss({version => "1.0"}); # TEST not_contains($rss, " "2.0"}); # TEST not_contains($rss, "", "1.0 - if an image was not specified it isn't there." ); } sub match_elements { local $Test::Builder::Level = $Test::Builder::Level + 1; my ($rss, $parent, $h) = @_; my $version = $rss->version; my $output = $rss->as_string; my $re = do { my %attrs; my $about = delete $h->{about}; if ($about) { $attrs{'rdf:about'} = $about; } my $str = "<$parent"; if (my @attr_keys = keys %attrs) { $str .= "(?: (?:" . join('|', map { qq|$_="$attrs{$_}"| } @attr_keys) . ")[^>/]*)"; } else { $str .= "[^>/]*"; } $str .= ">((?!).+?)"; qr{(?sm)$str}; }; ok ($output =~ /$re/, "Checking for $parent in RSS $version"); my $contents = $1 || ''; while (my ($e, $v) = each %$h) { my $local_re = do { my $content = ref $v ? delete $v->{content} : $v; if (! defined $content) { $content = ''; } my $str = "<$e"; if (ref $v) { $str .= "(?: (?:" . join('|', map { qq|$_="$v->{$_}"| } keys %$v) . ")[^>/]*)"; } $str .= ">"; if (! length $content) { $str =~ s/\)[^\)]+\)>/\)\)\/>/; qr{$str}; } else { qr{$str$content}; } }; ok($contents =~ $local_re, "Checking for $e = $local_re in $parent for RSS $version"); } } { foreach my $version (qw(0.9 0.91 1.0 2.0)) { my $rss = create_rss_1({version => $version}); # TEST match_elements($rss, 'image', { url => 0, link => "http://freshmeat.net/", title => "freshmeat.net" }); } } { foreach my $version (qw(0.9 0.91 1.0 2.0)) { my $rss = create_rss_1({version => $version, image_link => "0",}); # TEST match_elements($rss, 'image', { url => 0, link => 0, title => "freshmeat.net" }); } } { foreach my $version (qw(0.91 2.0)) { my $rss = create_rss_1({ version => $version, image_params => [width => 0, height => 0, description => 0], } ); # TEST match_elements($rss, 'image', { url => 0, link => "http://freshmeat.net/", title => "freshmeat.net", description => 0, width => 0, height => 0 }); } } { my $rss = create_item_with_0_rss({version => "0.9"}); # TEST match_elements($rss, 'item', { title => 0, link => "http://rss.mytld/" }); } { my $rss = create_item_with_0_rss({version => "0.91", item_params => [description => "Hello There"], }); # TEST match_elements($rss, 'item', { title => 0, link => "http://rss.mytld/", description => "Hello There" }); } { my $rss = create_item_with_0_rss({version => "0.91", item_params => [description => "0"], }); # TEST match_elements($rss, 'item', { title => 0, link => "http://rss.mytld/", description => 0 } ); } { my $rss = create_item_with_0_rss({version => "1.0", item_params => [description => "Hello There", about => "Yowza"], }); # TEST match_elements($rss, 'item', { about => "Yowza", title => 0, link => "http://rss.mytld/", description => "Hello There" } ); } { my $rss = create_item_with_0_rss({version => "1.0", item_params => [description => "0", about => "Yowza"], }); # TEST match_elements($rss, 'item', { about => "Yowza", title => 0, link => "http://rss.mytld/", description => 0 }); } # TODO : Test the dc: items. { my @subs = (qw(title link description author category comments pubDate)); my $rss = create_item_with_0_rss({version => "2.0", item_params => [ map { $_ => 0 } @subs ], } ); match_elements($rss, 'item', +{ map { ($_ => 0) } @subs }); } { my $rss = create_item_with_0_rss({version => "2.0", item_params => [ title => "Foo&Bar", link => "http://www.mytld/", permaLink => "0", ], } ); # TEST match_elements($rss, 'item', { title => "Foo&Bar", link => "http://www.mytld/", guid => { isPermaLink => "true", content => 0 } }); } { my $rss = create_item_with_0_rss({version => "2.0", item_params => [ title => "Foo&Bar", link => "http://www.mytld/", guid => "0", ], } ); match_elements($rss, 'item', { title => "Foo&Bar", link => "http://www.mytld/", guid => { isPermaLink => "false", content => 0 } }); } SKIP: { skip "TODO", 4; # TEST:$num_iters=4; foreach my $s ( ["Hercules", "http://www.hercules.tld/",], ["0", "http://www.hercules.tld/",], ["Hercules", "0",], ["0", "0",], ) { my $rss = create_item_with_0_rss({version => "2.0", item_params => [ title => "Foo&Bar", link => "http://www.mytld/", source => $s->[0], sourceUrl => $s->[1], ], } ); # TEST*$num_iters contains( $rss, ("\n" . "Foo&Bar\n" . "http://www.mytld/\n" . "[1]\">$s->[0]\n" . "" ), "2.0 - item - source = $s->[0] sourceUrl = $s->[1]", ); } } { foreach my $version (qw(0.9 0.91 2.0)) { my $rss = create_no_image_rss({version => $version}); # TEST not_contains($rss, "", "$version - if a textinput was not specified it isn't there." ); } } { foreach my $version (qw(0.9 0.91)) { my $rss = create_textinput_with_0_rss({version => $version}); # TEST match_elements($rss, 'textinput', { title => 0, description => 0, name => 0, link => 0 }); } } { my $rss = create_no_image_rss({version => "1.0"}); # TEST not_contains($rss, " "1.0"}); # TEST contains( $rss, ("\n" . join("", map {"<$_>0\n"} (qw(title description name link))) . "\n"), "1.0 - textinput/link == 0", ); # TEST contains( $rss, "\n\n", "1.0 - textinput/link == 0 and textinput rdf:resource", ); } { my $rss = create_textinput_with_0_rss({version => "2.0"}); # TEST match_elements($rss, 'textInput', { link => 0, title => 0, description => 0, name => 0}); } { my $rss = create_channel_rss({version => "0.91"}); # TEST match_elements($rss, 'channel', { title => 'freshmeat.net', link => 'http://freshmeat.net', 'description' => 'Linux software' }); } { my $rss = create_channel_rss({ version => "0.91", channel_params => [dc => { language => "0",},], }); # TEST match_elements($rss, 'channel', { title => 'freshmeat.net', link => 'http://freshmeat.net', 'description' => 'Linux software', 'dc:language' => 0 }); } { my $rss = create_channel_rss({ version => "0.91", channel_params => [language => "0",], }); match_elements($rss, 'channel', { title => 'freshmeat.net', link => 'http://freshmeat.net', 'description' => 'Linux software', 'language' => 0 }); } { my $rss = create_channel_rss({version => "1.0"}); # TEST match_elements($rss, 'channel', { about => "http://freshmeat.net", title => 'freshmeat.net', link => 'http://freshmeat.net', 'description' => 'Linux software' }); } { my $rss = create_channel_rss({ version => "1.0", channel_params => [dc => { language => "0",},], }); # TEST match_elements($rss, 'channel', { about => "http://freshmeat.net", title => 'freshmeat.net', link => 'http://freshmeat.net', 'description' => 'Linux software', 'dc:language' => 0 }); } { my $rss = create_channel_rss({ version => "1.0", channel_params => [language => "0",], }); # TEST match_elements($rss, 'channel', { about => "http://freshmeat.net", title => 'freshmeat.net', link => 'http://freshmeat.net', 'description' => 'Linux software', 'dc:language' => 0 }); } { my $rss = create_channel_rss({version => "2.0"}); # TEST match_elements($rss, 'channel', { title => 'freshmeat.net', link => 'http://freshmeat.net', 'description' => 'Linux software', 'lastBuildDate' => 'Sat, 07 Sep 2002 09:42:31 GMT' }); } { my $rss = create_channel_rss({ version => "2.0", channel_params => [dc => { language => "0",},], }); # XXX - Original only tested for 'language'. should this be the case? # TEST match_elements($rss, 'channel', { title => 'freshmeat.net', link => 'http://freshmeat.net', 'description' => 'Linux software', 'dc:language' => 0, 'language' => 0, 'lastBuildDate' => 'Sat, 07 Sep 2002 09:42:31 GMT' }); } { my $rss = create_channel_rss({ version => "2.0", channel_params => [language => "0",], }); # TEST match_elements($rss, 'channel', { title => 'freshmeat.net', link => 'http://freshmeat.net', 'description' => 'Linux software', 'language' => 0, 'lastBuildDate' => 'Sat, 07 Sep 2002 09:42:31 GMT' }); } { my $rss = create_channel_rss({ version => "0.91", channel_params => [rating => "0",], }); # TEST match_elements($rss, 'channel', { title => 'freshmeat.net', link => 'http://freshmeat.net', 'description' => 'Linux software', 'rating' => 0}); } { my $rss = create_channel_rss({ version => "0.91", channel_params => [rating => "Hello", dc => {rights => "0"},], }); # TEST match_elements($rss, 'channel', { title => 'freshmeat.net', link => 'http://freshmeat.net', 'description' => 'Linux software', 'rating' => 'Hello', 'dc:rights' => 0}); } { my $rss = create_channel_rss({ version => "0.91", channel_params => [rating => "Hello", copyright => "0",], }); # TEST match_elements($rss, 'channel', { title => 'freshmeat.net', link => 'http://freshmeat.net', 'description' => 'Linux software', 'rating' => 'Hello', 'copyright' => 0}); } { my $rss = create_channel_rss({ version => "2.0", channel_params => [dc => {rights => "0"},], }); # TEST match_elements($rss, 'channel', { title => 'freshmeat.net', link => 'http://freshmeat.net', 'description' => 'Linux software', 'dc:rights' => 0, 'lastBuildDate' => 'Sat, 07 Sep 2002 09:42:31 GMT' }); } { my $rss = create_channel_rss({ version => "2.0", channel_params => [copyright=> "0",], }); # TEST match_elements($rss, 'channel', { title => 'freshmeat.net', link => 'http://freshmeat.net', 'description' => 'Linux software', 'copyright' => 0, 'lastBuildDate' => 'Sat, 07 Sep 2002 09:42:31 GMT' }); } { my $rss = create_channel_rss({ version => "0.91", channel_params => [rating => "Hello", copyright => "Martha",docs => "0",], }); # TEST match_elements($rss, 'channel', { title => 'freshmeat.net', link => 'http://freshmeat.net', 'description' => 'Linux software', 'copyright' => 'Martha', docs => 0 }); } { my $rss = create_channel_rss({ version => "2.0", channel_params => [copyright => "Martha", docs => "0",], }); # TEST match_elements($rss, 'channel', { title => 'freshmeat.net', link => 'http://freshmeat.net', 'description' => 'Linux software', 'copyright' => 'Martha', docs => 0 }); } { my $rss = create_channel_rss({ version => "0.91", channel_params => [rating => "Hello", copyright => "Martha", docs => "MyDr. docs",dc => {publisher => 0}], }); # TEST match_elements($rss, 'channel', { title => 'freshmeat.net', link => 'http://freshmeat.net', 'description' => 'Linux software', 'copyright' => 'Martha', docs => 'MyDr. docs', managingEditor => 0 }); } { my $rss = create_channel_rss({ version => "0.91", channel_params => [rating => "Hello", copyright => "Martha", docs => "MyDr. docs",managingEditor => 0], }); # TEST match_elements($rss, 'channel', { title => 'freshmeat.net', link => 'http://freshmeat.net', 'description' => 'Linux software', 'copyright' => 'Martha', docs => 'MyDr. docs', managingEditor => 0 }); } { my $rss = create_channel_rss({ version => "2.0", channel_params => [copyright => "Martha", docs => "MyDr. docs",managingEditor => 0], }); # TEST match_elements($rss, 'channel', { title => 'freshmeat.net', link => 'http://freshmeat.net', 'description' => 'Linux software', 'copyright' => 'Martha', lastBuildDate => 'Sat, 07 Sep 2002 09:42:31 GMT', docs => 'MyDr. docs', managingEditor => 0 }); } { my $rss = create_channel_rss({ version => "2.0", channel_params => [copyright => "Martha", docs => "MyDr. docs", dc => {publisher => 0}], }); # TEST match_elements($rss, 'channel', { title => 'freshmeat.net', link => 'http://freshmeat.net', 'description' => 'Linux software', 'copyright' => 'Martha', lastBuildDate => 'Sat, 07 Sep 2002 09:42:31 GMT', docs => 'MyDr. docs', managingEditor => 0 }); } { my $rss = create_channel_rss({ version => "1.0", channel_params => [copyright => "Martha", dc => {publisher => 0}], }); # TEST match_elements($rss, 'channel', { about => "http://freshmeat.net", title => 'freshmeat.net', link => 'http://freshmeat.net', 'description' => 'Linux software', 'dc:rights' => 'Martha', 'dc:publisher' => 0 }); } { # Here we create an RSS 2.0 object and render it as 1.0 to get the # "managingEditor" field acknowledged. my $rss = create_channel_rss({ version => "2.0", channel_params => [copyright => "Martha", managingEditor => 0,], omit_date => 1, }); $rss->{output} = "1.0"; # TEST match_elements($rss, 'channel', { about => "http://freshmeat.net", title => 'freshmeat.net', link => 'http://freshmeat.net', 'description' => 'Linux software', 'dc:rights' => 'Martha', 'dc:publisher' => 0 }); } { my $rss = create_channel_rss({ version => "0.91", channel_params => [rating => "Hello", copyright => "Martha", docs => "MyDr. docs",dc => {creator => 0}], }); # TEST match_elements($rss, 'channel', { title => 'freshmeat.net', link => 'http://freshmeat.net', description => 'Linux software', rating => 'Hello', copyright => 'Martha', docs => 'MyDr. docs', webMaster => 0 }); } { my $rss = create_channel_rss({ version => "0.91", channel_params => [rating => "Hello", copyright => "Martha", docs => "MyDr. docs",webMaster => 0], }); # TEST match_elements($rss, 'channel', { title => 'freshmeat.net', link => 'http://freshmeat.net', description => 'Linux software', rating => 'Hello', copyright => 'Martha', docs => 'MyDr. docs', webMaster => 0 }); } { my $rss = create_channel_rss({ version => "1.0", channel_params => [copyright => "Martha", dc => {creator => 0}], }); # TEST match_elements($rss, 'channel', { about => "http://freshmeat.net", title => 'freshmeat.net', link => 'http://freshmeat.net', 'description' => 'Linux software', 'dc:rights' => 'Martha', 'dc:creator' => 0 }); } { # Here we create an RSS 2.0 object and render it as 1.0 to get the # "managingEditor" field acknowledged. my $rss = create_channel_rss({ version => "2.0", channel_params => [copyright => "Martha", webMaster => 0,], omit_date => 1, }); $rss->{output} = "1.0"; # TEST match_elements($rss, 'channel', { about => "http://freshmeat.net", title => 'freshmeat.net', link => 'http://freshmeat.net', 'description' => 'Linux software', 'dc:rights' => 'Martha', 'dc:creator' => 0 }); } { my $rss = create_channel_rss({ version => "2.0", channel_params => [copyright => "Martha", docs => "MyDr. docs",webMaster => 0], }); # TEST match_elements($rss, 'channel', { title => 'freshmeat.net', link => 'http://freshmeat.net', 'description' => 'Linux software', 'copyright' => 'Martha', lastBuildDate => 'Sat, 07 Sep 2002 09:42:31 GMT', docs => 'MyDr. docs', webMaster => 0 }); } { my $rss = create_channel_rss({ version => "2.0", channel_params => [copyright => "Martha", docs => "MyDr. docs", dc => {creator => 0}], }); # TEST match_elements($rss, 'channel', { title => 'freshmeat.net', link => 'http://freshmeat.net', 'description' => 'Linux software', 'copyright' => 'Martha', lastBuildDate => 'Sat, 07 Sep 2002 09:42:31 GMT', docs => 'MyDr. docs', webMaster => 0 }); } { my $rss = create_no_image_rss({version => "0.91"}); # TEST not_contains($rss, "", "0.91 - if skipHours was not specified it isn't there." ); } { my $rss = create_skipHours_rss({ version => "0.91", skipHours_params => [ hour => "0" ], }); # TEST match_elements($rss, 'channel', { skipHours => '\s*0\s*' }); } { my $rss = create_no_image_rss({version => "2.0"}); # TEST not_contains($rss, "", "2.0 - if skipHours was not specified it isn't there." ); } { my $rss = create_skipHours_rss({ version => "2.0", skipHours_params => [ hour => "0" ], }); # TEST match_elements($rss, 'channel', { skipHours => '\s*0\s*' }); } { my $rss = create_no_image_rss({version => "0.91"}); # TEST not_contains($rss, "", "0.91 - if skipDays was not specified it isn't there." ); } { my $rss = create_skipDays_rss({ version => "0.91", skipDays_params => [ day => "0" ], }); # TEST match_elements($rss, 'channel', { skipDays => '\s*0\s*' }); } { my $rss = create_no_image_rss({version => "2.0"}); # TEST not_contains($rss, "", "2.0 - if skipDays was not specified it isn't there." ); } { my $rss = create_skipDays_rss({ version => "2.0", skipDays_params => [ day => "0" ], }); # TEST match_elements($rss, 'channel', { skipDays => '\s*0\s*' }); } { my $rss = create_channel_rss({ version => "1.0", channel_params => [copyright => 0,], }); # TEST match_elements($rss, 'channel', { about => "http://freshmeat.net", title => 'freshmeat.net', link => 'http://freshmeat.net', 'description' => 'Linux software', 'dc:rights' => 0 }); =head1 contains($rss, "\n" . "freshmeat.net\n" . "http://freshmeat.net\n" . "Linux software\n" . "0\n" . "\n", "1.0 - channel/copyright == 0" ); =cut } { my $rss = create_channel_rss({ version => "1.0", channel_params => [dc => { rights => 0},], }); # TEST match_elements($rss, 'channel', { about => "http://freshmeat.net", title => 'freshmeat.net', link => 'http://freshmeat.net', 'description' => 'Linux software', 'dc:rights' => 0 }); =head1 contains($rss, "\n" . "freshmeat.net\n" . "http://freshmeat.net\n" . "Linux software\n" . "0\n" . "\n", "1.0 - channel/dc/rights == 0" ); =cut } { my $rss = create_channel_rss({ version => "1.0", channel_params => [dc => { title => 0},], }); # TEST match_elements($rss, 'channel', { about => "http://freshmeat.net", title => 'freshmeat.net', link => 'http://freshmeat.net', 'description' => 'Linux software', 'dc:title' => 0 }); =head1 contains($rss, "\n" . "freshmeat.net\n" . "http://freshmeat.net\n" . "Linux software\n" . "0\n" . "\n", "1.0 - channel/dc/title == 0" ); =cut } { my $rss = create_channel_rss({ version => "1.0", channel_params => [syn => { updateBase=> 0},], }); # TEST match_elements($rss, 'channel', { about => "http://freshmeat.net", title => 'freshmeat.net', link => 'http://freshmeat.net', 'description' => 'Linux software', 'syn:updateBase' => 0 }); =head1 contains($rss, "\n" . "freshmeat.net\n" . "http://freshmeat.net\n" . "Linux software\n" . "0\n" . "\n", "1.0 - channel/syn/updateBase == 0" ); =cut } { my $rss = create_rss_1({version => "1.0", image_params => [ dc => { subject => 0, }] }); # TEST match_elements($rss, 'image', { about => 0, title => 'freshmeat.net', url => 0, link => 'http://freshmeat.net/', 'dc:subject' => 0 }); =head1 contains ($rss, (qq{\nfreshmeat.net\n} . qq{0\nhttp://freshmeat.net/\n} . qq{0\n}), "1.0 - Checking for image/dc/subject == 0"); =cut } { my $rss = create_item_with_0_rss({version => "1.0", item_params => [ description => "Hello There", about => "Yowza", dc => { subject => 0,}, ], }); # TEST match_elements($rss, 'item', { about => "Yowza", title => 0, link => "http://rss.mytld/", description => "Hello There", "dc:subject" => 0 }); =head1 contains( $rss, "\n0\nhttp://rss.mytld/\nHello There\n0\n", "1.0 - item/dc/subject == 0", ); =cut } { my $rss = create_textinput_with_0_rss({version => "1.0", textinput_params => [dc => { subject => 0,},], }); # TEST match_elements($rss, 'textinput', { about => 0, title => 0, description => 0, name => 0, link => 0, 'dc:subject' => 0 }); =head1 contains( $rss, ("\n" . join("", map {"<$_>0\n"} (qw(title description name link dc:subject))) . "\n"), "1.0 - textinput/dc/subject == 0", ); =cut } { # TEST:$num_fields=3; foreach my $field (qw(category generator ttl)) { # TEST:$num_dc=2; foreach my $dc (1,0) { my $rss = create_channel_rss({ version => "2.0", channel_params => [$dc ? (dc => {$field => 0 }) : ($field => 0) ], }); # TEST*$num_fields*$num_dc match_elements($rss, 'channel', { title => 'freshmeat.net', link => 'http://freshmeat.net', description => 'Linux software', lastBuildDate => 'Sat, 07 Sep 2002 09:42:31 GMT', $field => 0 }); =head contains($rss, "\n" . "freshmeat.net\n" . "http://freshmeat.net\n" . "Linux software\n" . "Sat, 07 Sep 2002 09:42:31 GMT\n" . "<$field>0\n" . "\n" . "\n", "2.0 - Testing for fields with an optional dc being 0. (dc=$dc,field=$field)" ); =cut } } } { my $rss = create_channel_rss({ version => "0.91", channel_params => [pubDate => "There&Everywhere"], }); # TEST match_elements($rss, 'channel', { title => 'freshmeat.net', link => 'http://freshmeat.net', description => 'Linux software', pubDate => '</pubDate><hello>There&amp;Everywhere</hello>' }); =head1 contains($rss, "\n" . "freshmeat.net\n" . "http://freshmeat.net\n" . "Linux software\n" . "</pubDate><hello>There&amp;Everywhere</hello>\n" . "\n" . "\n", "0.9.1 - channel/pubDate Markup Injection" ); =cut } { my $rss = create_channel_rss({ version => "0.91", channel_params => [lastBuildDate => "There&Everywhere"], }); # TEST match_elements($rss, 'channel', { title => 'freshmeat.net', link => 'http://freshmeat.net', description => 'Linux software', lastBuildDate => '</pubDate><hello>There&amp;Everywhere</hello>' }); =head1 contains($rss, "\n" . "freshmeat.net\n" . "http://freshmeat.net\n" . "Linux software\n" . "</pubDate><hello>There&amp;Everywhere</hello>\n" . "\n" . "\n", "0.9.1 - channel/lastBuildDate Markup Injection" ); =cut } { my $rss = create_channel_rss({ version => "1.0", channel_params => [ dc => { date => "There&Everywhere" }, ], }); # TEST match_elements($rss, 'channel', { about => 'http://freshmeat.net', title => 'freshmeat.net', link => 'http://freshmeat.net', description => 'Linux software', 'dc:date' => '</pubDate><hello>There&amp;Everywhere</hello>' }); =head1 contains($rss, "\n" . "freshmeat.net\n" . "http://freshmeat.net\n" . "Linux software\n" . "</pubDate><hello>There&amp;Everywhere</hello>\n" . "\n", "1.0 - dc/date Markup Injection" ); =cut } { my $rss = create_channel_rss({version => "2.0", channel_params => [pubDate => "There&Everywhere"], omit_date => 1, }); # TEST match_elements($rss, 'channel', { title => 'freshmeat.net', link => 'http://freshmeat.net', description => 'Linux software', 'pubDate' => '</pubDate><hello>There&amp;Everywhere</hello>' }); =head1 contains($rss, "\n" . "freshmeat.net\n" . "http://freshmeat.net\n" . "Linux software\n" . "</pubDate><hello>There&amp;Everywhere</hello>\n" . "\n" . "\n", "2.0 - channel/pubDate Markup Injection" ); =cut } { my $rss = create_channel_rss({version => "2.0", channel_params => [lastBuildDate => "There&Everywhere"], omit_date => 1, }); # TEST match_elements($rss, 'channel', { title => 'freshmeat.net', link => 'http://freshmeat.net', description => 'Linux software', 'lastBuildDate' => '</pubDate><hello>There&amp;Everywhere</hello>' }); =head1 contains($rss, "\n" . "freshmeat.net\n" . "http://freshmeat.net\n" . "Linux software\n" . "</pubDate><hello>There&amp;Everywhere</hello>\n" . "\n" . "\n", "2.0 - channel/lastBuildDate Markup Injection" ); =cut } { my $rss = create_rss_with_image_w_undef_link({version => "0.9"}); # TEST match_elements($rss, 'image', { title => 'freshmeat.net', url => 0 }); =head1 contains ($rss, qq{\nfreshmeat.net\n0\n\n}, "Image with undefined link does not render the Image - RSS version 0.9" ); =cut } { my $rss = create_rss_with_image_w_undef_link({version => "1.0"}); # TEST match_elements($rss, 'image', { about => 0, title => 'freshmeat.net', url => 0 }); =head1 contains ($rss, qq{\nfreshmeat.net\n} . qq{0\n\n}, "Image with undefined link does not render the Image - RSS version 1.0" ); =cut } { my $rss = create_channel_rss({ version => "1.0", channel_params => [about => "http://xml-rss-hackers.tld/"], }); # TEST match_elements($rss, 'channel', { about => 'http://xml-rss-hackers.tld/', title => 'freshmeat.net', link => 'http://freshmeat.net', description => 'Linux software' }); =head1 contains($rss, "\n" . "freshmeat.net\n" . "http://freshmeat.net\n" . "Linux software\n" . "\n", "1.0 - channel/about overrides the rdf:about attribute." ); =cut } { my $rss = create_channel_rss({ version => "1.0", channel_params => [ taxo => ["Foo", "Bar", "QuGof", "Lambda&Delta"], ], }); # TEST match_elements($rss, 'channel', { about => "http://freshmeat.net", title => 'freshmeat.net', link => 'http://freshmeat.net', description => 'Linux software' }); match_elements($rss, 'rdf:Bag', { 'rdf:li' => { resource => 'Foo' } }); match_elements($rss, 'rdf:Bag', { 'rdf:li' => { resource => 'Bar' } }); match_elements($rss, 'rdf:Bag', { 'rdf:li' => { resource => 'QuGof' } }); match_elements($rss, 'rdf:Bag', { 'rdf:li' => { resource => 'Lambda&Delta' } }); =head1 contains($rss, "\n" . "freshmeat.net\n" . "http://freshmeat.net\n" . "Linux software\n" . qq{\n \n} . qq{ \n} . qq{ \n} . qq{ \n} . qq{ \n} . qq{ \n\n} . "\n", "1.0 - taxo topics" ); =cut } SKIP: { skip "TODO (Unsupported key)", 3; { my $rss = create_channel_rss({ version => "1.0", channel_params => [ admin => { 'foobar' => "Quod", }, ], }); # TEST contains($rss, "\n" . "freshmeat.net\n" . "http://freshmeat.net\n" . "Linux software\n" . "Quod\n" . "\n", '1.0 - channel/[module] with unknown key' ); } { my $rss = create_channel_rss({ version => "1.0", channel_params => [ eloq => { 'grow' => "There", }, ], }); $rss->add_module(prefix => "eloq", uri => "http://eloq.tld2/Gorj/"); # TEST contains($rss, "\n" . "freshmeat.net\n" . "http://freshmeat.net\n" . "Linux software\n" . "There\n" . "\n", '1.0 - channel/[module] with new module' ); } { my $rss = create_rss_1({ version => "1.0", image_params => [ admin => { 'foobar' => "Quod", }, ], }); # TEST contains($rss, "\n" . "freshmeat.net\n" . "0\n" . "http://freshmeat.net/\n" . "Quod\n" . "", '1.0 - image/[module] with unknown key' ); } } { my $rss = create_rss_1({ version => "1.0", image_params => [ eloq => { 'grow' => "There", }, ], }); $rss->add_module(prefix => "eloq", uri => "http://eloq.tld2/Gorj/"); # TEST match_elements($rss, 'image', { about => 0, title => 'freshmeat.net', url => 0, link => "http://freshmeat.net/", 'eloq:grow' => 'There' }); =head1 contains($rss, "\n" . "freshmeat.net\n" . "0\n" . "http://freshmeat.net/\n" . "There\n" . "", '1.0 - image/[module] with new module' ); =cut } SKIP: { skip "TODO (generatorAgent)", 1; my $rss = create_rss_1({ version => "1.0", image_params => [ admin => { 'generatorAgent' => "Spozilla 5.5", }, ], }); # TEST match_elements($rss, 'image', { about => 0, title => 'freshmeat.net', url => 0, link => "http://freshmeat.net/", 'admin:generatorAgent' => { 'rdf:resource' => 'Spozilla 5.5' } }); =head1 contains($rss, "\n" . "freshmeat.net\n" . "0\n" . "http://freshmeat.net/\n" . "\n" . "", '1.0 - image/[module] with known module' ); =cut } { my $rss = create_channel_rss({ version => "1.0", }); $rss->add_item( title => "In the Jungle", link => "http://jungle.tld/Enter/", taxo => ["Foo","Loom", "", "Yok&Dol"], ); # TEST match_elements($rss, 'item', { about => "http://jungle.tld/Enter/", title => 'In the Jungle', link => 'http://jungle.tld/Enter/'}); match_elements($rss, 'rdf:Bag', { 'rdf:li' => { resource => 'Foo' } }); match_elements($rss, 'rdf:Bag', { 'rdf:li' => { resource => 'Loom' } }); match_elements($rss, 'rdf:Bag', { 'rdf:li' => { resource => '<Ard>' } }); match_elements($rss, 'rdf:Bag', { 'rdf:li' => { resource => 'Yok&Dol' } }); =head1 contains($rss, "\n" . "In the Jungle\n" . "http://jungle.tld/Enter/\n" . qq{\n} . qq{ \n} . qq{ \n} . qq{ \n} . qq{ \n} . qq{ \n} . qq{ \n} . qq{\n} . "\n", "1.0 - item/taxo:topics (with escaping)" ); =cut } ## Test the RSS 1.0 items' ad-hoc modules support. SKIP: { skip "hoge", 10; { my $rss = create_item_rss({ version => "1.0", item_params => [ admin => { 'foobar' => "Quod", }, ], }); # TEST contains($rss, "\n" . "Freecell Solver\n" . "http://fc-solve.berlios.de/\n" . "Quod\n" . "", '1.0 - item/[module] with unknown key' ); } { my $rss = create_item_rss({ version => "1.0", item_params => [ eloq => { 'grow' => "There", }, ], }); $rss->add_module(prefix => "eloq", uri => "http://eloq.tld2/Gorj/"); # TEST contains($rss, "\n" . "Freecell Solver\n" . "http://fc-solve.berlios.de/\n" . "There\n" . "", '1.0 - item/[module] with new module' ); } { my $rss = create_item_rss({ version => "1.0", item_params => [ admin => { 'generatorAgent' => "Spozilla 5.5", }, ], }); # TEST contains($rss, "\n" . "Freecell Solver\n" . "http://fc-solve.berlios.de/\n" . "\n" . "", '1.0 - item/[module] with known module' ); } { my $rss = create_textinput_with_0_rss({version => "1.0", textinput_params => [admin => { 'foobar' => "Quod", },], }); # TEST contains( $rss, ("\n" . join("", map {"<$_>0\n"} (qw(title description name link))) . "Quod\n" . "\n" ), "1.0 - textinput/[module]", ); } { my $rss = create_channel_rss({ version => "2.0", channel_params => [ admin => { 'generatorAgent' => "Spozilla 5.5", }, ], }); $rss->add_module(prefix => "admin", uri => "http://webns.net/mvcb/"); # TEST contains($rss, "\n" . "freshmeat.net\n" . "http://freshmeat.net\n" . "Linux software\n" . "Sat, 07 Sep 2002 09:42:31 GMT\n" . "\n" . "\n" . "\n", '2.0 - channel/[module] with known module and key' ); } { my $rss = create_channel_rss({ version => "2.0", channel_params => [ admin => { 'foobar' => "Quod", }, ], }); $rss->add_module(prefix => "admin", uri => "http://webns.net/mvcb/"); # TEST contains($rss, "\n" . "freshmeat.net\n" . "http://freshmeat.net\n" . "Linux software\n" . "Sat, 07 Sep 2002 09:42:31 GMT\n" . "Quod\n" . "\n" . "\n", '2.0 - channel/[module] with unknown key' ); } { my $rss = create_channel_rss({ version => "2.0", channel_params => [ eloq => { 'grow' => "There", }, ], }); $rss->add_module(prefix => "eloq", uri => "http://eloq.tld2/Gorj/"); # TEST contains($rss, "\n" . "freshmeat.net\n" . "http://freshmeat.net\n" . "Linux software\n" . "Sat, 07 Sep 2002 09:42:31 GMT\n" . "There\n" . "\n" . "\n", '2.0 - channel/[module] with new module' ); } ## Testing the RSS 2.0 Image Modules Support { my $rss = create_rss_1({ version => "2.0", image_params => [ admin => { 'foobar' => "Quod", }, ], }); $rss->add_module(prefix => "admin", uri => "http://webns.net/mvcb/"); # TEST contains($rss, "\n" . "freshmeat.net\n" . "0\n" . "http://freshmeat.net/\n" . "Quod\n" . "\n", '2.0 - image/[module] with unknown key' ); } { my $rss = create_rss_1({ version => "2.0", image_params => [ eloq => { 'grow' => "There", }, ], }); $rss->add_module(prefix => "eloq", uri => "http://eloq.tld2/Gorj/"); # TEST contains($rss, "\n" . "freshmeat.net\n" . "0\n" . "http://freshmeat.net/\n" . "There\n" . "", '2.0 - image/[module] with new module' ); } { my $rss = create_rss_1({ version => "2.0", image_params => [ admin => { 'generatorAgent' => "Spozilla 5.5", }, ], }); $rss->add_module(prefix => "admin", uri => "http://webns.net/mvcb/"); # TEST contains($rss, "\n" . "freshmeat.net\n" . "0\n" . "http://freshmeat.net/\n" . "\n" . "", '2.0 - image/[module] with known module' ); } ## Test the RSS 2.0 items' ad-hoc modules support. { my $rss = create_item_rss({ version => "2.0", item_params => [ admin => { 'foobar' => "Quod", }, ], }); $rss->add_module(prefix => "admin", uri => "http://webns.net/mvcb/"); # TEST contains($rss, "\n" . "Freecell Solver\n" . "http://fc-solve.berlios.de/\n" . "Quod\n" . "", '2.0 - item/[module] with unknown key' ); } { my $rss = create_item_rss({ version => "2.0", item_params => [ eloq => { 'grow' => "There", }, ], }); $rss->add_module(prefix => "eloq", uri => "http://eloq.tld2/Gorj/"); # TEST contains($rss, "\n" . "Freecell Solver\n" . "http://fc-solve.berlios.de/\n" . "There\n" . "", '2.0 - item/[module] with new module' ); } { my $rss = create_item_rss({ version => "2.0", item_params => [ admin => { 'generatorAgent' => "Spozilla 5.5", }, ], }); $rss->add_module(prefix => "admin", uri => "http://webns.net/mvcb/"); # TEST contains($rss, "\n" . "Freecell Solver\n" . "http://fc-solve.berlios.de/\n" . "\n" . "", '2.0 - item/[module] with known module' ); } } ## Test the RSS 2.0 skipping-items condition. { my $rss = create_rss_without_item({ version => "2.0", }); $rss->add_item( link => "http://freshmeat.net/news/1999/06/21/930003829.html" ); # TEST contains($rss, "\n", '2.0 - Item without description or title is included' ); } ## Test the RSS 2.0 "2.0", item_params => [ title => "Foo&Bar", link => "http://www.mylongtldyeahbaby/", source => $s->[0], sourceUrl => $s->[1], ], } ); # TEST*$num_iters match_elements($rss, 'item', { title => 'Foo&Bar', link => 'http://www.mylongtldyeahbaby/' }); =head1 contains( $rss, ("\n" . "Foo&Bar\n" . "http://www.mylongtldyeahbaby/\n" . "" ), "2.0 - item - Source and/or Source URL are not defined", ); =cut } } { # Here we create an RSS 2.0 object and render it as the output # version "3.5" in order to test that version 1.0 is the default # version for output. my $rss = create_channel_rss({ version => "2.0", channel_params => [copyright => "Martha", managingEditor => 0,], omit_date => 1, }); $rss->{output} = "3.5"; # TEST match_elements($rss, 'channel', { about => "http://freshmeat.net", title => "freshmeat.net", link => "http://freshmeat.net", description => "Linux software", 'dc:rights' => 'Martha', 'dc:publisher' => 0 }); =head1 contains($rss, "\n" . "freshmeat.net\n" . "http://freshmeat.net\n" . "Linux software\n" . "Martha\n" . "0\n" . "\n", "Unknown version renders as 1.0" ); =cut } { my $rss = eval { create_channel_rss({ version => "0.91", image_link => undef, channel_params => [ title => undef ], }); }; # TEST ok ($@ =~ m{\AUndefined value in XML::RSS::LibXML::validate_accessor}, "Undefined string throws an exception" ); } SKIP: { skip "TODO", 1; my $rss = create_channel_rss({ version => "0.91", image_link => undef, channel_params => [ title => "Hello and ]]>"], }); # TEST contains($rss, "Hello and <![CDATA[Aloha<&>]]>", ); } ################ ### RSS Parsing Tests: ### We generate RSS and test that we get the same results. ################ sub parse_generated_rss { my $args = shift; my $gen_func = $args->{'func'}; my $rss_generator = $gen_func->($args); $rss_generator->{output} = $args->{version}; my $output = $rss_generator->as_string(); if ($args->{postproc}) { $args->{postproc}->(\$output); } my $parser = XML::RSS::LibXML->new(version => $args->{version}); $parser->parse($output); return $parser; } SKIP: { skip "TODO", 2; # Why 0.9, and forcing rdf:RDF -> rss ? { my $rss = parse_generated_rss({ func => \&create_textinput_with_0_rss, version => "0.9", textinput_params => [ description => "Welcome to the Jungle.", 'link' => "http://fooque.tld/", 'title' => "The Jungle of the City", 'name' => "There's more than one way to do it.", ], postproc => sub { for (${shift()}) { s{(]*(>)}{}; s{}{}; } }, }); # TEST is ($rss->{textinput}->{description}, "Welcome to the Jungle.", "0.9 parse - textinput/description", ); # TEST is ($rss->{textinput}->{link}, "http://fooque.tld/", "0.9 parse - textinput/link", ); # TEST is ($rss->{textinput}->{title}, "The Jungle of the City", "0.9 parse - textinput/title", ); # TEST is ($rss->{textinput}->{name}, "There's more than one way to do it.", "0.9 parse - textinput/name", ); } { my $rss_parser = parse_generated_rss( { func => \&create_textinput_with_0_rss, version => "0.9", textinput_params => [ description => "Welcome to the Jungle.", 'link' => "http://fooque.tld/", 'title' => "The Jungle of the City", 'name' => "There's more than one way to do it.", ], postproc => sub { for (${shift()}) { s{(]*(>)}{}; s{}{}; s{<(/?)textinput([^>]*)>}{<$1textInput$2>}g; } }, } ); # TEST is ($rss_parser->{textinput}->{description}, "Welcome to the Jungle.", "0.9 parse - textinput/description", ); # TEST is ($rss_parser->{textinput}->{link}, "http://fooque.tld/", "Parse textInput (with capital I) - textinput/link", ); # TEST is ($rss_parser->{textinput}->{title}, "The Jungle of the City", "Parse textInput (with capital I) - textinput/title", ); # TEST is ($rss_parser->{textinput}->{name}, "There's more than one way to do it.", "Parse textInput (with capital I) - textinput/name", ); } } { my $rss_parser = parse_generated_rss( { func => \&create_textinput_with_0_rss, version => "0.9", textinput_params => [ description => "Welcome to the Jungle.", 'link' => "http://fooque.tld/", 'title' => "The Jungle of the City", 'name' => "There's more than one way to do it.", ], postproc => sub { for (${shift()}) { s{<(/?)textinput([^>]+)?>}{sprintf('<%stextInput%s>', $1 || '', $2 || '')}ge } }, } ); # TEST is ($rss_parser->{textinput}->{description}, "Welcome to the Jungle.", "0.9 parse - textinput/description", ); # TEST is ($rss_parser->{textinput}->{link}, "http://fooque.tld/", "Parse textInput (with capital I) - textinput/link", ); # TEST is ($rss_parser->{textinput}->{title}, "The Jungle of the City", "Parse textInput (with capital I) - textinput/title", ); # TEST is ($rss_parser->{textinput}->{name}, "There's more than one way to do it.", "Parse textInput (with capital I) - textinput/name", ) } { my $rss_parser = parse_generated_rss( { func => \&create_skipHours_rss, version => "0.91", skipHours_params => [ hour => "5" ], } ); # TEST is ($rss_parser->{skipHours}->{hour}, "5", "Parse 0.91 - skipHours/hour", ); } { my $rss_parser = parse_generated_rss( { func => \&create_skipHours_rss, version => "2.0", skipHours_params => [ hour => "5" ], } ); # TEST is ($rss_parser->{skipHours}->{hour}, "5", "Parse 2.0 - skipHours/hour", ); } ## Test the skipDays parsing. { my $rss_parser = parse_generated_rss( { func => \&create_skipDays_rss, version => "0.91", skipDays_params => [ day => "5" ], } ); # TEST is ($rss_parser->{skipDays}->{day}, "5", "Parse 0.91 - skipDays/day", ); } { my $rss_parser = parse_generated_rss( { func => \&create_skipDays_rss, version => "2.0", skipDays_params => [ day => "5" ], } ); # TEST is ($rss_parser->{skipDays}->{day}, "5", "Parse 2.0 - skipDays/day", ); } { my $rss_parser = XML::RSS::LibXML->new(version => "2.0"); $rss_parser->parse(<<'EOF'); Test 2.0 Feed http://example.com/ en-us Copyright 2002 2007-01-19T14:21:43+0200 2007-01-19T14:21:43+0200 http://backend.userland.com/rss editor@example.com webmaster@example.com MyCategory XML::RSS::LibXML Test 60 Test Image http://example.com/example.gif http://example.com/ 25 Test Image Hi there! This is an item http://example.com/2007/01/19 Yadda yadda yadda - R&D; joeuser@example.com MyCategory http://example.com/2007/01/19/comments.html http://example.com/2007/01/19 Fri 19 Jan 2007 02:21:43 PM IST GMT my brain EOF # TEST is ($rss_parser->{image}->{"http://foo.tld/foobar/"}->{hello}, "Hi there!", "Parsing 2.0 - element in a different namespace contained in image", ); } SKIP: { skip "TODO (null namespace)", 1; my $rss_parser = XML::RSS::LibXML->new(version => "1.0"); $rss_parser->parse(<<'EOF'); Test 1.0 Feed http://example.com/ To lead by example 2007-01-19T14:21:18+0200 Test Image http://example.com/example.gif http://example.com/ Aye Karamba This is an item http://example.com/2007/01/19 Yadda & yadda & yadda joeuser@example.com Search Search for an example q http://example.com/search.pl EOF # TEST is ($rss_parser->{image}->{""}->{foo}, "Aye Karamba", "Parsing 1.0 - element in a null namespace contained in image", ); } { my $rss_parser = XML::RSS::LibXML->new(version => "2.0"); $rss_parser->parse(<<'EOF'); Test 2.0 Feed http://example.com/ en-us Copyright 2002 2007-01-19T14:21:43+0200 2007-01-19T14:21:43+0200 http://backend.userland.com/rss editor@example.com webmaster@example.com MyCategory XML::RSS::LibXML Test 60 Test Image http://example.com/example.gif http://example.com/ 25 Test Image This is an item http://example.com/2007/01/19 Yadda yadda yadda - R&D; joeuser@example.com MyCategory http://example.com/2007/01/19/comments.html http://example.com/2007/01/19 Fri 19 Jan 2007 02:21:43 PM IST GMT my brain Hi there! EOF # TEST is ($rss_parser->{items}->[0]->{"http://foo.tld/foobar/"}->{hello}, "Hi there!", "Parsing 2.0 - element in a different namespace contained in an item", ); } SKIP: { skip "TODO (null namespace)", 1; my $rss_parser = XML::RSS::LibXML->new(version => "1.0"); $rss_parser->parse(<<'EOF'); Test 1.0 Feed http://example.com/ To lead by example 2007-01-19T14:21:18+0200 Test Image http://example.com/example.gif http://example.com/ This is an item http://example.com/2007/01/19 Yadda & yadda & yadda joeuser@example.com Aye Karamba Search Search for an example q http://example.com/search.pl EOF # TEST is ($rss_parser->{items}->[0]->{""}->{foo}, "Aye Karamba", "Parsing 1.0 - element in a null namespace contained in image", ); } { my $rss_parser = XML::RSS::LibXML->new(version => "2.0"); $rss_parser->parse(<<'EOF'); Test 2.0 Feed http://example.com/ en-us Copyright 2002 2007-01-19T14:21:43+0200 2007-01-19T14:21:43+0200 http://backend.userland.com/rss editor@example.com webmaster@example.com MyCategory XML::RSS::LibXML Test 60 Test Image http://example.com/example.gif http://example.com/ 25 Test Image This is an item http://example.com/2007/01/19 Yadda yadda yadda - R&D; joeuser@example.com MyCategory http://example.com/2007/01/19/comments.html http://example.com/2007/01/19 Fri 19 Jan 2007 02:21:43 PM IST GMT my brain Search Search for an example q http://example.com/search.pl Show Baloon EOF # TEST is ($rss_parser->{textinput}->{"http://foo.tld/foobar/"}->{hello}, "Show Baloon", "Parsing 2.0 - element in a different namespace contained in a textinput", ); } SKIP: { skip "TODO (null namespace)", 1; my $rss_parser = XML::RSS::LibXML->new(version => "1.0"); $rss_parser->parse(<<'EOF'); Test 1.0 Feed http://example.com/ To lead by example 2007-01-19T14:21:18+0200 Test Image http://example.com/example.gif http://example.com/ This is an item http://example.com/2007/01/19 Yadda & yadda & yadda joeuser@example.com Search Search for an example q http://example.com/search.pl Priceless EOF # TEST is ($rss_parser->{textinput}->{""}->{foo}, "Priceless", "Parsing 1.0 - element in a null namespace contained in a textinput", ); } { my $rss_parser = XML::RSS::LibXML->new(version => "2.0"); $rss_parser->parse(<<'EOF'); Test 2.0 Feed http://example.com/ en-us Copyright 2002 2007-01-19T14:21:43+0200 2007-01-19T14:21:43+0200 http://backend.userland.com/rss editor@example.com webmaster@example.com MyCategory XML::RSS::LibXML Test 60 The RSS Must Flow Test Image http://example.com/example.gif http://example.com/ 25 Test Image This is an item http://example.com/2007/01/19 Yadda yadda yadda - R&D; joeuser@example.com MyCategory http://example.com/2007/01/19/comments.html http://example.com/2007/01/19 Fri 19 Jan 2007 02:21:43 PM IST GMT my brain Search Search for an example q http://example.com/search.pl EOF # TEST is ($rss_parser->{channel}->{"http://foo.tld/foobar/"}->{hello}, "The RSS Must Flow", "Parsing 2.0 - element in a different namespace contained in a channel", ); } SKIP: { skip "TODO", 1; my $rss_parser = XML::RSS::LibXML->new(version => "1.0"); $rss_parser->parse(<<'EOF'); Test 1.0 Feed http://example.com/ To lead by example 2007-01-19T14:21:18+0200 Placebo is here Test Image http://example.com/example.gif http://example.com/ This is an item http://example.com/2007/01/19 Yadda & yadda & yadda joeuser@example.com Search Search for an example q http://example.com/search.pl EOF # TEST is ($rss_parser->{channel}->{""}->{foo}, "Placebo is here", "Parsing 1.0 - element in a null namespace contained in a channel", ); } { my $rss_parser = XML::RSS::LibXML->new(version => "1.0"); $rss_parser->parse(<<'EOF'); freshmeat.net http://freshmeat.net Linux software GTKeyboard 0.85 http://freshmeat.net/news/1999/06/21/930003829.html In the Jungle http://jungle.tld/Enter/ EOF # TEST is_deeply ($rss_parser->{items}->[1]->{taxo}, ["Foo", "Loom", "Hello", "myowA"], "Parsing 1.0 - taxo items", ); } { my $rss_parser = XML::RSS::LibXML->new(version => "1.0"); $rss_parser->parse(<<'EOF'); freshmeat.net http://freshmeat.net Linux software GTKeyboard 0.85 http://freshmeat.net/news/1999/06/21/930003829.html In the Jungle http://jungle.tld/Enter/ EOF # TEST is_deeply ($rss_parser->{items}->[1]->{taxo}, ["Everybody", "needs", "a", "[[[HUG]]]"], "Parsing 1.0 - taxo bag in with junk elements", ); } { my $rss_parser = XML::RSS::LibXML->new(version => "1.0"); $rss_parser->parse(<<'EOF'); freshmeat.net http://freshmeat.net Linux software GTKeyboard 0.85 http://freshmeat.net/news/1999/06/21/930003829.html In the Jungle http://jungle.tld/Enter/ EOF # TEST is_deeply ($rss_parser->{channel}->{taxo}, ["Elastic", "Plastic", "stochastic", "dynamic^^K"], "Parsing 1.0 - taxo items in channel", ); } { my $rss_parser = XML::RSS::LibXML->new(version => "1.0"); $rss_parser->parse(<<'EOF'); freshmeat.net http://freshmeat.net Linux software GTKeyboard 0.85 http://freshmeat.net/news/1999/06/21/930003829.html In the Jungle http://jungle.tld/Enter/ EOF # TEST is_deeply ($rss_parser->{channel}->{taxo}, ["Elastic", "Plastic", "stochastic", "dynamic^^K"], "Parsing 1.0 - taxo items in channel with junk items", ); } { my $rss_parser = XML::RSS::LibXML->new(version => "1.0"); $rss_parser->parse(<<'EOF'); freshmeat.net http://freshmeat.net Linux software GTKeyboard 0.85 http://freshmeat.net/news/1999/06/21/930003829.html In the Jungle http://jungle.tld/Enter/ Gow EOF # TEST is ($rss_parser->{items}->[1]->{"http://webns.net/mvcb/"}->{hello}, "Gow", "Parsing 1.0 - Elements inside that don't exist in \%rdf_resource_fields", ); } { my $rss_parser = XML::RSS::LibXML->new(version => "1.0"); $rss_parser->parse(<<'EOF'); freshmeat.net http://freshmeat.net Linux software Gow GTKeyboard 0.85 http://freshmeat.net/news/1999/06/21/930003829.html In the Jungle http://jungle.tld/Enter/ EOF # TEST ok ((!grep { exists($_->{"http://webns.net/mvcb/"}->{generatorAgent}) } @{$rss_parser->{items}}), "Parsing 1.0 - Elements that exist in \%rdf_resource_fields but not inside item", ); } { my $rss_parser = XML::RSS::LibXML->new(version => "1.0"); $rss_parser->parse(<<'EOF'); freshmeat.net http://freshmeat.net Linux software GTKeyboard 0.85 http://freshmeat.net/news/1999/06/21/930003829.html In the Jungle http://jungle.tld/Enter/ EOF # TEST ok ((!grep { exists($_->{enclosure}) } @{$rss_parser->{items}}), "Parsing 1.0 - Testing \%empty_ok_elements", ); } { my $rss_parser = XML::RSS::LibXML->new(version => "1.0"); $rss_parser->parse(<<'EOF'); freshmeat.net http://freshmeat.net Linux software GTKeyboard 0.85 http://freshmeat.net/news/1999/06/21/930003829.html In the Jungle http://jungle.tld/Enter/ EOF # TEST is (scalar(@{$rss_parser->{items}}), 1, "Parse 1.0 with item in a different NS - There is 1 item"); # TEST is ($rss_parser->{items}->[0]->{title}, "GTKeyboard 0.85", "Parse 1.0 with item in a different NS - it is not the item in the other NS"); } { my $rss_parser = XML::RSS::LibXML->new(version => "1.0"); $rss_parser->parse(<<'EOF'); freshmeat.net http://freshmeat.net Linux software In the Jungle http://jungle.tld/Enter/ EOF # TEST is (scalar(@{$rss_parser->{items}}), 0, "Parse 1.0 with item in null namespace"); } { my $rss_parser = XML::RSS::LibXML->new(version => "1.0"); $rss_parser->parse(<<'EOF'); Test 1.0 Feed http://example.com/ To lead by example 2007-01-19T14:21:18+0200 Test Image http://example.com/example.gif http://example.com/ 5 Sep 2006 This is an item http://example.com/2007/01/19 Yadda & yadda & yadda joeuser@example.com Search Search for an example q http://example.com/search.pl EOF # TEST is ($rss_parser->{image}->{dc}->{date}, "5 Sep 2006", "Parsing 1.0 - Known module in image", ); } { my $rss_parser = XML::RSS::LibXML->new(version => "1.0"); $rss_parser->parse(<<'EOF'); Test 1.0 Feed http://example.com/ To lead by example 2007-01-19T14:21:18+0200 Test Image http://example.com/example.gif http://example.com/ This is an item http://example.com/2007/01/19 Yadda & yadda & yadda joeuser@example.com Search Search for an example q http://example.com/search.pl 5 May 1977 EOF # TEST is ($rss_parser->{textinput}->{dc}->{date}, "5 May 1977", "Parsing 1.0 - Known module in a textinput", ); } SKIP: { skip "TODO", 1; my $rss_parser = XML::RSS::LibXML->new(version => "2.0"); my $xml_text = <<'EOF'; Test 2.0 Feed http://example.com/ en-us Copyright 2002 2007-01-19T14:21:43+0200 2007-01-19T14:21:43+0200 http://backend.userland.com/rss editor@example.com webmaster@example.com MyCategory XML::RSS::LibXML Test 60 Test Image http://example.com/example.gif http://example.com/ 25 Test Image Hi there! This is an item http://example.com/2007/01/19 Yadda yadda yadda - R&D; joeuser@example.com MyCategory http://example.com/2007/01/19/comments.html http://example.com/2007/01/19 Fri 19 Jan 2007 02:21:43 PM IST GMT my brain EOF eval { $rss_parser->parse($xml_text); }; # TEST ok ($@ =~ m{\AMalformed RSS}, "Checking for thrown exception on missing version attribute" ); } SKIP: { skip "TODO", 1; my $rss_parser = XML::RSS::LibXML->new(version => "1.0"); my $xml_text = <<'EOF'; Test 1.0 Feed http://example.com/ To lead by example 2007-01-19T14:21:18+0200 Test Image http://example.com/example.gif http://example.com/ This is an item http://example.com/2007/01/19 Yadda & yadda & yadda joeuser@example.com Search Search for an example q http://example.com/search.pl 5 May 1977 EOF eval { $rss_parser->parse($xml_text); }; # TEST ok ($@ =~ m{\AMalformed RSS: invalid version}, "Checking for thrown exception on missing version attribute" ); } { my $rss_parser = XML::RSS::LibXML->new(version => "1.0"); $rss_parser->parse(<<'EOF'); freshmeat.net http://freshmeat.net Linux software GTKeyboard 0.85 http://freshmeat.net/news/1999/06/21/930003829.html EOF # TEST is (scalar(@{$rss_parser->{items}}), 1, "Parse 1.0 with nested "); } { my $rss_parser = XML::RSS::LibXML->new(version => "2.0"); my $xml_text = <<'EOF'; Test 2.0 Feed http://example.com/ Lambda EOF $rss_parser->parse($xml_text); my $channel = $rss_parser->{channel}; is($channel->{description}, "Lambda", "Testing for non-moduled-namespaced element inside the channel (description)"); is($channel->{"http://purl.org/rss/1.0/modules/annotate/"}{reference}, "Aloha", "Testing for non-moduled-namespacedelement inside the channel (reference)"); } { my $rss_parser = XML::RSS::LibXML->new(version => "2.0"); my $xml_text = <<'EOF'; Test 2.0 Feed http://example.com/ Lambda This is an item http://example.com/2007/01/19 Yadda yadda yadda joeuser@example.com EOF $rss_parser->parse($xml_text); my $item = $rss_parser->{items}->[0]; # Sanitize the channel out of uninitialised keys. foreach my $field (qw( item )) { delete $item->{$field}; } # TEST is($item->{title}, "This is an item", "Testing for non-moduled-namespaced element inside an item (title)"); is($item->{"http://purl.org/rss/1.0/modules/annotate/"}{reference}, "Aloha", "Testing for non-moduled-namespaced element inside an item (title)"); } { my $rss_parser = XML::RSS::LibXML->new(version => "1.0"); $rss_parser->parse(<<'EOF'); Test 1.0 Feed http://example.com/ To lead by example 2007-01-19T14:21:18+0200 Test Image http://example.com/example.gif http://example.com/ 5 Sep 2006 This is an item http://example.com/2007/01/19 Yadda & yadda & yadda joeuser@example.com Search Search for an example q http://example.com/search.pl EOF # TEST is ($rss_parser->{items}->[0]->{admin}->{generatorAgent}, "XmlRssGenKon", "Parsing 1.0 - known module rdf_resource_field", ); } libxml-rss-libxml-perl-0.3102+dfsg.orig/t/generated/0000755000175000017500000000000011637345541022372 5ustar nicholasnicholaslibxml-rss-libxml-perl-0.3102+dfsg.orig/t/generated/1.0-generated.xml0000644000175000017500000000250711633756757025365 0ustar nicholasnicholas http://example.com/ To lead by example 2011-09-13T22:49:19+0900 Test 1.0 Feed http://example.com/2011/09/13 Yadda & yadda & yadda joeuser@example.com This is an item http://example.com/example.gif http://example.com/ Test Image http://example.com/search.pl q Search for an example Search libxml-rss-libxml-perl-0.3102+dfsg.orig/t/generated/charset1-generated.xml0000644000175000017500000000114511633756762026572 0ustar nicholasnicholas http://channel.url/ Channel Description Channel Title http://item.url/ Item Description (&copy;) Item Title libxml-rss-libxml-perl-0.3102+dfsg.orig/t/generated/2.0-generated.xml0000644000175000017500000000305311633756760025355 0ustar nicholasnicholas 60 Copyright 2002 XML::RSS::LibXML Test MyCategory webmaster\@example.com http://backend.userland.com/rss http://example.com/ en-us 2011-09-13T22:49:20+0900 Test 2.0 Feed 2011-09-13T22:49:20+0900 editor\@example.com joeuser@example.com http://example.com/2011/09/13/comments.html MyCategory http://example.com/2011/09/13 HASH(0x100b58838) Yadda yadda yadda - R&D; This is an item 火 9/13 22:49:20 2011 GMT http://example.com/2011/09/13 http://example.com/example.gif http://example.com/ 25 Test Image Test Image http://example.com/search.pl q Search for an example Search libxml-rss-libxml-perl-0.3102+dfsg.orig/t/guid.t0000644000175000017500000000342411401562045021541 0ustar nicholasnicholas# This is to test the following bug: # https://rt.cpan.org/Ticket/Display.html?id=24742 use strict; use Test::More tests => 1; use XML::RSS::LibXML; { my $rss_text = qq( Example 2.0 Channel http://example.com/ To lead by example en-us All content Public Domain, except comments which remains copyright the author editor\@example.com webmaster\@example.com http://backend.userland.com/rss Reference/Libraries/Library_and_Information_Science/Technical_Services/Cataloguing/Metadata/RDF/Applications/RSS/ The Superest Dooperest RSS Generator Mon, 02 Sep 2002 03:19:17 GMT 60 News for September the Second http://example.com/2002/09/02 other things happened today http://example.com/2002/09/02/comments.html joeuser\@example.com Mon, 02 Sep 2002 03:19:00 GMT http://example.com/2002/09/02 ); my $xml = XML::RSS::LibXML->new(); $xml->parse($rss_text); # TEST ok ( (index($xml->as_string(), q{http://example.com/2002/09/02}) >= 0), "Checking for correct guid" ); } libxml-rss-libxml-perl-0.3102+dfsg.orig/t/2.0-generate.t0000644000175000017500000001261511404267470022711 0ustar nicholasnicholasuse strict; use File::Spec; use Test::More tests => 29; BEGIN { use_ok("XML::RSS::LibXML"); use_ok("POSIX"); } use constant DATE_TEMPLATE_LONG => "%Y-%m-%dT%H:%M:%S%z"; use constant DATE_TEMPLATE_SHORT => "%Y/%m/%d"; use constant DATE_TEMPLATE_PUB => "%c GMT"; my $current_date = &POSIX::strftime( DATE_TEMPLATE_LONG, gmtime ); my $short_date = &POSIX::strftime( DATE_TEMPLATE_SHORT, gmtime ); my $pub_date = &POSIX::strftime( DATE_TEMPLATE_PUB, gmtime ); ok( $current_date, "Current date: $current_date" ); use constant BASEDIR => File::Spec->catdir('t', 'generated'); use constant RSS_VERSION => "2.0"; use constant RSS_SAVEAS => File::Spec->catfile(BASEDIR, RSS_VERSION."-generated.xml"); use constant RSS_MOD_PREFIX => "my"; use constant RSS_MOD_URI => 'http://purl.org/my/rss/module/'; use constant RSS_BLOGCHANNEL_PREFIX => "blogChannel"; use constant RSS_BLOGCHANNEL_URI => "http://backend.userland.com/blogChannelModule"; use constant RSS_CREATOR => "joeuser\@example.com"; use constant RSS_ITEM_TITLE => "This is an item"; use constant RSS_ITEM_LINK => "http://example.com/" . &POSIX::strftime( DATE_TEMPLATE_SHORT, gmtime ); # "$short_date"; use constant RSS_ITEM_DESC => "Yadda yadda yadda - R&D;"; my $rss = XML::RSS::LibXML->new( version => RSS_VERSION, base => 'http://yow.com/' ); isa_ok( $rss, "XML::RSS::LibXML" ); is( $rss->{'version'}, RSS_VERSION, 'Version is ' . RSS_VERSION ); # This includes all fields, only title, link, and description # are required. ok( $rss->channel( 'title' => "Test 2.0 Feed", 'link' => "http://example.com/", 'description' => "", 'language' => 'en-us', copyright => 'Copyright 2002', pubDate => $current_date, lastBuildDate => $current_date, docs => 'http://backend.userland.com/rss', managingEditor => 'editor\@example.com', webMaster => 'webmaster\@example.com', category => 'MyCategory', ttl => '60', 'generator' => 'XML::RSS::LibXML Test', ), "Set RSS channel" ); ok($rss->image( title => 'Test Image', url => 'http://example.com/example.gif', 'link' => 'http://example.com/', description => 'Test Image', height => '25', weight => '144', ), "Set RSS image" ); ok($rss->textinput( title => 'Search', description => 'Search for an example', name => 'q', 'link' => 'http://example.com/search.pl', ), "Set RSS text input" ); ok($rss->add_item( title => RSS_ITEM_TITLE, 'link' => RSS_ITEM_LINK, description => RSS_ITEM_DESC, author => RSS_CREATOR, category => 'MyCategory', comments => "http://example.com/$short_date/comments.html", permaLink => "http://example.com/$short_date", pubDate => $pub_date, source => 'my brain', sourceUrl => 'http://example.com', enclosure => { type=>"application/x-bittorrent", url => 'http://127.0.0.1/torrents/The_Passion_of_Dave_Winer.torrent' }, ), "Set one RSS item" ); ok( $rss->add_module( prefix => RSS_MOD_PREFIX, uri => RSS_MOD_URI ), "Added module: " . RSS_MOD_PREFIX ); my $uri = RSS_MOD_URI; #use Data::Dumper; #warn Data::Dumper->Dump([\$rss], [qw(rss)] ); is( $rss->{modules}->{$uri}, RSS_MOD_PREFIX, "Namespace URI is " . RSS_MOD_URI); my $as_string = $rss->as_string(); my $len = length($as_string); ok( $len, "RSS feed has '$len' characters" ); ok( $rss->save(RSS_SAVEAS), "Wrote to disk: " . RSS_SAVEAS ); my $file_contents; { local $/; open I, "<", RSS_SAVEAS(); $file_contents = ; close(I); } is($file_contents,$as_string,RSS_SAVEAS." contains the as_string() result"); eval { $rss->parsefile( RSS_SAVEAS ) }; is( $@, '', "Parsed " . RSS_SAVEAS ); is( $rss->{channel}->{lastBuildDate}, $current_date, "Last built: " . $current_date ); is( $rss->{channel}->{category}, 'MyCategory', 'channel->{category}'); cmp_ok( keys %{ $rss->{namespaces} }, ">=", 1, "RSS feed has at least one namespace"); cmp_ok($rss->version, 'eq', RSS_VERSION, 'Should have the RSS version'); cmp_ok($rss->base, 'eq', 'http://yow.com/', 'Should have the XML base'); SKIP: { skip "TODO", 2; my $prefix = RSS_BLOGCHANNEL_PREFIX; ok( exists $rss->{namespaces}->{$prefix}, "$prefix namespace is registered" ); is($rss->{namespaces}->{$prefix}, RSS_BLOGCHANNEL_URI, RSS_BLOGCHANNEL_URI ); } isa_ok( $rss->{'items'} ,"ARRAY", "RSS object has an array of objects" ); is( scalar( @{$rss->{'items'}} ), 1, "RSS object has one item" ); is( $rss->{items}->[0]->{title}, RSS_ITEM_TITLE, RSS_ITEM_TITLE ); is( $rss->{items}->[0]->{link}, RSS_ITEM_LINK, RSS_ITEM_LINK ); is( $rss->{items}->[0]->{description}, RSS_ITEM_DESC, RSS_ITEM_DESC ); is( $rss->{items}->[0]->{author}, RSS_CREATOR, RSS_CREATOR ); eval { $rss->save("."); }; ok ($@ =~ m{\ACannot open file \. for write}, "Exception upon saving to an invalid location" ); #END{ unlink RSS_SAVEAS } __END__ =head1 NAME 2.0-generate.t - tests for generating RSS 2.0 data with XML::RSS::LibXML.pm =head1 SYNOPSIS use Test::Harness qw (runtests); runtests (./XML-RSS/t/*.t); =head1 DESCRIPTION Tests for generating RSS 2.0 data with XML::RSS::LibXML.pm =head1 VERSION $Revision: 1.8 $ =head1 DATE $Date: 2004/04/21 02:44:40 $ =head1 AUTHOR Aaron Straup Cope =head1 SEE ALSO http://backend.userland.com/rss2 =cu libxml-rss-libxml-perl-0.3102+dfsg.orig/t/load.t0000644000175000017500000000067511401562045021535 0ustar nicholasnicholasBEGIN { use File::Find; @files = (); my $lib = 'lib'; $lib = 'blib/lib' if -e 'blib/lib'; find(sub { push @files, $File::Find::name if $_ =~ m/\.pm$/;}, ($lib)); @classes = map { my $x = $_; $x =~ s|^blib/lib/||; $x =~ s|/|::|g; $x =~ s|\.pm$||; $x; } @files; } use Test::More tests => scalar @classes; foreach my $class ( @classes ){ print "bail out! $class did not compile" unless use_ok( $class ); } libxml-rss-libxml-perl-0.3102+dfsg.orig/lib/0000755000175000017500000000000011637345541020737 5ustar nicholasnicholaslibxml-rss-libxml-perl-0.3102+dfsg.orig/lib/XML/0000755000175000017500000000000011633756767021413 5ustar nicholasnicholaslibxml-rss-libxml-perl-0.3102+dfsg.orig/lib/XML/RSS/0000755000175000017500000000000011633756770022054 5ustar nicholasnicholaslibxml-rss-libxml-perl-0.3102+dfsg.orig/lib/XML/RSS/LibXML/0000755000175000017500000000000011637345541023135 5ustar nicholasnicholaslibxml-rss-libxml-perl-0.3102+dfsg.orig/lib/XML/RSS/LibXML/MagicElement.pm0000644000175000017500000000553311522213737026025 0ustar nicholasnicholas# $Id$ # # Copyright (c) 2005 Daisuke Maki # All rights reserved. package XML::RSS::LibXML::MagicElement; use strict; use overload bool => sub { 1 }, '""' => \&toString, fallback => 1 ; use vars qw($VERSION); $VERSION = '0.02'; # Make UNIVERSAL::isa happy sub isa { __PACKAGE__ eq ($_[1] || '') } sub new { my $class = shift; my %args = @_; my %attrs; my @attrs; my $attrs = $args{attributes}; if (ref($attrs) eq 'ARRAY') { %attrs = map { ( $_->prefix && $_->prefix ne 'xmlns' ? sprintf('%s:%s', $_->prefix, $_->localname || '') : $_->localname || '' , $_->getData ) } @$attrs; @attrs = map { $_->getName } @$attrs; } elsif (ref($attrs) eq 'HASH') { %attrs = %$attrs; @attrs = keys %$attrs; } else { die "'attributes' must be an arrayref of XML::LibXML::Attr objects, or a hashref of scalars"; } return bless { %attrs, _attributes => \@attrs, _content => $args{content}, }, $class; } sub attributes { my $self = shift; return wantarray ? @{$self->{_attributes}} : $self->{_attributes}; } sub toString { my $self = shift; return (defined $self->{_content} && length $self->{_content}) ? $self->{_content} : join('', map { $self->{$_} || '' } $self->attributes); } 1; __END__ =head1 NAME XML::RSS::LibXML::MagicElement - Represent A Non-Trivial RSS Element =head1 SYNOPSIS us XML::RS::LibXML::MagicElement; my $xml = XML::RSS::LibXML::MagicElement->new( content => $textContent, attributes => \@attributes ); =head1 DESCRIPTION This module is a handy object that allows users to access non-trivial RSS elements in XML::RSS style. For example, suppose you have an RSS feed with an element like the following: Example baz ... While it is simple to access the title element like this: $rss->{channel}->{title}; It was slightly non-trivial for the second tag. With this module, EtagE is parsed as a XML::RSS::LibXML::MagicElement object and then you can access all the elements like so: $rss->{channel}->{tag}; # "baz" $rss->{channel}->{tag}->{attr1}; # "foo" $rss->{channel}->{tag}->{attr2}; # "bar" =head1 METHODS =head2 new Create a new MagicElement object. =head2 attributes Returns the list of attributes associated with this element =head2 toString Returns the string representation of this object. By default we use the "text content" of the found tag, but for XML::RSS compatibility, we use the concatenation of the attributes if no content is found. =head1 AUTHOR Copyright 2005 Daisuke Maki Edmaki@cpan.orgE. All rights reserved. Development partially funded by Brazil, Ltd. Ehttp://b.razil.jpE =cut libxml-rss-libxml-perl-0.3102+dfsg.orig/lib/XML/RSS/LibXML/V1_0.pm0000644000175000017500000002022211410004532024153 0ustar nicholasnicholas# $Id$ # # Copyright (c) 2005-2007 Daisuke Maki # All rights reserved. package XML::RSS::LibXML::V1_0; use strict; use warnings; use base qw(XML::RSS::LibXML::ImplBase); use XML::RSS::LibXML::Namespaces qw(NS_RSS10 NS_RDF); use DateTime::Format::W3CDTF; use DateTime::Format::Mail; sub definition { return { channel => { title => '', description => '', link => '', }, image => bless ({ title => undef, url => undef, link => undef, }, 'XML::RSS::LibXML::ElementSpec'), textinput => bless ({ title => undef, description => undef, name => undef, link => undef, }, 'XML::RSS::LibXML::ElementSpec'), skipDays => bless ({ day => undef }, 'XML::RSS::LibXML::ElementSpec' ), skipHours => bless ({ hour => undef }, 'XML::RSS::LibXML::ElementSpec' ), }; } sub parse_dom { my $self = shift; my $c = shift; my $dom = shift; $c->reset; $c->version('1.0'); $c->encoding($dom->encoding); $self->parse_namespaces($c, $dom); $c->internal('prefix', 'rss10'); # Check if we have non-default RSS namespace my $namespaces = $c->namespaces; while (my($prefix, $uri) = each %$namespaces) { if ($uri eq NS_RSS10 && $prefix ne '#default') { $c->internal('prefix', $prefix); last; } } $dom->getDocumentElement()->setNamespace(NS_RSS10, $c->internal('prefix'), 0); $self->parse_channel($c, $dom); $self->parse_items($c, $dom); $self->parse_misc_simple($c, $dom); } sub parse_misc_simple { my ($self, $c, $dom) = @_; my $xc = $c->create_xpath_context($c->{namespaces}); foreach my $node ($xc->findnodes('/rdf:RDF/*[name() != "channel" and name() != "item"]', $dom)) { my $h = $self->parse_children($c, $node); my $name = $node->localname; $name = 'textinput' if $name eq 'textInput'; my $prefix = $node->getPrefix(); if ($prefix) { $c->{$prefix} ||= {}; $self->store_element($c->{$prefix}, $name, $h); # XML::RSS requires us to allow access to elements both from # the prefix and the namespace $c->{$c->{namespaces}{$prefix}} ||= {}; $self->store_element($c->{$c->{namespaces}{$prefix}}, $name, $h); } else { $self->store_element($c, $name, $h); } } } sub parse_channel { my ($self, $c, $dom) = @_; my $namespaces = $c->namespaces; my $xc = $c->create_xpath_context($namespaces); my $xpath = sprintf('/rdf:RDF/%s:channel', $c->internal('prefix')); my ($root) = $xc->findnodes($xpath, $dom); my %h = $self->parse_children($c, $root); if (delete $h{taxo}) { $self->parse_taxo($c, $dom, \%h, $root); } $c->channel(%h); } sub parse_items { my $self = shift; my $c = shift; my $dom = shift; my @items; my $version = $c->version; my $xc = $c->create_xpath_context(scalar $c->namespaces); my $xpath = sprintf('/rdf:RDF/%s:item', $c->internal('prefix')); foreach my $item ($xc->findnodes($xpath, $dom)) { my $i = $self->parse_children($c, $item); if (delete $i->{taxo}) { $self->parse_taxo($c, $dom, $i, $item); } $self->add_item($c, $i); } } sub create_rootelement { my $self = shift; my $c = shift; my $dom = shift; my $e = $dom->createElementNS(NS_RSS10, 'RDF'); $dom->setDocumentElement($e); $e->setNamespace(NS_RDF, 'rdf', 1); $c->add_module(prefix => 'rdf', uri => NS_RDF); } my $format_dates = sub { my $v = eval { DateTime::Format::W3CDTF->format_datetime( DateTime::Format::Mail->parse_datetime($_[0]) ); }; if ($v && ! $@) { $_[0] = $v; } }; my %DcElements = ( 'dc:date' => { candidates => [ { module => 'dc', element => 'date' }, 'pubDate', 'lastBuildDate', ], callback => $format_dates }, 'dc:language' => [ { module => 'dc', element => 'language' }, 'language' ], 'dc:rights' => [ { module => 'dc', element => 'rights' }, 'copyright' ], 'dc:publisher' => [ { module => 'dc', element => 'publisher' }, 'managingEditor' ], 'dc:creator' => [ { module => 'dc', element => 'creator' }, 'webMaster' ], (map { ("dc:$_" => [ { module => 'dc', element => $_ } ]) } qw(title subject description contributer type format identifier source relation coverage)), ); my %SynElements = ( (map { ("syn:$_" => [ { module => 'syn', element => $_ } ]) } qw(updateBase updateFrequency updatePeriod)), ); my %ChannelElements = ( %DcElements, %SynElements, (map { ($_ => [ $_ ]) } qw(title link description)), ); my %ItemElements = ( (map { ($_ => [$_]) } qw(title link description)), %DcElements ); my %ImageElements = ( (map { ($_ => [$_]) } qw(title url link)), %DcElements, ); my %TextInputElements = ( (map { ($_ => [$_]) } qw(title link description name)), %DcElements ); sub create_dom { my ($self, $c) = @_; my $dom = $self->SUPER::create_dom($c); my $root = $dom->getDocumentElement(); my $xc = $c->create_xpath_context(scalar $c->namespaces); my($channel) = $xc->findnodes('/rdf:RDF/channel', $dom); if (my $image = $c->image) { my $inode; $inode = $dom->createElement('image'); $inode->setAttribute('rdf:resource', $image->{url}) if $image->{url}; $channel->appendChild($inode); $inode = $dom->createElement('image'); $inode->setAttribute('rdf:resource', $image->{url}) if $image->{url}; $self->create_element_from_spec($image, $dom, $inode, \%ImageElements); $self->create_extra_modules($image, $dom, $inode, $c->namespaces); $root->appendChild($inode); } if (my $textinput = $c->textinput) { my $inode; $inode = $dom->createElement('textinput'); $inode->setAttribute('rdf:resource', $textinput->{link}) if $textinput->{link}; $channel->appendChild($inode); $inode = $dom->createElement('textinput'); $inode->setAttribute('rdf:resource', $textinput->{link}) if $textinput->{link}; $self->create_element_from_spec($textinput, $dom, $inode, \%TextInputElements); $self->create_extra_modules($textinput, $dom, $inode, $c->namespaces); $root->appendChild($inode); } return $dom; } sub create_channel { my $self = shift; my $c = shift; my $dom = shift; my $root = $dom->getDocumentElement(); my $channel = $dom->createElement('channel'); if ($c->{channel} && $c->{channel}{about}) { $channel->setAttribute('rdf:about', $c->{channel}{about}); } elsif ($c->{channel} && $c->{channel}{link}) { $channel->setAttribute('rdf:about', $c->{channel}{link}); } $root->appendChild($channel); $self->create_taxo($c->{channel}, $dom, $channel); $self->create_element_from_spec($c->channel, $dom, $channel, \%ChannelElements); } sub create_items { my $self = shift; my $c = shift; my $dom = shift; my $root = $dom->getDocumentElement(); my $node; my $items = $dom->createElement('items'); my $seq = $dom->createElement('rdf:Seq'); foreach my $item ($c->items) { my $about = $item->{about} || $item->{link}; $node = $dom->createElement('rdf:li'); $node->setAttribute('rdf:resource', $about) if $about; $seq->appendChild($node); $node = $dom->createElement('item'); $node->setAttribute('rdf:about', $about) if $about; $self->create_element_from_spec($item, $dom, $node, \%ItemElements); $self->create_extra_modules($item, $dom, $node, $c->namespaces); $self->create_taxo($item, $dom, $node); $root->appendChild($node); } $items->appendChild($seq); my $xc = $c->create_xpath_context(scalar $c->namespaces); my($channel) = $xc->findnodes('/rdf:RDF/channel', $dom); $channel->appendChild($items); } 1; libxml-rss-libxml-perl-0.3102+dfsg.orig/lib/XML/RSS/LibXML/Namespaces.pm0000644000175000017500000000310711401601511025530 0ustar nicholasnicholas# $Id$ # # Copyright (c) 2005-2007 Daisuke Maki # All rights reserved. package XML::RSS::LibXML::Namespaces; use strict; use warnings; use base qw(Exporter); use vars qw(@EXPORT_OK); my %KnownNamespaces; my %RevKnownNamespaces; BEGIN { %KnownNamespaces = ( rdf => "http://www.w3.org/1999/02/22-rdf-syntax-ns#", dc => "http://purl.org/dc/elements/1.1/", syn => "http://purl.org/rss/1.0/modules/syndication/", admin => "http://webns.net/mvcb/", content => "http://purl.org/rss/1.0/modules/content/", cc => "http://web.resource.org/cc/", taxo => "http://purl.org/rss/1.0/modules/taxonomy/", rss20 => "http://backend.userland.com/rss2", # really a dummy rss10 => "http://purl.org/rss/1.0/", rss09 => "http://my.netscape.com/rdf/simple/0.9/", ); %RevKnownNamespaces = map { ($KnownNamespaces{$_} => $_) } keys %KnownNamespaces; my %constants; while (my ($prefix, $ns) = each %KnownNamespaces) { $constants{'NS_' . uc($prefix)} = $ns; } require constant; constant->import(\%constants); @EXPORT_OK = keys %constants; } sub lookup_prefix { $RevKnownNamespaces{$_[0]} } sub lookup_uri { $KnownNamespaces{$_[0]} } 1; __END__ =head1 NAME XML::RSS::LibXML::Namespaces - Utility Catalog For Known Namespacee =head1 SYNOPSIS use XML::RSS::LibXML::Namespaces qw(NS_RSS10); print NS_RSS10, "\n"; XML::RSS::LibXML::Namespaces::lookup_uri('rdf'); =head1 FUNCTIONS =head2 lookup_uri($prefix) =head2 lookup_prefix($uri) =cut libxml-rss-libxml-perl-0.3102+dfsg.orig/lib/XML/RSS/LibXML/ImplBase.pm0000644000175000017500000003143711522213717025167 0ustar nicholasnicholas# $Id$ # # Copyright (c) 2005-2007 Daisuke Maki # All rights reserved. package XML::RSS::LibXML::ImplBase; use strict; use warnings; use base qw(Class::Accessor::Fast); use Carp qw(croak); use XML::RSS::LibXML::MagicElement; use XML::RSS::LibXML::Namespaces; sub rss_accessor { my $self = shift; my $name = shift; my $c = shift; if (! exists $c->{$name}) { croak "Unregistered entity: Can't access $name field in object of class " . ref($self); } my $ret; if (@_ == 1) { if (ref $_[0]) { # eval { $_[0]->isa('XML::RSS::LibXML::MagicElement') }) { $ret = $c->{$name}; $c->{$name} = $_[0]; } else { $ret = $c->{$name}->{$_[0]}; if (ref $ret && eval { $ret->isa('XML::RSS::LibXML::ElementSpec') }) { $ret = undef; } } } elsif (@_ > 1) { my %hash = @_; my $definition = $self->accessor_definition; foreach my $key (keys %hash) { $self->validate_accessor($definition, $name, $key, $hash{$key}) if $definition; if ($key =~ /^(?:rdf|dc|syn|taxo|admin|content|cc)$/) { if (! exists $c->namespaces->{$key}) { $c->add_module(prefix => $key, uri => XML::RSS::LibXML::Namespaces::lookup_uri($key)); } } # $self->store_element($c, $c->{$name}, $key, $hash{$key}); $self->set_value($c, $name, $key, $hash{$key}); if (my $uri = $c->namespaces->{$key}) { $self->set_value($c, $name, $uri, $hash{$key}); # $self->store_element($c, $c->{$name}, $uri, $hash{$key}); } } $ret = $c->{$name}; } else { $ret = $c->{$name}; if (ref $ret && eval { $ret->isa('XML::RSS::LibXML::ElementSpec') }) { $ret = undef; } } return $ret; } sub definition {} sub accessor_definition { } sub validate_accessor { my ($self, $definition, $prefix, $key, $value) = @_; if (! defined $value) { croak "Undefined value in XML::RSS::LibXML::validate_accessor"; } my $spec = $definition->{$prefix}{$key}; croak "$key cannot exceed " . $spec->[1] . " characters in length" if defined $spec->[1] && length($value) > $spec->[1]; } sub set_value { my ($self, $c, $prefix, $key, $value) = @_; if (eval { $c->{$prefix}->isa('XML::RSS::LibXML::ElementSpec') }) { $c->{$prefix} = +{ %{ $c->{$prefix} } }; } $c->{$prefix}{$key} = $value; } sub validate_item { } sub channel { shift->rss_accessor('channel', @_) } sub image { shift->rss_accessor('image', @_) } sub textinput { shift->rss_accessor('textinput', @_) } sub skipDays { shift->rss_accessor('skipDays', @_) } sub skipHours { shift->rss_accessor('skipHours', @_) } sub reset { my ($self, $c) = @_; # internal hash $c->_internal({}); # init num of items to 0 $c->num_items(0); # initialize items $c->{items} = []; my $definition = $self->definition; while (my ($k, $v) = each(%$definition)) { $c->{$k} = +{%{$v}}; bless($c->{$k}, 'XML::RSS::LibXML::ElementSpec') if (ref($v) eq 'XML::RSS::LibXML::ElementSpec'); } return; } sub store_element { my ($self, $container, $name, $value) = @_; my $v = $container->{$name}; if (! $v || eval { $v->isa('XML::RSS::LibXML::ElementSpec') }) { $container->{$name} = $value; } elsif (ref($v) eq 'ARRAY') { push @$v, $value; } else { $container->{$name} = [ $v, $value ]; } } sub parse_dom { } sub parse_base { my ($self, $c, $dom) = @_; my $xc = $c->create_xpath_context(scalar $c->namespaces); if (my $b = $xc->findvalue('/rss/@xml:base', $dom)) { $c->base($b); } else { $c->base(undef); } } sub parse_namespaces { my ($self, $c, $dom) = @_; my %namespaces = $self->parse_namespaces_recurse($c, $dom->documentElement()); while (my ($prefix, $uri) = each %namespaces) { $c->add_module(prefix => $prefix, uri => $uri); } } sub parse_namespaces_recurse { my ($self, $c, $parent) = @_; my %namespaces; foreach my $node ($parent->findnodes('./*')) { my %h = $self->parse_namespaces_recurse($c, $node); %namespaces = (%namespaces, %h); } return (%namespaces, $c->get_namespaces($parent)); } sub parse_taxo { my ($self, $c, $dom, $container, $parent) = @_; my $xc = $c->create_xpath_context(scalar $c->namespaces); my @nodes = $xc->findnodes('taxo:topics/rdf:Bag/rdf:li', $parent); return unless @nodes; my $uri = XML::RSS::LibXML::Namespaces::lookup_uri('taxo'); if (! exists $c->namespaces->{taxo}) { $c->add_module(prefix => 'taxo', uri => $uri); } $container->{taxo} ||= []; foreach my $p (@nodes) { push @{ $container->{taxo} }, $p->findvalue('@resource'); } $container->{$uri} = $container->{taxo}; } sub parse_misc_simple { } sub may_have_children { qw(channel item image textinput skipHours skipDays) } sub parse_children { my ($self, $c, $node, $xpath) = @_; my %h; $xpath ||= './*'; my $xc = $c->create_xpath_context(scalar $c->namespaces); foreach my $child ($xc->findnodes($xpath, $node)) { my $prefix = $child->getPrefix(); my $name = $child->localname(); # XXX - this is probably the only case where we need to explicitly # normalize a name $name = 'textinput' if ($name eq 'textInput'); my $val = undef; if ($child->findnodes('./*')) { if (!grep { $_ eq $name } $self->may_have_children) { # Urk. Should have been encoded and wasn't! Stupid thing. $val = join '', map { $_->toString } $child->childNodes; } else { $val = $self->parse_children($c, $child); } } else { my $text = $child->textContent(); $text = '' if $text !~ /\S/ ; # argh. it has attributes. we do our little hack... if ($child->hasAttributes) { $val = XML::RSS::LibXML::MagicElement->new( content => $text, attributes => [ $child->attributes ] ); } else { $val = $text; } } # XXX - XML::RSS now can store multiple elements in a slot. # This we detect and change the underlying structure from a # scalar to an array if ($prefix) { $h{$prefix} ||= {}; $self->store_element($h{$prefix}, $name, $val); # XML::RSS requires us to allow access to elements both from # the prefix and the namespace $h{$c->{namespaces}{$prefix}} ||= {}; $self->store_element($h{$c->{namespaces}{$prefix}}, $name, $val); } else { $self->store_element(\%h, $name, $val); } } return wantarray ? %h : \%h; } sub as_string { my ($self, $c, $format) = @_; my $dom = $self->create_dom($c); return $dom->toString($format); } sub create_dom { my ($self, $c) = @_; my $dom = $self->create_document($c); $self->create_dtd($c, $dom); $self->create_pi($c, $dom); $self->create_rootelement($c, $dom); $self->create_namespaces($c, $dom); $self->create_channel($c, $dom); $self->create_items($c, $dom); return $dom; } sub create_pi { my ($self, $c, $dom) = @_; my $styles = $c->stylesheets; foreach my $style (@$styles) { my $pi = $dom->createProcessingInstruction('xml-stylesheet'); $pi->setData(type => 'text/xsl', href => $style); $dom->appendChild($pi); } } sub create_document { my $self = shift; my $c = shift; return XML::LibXML::Document->new('1.0', $c->encoding); } sub create_rootelement {} sub create_dtd {} sub create_channel {} sub create_items {} sub create_misc_simple { my ($self, $c, $dom, $parent) = @_; my $definition = $self->definition; while (my($p, $children) = each %$definition) { next if ! $c->{$p}; my @nodes; while (my($e, $value) = each %$children) { if (defined $value) { my $node = $dom->createElement($e); $node->appendText($value); push @nodes, $node; } } if (@nodes) { my $local_parent = $dom->createElement($p); $local_parent->appendChild($_) for @nodes; $parent->appendChild($local_parent); } } } sub create_taxo { my ($self, $c, $dom, $parent) = @_; my $list = $c->{taxo}; if (! $list || @$list <= 0) { return; } my $topic = $dom->createElement('taxo:topics'); my $bag = $dom->createElement('rdf:Bag'); foreach my $taxo (@$list) { my $node = $dom->createElement('rdf:li'); $node->setAttribute(resource => $taxo); $bag->appendChild($node); } $topic->appendChild($bag); $parent->appendChild($topic); } sub create_extra_modules { my ($self, $c, $dom, $parent, $namespaces) = @_; while (my ($prefix, $uri) = each %$namespaces) { next if $prefix =~ /^(?:dc|syn|taxo|rss\d\d)$/; next if ! defined $c->{$prefix}; while (my($e, $value) = each %{ $c->{$prefix} }) { my $node = $dom->createElement("$prefix:$e"); $node->appendText($value); $parent->appendChild($node); } } } sub create_namespaces { my $self = shift; my $c = shift; my $dom = shift; my $root = $dom->getDocumentElement() or croak "No document element found?!"; my $namespaces = $c->namespaces; while (my($prefix, $url) = each %$namespaces) { next if $prefix =~ /^rss\d\d$/; next if $prefix =~ /^#default$/; $root->setNamespace($url, $prefix, 0); } } sub create_element_from_spec { my ($self, $c, $dom, $parent, $specs) = @_; my $root = $dom->getDocumentElement(); my $node; while (my ($e, $spec) = each %$specs) { my( $callback, $list ); if (ref $spec eq 'HASH') { $callback = $spec->{callback}; $list = $spec->{candidates}; } elsif (ref $spec eq 'ARRAY') { $list = $spec; } foreach my $p (@$list) { my ($prefix, $value); if (ref $p && ref $p eq 'HASH') { if ($c->{$p->{module}}) { $prefix = $p->{module}; $value = $c->{$p->{module}}{$p->{element}}; } } else { $value = $c->{$p}; } if (defined $value) { if ($prefix) { $root->setNamespace( XML::RSS::LibXML::Namespaces::lookup_uri($prefix), $prefix, 0 ); } $node = $dom->createElement($e); if (ref $value && eval { $value->isa('XML::RSS::LibXML::MagicElement') }) { foreach my $attr ($value->attributes) { $node->setAttribute($attr, $value->{$attr}); } } elsif ($callback) { $callback->($value); } $node->appendText($value); $parent->appendChild($node); last; } } } } sub add_item { my $self = shift; my $c = shift; my $h = ref($_[0]) eq 'HASH' ? $_[0] : {@_}; $self->validate_item($c, $h); my $guid = $h->{guid}; if (defined $guid) { # guid should *only* be MagicElement if (! eval { $guid->isa('XML::RSS::LibXML::MagicElement') }) { $h->{permaLink} = $guid; } else { if (my $is_permalink = $guid->{isPermaLink}) { if ($is_permalink eq 'true') { $h->{permaLink} = $guid->{_content}; } } else { $h->{permaLink} = $guid->{_content}; } } } elsif (defined (my $permaLink = $h->{permaLink})) { $h->{guid} = XML::RSS::LibXML::MagicElement->new( content => $permaLink, attributes => { isPermaLink => 'true' } ); } my $namespaces = $c->namespaces; foreach my $p (keys %$namespaces) { if ($h->{$p}) { $h->{ $namespaces->{$p} } = $h->{$p}; } } # add the item to the list if (defined($h->{mode}) && delete $h->{mode} eq 'insert') { unshift(@{$c->items}, $h); } else { push(@{$c->items}, $h); } # return reference to the list of items return $c->{items}; } 1; __END__ =head1 NAME XML::RSS::LibXML::ImplBase - Implementation Base For XML::RSS::LibXML =head1 SYNOPSIS # Internal use only =head1 DESCRIPTION =cut libxml-rss-libxml-perl-0.3102+dfsg.orig/lib/XML/RSS/LibXML/Null.pm0000644000175000017500000000033611401601511024364 0ustar nicholasnicholas# $Id$ # # Copyright (c) 2005-2007 Daisuke Maki # All rights reserved. package XML::RSS::LibXML::Null; use strict; use warnings; use base qw(XML::RSS::LibXML::ImplBase); sub definition { +{} } 1; libxml-rss-libxml-perl-0.3102+dfsg.orig/lib/XML/RSS/LibXML/V0_92.pm0000644000175000017500000000067611410004532024260 0ustar nicholasnicholaspackage XML::RSS::LibXML::V0_92; use strict; use warnings; use base qw(XML::RSS::LibXML::V0_91); # Should be compatible with 0.91. # See http://backend.userland.com/rss092 sub parse_dom { my $self = shift; my $c = shift; my $dom = shift; $c->reset; $c->version('0.92'); $c->encoding($dom->encoding); $self->parse_namespaces($c, $dom); $self->parse_channel($c, $dom); $self->parse_items($c, $dom); } 1; libxml-rss-libxml-perl-0.3102+dfsg.orig/lib/XML/RSS/LibXML/V0_9.pm0000644000175000017500000002026111604763245024210 0ustar nicholasnicholas# $Id$ # # Copyright (c) 2005-2007 Daisuke Maki # All rights reserved. package XML::RSS::LibXML::V0_9; use strict; use base qw(XML::RSS::LibXML::ImplBase); use Carp qw(croak); use XML::RSS::LibXML::Namespaces qw(NS_RSS09 NS_RDF); my $format_dates = sub { my $v = eval { DateTime::Format::W3CDTF->format_datetime( DateTime::Format::Mail->parse_datetime($_[0]) ); }; if ($v && ! $@) { $_[0] = $v; } }; my %DcElements = ( 'dc:date' => { candidates => [ { module => 'dc', element => 'date' }, 'pubDate', 'lastBuildDate', ], callback => $format_dates }, (map { ("dc:$_" => [ { module => 'dc', element => $_ } ]) } qw(language rights publisher creator title subject description contributer type format identifier source relation coverage)), ); my %ImageElements = ( (map { ($_ => [$_]) } qw(title url link)), %DcElements, ); my %TextInputElements = ( (map { ($_ => [$_]) } qw(title link description name)), %DcElements ); sub definition { return { channel => { title => '', description => '', link => '', }, image => bless({ title => undef, url => undef, link => undef, }, 'XML::RSS::LibXML::ElementSpec'), textinput => bless({ title => undef, description => undef, name => undef, link => undef, }, 'XML::RSS::LibXML::ElementSpec'), }, } sub accessor_definition { return +{ channel => { "title" => [1, 40], "description" => [1, 500], "link" => [1, 500] }, image => { "title" => [1, 40], "url" => [1, 500], "link" => [1, 500] }, item => { "title" => [1, 100], "link" => [1, 500] }, textinput => { "title" => [1, 40], "description" => [1, 100], "name" => [1, 500], "link" => [1, 500] } } } sub parse_dom { my $self = shift; my $c = shift; my $dom = shift; $c->reset; $c->version(0.9); $c->encoding($dom->encoding); $self->parse_namespaces($c, $dom); $c->internal('prefix', 'rss09'); # Check if we have non-default RSS namespace my $namespaces = $c->namespaces; while (my($prefix, $uri) = each %$namespaces) { if ($uri eq NS_RSS09 && $prefix ne '#default') { $c->internal('prefix', $prefix); last; } } $dom->getDocumentElement()->setNamespace(NS_RSS09, $c->internal('prefix'), 0); $self->parse_channel($c, $dom); $self->parse_items($c, $dom); $self->parse_misc_simple($c, $dom); } sub parse_namespaces { my ($self, $c, $dom) = @_; $self->SUPER::parse_namespaces($c, $dom); my $namespaces = $c->namespaces; while (my($prefix, $uri) = each %$namespaces) { if ($uri eq NS_RSS09) { } } } sub parse_channel { my ($self, $c, $dom) = @_; my $xc = $c->create_xpath_context($c->{namespaces}); my ($root) = $xc->findnodes('/rdf:RDF/rss09:channel', $dom); my %h = $self->parse_children($c, $root); foreach my $field (qw(textinput image)) { delete $h{$field}; # if (my $v = $h{$field}) { # $c->$field(UNIVERSAL::isa($v, 'XML::RSS::LibXML::MagicElement') ? $v : %$v); # } } $c->channel(%h); } sub parse_items { my $self = shift; my $c = shift; my $dom = shift; my @items; my $version = $c->version; my $xc = $c->create_xpath_context($c->{namespaces}); my $xpath = '/rdf:RDF/rss09:item'; foreach my $item ($xc->findnodes($xpath, $dom)) { my $i = $self->parse_children($c, $item); $self->add_item($c, $i); } } sub parse_misc_simple { my ($self, $c, $dom) = @_; my $xc = $c->create_xpath_context($c->{namespaces}); foreach my $node ($xc->findnodes('/rdf:RDF/*[name() != "channel" and name() != "item"]', $dom)) { my $h = $self->parse_children($c, $node); my $name = $node->localname; $name = 'textinput' if $name eq 'textInput'; my $prefix = $node->getPrefix(); if ($prefix) { $c->{$prefix} ||= {}; $self->store_element($c->{$prefix}, $name, $h); # XML::RSS requires us to allow access to elements both from # the prefix and the namespace $c->{$c->{namespaces}{$prefix}} ||= {}; $self->store_element($c->{$c->{namespaces}{$prefix}}, $name, $h); } else { $self->store_element($c, $name, $h); } } } sub validate_item { my $self = shift; my $c = shift; my $h = shift; # make sure we have a title and link croak "title and link elements are required" unless (defined $h->{title} && defined $h->{'link'}); # check string lengths croak "title cannot exceed 100 characters in length" if (length($h->{title}) > 100); croak "link cannot exceed 500 characters in length" if (length($h->{'link'}) > 500); croak "description cannot exceed 500 characters in length" if (exists($h->{description}) && length($h->{description}) > 500); # make sure there aren't already 15 items croak "total items cannot exceed 15 " if (@{$c->items} >= 15); } sub create_dom { my ($self, $c) = @_; my $dom = $self->SUPER::create_dom($c); my $xc = $c->create_xpath_context($c->namespaces); my ($channel) = $xc->findnodes('/rdf:RDF/channel', $dom); my $root = $dom->getDocumentElement(); if (my $image = $c->image) { my $inode; $inode = $dom->createElement('image'); $inode->setAttribute('rdf:resource', $image->{url}) if defined $image->{url}; $channel->appendChild($inode); $inode = $dom->createElement('image'); $inode->setAttribute('rdf:resource', $image->{url}) if defined $image->{url}; $self->create_element_from_spec($image, $dom, $inode, \%ImageElements); $self->create_extra_modules($image, $dom, $inode, $c->namespaces); $root->appendChild($inode); } if (my $textinput = $c->textinput) { my $inode; $inode = $dom->createElement('textinput'); $inode->setAttribute('rdf:resource', $textinput->{link}) if $textinput->{link}; $channel->appendChild($inode); $inode = $dom->createElement('textinput'); $inode->setAttribute('rdf:resource', $textinput->{link}) if $textinput->{link}; $self->create_element_from_spec($textinput, $dom, $inode, \%TextInputElements); $self->create_extra_modules($textinput, $dom, $inode, $c->namespaces); $root->appendChild($inode); } return $dom; } sub create_rootelement { my $self = shift; my $c = shift; my $dom = shift; my $e = $dom->createElementNS(NS_RSS09, 'RDF'); $dom->setDocumentElement($e); $e->setNamespace(NS_RDF, 'rdf', 1); $c->add_module(prefix => 'rdf', uri => NS_RDF); } sub create_channel { my $self = shift; my $c = shift; my $dom = shift; my $root = $dom->getDocumentElement(); my $channel = $dom->createElement('channel'); $root->appendChild($channel); my $node; foreach my $p (qw(title link description)) { my $text = $c->{channel}{$p}; next unless defined $text; $node = $dom->createElement($p); $node->appendText($c->{channel}{$p}); $channel->appendChild($node); } } sub create_items { my $self = shift; my $c = shift; my $dom = shift; my $root = $dom->getDocumentElement(); foreach my $i ($c->items) { my $item = $self->create_item($c, $dom, $i); $root->appendChild($item); } } sub create_item { my $self = shift; my $c = shift; my $dom = shift; my $i = shift; my $item = $dom->createElement('item'); my $node; foreach my $e (qw(title link)) { $node = $dom->createElement($e); $node->appendText($i->{$e}); $item->addChild($node); } return $item; } 1; libxml-rss-libxml-perl-0.3102+dfsg.orig/lib/XML/RSS/LibXML/V0_91.pm0000644000175000017500000001733511604763245024301 0ustar nicholasnicholas# $Id$ # # Copyright (c) 2005-2007 Daisuke Maki # All rights reserved. package XML::RSS::LibXML::V0_91; use strict; use warnings; use base qw(XML::RSS::LibXML::ImplBase); use DateTime::Format::W3CDTF; use DateTime::Format::Mail; my %DcElements = ( (map { ("dc:$_" => [ { module => 'dc', element => $_ } ]) } qw(language rights date publisher creator title subject description contributer type format identifier source relation coverage)), ); my %SynElements = ( (map { ("syn:$_" => [ { module => 'syn', element => $_ } ]) } qw(updateBase updateFrequency updatePeriod)), ); my $format_dates = sub { my $v = eval { DateTime::Format::Mail->format_datetime( DateTime::Format::W3CDTF->parse_datetime($_[0]) ); }; if ($v && ! $@) { $_[0] = $v; } }; my %ChannelElements = ( %DcElements, %SynElements, (map { ($_ => [ $_ ]) } qw(title link description)), language => [ { module => 'dc', element => 'language' }, 'language' ], copyright => [ { module => 'dc', element => 'rights' }, 'copyright' ], pubDate => { candidates => [ 'pubDate', { module => 'dc', element => 'date' } ], callback => $format_dates, }, lastBuildDate => { candidates => [ { module => 'dc', element => 'date' }, 'lastBuildDate' ], callback => $format_dates, }, docs => [ 'docs' ], managingEditor => [ { module => 'dc', element => 'publisher' }, 'managingEditor' ], webMaster => [ { module => 'dc', element => 'creator' }, 'webMaster' ], category => [ { module => 'dc', element => 'category' }, 'category' ], generator => [ { module => 'dc', element => 'generator' }, 'generator' ], ttl => [ { module => 'dc', element => 'ttl' }, 'ttl' ], rating => [ 'rating' ], ); delete $ChannelElements{'dc:creator'}; my %ItemElements = ( %DcElements, map { ($_ => [$_]) } qw(title link description author category comments pubDate) ); my %ImageElements = ( (map { ($_ => [$_]) } qw(title url link description width height)), %DcElements, ); my %TextInputElements = ( (map { ($_ => [$_]) } qw(title link description name)), %DcElements ); sub definition { return +{ channel => { title => '', copyright => undef, description => '', docs => undef, language => undef, lastBuildDate => undef, 'link' => '', managingEditor => undef, pubDate => undef, rating => undef, webMaster => undef, }, image => bless({ title => undef, url => undef, 'link' => undef, width => undef, height => undef, description => undef, }, 'XML::RSS::LibXML::ElementSpec'), skipDays => {day => undef,}, skipHours => {hour => undef,}, textinput => bless({ title => undef, description => undef, name => undef, 'link' => undef, }, 'XML::RSS::LibXML::ElementSpec'), } } sub accessor_definition { return +{ channel => { "title" => [1, 100], "description" => [1, 500], "link" => [1, 500], "language" => [1, 5], "rating" => [0, 500], "copyright" => [0, 100], "pubDate" => [0, 100], "lastBuildDate" => [0, 100], "docs" => [0, 500], "managingEditor" => [0, 100], "webMaster" => [0, 100], }, image => { "title" => [1, 100], "url" => [1, 500], "link" => [0, 500], "width" => [0, 144], "height" => [0, 400], "description" => [0, 500] }, item => { "title" => [1, 100], "link" => [1, 500], "description" => [0, 500] }, textinput => { "title" => [1, 100], "description" => [1, 500], "name" => [1, 20], "link" => [1, 500] }, skipHours => {"hour" => [1, 23]}, skipDays => {"day" => [1, 10]} } } sub parse_dom { my $self = shift; my $c = shift; my $dom = shift; $c->reset; $c->version('0.91'); $c->encoding($dom->encoding); $self->parse_namespaces($c, $dom); $self->parse_channel($c, $dom); $self->parse_items($c, $dom); } sub parse_channel { my ($self, $c, $dom) = @_; my $xc = $c->create_xpath_context($c->{namespaces}); my ($root) = $xc->findnodes('/rss/channel', $dom); my %h = $self->parse_children($c, $root); foreach my $type (qw(day hour)) { my $field = 'skip' . ucfirst($type) . 's'; if (my $skip = delete $h{$field}) { $c->$field(%$skip); } } $c->channel(%h); } sub parse_items { my $self = shift; my $c = shift; my $dom = shift; my @items; my $version = $c->version; my $xc = $c->create_xpath_context($c->{namespaces}); my $xpath = '/rss/channel/item'; foreach my $item ($xc->findnodes($xpath, $dom)) { my $i = $self->parse_children($c, $item); $self->add_item($c, $i); } } sub create_dtd { my $self = shift; my $c = shift; my $dom = shift; my $dtd = $dom->createExternalSubset( 'rss', '-//Netscape Communications//DTD RSS 0.91//EN', 'http://my.netscape.com/publish/formats/rss-0.91.dtd' ); $dom->setInternalSubset($dtd); } sub create_rootelement { my ($self, $c, $dom) = @_; my $root = $dom->createElement('rss'); $root->setAttribute(version => '0.91'); $dom->setDocumentElement($root); } sub create_channel { my ($self, $c, $dom) = @_; my $root = $dom->getDocumentElement(); my $channel = $dom->createElement('channel'); $self->create_element_from_spec($c->channel, $dom, $channel, \%ChannelElements); if (my $image = $c->image) { if (! UNIVERSAL::isa($image, 'XML::RSS::LibXML::ElementSpec')) { my $inode; $inode = $dom->createElement('image'); $self->create_element_from_spec($image, $dom, $inode, \%ImageElements); $self->create_extra_modules($image, $dom, $inode, $c->namespaces); $channel->appendChild($inode); } } if (my $textinput = $c->textinput) { if (! UNIVERSAL::isa($textinput, 'XML::RSS::LibXML::ElementSpec')) { my $inode; $inode = $dom->createElement('textinput'); $self->create_element_from_spec($textinput, $dom, $inode, \%TextInputElements); $self->create_extra_modules($textinput, $dom, $inode, $c->namespaces); $channel->appendChild($inode); } } foreach my $type (qw(day hour)) { my $field = 'skip' . ucfirst($type) . 's'; my $skip = $c->$field; if ($skip && defined $skip->{$type}) { my $sd = $dom->createElement($field); my $d = $dom->createElement($type); $d->appendChild($dom->createTextNode($skip->{$type})); $sd->appendChild($d); $channel->appendChild($sd); } } $root->appendChild($channel); } sub create_items { my ($self, $c, $dom) = @_; my ($channel) = $dom->findnodes('/rss/channel'); foreach my $i ($c->items) { my $item = $dom->createElement('item'); $self->create_element_from_spec($i, $dom, $item, \%ItemElements); $channel->appendChild($item); } } 1; libxml-rss-libxml-perl-0.3102+dfsg.orig/lib/XML/RSS/LibXML/V2_0.pm0000644000175000017500000002201511604763245024200 0ustar nicholasnicholas# $Id$ # # Copyright (c) 2005-2007 Daisuke Maki # All rights reserved. package XML::RSS::LibXML::V2_0; use strict; use warnings; use base qw(XML::RSS::LibXML::ImplBase); use DateTime::Format::W3CDTF; use DateTime::Format::Mail; my %DcElements = ( (map { ("dc:$_" => [ { module => 'dc', element => $_ } ]) } qw(language rights date publisher creator title subject description contributer type format identifier source relation coverage)), ); my %SynElements = ( (map { ("syn:$_" => [ { module => 'syn', element => $_ } ]) } qw(updateBase updateFrequency updatePeriod)), ); my $format_dates = sub { my $v = eval { DateTime::Format::Mail->format_datetime( DateTime::Format::W3CDTF->parse_datetime($_[0]) ); }; if ($v && ! $@) { $_[0] = $v; } }; my %ChannelElements = ( %DcElements, %SynElements, (map { ($_ => [ $_ ]) } qw(title link description)), language => [ { module => 'dc', element => 'language' }, 'language' ], copyright => [ { module => 'dc', element => 'rights' }, 'copyright' ], pubDate => { candidates => [ 'pubDate', { module => 'dc', element => 'date' } ], callback => $format_dates, }, lastBuildDate => { candidates => [ { module => 'dc', element => 'date' }, 'lastBuildDate' ], callback => $format_dates, }, docs => [ 'docs' ], managingEditor => [ { module => 'dc', element => 'publisher' }, 'managingEditor' ], webMaster => [ { module => 'dc', element => 'creator' }, 'webMaster' ], category => [ { module => 'dc', element => 'category' }, 'category' ], generator => [ { module => 'dc', element => 'generator' }, 'generator' ], ttl => [ { module => 'dc', element => 'ttl' }, 'ttl' ], ); my %ItemElements = ( %DcElements, enclosure => ['enclosure'], map { ($_ => [$_]) } qw(title link description author category comments pubDate) ); my %ImageElements = ( (map { ($_ => [$_]) } qw(title url link width height description)), %DcElements, ); my %TextInputElements = ( (map { ($_ => [$_]) } qw(title link description name)), %DcElements ); sub definition { return +{ channel => { title => '', 'link' => '', description => '', language => undef, copyright => undef, managingEditor => undef, webMaster => undef, pubDate => undef, lastBuildDate => undef, category => undef, generator => undef, docs => undef, cloud => '', ttl => undef, image => '', textinput => '', skipHours => '', skipDays => '', }, image => bless ({ title => undef, url => undef, 'link' => undef, width => undef, height => undef, description => undef, }, 'XML::RSS::LibXML::ElementSpec'), skipDays => bless ({ day => undef, }, 'XML::RSS::LibXML::ElementSpec'), skipHours => bless ({ hour => undef, }, 'XML::RSS::LibXML::ElementSpec'), textinput => bless ({ title => undef, description => undef, name => undef, 'link' => undef, }, 'XML::RSS::LibXML::ElementSpec'), }; } sub parse_dom { my $self = shift; my $c = shift; my $dom = shift; $c->reset; $c->version('2.0'); $c->encoding($dom->encoding); $self->parse_base($c, $dom); $self->parse_namespaces($c, $dom); $self->parse_channel($c, $dom); $self->parse_items($c, $dom); $self->parse_misc_simple($c, $dom); } sub parse_channel { my ($self, $c, $dom) = @_; my $xc = $c->create_xpath_context($c->{namespaces}); my ($root) = $xc->findnodes('/rss/channel', $dom); my %h = $self->parse_children($c, $root, './*[name() != "item"]'); foreach my $type (qw(day hour)) { my $field = 'skip' . ucfirst($type) . 's'; if (my $skip = delete $h{$field}) { if (ref $skip ne 'HASH') { # warn "field $field has invalid entry (does this RSS validate?)"; } elsif (! UNIVERSAL::isa($skip, 'XML::RSS::LibXML::ElementSpec')) { $c->$field(UNIVERSAL::isa($skip, 'XML::RSS::LibXML::MagicElement') ? $skip : %$skip); } } } foreach my $field (qw(textinput image)) { if (my $v = $h{$field}) { if (ref $v ne 'HASH') { # warn "field $field has invalid entry (does this RSS validate?)"; } elsif (! UNIVERSAL::isa($v, 'XML::RSS::LibXML::ElementSpec')) { $c->$field(UNIVERSAL::isa($v, 'XML::RSS::LibXML::MagicElement') ? $v : %$v); } } } $c->channel(%h); } sub parse_items { my ($self, $c, $dom) = @_; my @items; my $version = $c->version; my $xc = $c->create_xpath_context($c->{namespaces}); my $xpath = '/rss/channel/item'; foreach my $item ($xc->findnodes($xpath, $dom)) { my $i = $self->parse_children($c, $item); $self->add_item($c, $i); } } sub parse_misc_simple { my ($self, $c, $dom) = @_; my $xc = $c->create_xpath_context($c->{namespaces}); foreach my $node ($xc->findnodes('/rss/*[name() != "channel" and name() != "item"]', $dom)) { my $h = $self->parse_children($c, $node); my $name = $node->localname; my $prefix = $node->getPrefix(); $name = 'textinput' if $name eq 'textInput'; if ($prefix) { $c->{$prefix} ||= {}; $self->store_element($c->{$prefix}, $name, $h); # XML::RSS requires us to allow access to elements both from # the prefix and the namespace $c->{$c->{namespaces}{$prefix}} ||= {}; $self->store_element($c->{$c->{namespaces}{$prefix}}, $name, $h); } else { $self->store_element($c, $name, $h); } } } sub create_dom { my ($self, $c) = @_; my $dom = $self->SUPER::create_dom($c); my $root = $dom->getDocumentElement(); my $xc = $c->create_xpath_context(scalar $c->namespaces); my($channel) = $xc->findnodes('/rss/channel', $dom); if (my $image = $c->image) { my $inode = $dom->createElement('image'); $self->create_element_from_spec($image, $dom, $inode, \%ImageElements); $self->create_extra_modules($image, $dom, $inode, $c->namespaces); $channel->appendChild($inode); } if (my $textinput = $c->textinput) { my $inode = $dom->createElement('textInput'); $self->create_element_from_spec($textinput, $dom, $inode, \%TextInputElements); $self->create_extra_modules($textinput, $dom, $inode, $c->namespaces); $channel->appendChild($inode); } return $dom; } sub create_rootelement { my ($self, $c, $dom) = @_; my $root = $dom->createElement('rss'); $root->setAttribute(version => '2.0'); if (my $base = $c->base) { $root->setAttribute('xml:base' => $base); } $dom->setDocumentElement($root); } sub create_channel { my ($self, $c, $dom) = @_; my $root = $dom->getDocumentElement(); my $channel = $dom->createElement('channel'); $self->create_element_from_spec($c->channel, $dom, $channel, \%ChannelElements); foreach my $type (qw(day hour)) { my $field = 'skip' . ucfirst($type) . 's'; my $skip = $c->$field; if ($skip && defined $skip->{$type}) { my $sd = $dom->createElement($field); my $d = $dom->createElement($type); $d->appendChild($dom->createTextNode($skip->{$type})); $sd->appendChild($d); $channel->appendChild($sd); } } $root->appendChild($channel); } sub create_items { my ($self, $c, $dom) = @_; my ($channel) = $dom->findnodes('/rss/channel'); foreach my $i ($c->items) { my $item = $dom->createElement('item'); $self->create_element_from_spec($i, $dom, $item, \%ItemElements); $self->create_extra_modules($i, $dom, $item, $c->namespaces); my $guid = $i->{guid}; if (defined $guid) { my $guid_element = $dom->createElement('guid'); if (eval { $guid->isa('XML::RSS::LibXML::MagicElement') }) { my $isperma = 'true'; if (! $guid->{isPermaLink} || $guid->{isPermaLink} ne 'true') { $isperma = 'false'; } $guid_element->setAttribute(isPermaLink => $isperma); $guid_element->appendChild($dom->createTextNode($guid->toString)); } else { $guid_element->setAttribute(isPermaLink => "false"); $guid_element->appendChild($dom->createTextNode($guid)); } $item->appendChild($guid_element); } $channel->appendChild($item); } } 1; libxml-rss-libxml-perl-0.3102+dfsg.orig/lib/XML/RSS/LibXML.pm0000644000175000017500000003474311633756611023506 0ustar nicholasnicholaspackage XML::RSS::LibXML; use strict; use warnings; use base qw(Class::Accessor::Fast); use Carp; use UNIVERSAL::require; use XML::LibXML; use XML::LibXML::XPathContext; use XML::RSS::LibXML::Namespaces qw(NS_RSS10); our $VERSION = '0.3102'; __PACKAGE__->mk_accessors($_) for qw(impl encoding strict namespaces modules output stylesheets _internal num_items); sub new { my $class = shift; my %args = @_; my $impl = $class->create_impl($args{version}); my $self = bless { impl => $impl, version => $args{version}, base => $args{base}, encoding => $args{encoding} || 'UTF-8', strict => exists $args{strict} ? $args{strict} : 0, namespaces => {}, modules => {}, _internal => {}, stylesheets => $args{stylesheet} ? (ref ($args{stylesheet}) eq 'ARRAY' ? $args{stylesheet} : [ $args{stylesheet} ]) : [], num_items => 0, libxml_opts => $args{libxml_opts} || { recover => 1, load_ext_dtd => 0 }, }, $class; $self->impl->reset($self); return $self; } { # Proxy methods foreach my $method (qw(reset channel image add_item textinput skipDays skipHours)) { no strict 'refs'; *{$method} = sub { my $self = shift; $self->impl->$method($self, @_) }; } } sub internal { my $self = shift; my $name = shift; my $value = $self->{_internal}{$name}; if (@_) { $self->{_internal}{$name} = $_[0]; } return $value; } sub version { my $self = shift; my $version = $self->{version}; if (@_) { $self->{version} = $_[0]; $self->internal('version', $_[0]); } return $version; } sub base { my $self = shift; my $base = $self->{base}; if (@_) { $self->{base} = $_[0]; $self->internal('base', $_[0]); } return $base; } sub add_module { my $self = shift; my %args = @_; if ($args{prefix} eq '#default') { # no op } else { $args{prefix} =~ /^[a-zA-Z_][a-zA-Z0-9.\-_]*$/ or croak "a namespace prefix should look like [a-z_][a-z0-9.\\-_]*"; } $args{uri} or croak "a URI must be provided in a namespace declaration"; $self->namespaces->{$args{prefix}} = $args{uri}; $self->modules->{$args{uri}} = $args{prefix}; } sub items { my $self = shift; my $items = $self->{items}; $items ? (wantarray ? @$items : $items) : (wantarray ? () : undef); } sub create_impl { my $self = shift; my $version = shift; my $module = "Null"; if ($version) { $module = $version; $module =~ s/\./_/g; $module = "V$module"; } my $pkg; REQUIRE: { $pkg = "XML::RSS::LibXML::$module"; eval { $pkg->require or die; }; if (my $e = $@) { if ($e =~ /Can't locate/) { $module = "V1_0"; $version = '1.0'; redo REQUIRE; } } } return $pkg->new; } sub create_libxml { my $self = shift; my $p = XML::LibXML->new; my $opts = $self->{libxml_opts} || {}; while (my($key, $value) = each %$opts) { $p->$key($value); } return $p; } sub parse { my $self = shift; $self->reset(); my $p = $self->create_libxml; my $dom = $p->parse_string($_[0]); $self->parse_dom($dom); $self; } sub parsefile { my $self = shift; $self->reset(); my $p = $self->create_libxml; my $dom = $p->parse_file($_[0]); $self->parse_dom($dom); $self; } sub parse_dom { my $self = shift; my $dom = shift; my $version = $self->guess_version_from_dom($dom); my $impl = $self->create_impl($version); $self->impl($impl); $self->impl->parse_dom($self, $dom); $self; } sub get_namespaces { my $self = shift; my $node = shift; my %h = map { (($_->getLocalName() || '#default') => $_->getData) } $node->getNamespaces(); if ($h{rdf} && ! $h{'#default'}) { $h{'#default'} = NS_RSS10; } return wantarray ? %h : \%h; } sub create_xpath_context { my $self = shift; my $namespaces = shift || {}; my $xc = XML::LibXML::XPathContext->new; while ( my ($prefix, $namespace) = each %{ $namespaces } ) { $xc->registerNs($prefix, $namespace); } return $xc; } sub guess_version_from_dom { my $self = shift; my $dom = shift; my $root = $dom->documentElement(); my $namespaces = $self->get_namespaces($root); # Check if we have non-default RSS namespace my $rss10_prefix = 'rss10'; while (my($prefix, $uri) = each %$namespaces) { if ($uri eq NS_RSS10) { $rss10_prefix = $prefix; last; } } if ($rss10_prefix && $rss10_prefix eq '#default') { $rss10_prefix = 'rss10'; $namespaces->{$rss10_prefix} = NS_RSS10; $root->setNamespace(NS_RSS10, $rss10_prefix, 0); } my $xc = $self->create_xpath_context( # use the minimum required to guess $namespaces ); my $version = 'UNKNOWN'; # Test starting from the most likely candidate if (eval { $xc->findnodes('/rdf:RDF', $dom) }) { # 1.0 or 0.9. # Wrap up in evail, because we may not have registered rss10 # namespace prefix if (eval { $xc->findnodes("/rdf:RDF/$rss10_prefix:channel", $dom) }) { $version = '1.0'; } else { $version = '0.9'; } } elsif (eval { $xc->findnodes('/rss', $dom) }) { # 0.91 or 2.0 -ish $version = $xc->findvalue('/rss/@version', $dom); } else { die "Failed to guess version"; } $version = "$1.0" if $version =~ /^(\d)$/; return $version; } sub as_string { my $self = shift; my $format = @_ ? $_[0] : 1; my $impl = $self->create_impl($self->output || $self->version); $self->impl($impl); $self->impl->as_string($self, $format); } sub save { my $self = shift; my $file = shift; open(OUT, ">$file") or Carp::croak("Cannot open file $file for write: $!"); print OUT $self->as_string; close(OUT); } 1; __END__ =head1 NAME XML::RSS::LibXML - XML::RSS with XML::LibXML =head1 SYNOPSIS use XML::RSS::LibXML; my $rss = XML::RSS::LibXML->new; $rss->parsefile($file); print "channel: $rss->{channel}->{title}\n"; foreach my $item (@{ $rss->{items} }) { print " item: $item->{title} ($item->{link})\n"; } # Add custom modules $rss->add_module(uri => $uri, prefix => $prefix); # See docs for XML::RSS for these $rss->channel(...); $rss->add_item(...); $rss->image(...); $rss->textinput(...); $rss->save(...); $rss->as_string($format); # XML::RSS::LibXML only methods my $version = $rss->version; my $base = $rss->base; my $hash = $rss->namespaces; my $list = $rss->items; my $encoding = $rss->encoding; my $modules = $rss->modules; my $output = $rss->output; my $stylesheets = $rss->stylesheets; my $num_items = $rss->num_items; =head1 DESCRIPTION XML::RSS::LibXML uses XML::LibXML (libxml2) for parsing RSS instead of XML::RSS' XML::Parser (expat), while trying to keep interface compatibility with XML::RSS. XML::RSS is an extremely handy tool, but it is unfortunately not exactly the most lean or efficient RSS parser, especially in a long-running process. So for a long time I had been using my own version of RSS parser to get the maximum speed and efficiency - this is the re-packaged version of that module, such that it adheres to the XML::RSS interface. Use this module when you have severe performance requirements working with RSS files. =head1 VERSION 0.30 The original XML::RSS has been evolving in fairly rapid manner lately, and that meant that there were a lot of features to keep up with. To keep compatibility, I've had to pretty much rewrite the module from ground up. Now XML::RSS::LibXML is *almost* compatible with XML::RSS. If there are problems, please send in bug reports (or more preferrably, patches ;) =head1 COMPATIBILITY There seems to be a bit of confusion as to how compatible XML::RSS::LibXML is with XML::RSS: XML::RSS::LibXML is B 100% compatible with XML::RSS. For instance XML::RS::LibXML does not do a complete parsing of the XML document because of the way we deal with XPath and libxml's DOM (see CAVEATS below) On top of that, I originally wrote XML::RSS::LibXML as sort of a fast replacement for XML::RAI, which looked cool in terms of abstracting the various modules. And therefore versions prior to 0.02 worked more like XML::RAI rather than XML::RSS. That was a mistake in hind sight, so it has been addressed (Since XML::RSS::LibXML version 0.08, it even supports writing RSS :) From now on XML::RSS::LibXML will try to match XML::RSS's functionality as much as possible in terms of parsing RSS feeds. Please send in patches and any tests that may be useful! =head1 PARSED STRUCTURE Once parsed the resulting data structure resembles that of XML::RSS. However, as one addition/improvement, XML::RSS::LibXML uses a technique to allow users to access complex data structures that XML::RSS doesn't support as of this writing. For example, suppose you have a tag like the following: ... foo bar baz All of the fields in this construct can be accessed like so: $rss->channel->{tag} # "foo bar baz" $rss->channel->{tag}{attr1} # "val1" $rss->channel->{tag}{attr2} # "val2" See L for details. =head1 METHODS =head2 new(%args) Creates a new instance of XML::RSS::LibXML. You may specify a version or an XML base in the constructor args to control which output format as_string() will use. XML::RSS::LibXML->new(version => '1.0', base => 'http://example.com/'); The XML base will be included only in RSS 2.0 output. You can also specify the encoding that you expect this RSS object to use when creating an RSS string XML::RSS::LiBXML->new(encoding => 'euc-jp'); =head2 parse($string) Parse a string containing RSS. =head2 parsefile($filename) Parse an RSS file specified by $filename =head2 channel(%args) =head2 add_item(%args) =head2 image(%args) =head2 textinput(%args) These methods are used to generate RSS. See the documentation for XML::RSS for details. Currently RSS version 0.9, 1.0, and 2.0 are supported. Additionally, add_item takes an extra parameter, "mode", which allows you to add items either in front of the list or at the end of the list: $rss->add_item( mode => "append", title => "...", link => "...", ); $rss->add_item( mode => "insert", title => "...", link => "...", ); By default, items are appended to the end of the list =head2 as_string($format) Return the string representation of the parsed RSS. If $format is true, this flag is passed to the underlying XML::LibXML object's toString() method. By default, $format is true. =head2 add_module(uri =E $uri, prefix =E $prefix) Adds a new module. You should do this before parsing the RSS. XML::RSS::LibXML understands a few modules by default: rdf => "http://www.w3.org/1999/02/22-rdf-syntax-ns#", dc => "http://purl.org/dc/elements/1.1/", syn => "http://purl.org/rss/1.0/modules/syndication/", admin => "http://webns.net/mvcb/", content => "http://purl.org/rss/1.0/modules/content/", cc => "http://web.resource.org/cc/", taxo => "http://purl.org/rss/1.0/modules/taxonomy/", So you do not need to add these explicitly. =head2 save($file) Saves the RSS to a file =head2 items() Syntactic sugar to allow statement like this: foreach my $item ($rss->items) { ... } Instead of foreach my $item (@{$rss->{items}}) { ... } In scalar context, returns the reference to the list of items. =head2 create_libxml() Creates, configures, and returns an XML::LibXML object. Used by C to instantiate the parser used to parse the feed. =head1 PERFORMANCE Here's a simple benchmark using benchmark.pl in this distribution, using XML::RSS 1.29_02 and XML::RSS::LibXML 0.30 daisuke@beefcake XML-RSS-LibXML$ perl -Mblib tools/benchmark.pl t/data/rss20.xml XML::RSS -> 1.29_02 XML::RSS::LibXML -> 0.30 Rate rss rss_libxml rss 25.6/s -- -67% rss_libxml 78.1/s 205% -- =head1 CAVEATS - Only first level data under EchannelE and EitemE tags are examined. So if you have complex data, this module will not pick it up. For most of the cases, this will suffice, though. - Namespace for namespaced attributes aren't properly parsed as part of the structure. Hopefully your RSS doesn't do something like this: You won't be able to get at "bar" in this case: $xml->{foo}{baz}; # "whee" $xml->{foo}{bar}{baz}; # nope - Some of the structures will need to be handled via XML::RSS::LibXML::MagicElement. For example, XML::RSS's SYNOPSIS shows a snippet like this: $rss->add_item(title => "GTKeyboard 0.85", # creates a guid field with permaLink=true permaLink => "http://freshmeat.net/news/1999/06/21/930003829.html", # alternately creates a guid field with permaLink=false # guid => "gtkeyboard-0.85 enclosure => { url=> 'http://example.com/torrent', type=>"application/x-bittorrent" }, description => 'blah blah' ); However, the enclosure element will need to be an object: enclosure => XML::RSS::LibXML::MagicElement->new( attributes => { url => 'http://example.com/torrent', type=>"application/x-bittorrent" }, ); - Some elements such as permaLink elements are not really parsed such that it can be serialized and parsed back and force. I could fix this, but that would break some compatibility with XML::RSS =head1 TODO Tests. Currently tests are simply stolen from XML::RSS. It would be nice to have tests that do more extensive testing for correctness =head1 SEE ALSO L, L, L =head1 COPYRIGHT AND LICENSE Copyright (c) 2005-2007 Daisuke Maki Edmaki@cpan.orgE, Tatsuhiko Miyagawa Emiyagawa@bulknews.netE. All rights reserved. Many tests were shamelessly borrowed from XML::RSS 1.29_02 Development partially funded by Brazil, Ltd. Ehttp://b.razil.jpE This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut libxml-rss-libxml-perl-0.3102+dfsg.orig/tools/0000755000175000017500000000000011637345541021331 5ustar nicholasnicholaslibxml-rss-libxml-perl-0.3102+dfsg.orig/tools/benchmark.pl0000644000175000017500000000125611401562045023611 0ustar nicholasnicholas#!perl use strict; use Benchmark qw(cmpthese); use XML::RSS; use XML::RSS::LibXML; print "XML::RSS -> $XML::RSS::VERSION\n"; print "XML::RSS::LibXML -> $XML::RSS::LibXML::VERSION\n"; my @files = @ARGV; my $i_rl = 0; my $i_r = 0; cmpthese(100, { rss_libxml => \&rss_libxml, rss => \&rss }); sub rss_libxml { my $rss = XML::RSS::LibXML->new; my $file = $files[$i_rl]; $rss->parsefile($file); if ($i_rl == $#files) { $i_rl = 0; } else { $i_rl++; } } sub rss { my $rss = XML::RSS->new; my $file = $files[$i_r]; $rss->parsefile($file); if ($i_r == $#files) { $i_r = 0; } else { $i_r++; } }libxml-rss-libxml-perl-0.3102+dfsg.orig/Changes0000644000175000017500000001574011633756743021501 0ustar nicholasnicholasChanges ======= Except where noted, all changes made by Daisuke Maki 0.3102 - 14 Sep 2011 * Allow upper uppercase letters as first character of namespace prefix [https://github.com/lestrrat/XML-RSS-LibXML/pull/2] (arc) 0.3101 - 06 Jul 2011 * Fix perl 5.14 qw() deprecation warnings (theory) * Fix some edge case errors cause by isa / UNIVERSAL::isa * Fix silly error detecting RSS 1.0 0.3100 - 22 Jun 2010 * Bunch of changes by David Wheeler, granting a minor version++ :) Note that changes about stringifying child elements may have affect some users. Drop me a line if you have a problem. - Add support for xml:base in RSS 2.0. (theory) - Parse and include items in RSS 2.0 feeds without a title or description. (theory) - The encoding() method now returns the encoding of a parsed feed. (theory) - Parser recognizes elements that should not have children and stringifies the children of such elements when it finds children. (theory) 0.3005 - 3 Jun 2010 - rt #58067 Document create_libxml() (theory) - rt #58068 Add support for RSS 0.92 (theory) 0.3004 - 20 Jan 2009 - rt #42536. Some files were removed from the distro for the time being. (I don't have the time to re-create these for now -- patch submissions are most welcome) 0.3003 - 26 Nov 2008 - Try not to die if we encountered a Broken tag in RSS 2.0 - We won't test RSS 0.9x. This is due to the nature of libxml wanting to validate the DTD, when the namespaces have been changed (see http://blog.netscape.com/2008/01/22/rss-specifications-moving-to-rss-advisory-board/) We could use a hackish fix, but we won't, as it may change the behavior for this widely used format (which is surprisingly large number). So instead, we'll just silence the tests, to stop odd failures from occurring - For practical purposes, we use the old namespace unless asked otherwise via XML_RSS_LIBXML_USE_NEW_RSS09 environment variable 0.3002 - 08 Oct 2007 - Apply fix from AAR (rt #29683) to make things work with XML::LibXML >= 1.64 0.3001 - 09 May 2007 - Fix Makefile.PL dependency - Remove stray debug output 0.30 - 08 May 2007 - Move to Module::Install - Tweak tests. 0.30_02 - 23 Mar 2007 - Make things more compatible with t/items-are-0.t 0.30_01 - 14 Mar 2007 - BEWARE! MAJOR CHANGE IN CODE! - Compatiblity with XML::RSS-1.29_02's test suite. - Completely redo the internal structure in a saner manner. 0.23 - 05 Jul 2006 - Apply multiple enclosure patch from SERGEYCHE (rt #20285) This allows you to *generate* RSS with multiple enclosures 0.22 - 28 Jun 2006 - Remove stray files and debug statements (rt #19939) 0.21 - 31 May 2006 - Repository blunder messes up the distro. fixed. Reported by Tatsuhiko Miyagawa 0.20 - 14 May 2006 - Set $rss->{version} for compatibility. - As a result, we no longer set or depend on $rss->{_internal}{version}. If you saw it and used it, then stop doing that ;) 0.19 - 17 Apr 2006 - Fixed bug where $rss->channel('title') and such would give you the non-UTF8 representation when another encoding is specified in the RSS document (reported by Tatsuhiko Miyagawa) 0.18 - 06 Mar 2006 - Fixed bug where extra modules were not included in the output string. (reported by Tatsuhiko Miyagawa) 0.17 - 05 Mar 2006 - s/getValue/getData/g (reported by Tatsuhiko Miyagawa) - Add caveat: namespaced attributes aren't parsed correctly 0.16 - 28 Feb 2006 - Fix namespace support for RSS 2.0. Reported by various people. 0.15 - 06 Jan 2006 - Fix cpan #16748, and now we can parse RSS 0.91. Patch provided by aar@cpan.org - Add tests for 0.91 0.14 - 20 Nov 2005 - Bah, stupid POD msitakes. No code change 0.13 - 18 Nov 2005 - XML::RSS::LibXML wasn't conforming to the XML::RSS interface on channel(), image() and textinput() methods. Reported by Taro Minowa. - Make POD tests run only on disttest 0.12 - 09 Nov 2005 - Ugh, need to use Test::Pod::Coverage more carefully. Reported by various people. 0.11 - 19 Oct 2005 - Most files were mysteriously not included in the previous release. 0.10 - 18 Oct 2005 - Mainly a kwalitee improvement release. Added bunch of POD and tests - Fix: Allow XML::RSS::LibXML constructor to accept encoding. Currently this just controls the output encoding, not the internal representation 0.09 - 17 Aug 2005 - Various fixes to make $rss->parse($rss->as_string) work. However, it turns out that since XML::RSS doesn't parse <-> generate RSS in a way that allows 100% of the cases to work, I've decided to stop it at a "good enough" state. - taxo: parses correctly - use exists() to prevent autovivification 0.08 - 17 Aug 2005 ("Insanity" Release) - In a fit of insanity, I've implemented RSS generation code. Currently RSS version 0.9, 1.0, and 2.0 are supported. - You can now parse RSS, serialize it via as_string(), parse it again, and get (almost) the same structure back. - Separated out RSS parsing/generation code from main module. These modules are loaded as necessary, or by demand. - Updated benchmark. 0.07 - 15 Aug 205 - Document MagicElements in the main docs. - Create XPathContext at parse time, andd call registerNs() only then. - Update benchmark for fairness. - Changed code to use eh, cleaner Test::More code - Removed unused code 0.06 - 10 Aug 2005 ("Magic Is In The Air" Release) - Introduce MagicElement.pm. This allows us to parse RSS elements that have attributes without sacrificing the interface (hopefully). Inspired by patch from Taro Minowa. 0.05 - 04 Jul 2005 ("I'm so dumb" Release) - Make $item->{$namespace_uri}->{$tag} work. Patch by Naoya Ito. - Add corresponding tests. Patch by Naoya Ito. 0.04 - 21 Jun 2005 - No code change. - Clarify compatibility issues. - Fix typos 0.03 - 21 Jun 2005 - channel() fix by Naoya Ito (compatibility with XML::RSS) 0.02 - 21 Jun 2005 - Doc tweaks. - This be 0.02. Remember to read the backward incompatible changes below. 0.01_01 - 20 Jun 2005 - Typo in Build.PL/Makefile.PL (Tatsuhiko Miyagawa) **** Backwards Incompatible Change **** - Make namespace handling the same as XML::RSS - e.g., is now parsed as $item->{content}->{encoded}. (thanks to Tatsuhiko Miyagawa for suggestions) - Remove add_parse_context(), as it is no longer necessary. - Parsing is now done only on nodes that are immediately under and . This is not correct spec-wise, but it does the job for most of the RSS out there. 0.01 - 14 Jun 2005 - Seems like some people just think about the same thing. Tatsuhiko Miyagawa caught me doing some of the same thing he was doing in an unrelease module, so merged some features from his :) - Added add_module() (Tatsuhiko Miyagawa) - Added as_string() (Tatsuhiko Miyagawa) - Added add_parse_context(). - Added fields to be parsed by default. - Changed internal representation a bit. 0.01_02 - 14 June 2005 - Doc screw up 0.01_01 - 14 June 2005 - Initial CPAN releaselibxml-rss-libxml-perl-0.3102+dfsg.orig/xt/0000755000175000017500000000000011633756770020632 5ustar nicholasnicholaslibxml-rss-libxml-perl-0.3102+dfsg.orig/xt/0.92-parse.t0000644000175000017500000000366711401623101022501 0ustar nicholasnicholasuse strict; use Test::More; use constant RSS_VERSION => "0.92"; use constant RSS_CHANNEL_TITLE => "Example 0.92 Channel"; use constant RSS_DOCUMENT => qq( Example 0.92 Channel http://example.com To lead by example News for September the Second http://example.com/2002/09/02 other things happened today News for September the First http://example.com/2002/09/01 something happened today ); use_ok("XML::RSS::LibXML"); my $xml = XML::RSS::LibXML->new(); isa_ok($xml,"XML::RSS::LibXML"); eval { $xml->parse(RSS_DOCUMENT); }; is($@,'',"Parsed RSS feed"); cmp_ok($xml->{'_internal'}->{'version'}, "eq", RSS_VERSION, "Is RSS version ".RSS_VERSION); cmp_ok($xml->{channel}->{'title'}, "eq", RSS_CHANNEL_TITLE, "Feed title is ".RSS_CHANNEL_TITLE); cmp_ok(ref($xml->{items}), "eq", "ARRAY", "\$xml->{items} is an ARRAY ref"); my $ok = 1; foreach my $item (@{$xml->{items}}) { foreach my $el ("title","link","description") { if (! exists $item->{$el}) { $ok = 0; last; } } last if (! $ok); } ok($ok,"All items have title,link and description elements"); done_testing(); __END__ =head1 NAME 0.92-parse.t - tests for parsing RSS 0.92 data with XML::RSS::LibXML.pm =head1 SYNOPSIS use Test::Harness qw (runtests); runtests (./XML-RSS/t/*.t); =head1 DESCRIPTION Tests for parsing RSS 0.92 data with XML::RSS::LibXML.pm =head1 VERSION $Revision: 1.2 $ =head1 DATE $Date: 2002/11/19 23:58:03 $ =head1 AUTHOR Aaron Straup Cope =head1 SEE ALSO http://my.netscape.com/publish/formats/rss-spec-0.92.html http://backend.userland.com/rss092 =cut libxml-rss-libxml-perl-0.3102+dfsg.orig/xt/0.91-parse.t0000644000175000017500000000367011401623101022472 0ustar nicholasnicholasuse strict; use Test::More; use constant RSS_VERSION => "0.91"; use constant RSS_CHANNEL_TITLE => "Example 0.91 Channel"; use constant RSS_DOCUMENT => qq( Example 0.91 Channel http://example.com To lead by example News for September the Second http://example.com/2002/09/02 other things happened today News for September the First http://example.com/2002/09/01 something happened today ); use_ok("XML::RSS::LibXML"); my $xml = XML::RSS::LibXML->new(); isa_ok($xml,"XML::RSS::LibXML"); eval { $xml->parse(RSS_DOCUMENT); }; is($@,'',"Parsed RSS feed"); cmp_ok($xml->{'_internal'}->{'version'}, "eq", RSS_VERSION, "Is RSS version ".RSS_VERSION); cmp_ok($xml->{channel}->{'title'}, "eq", RSS_CHANNEL_TITLE, "Feed title is ".RSS_CHANNEL_TITLE); cmp_ok(ref($xml->{items}), "eq", "ARRAY", "\$xml->{items} is an ARRAY ref"); my $ok = 1; foreach my $item (@{$xml->{items}}) { foreach my $el ("title","link","description") { if (! exists $item->{$el}) { $ok = 0; last; } } last if (! $ok); } ok($ok,"All items have title,link and description elements"); done_testing(); __END__ =head1 NAME 0.91-parse.t - tests for parsing RSS 0.91 data with XML::RSS::LibXML.pm =head1 SYNOPSIS use Test::Harness qw (runtests); runtests (./XML-RSS/t/*.t); =head1 DESCRIPTION Tests for parsing RSS 0.91 data with XML::RSS::LibXML.pm =head1 VERSION $Revision: 1.2 $ =head1 DATE $Date: 2002/11/19 23:58:03 $ =head1 AUTHOR Aaron Straup Cope =head1 SEE ALSO http://my.netscape.com/publish/formats/rss-spec-0.91.html http://backend.userland.com/rss091 =cut libxml-rss-libxml-perl-0.3102+dfsg.orig/xt/0.9-generate.t0000644000175000017500000000101111401623101023054 0ustar nicholasnicholasuse strict; use Test::More; ok(1, "More tests soon"); done_testing(); __END__ =head1 NAME 0.9-generate.t - tests for generating RSS 0.90 data with XML::RSS::LibXML.pm =head1 SYNOPSIS use Test::Harness qw (runtests); runtests (./XML-RSS/t/*.t); =head1 DESCRIPTION Tests for generating RSS 0.90 data with XML::RSS::LibXML.pm =head1 VERSION $Revision: 1.2 $ =head1 DATE $Date: 2003/02/20 17:12:44 $ =head1 AUTHOR Aaron Straup Cope =head1 SEE ALSO http://www.purplepages.ie/RSS/netscape/rss0.90.html =cut libxml-rss-libxml-perl-0.3102+dfsg.orig/xt/pod.t0000644000175000017500000000013311404267737021572 0ustar nicholasnicholasuse strict; use Test::More; use Test::Requires 'Test::Pod'; Test::Pod::all_pod_files_ok(); libxml-rss-libxml-perl-0.3102+dfsg.orig/xt/0.9-parse.t0000644000175000017500000000400211401623101022377 0ustar nicholasnicholasuse strict; use Test::More; use constant RSS_VERSION => "0.9"; use constant RSS_CHANNEL_TITLE => "Example 0.9 Channel"; use constant RSS_DOCUMENT => qq( Example 0.9 Channel http://www.example.com To lead by example Mozilla http://www.example.com/images/whoisonfirst.gif http://www.example.com News for September the second http://www.example.com/2002/09/02 News for September the first http://www.example.com/2002/09/01 ); use_ok("XML::RSS::LibXML"); my $xml = XML::RSS::LibXML->new(); isa_ok($xml,"XML::RSS::LibXML"); eval { $xml->parse(RSS_DOCUMENT); }; is($@,'',"Parsed RSS feed"); cmp_ok($xml->{'_internal'}->{'version'}, "eq", RSS_VERSION, "Is RSS version ".RSS_VERSION); cmp_ok($xml->{channel}->{'title'}, "eq", RSS_CHANNEL_TITLE, "Feed title is ".RSS_CHANNEL_TITLE); cmp_ok(ref($xml->{items}), "eq", "ARRAY", "\$xml->{items} is an ARRAY ref"); my $ok = 1; foreach my $item (@{$xml->{items}}) { foreach my $el ("title","link") { if (! exists $item->{$el}) { $ok = 0; last; } } last if (! $ok); } ok($ok,"All items have title and link elements"); done_testing(); __END__ =head1 NAME 0.9-parse.t - tests for parsing RSS 0.90 data with XML::RSS::LibXML.pm =head1 SYNOPSIS use Test::Harness qw (runtests); runtests (./XML-RSS/t/*.t); =head1 DESCRIPTION Tests for parsing RSS 0.90 data with XML::RSS::LibXML.pm =head1 VERSION $Revision: 1.2 $ =head1 DATE $Date: 2002/11/20 00:01:44 $ =head1 AUTHOR Aaron Straup Cope =head1 SEE ALSO http://www.purplepages.ie/RSS/netscape/rss0.90.html =cut libxml-rss-libxml-perl-0.3102+dfsg.orig/xt/0.9-strict.t0000644000175000017500000001056011401623101022603 0ustar nicholasnicholas#!/usr/bin/perl # Test the strict mode of RSS 0.9 and RSS 0.91 use strict; use warnings; use Test::More; use XML::RSS::LibXML; sub item_throws_like { local $Test::Builder::Level = $Test::Builder::Level + 1; my ($rss, $params, $regex, $msg) = @_; eval { $rss->add_item(@$params); }; like ($@, $regex, $msg); } { my $rss = XML::RSS::LibXML->new(version => "0.9"); $rss->strict(1); $rss->channel( title => "freshmeat.net", link => "http://freshmeat.net", description => "the one-stop-shop for all your Linux software needs", ); # TEST item_throws_like($rss, [link => "http://foobar.tld/from/"], qr{\Atitle and link elements are required}, "strict - checking for exception on non-specified title" ); # TEST item_throws_like($rss, [title => "From Foobar"], qr{\Atitle and link elements are required}, "strict - checking for exception on non-specified link" ); # TEST item_throws_like($rss, [link => "http://foobar.tld/", title => ("Very long title indeed" x 50)], qr{\Atitle cannot exceed}, "strict - checking for long title" ); # TEST item_throws_like($rss, [ link => "http://" . ("foobarminimoni" x 200) . ".tld/", title => "Short Title" ], qr{\Alink cannot exceed}, "strict - checking for long link" ); # TEST item_throws_like($rss, [ link => "http://foobar.tld/from/", title => "Short Title", description => ("This description is way too long!" x 100), ], qr{\Adescription cannot exceed}, "strict - checking for a long description" ); } { my $rss = XML::RSS::LibXML->new(version => "0.9"); $rss->strict(1); $rss->channel( title => "freshmeat.net", link => "http://freshmeat.net", description => "the one-stop-shop for all your Linux software needs", ); foreach my $i (1 .. 15) { $rss->add_item( link => "http://foobar.tld/item-$i", title => "Item $i", ); } # TEST item_throws_like($rss, [ link => "http://foobar.tld/from/", title => "Short Title", description => "Good description", ], qr{\Atotal items cannot exceed}, "strict - checking for too many items" ); } { my $rss = XML::RSS::LibXML->new(version => "0.9"); $rss->strict(1); $rss->channel( title => "freshmeat.net", link => "http://freshmeat.net", description => "the one-stop-shop for all your Linux software needs", stupid_key => ("I think therefore I am." x 1000), ); # TEST ok (1, "Can add unknown keys of unlimited size without restriction"); } { my $rss = XML::RSS::LibXML->new(version => "0.9"); $rss->strict(1); eval { $rss->channel( title => "freshmeat.net", link => "http://freshmeat.net", description => ("I think therefore I am." x 1000), ); }; # TEST like ($@, qr{\Adescription cannot exceed 500 characters in length}, "Testing for exception thrown on a very long key" ); } { my $rss = XML::RSS::LibXML->new(version => "0.9"); $rss->strict(1); eval { $rss->skipHours( hour => 5, ); }; # TEST like ($@, qr{\AUnregistered entity: Can't access skipHours field in object of class}, "Testing for exception thrown on an unknown field" ); } { my $rss = XML::RSS::LibXML->new(version => "0.9"); $rss->channel( title => "freshmeat.net", link => "http://freshmeat.net", description => "the one-stop-shop for all your Linux software needs", ); # TEST is ($rss->channel()->{title}, "freshmeat.net", "Testing for an AUTOLOAD accessor with 0 arguments" ); # TEST is ($rss->channel('title'), "freshmeat.net", "Testing for an AUTOLOAD accessor with 1 argument" ); } { my $rss = XML::RSS::LibXML->new(version => "0.91"); $rss->strict(1); eval { $rss->skipDays( day => "FoolambdaCroakThemOfMonetaryJudgement" ); }; # TEST like ($@, qr{\Aday cannot exceed 10 characters in length}, "Testing for exception thrown on a key for 0.91" ); } done_testing; libxml-rss-libxml-perl-0.3102+dfsg.orig/xt/pod-coverage.t0000644000175000017500000000026311404267676023371 0ustar nicholasnicholasuse strict; use Test::More; use Test::Requires 'Test::Pod::Coverage'; plan tests => 1; Test::Pod::Coverage::pod_coverage_ok( "XML::RSS::LibXML", "XML::RSS::LibXML is covered" );