r2107 - in packages: . libxml-feed-perl libxml-feed-perl/branches
libxml-feed-perl/branches/upstream
libxml-feed-perl/branches/upstream/current
libxml-feed-perl/branches/upstream/current/inc
libxml-feed-perl/branches/upstream/current/inc/ExtUtils
libxml-feed-perl/branches/upstream/current/inc/Module
libxml-feed-perl/branches/upstream/current/inc/Module/Install
libxml-feed-perl/branches/upstream/current/lib
libxml-feed-perl/branches/upstream/current/lib/XML
libxml-feed-perl/branches/upstream/current/lib/XML/Feed
libxml-feed-perl/branches/upstream/current/t
libxml-feed-perl/branches/upstream/current/t/samples
Jaldhar H. Vyas
jaldhar at costa.debian.org
Fri Feb 10 22:40:24 UTC 2006
Author: jaldhar
Date: 2006-02-10 22:39:48 +0000 (Fri, 10 Feb 2006)
New Revision: 2107
Added:
packages/libxml-feed-perl/
packages/libxml-feed-perl/branches/
packages/libxml-feed-perl/branches/upstream/
packages/libxml-feed-perl/branches/upstream/current/
packages/libxml-feed-perl/branches/upstream/current/Build.PL
packages/libxml-feed-perl/branches/upstream/current/Changes
packages/libxml-feed-perl/branches/upstream/current/MANIFEST
packages/libxml-feed-perl/branches/upstream/current/META.yml
packages/libxml-feed-perl/branches/upstream/current/Makefile.PL
packages/libxml-feed-perl/branches/upstream/current/README
packages/libxml-feed-perl/branches/upstream/current/inc/
packages/libxml-feed-perl/branches/upstream/current/inc/ExtUtils/
packages/libxml-feed-perl/branches/upstream/current/inc/ExtUtils/AutoInstall.pm
packages/libxml-feed-perl/branches/upstream/current/inc/Module/
packages/libxml-feed-perl/branches/upstream/current/inc/Module/Install.pm
packages/libxml-feed-perl/branches/upstream/current/inc/Module/Install/
packages/libxml-feed-perl/branches/upstream/current/inc/Module/Install/AutoInstall.pm
packages/libxml-feed-perl/branches/upstream/current/inc/Module/Install/Base.pm
packages/libxml-feed-perl/branches/upstream/current/inc/Module/Install/Build.pm
packages/libxml-feed-perl/branches/upstream/current/inc/Module/Install/Can.pm
packages/libxml-feed-perl/branches/upstream/current/inc/Module/Install/Fetch.pm
packages/libxml-feed-perl/branches/upstream/current/inc/Module/Install/Include.pm
packages/libxml-feed-perl/branches/upstream/current/inc/Module/Install/Makefile.pm
packages/libxml-feed-perl/branches/upstream/current/inc/Module/Install/Metadata.pm
packages/libxml-feed-perl/branches/upstream/current/inc/Module/Install/Win32.pm
packages/libxml-feed-perl/branches/upstream/current/inc/Module/Install/WriteAll.pm
packages/libxml-feed-perl/branches/upstream/current/lib/
packages/libxml-feed-perl/branches/upstream/current/lib/XML/
packages/libxml-feed-perl/branches/upstream/current/lib/XML/Feed.pm
packages/libxml-feed-perl/branches/upstream/current/lib/XML/Feed/
packages/libxml-feed-perl/branches/upstream/current/lib/XML/Feed/Atom.pm
packages/libxml-feed-perl/branches/upstream/current/lib/XML/Feed/Content.pm
packages/libxml-feed-perl/branches/upstream/current/lib/XML/Feed/Entry.pm
packages/libxml-feed-perl/branches/upstream/current/lib/XML/Feed/RSS.pm
packages/libxml-feed-perl/branches/upstream/current/t/
packages/libxml-feed-perl/branches/upstream/current/t/00-compile.t
packages/libxml-feed-perl/branches/upstream/current/t/01-parse.t
packages/libxml-feed-perl/branches/upstream/current/t/02-create.t
packages/libxml-feed-perl/branches/upstream/current/t/04-splice.t
packages/libxml-feed-perl/branches/upstream/current/t/samples/
packages/libxml-feed-perl/branches/upstream/current/t/samples/atom.xml
packages/libxml-feed-perl/branches/upstream/current/t/samples/rss10.xml
packages/libxml-feed-perl/branches/upstream/current/t/samples/rss20-no-summary.xml
packages/libxml-feed-perl/branches/upstream/current/t/samples/rss20.xml
packages/libxml-feed-perl/tags/
Log:
[svn-inject] Installing original source of libxml-feed-perl
Added: packages/libxml-feed-perl/branches/upstream/current/Build.PL
===================================================================
--- packages/libxml-feed-perl/branches/upstream/current/Build.PL 2006-02-09 19:28:39 UTC (rev 2106)
+++ packages/libxml-feed-perl/branches/upstream/current/Build.PL 2006-02-10 22:39:48 UTC (rev 2107)
@@ -0,0 +1,3 @@
+# $Id: Build.PL 918 2004-05-29 17:29:55Z btrott $
+
+require 'Makefile.PL';
Added: packages/libxml-feed-perl/branches/upstream/current/Changes
===================================================================
--- packages/libxml-feed-perl/branches/upstream/current/Changes 2006-02-09 19:28:39 UTC (rev 2106)
+++ packages/libxml-feed-perl/branches/upstream/current/Changes 2006-02-10 22:39:48 UTC (rev 2107)
@@ -0,0 +1,49 @@
+# $Id: Changes 1872 2005-08-12 04:28:42Z btrott $
+
+Revision history for XML::Feed
+
+0.07 2005.08.11
+ - Added XML::Feed::splice method, to make feed splicing easier.
+ - Fixed some unitialized value warnings.
+
+0.06 2005.08.09
+ - Added Feed->convert and Entry->convert methods to allow conversion
+ between formats.
+ - Added ability to create new Feed and Entry objects, add entries, etc.
+ - Added $PREFERRED_PARSER variable to allow usage of compatible
+ RSS parsers, like XML::RSS::LibXML. Thanks to Tatsuhiko Miyagawa
+ for the patch.
+
+0.05 2005.01.01
+ - Call URI::Fetch::URI_GONE() instead of URI::Fetch::FEED_GONE(). Thanks
+ to Richard Clamp for the patch.
+
+0.04 2004.12.31
+ - Use "loose" parsing in DateTime::Format::Mail so that we don't die
+ on invalid RFC-822 dates.
+ - XML::Feed::Entry->link on RSS feeds will now use a <guid> element
+ if a <link> element isn't found.
+ - Switched to using URI::Fetch when fetching feeds. Since we're not
+ storing or caching feeds currently, this basically just buys us
+ GZIP support, but that's something.
+
+0.03 2004.10.09
+ - Fixed bug with feed format detection: properly detect format even in
+ feeds with <!DOCTYPE> at the top. (Thanks to Alberto Quario for the
+ note.)
+ - Use Class::ErrorHandler instead of XML::Feed::ErrorHandler.
+ - Moved auto-discovery code into Feed::Find. XML::Feed->find_feeds is
+ now just a wrapper around that module.
+
+0.02 2004.07.29
+ - Changed behavior of Entry->summary to prevent it from returning the
+ full contents of the entry. Now, in an RSS feed, summary only returns
+ a value if there is both a <description> element *and* one of the
+ other elements typically used for the full content.
+ - Changed content model for Entry->content and Entry->summary.
+ They now return an XML::Feed::Content object, which knows about both
+ the actual content and the MIME type of the content.
+ - Improved feed format detection by first tag in feed.
+
+0.01 2004.06.01
+ - Initial distribution.
Added: packages/libxml-feed-perl/branches/upstream/current/MANIFEST
===================================================================
--- packages/libxml-feed-perl/branches/upstream/current/MANIFEST 2006-02-09 19:28:39 UTC (rev 2106)
+++ packages/libxml-feed-perl/branches/upstream/current/MANIFEST 2006-02-10 22:39:48 UTC (rev 2107)
@@ -0,0 +1,31 @@
+Build.PL
+Changes
+inc/ExtUtils/AutoInstall.pm
+inc/Module/Install.pm
+inc/Module/Install/AutoInstall.pm
+inc/Module/Install/Base.pm
+inc/Module/Install/Build.pm
+inc/Module/Install/Can.pm
+inc/Module/Install/Fetch.pm
+inc/Module/Install/Include.pm
+inc/Module/Install/Makefile.pm
+inc/Module/Install/Metadata.pm
+inc/Module/Install/Win32.pm
+inc/Module/Install/WriteAll.pm
+lib/XML/Feed.pm
+lib/XML/Feed/Atom.pm
+lib/XML/Feed/Content.pm
+lib/XML/Feed/Entry.pm
+lib/XML/Feed/RSS.pm
+Makefile.PL
+MANIFEST This list of files
+META.yml
+README
+t/00-compile.t
+t/01-parse.t
+t/02-create.t
+t/04-splice.t
+t/samples/atom.xml
+t/samples/rss10.xml
+t/samples/rss20-no-summary.xml
+t/samples/rss20.xml
Added: packages/libxml-feed-perl/branches/upstream/current/META.yml
===================================================================
--- packages/libxml-feed-perl/branches/upstream/current/META.yml 2006-02-09 19:28:39 UTC (rev 2106)
+++ packages/libxml-feed-perl/branches/upstream/current/META.yml 2006-02-10 22:39:48 UTC (rev 2107)
@@ -0,0 +1,24 @@
+name: XML-Feed
+version: 0.07
+abstract: XML Syndication Feed Support
+author: Six Apart <cpan at sixapart.com>
+license: perl
+distribution_type: module
+requires:
+ Class::ErrorHandler: 0
+ Feed::Find: 0
+ URI::Fetch: 0
+ XML::RSS: 1.01
+ XML::Atom: 0.08
+ LWP: 0
+ HTML::Parser: 0
+ URI: 0
+ DateTime: 0
+ DateTime::Format::Mail: 0
+ DateTime::Format::W3CDTF: 0
+ List::Util: 0
+no_index:
+ directory:
+ - t
+ - inc
+generated_by: Module::Install version 0.36
Added: packages/libxml-feed-perl/branches/upstream/current/Makefile.PL
===================================================================
--- packages/libxml-feed-perl/branches/upstream/current/Makefile.PL 2006-02-09 19:28:39 UTC (rev 2106)
+++ packages/libxml-feed-perl/branches/upstream/current/Makefile.PL 2006-02-10 22:39:48 UTC (rev 2107)
@@ -0,0 +1,31 @@
+# $Id: Makefile.PL 1869 2005-08-10 00:02:25Z btrott $
+
+use inc::Module::Install;
+
+name('XML-Feed');
+abstract('XML Syndication Feed Support');
+author('Six Apart <cpan at sixapart.com>');
+version_from('lib/XML/Feed.pm');
+license('perl');
+no_index(directory => 't');
+sign(1);
+
+include('ExtUtils::AutoInstall');
+
+requires('Class::ErrorHandler');
+requires('Feed::Find');
+requires('URI::Fetch');
+requires('XML::RSS' => 1.01);
+requires('XML::Atom' => 0.08);
+requires('LWP');
+requires('HTML::Parser');
+requires('URI');
+requires('DateTime');
+requires('DateTime::Format::Mail');
+requires('DateTime::Format::W3CDTF');
+requires('List::Util');
+
+auto_include();
+auto_install();
+
+&WriteAll;
Added: packages/libxml-feed-perl/branches/upstream/current/README
===================================================================
--- packages/libxml-feed-perl/branches/upstream/current/README 2006-02-09 19:28:39 UTC (rev 2106)
+++ packages/libxml-feed-perl/branches/upstream/current/README 2006-02-10 22:39:48 UTC (rev 2107)
@@ -0,0 +1,37 @@
+$Id: README 1869 2005-08-10 00:02:25Z btrott $
+
+This is XML::Feed, an abstraction above the RSS and Atom syndication
+feed formats. It supports both parsing and autodiscovery of feeds.
+
+PREREQUISITES
+
+ * Class::ErrorHandler
+ * XML::RSS
+ * XML::Atom
+ * LWP
+ * HTML::Parser
+ * URI
+ * DateTime
+ * DateTime::Format::Mail
+ * DateTime::Format::W3CDTF
+ * List::Util
+ * Feed::Find
+ * URI::Fetch
+
+INSTALLATION
+
+XML::Feed installation is straightforward. If your CPAN shell
+is set up, you should just be able to do
+
+ % perl -MCPAN -e 'install XML::Feed'
+
+Download it, unpack it, then build it as per the usual:
+
+ % perl Makefile.PL
+ % make && make test
+
+Then install it:
+
+ % make install
+
+Six Apart / cpan at sixapart.com
Added: packages/libxml-feed-perl/branches/upstream/current/inc/ExtUtils/AutoInstall.pm
===================================================================
--- packages/libxml-feed-perl/branches/upstream/current/inc/ExtUtils/AutoInstall.pm 2006-02-09 19:28:39 UTC (rev 2106)
+++ packages/libxml-feed-perl/branches/upstream/current/inc/ExtUtils/AutoInstall.pm 2006-02-10 22:39:48 UTC (rev 2107)
@@ -0,0 +1,631 @@
+#line 1 "inc/ExtUtils/AutoInstall.pm - /Library/Perl/5.8.1/ExtUtils/AutoInstall.pm"
+# $File: //member/autrijus/ExtUtils-AutoInstall/lib/ExtUtils/AutoInstall.pm $
+# $Revision: #9 $ $Change: 9532 $ $DateTime: 2004/01/01 06:47:30 $ vim: expandtab shiftwidth=4
+
+package ExtUtils::AutoInstall;
+$ExtUtils::AutoInstall::VERSION = '0.56';
+
+use strict;
+use Cwd ();
+use ExtUtils::MakeMaker ();
+
+#line 282
+
+# special map on pre-defined feature sets
+my %FeatureMap = (
+ '' => 'Core Features', # XXX: deprecated
+ '-core' => 'Core Features',
+);
+
+# various lexical flags
+my (@Missing, @Existing, %DisabledTests, $UnderCPAN, $HasCPANPLUS);
+my ($Config, $CheckOnly, $SkipInstall, $AcceptDefault, $TestOnly);
+my ($PostambleActions, $PostambleUsed);
+
+$AcceptDefault = 1 unless -t STDIN; # non-interactive session
+_init();
+
+sub missing_modules {
+ return @Missing;
+}
+
+sub do_install {
+ __PACKAGE__->install(
+ [ UNIVERSAL::isa($Config, 'HASH') ? %{$Config} : @{$Config}],
+ @Missing,
+ );
+}
+
+# initialize various flags, and/or perform install
+sub _init {
+ foreach my $arg (@ARGV, split(/[\s\t]+/, $ENV{PERL_EXTUTILS_AUTOINSTALL} || '')) {
+ if ($arg =~ /^--config=(.*)$/) {
+ $Config = [ split(',', $1) ];
+ }
+ elsif ($arg =~ /^--installdeps=(.*)$/) {
+ __PACKAGE__->install($Config, @Missing = split(/,/, $1));
+ exit 0;
+ }
+ elsif ($arg =~ /^--default(?:deps)?$/) {
+ $AcceptDefault = 1;
+ }
+ elsif ($arg =~ /^--check(?:deps)?$/) {
+ $CheckOnly = 1;
+ }
+ elsif ($arg =~ /^--skip(?:deps)?$/) {
+ $SkipInstall = 1;
+ }
+ elsif ($arg =~ /^--test(?:only)?$/) {
+ $TestOnly = 1;
+ }
+ }
+}
+
+# overrides MakeMaker's prompt() to automatically accept the default choice
+sub _prompt {
+ goto &ExtUtils::MakeMaker::prompt unless $AcceptDefault;
+
+ my ($prompt, $default) = @_;
+ my $y = ($default =~ /^[Yy]/);
+
+ print $prompt, ' [', ($y ? 'Y' : 'y'), '/', ($y ? 'n' : 'N'), '] ';
+ print "$default\n";
+ return $default;
+}
+
+# the workhorse
+sub import {
+ my $class = shift;
+ my @args = @_ or return;
+ my $core_all;
+
+ print "*** $class version ".$class->VERSION."\n";
+ print "*** Checking for dependencies...\n";
+
+ my $cwd = Cwd::cwd();
+
+ $Config = [];
+
+ my $maxlen = length((sort { length($b) <=> length($a) }
+ grep { /^[^\-]/ }
+ map { ref($_) ? keys %{ref($_) eq 'HASH' ? $_ : +{@{$_}}} : '' }
+ map { +{@args}->{$_} }
+ grep { /^[^\-]/ or /^-core$/i } keys %{+{@args}})[0]);
+
+ while (my ($feature, $modules) = splice(@args, 0, 2)) {
+ my (@required, @tests, @skiptests);
+ my $default = 1;
+ my $conflict = 0;
+
+ if ($feature =~ m/^-(\w+)$/) {
+ my $option = lc($1);
+
+ # check for a newer version of myself
+ _update_to($modules, @_) and return if $option eq 'version';
+
+ # sets CPAN configuration options
+ $Config = $modules if $option eq 'config';
+
+ # promote every features to core status
+ $core_all = ($modules =~ /^all$/i) and next
+ if $option eq 'core';
+
+ next unless $option eq 'core';
+ }
+
+ print "[".($FeatureMap{lc($feature)} || $feature)."]\n";
+
+ $modules = [ %{$modules} ] if UNIVERSAL::isa($modules, 'HASH');
+
+ unshift @$modules, -default => &{shift(@$modules)}
+ if (ref($modules->[0]) eq 'CODE'); # XXX: bugward combatability
+
+ while (my ($mod, $arg) = splice(@$modules, 0, 2)) {
+ if ($mod =~ m/^-(\w+)$/) {
+ my $option = lc($1);
+
+ $default = $arg if ($option eq 'default');
+ $conflict = $arg if ($option eq 'conflict');
+ @tests = @{$arg} if ($option eq 'tests');
+ @skiptests = @{$arg} if ($option eq 'skiptests');
+
+ next;
+ }
+
+ printf("- %-${maxlen}s ...", $mod);
+
+ # XXX: check for conflicts and uninstalls(!) them.
+ if (defined(my $cur = _version_check(_load($mod), $arg ||= 0))) {
+ print "loaded. ($cur".($arg ? " >= $arg" : '').")\n";
+ push @Existing, $mod => $arg;
+ $DisabledTests{$_} = 1 for map { glob($_) } @skiptests;
+ }
+ else {
+ print "missing." . ($arg ? " (would need $arg)" : '') . "\n";
+ push @required, $mod => $arg;
+ }
+ }
+
+ next unless @required;
+
+ my $mandatory = ($feature eq '-core' or $core_all);
+
+ if (!$SkipInstall and ($CheckOnly or _prompt(
+ qq{==> Auto-install the }. (@required / 2).
+ ($mandatory ? ' mandatory' : ' optional').
+ qq{ module(s) from CPAN?}, $default ? 'y' : 'n',
+ ) =~ /^[Yy]/)) {
+ push (@Missing, @required);
+ $DisabledTests{$_} = 1 for map { glob($_) } @skiptests;
+ }
+
+ elsif (!$SkipInstall and $default and $mandatory and _prompt(
+ qq{==> The module(s) are mandatory! Really skip?}, 'n',
+ ) =~ /^[Nn]/) {
+ push (@Missing, @required);
+ $DisabledTests{$_} = 1 for map { glob($_) } @skiptests;
+ }
+
+ else {
+ $DisabledTests{$_} = 1 for map { glob($_) } @tests;
+ }
+ }
+
+ _check_lock(); # check for $UnderCPAN
+
+ if (@Missing and not ($CheckOnly or $UnderCPAN)) {
+ require Config;
+ print "*** Dependencies will be installed the next time you type '$Config::Config{make}'.\n";
+ # make an educated guess of whether we'll need root permission.
+ print " (You may need to do that as the 'root' user.)\n" if eval '$>';
+ }
+ print "*** $class configuration finished.\n";
+
+ chdir $cwd;
+
+ # import to main::
+ no strict 'refs';
+ *{'main::WriteMakefile'} = \&Write if caller(0) eq 'main';
+}
+
+# CPAN.pm is non-reentrant, so check if we're under it and have no CPANPLUS
+sub _check_lock {
+ return unless @Missing;
+ return if _has_cpanplus();
+
+ require CPAN; CPAN::Config->load;
+ my $lock = MM->catfile($CPAN::Config->{cpan_home}, ".lock");
+
+ if (-f $lock and open(LOCK, $lock)
+ and ($^O eq 'MSWin32' ? _under_cpan() : <LOCK> == getppid())
+ and ($CPAN::Config->{prerequisites_policy} || '') ne 'ignore'
+ ) {
+ print << '.';
+
+*** Since we're running under CPAN, I'll just let it take care
+ of the dependency's installation later.
+.
+ $UnderCPAN = 1;
+ }
+
+ close LOCK;
+}
+
+sub install {
+ my $class = shift;
+
+ my $i; # used below to strip leading '-' from config keys
+ my @config = (map { s/^-// if ++$i; $_ } @{+shift});
+
+ my (@modules, @installed);
+ while (my ($pkg, $ver) = splice(@_, 0, 2)) {
+ # grep out those already installed
+ if (defined(_version_check(_load($pkg), $ver))) {
+ push @installed, $pkg;
+ }
+ else {
+ push @modules, $pkg, $ver;
+ }
+ }
+
+ return @installed unless @modules; # nothing to do
+
+ print "*** Installing dependencies...\n";
+
+ return unless _connected_to('cpan.org');
+
+ my %args = @config;
+ my %failed;
+ local *FAILED;
+ if ($args{do_once} and open(FAILED, '.#autoinstall.failed')) {
+ while (<FAILED>) { chomp; $failed{$_}++ }
+ close FAILED;
+
+ my @newmod;
+ while (my ($k, $v) = splice(@modules, 0, 2)) {
+ push @newmod, ($k => $v) unless $failed{$k};
+ }
+ @modules = @newmod;
+ }
+
+ if (_has_cpanplus()) {
+ _install_cpanplus(\@modules, \@config);
+ }
+ else {
+ _install_cpan(\@modules, \@config);
+ }
+
+ print "*** $class installation finished.\n";
+
+ # see if we have successfully installed them
+ while (my ($pkg, $ver) = splice(@modules, 0, 2)) {
+ if (defined(_version_check(_load($pkg), $ver))) {
+ push @installed, $pkg;
+ }
+ elsif ($args{do_once} and open(FAILED, '>> .#autoinstall.failed')) {
+ print FAILED "$pkg\n";
+ }
+ }
+
+ close FAILED if $args{do_once};
+
+ return @installed;
+}
+
+sub _install_cpanplus {
+ my @modules = @{+shift};
+ my @config = @{+shift};
+ my $installed = 0;
+
+ require CPANPLUS::Backend;
+ my $cp = CPANPLUS::Backend->new;
+ my $conf = $cp->configure_object;
+
+ return unless _can_write($conf->_get_build('base'));
+
+ # if we're root, set UNINST=1 to avoid trouble unless user asked for it.
+ my $makeflags = $conf->get_conf('makeflags') || '';
+ if (UNIVERSAL::isa($makeflags, 'HASH')) {
+ # 0.03+ uses a hashref here
+ $makeflags->{UNINST} = 1 unless exists $makeflags->{UNINST};
+ }
+ else {
+ # 0.02 and below uses a scalar
+ $makeflags = join(' ', split(' ', $makeflags), 'UNINST=1')
+ if ($makeflags !~ /\bUNINST\b/ and eval qq{ $> eq '0' });
+ }
+ $conf->set_conf(makeflags => $makeflags);
+
+ while (my ($key, $val) = splice(@config, 0, 2)) {
+ eval { $conf->set_conf($key, $val) };
+ }
+
+ my $modtree = $cp->module_tree;
+ while (my ($pkg, $ver) = splice(@modules, 0, 2)) {
+ print "*** Installing $pkg...\n";
+
+ MY::preinstall($pkg, $ver) or next if defined &MY::preinstall;
+
+ my $success;
+ my $obj = $modtree->{$pkg};
+
+ if ($obj and defined(_version_check($obj->{version}, $ver))) {
+ my $pathname = $pkg; $pathname =~ s/::/\\W/;
+
+ foreach my $inc (grep { m/$pathname.pm/i } keys(%INC)) {
+ delete $INC{$inc};
+ }
+
+ my $rv = $cp->install( modules => [ $obj->{module} ]);
+
+ if ($rv and ($rv->{$obj->{module}} or $rv->{ok})) {
+ print "*** $pkg successfully installed.\n";
+ $success = 1;
+ }
+ else {
+ print "*** $pkg installation cancelled.\n";
+ $success = 0;
+ }
+
+ $installed += $success;
+ }
+ else {
+ print << ".";
+*** Could not find a version $ver or above for $pkg; skipping.
+.
+ }
+
+ MY::postinstall($pkg, $ver, $success) if defined &MY::postinstall;
+ }
+
+ return $installed;
+}
+
+sub _install_cpan {
+ my @modules = @{+shift};
+ my @config = @{+shift};
+ my $installed = 0;
+ my %args;
+
+ require CPAN; CPAN::Config->load;
+
+ return unless _can_write(MM->catfile($CPAN::Config->{cpan_home}, 'sources'));
+
+ # if we're root, set UNINST=1 to avoid trouble unless user asked for it.
+ my $makeflags = $CPAN::Config->{make_install_arg} || '';
+ $CPAN::Config->{make_install_arg} = join(' ', split(' ', $makeflags), 'UNINST=1')
+ if ($makeflags !~ /\bUNINST\b/ and eval qq{ $> eq '0' });
+
+ # don't show start-up info
+ $CPAN::Config->{inhibit_startup_message} = 1;
+
+ # set additional options
+ while (my ($opt, $arg) = splice(@config, 0, 2)) {
+ ($args{$opt} = $arg, next)
+ if $opt =~ /^force$/; # pseudo-option
+ $CPAN::Config->{$opt} = $arg;
+ }
+
+ while (my ($pkg, $ver) = splice(@modules, 0, 2)) {
+ MY::preinstall($pkg, $ver) or next if defined &MY::preinstall;
+
+ print "*** Installing $pkg...\n";
+
+ my $obj = CPAN::Shell->expand(Module => $pkg);
+ my $success = 0;
+
+ if ($obj and defined(_version_check($obj->cpan_version, $ver))) {
+ my $pathname = $pkg; $pathname =~ s/::/\\W/;
+
+ foreach my $inc (grep { m/$pathname.pm/i } keys(%INC)) {
+ delete $INC{$inc};
+ }
+
+ $obj->force('install') if $args{force};
+
+ if ($obj->install eq 'YES') {
+ print "*** $pkg successfully installed.\n";
+ $success = 1;
+ }
+ else {
+ print "*** $pkg installation failed.\n";
+ $success = 0;
+ }
+
+ $installed += $success;
+ }
+ else {
+ print << ".";
+*** Could not find a version $ver or above for $pkg; skipping.
+.
+ }
+
+ MY::postinstall($pkg, $ver, $success) if defined &MY::postinstall;
+ }
+
+ return $installed;
+}
+
+sub _has_cpanplus {
+ return (
+ $HasCPANPLUS = (
+ $INC{'CPANPLUS/Config.pm'} or
+ _load('CPANPLUS::Shell::Default')
+ )
+ );
+}
+
+# make guesses on whether we're under the CPAN installation directory
+sub _under_cpan {
+ require Cwd;
+ require File::Spec;
+
+ my $cwd = File::Spec->canonpath(Cwd::cwd());
+ my $cpan = File::Spec->canonpath($CPAN::Config->{cpan_home});
+
+ return (index($cwd, $cpan) > -1);
+}
+
+sub _update_to {
+ my $class = __PACKAGE__;
+ my $ver = shift;
+
+ return if defined(_version_check(_load($class), $ver)); # no need to upgrade
+
+ if (_prompt(
+ "==> A newer version of $class ($ver) is required. Install?", 'y'
+ ) =~ /^[Nn]/) {
+ die "*** Please install $class $ver manually.\n";
+ }
+
+ print << ".";
+*** Trying to fetch it from CPAN...
+.
+
+ # install ourselves
+ _load($class) and return $class->import(@_)
+ if $class->install([], $class, $ver);
+
+ print << '.'; exit 1;
+
+*** Cannot bootstrap myself. :-( Installation terminated.
+.
+}
+
+# check if we're connected to some host, using inet_aton
+sub _connected_to {
+ my $site = shift;
+
+ return (
+ ( _load('Socket') and Socket::inet_aton($site) ) or _prompt(qq(
+*** Your host cannot resolve the domain name '$site', which
+ probably means the Internet connections are unavailable.
+==> Should we try to install the required module(s) anyway?), 'n'
+ ) =~ /^[Yy]/
+ );
+}
+
+# check if a directory is writable; may create it on demand
+sub _can_write {
+ my $path = shift;
+ mkdir ($path, 0755) unless -e $path;
+
+ require Config;
+ return 1 if -w $path and -w $Config::Config{sitelib};
+
+ print << ".";
+*** You are not allowed to write to the directory '$path';
+ the installation may fail due to insufficient permissions.
+.
+
+ if (eval '$>' and lc(`sudo -V`) =~ /version/ and _prompt(qq(
+==> Should we try to re-execute the autoinstall process with 'sudo'?), 'y'
+ ) =~ /^[Yy]/) {
+ # try to bootstrap ourselves from sudo
+ print << ".";
+*** Trying to re-execute the autoinstall process with 'sudo'...
+.
+ my $missing = join(',', @Missing);
+ my $config = join(',',
+ UNIVERSAL::isa($Config, 'HASH') ? %{$Config} : @{$Config}
+ ) if $Config;
+
+ return unless system('sudo', $^X, $0, "--config=$config", "--installdeps=$missing");
+
+ print << ".";
+*** The 'sudo' command exited with error! Resuming...
+.
+ }
+
+ return _prompt(qq(
+==> Should we try to install the required module(s) anyway?), 'n'
+ ) =~ /^[Yy]/
+}
+
+# load a module and return the version it reports
+sub _load {
+ my $mod = pop; # class/instance doesn't matter
+ my $file = $mod;
+
+ $file =~ s|::|/|g;
+ $file .= '.pm';
+
+ local $@;
+ return eval { require $file; $mod->VERSION } || ($@ ? undef : 0);
+}
+
+# compare two versions, either use Sort::Versions or plain comparison
+sub _version_check {
+ my ($cur, $min) = @_;
+ return unless defined $cur;
+
+ $cur =~ s/\s+$//;
+
+ # check for version numbers that are not in decimal format
+ if (ref($cur) or ref($min) or $cur =~ /v|\..*\./ or $min =~ /v|\..*\./) {
+ if ($version::VERSION or defined(_load('version'))) {
+ # use version.pm if it is installed.
+ return ((version->new($cur) >= version->new($min)) ? $cur : undef);
+ }
+ elsif ($Sort::Versions::VERSION or defined(_load('Sort::Versions'))) {
+ # use Sort::Versions as the sorting algorithm for a.b.c versions
+ return ((Sort::Versions::versioncmp($cur, $min) != -1) ? $cur : undef);
+ }
+
+ warn "Cannot reliably compare non-decimal formatted versions.\n".
+ "Please install version.pm or Sort::Versions.\n";
+ }
+
+ # plain comparison
+ local $^W = 0; # shuts off 'not numeric' bugs
+ return ($cur >= $min ? $cur : undef);
+}
+
+# nothing; this usage is deprecated.
+sub main::PREREQ_PM { return {}; }
+
+sub _make_args {
+ my %args = @_;
+
+ $args{PREREQ_PM} = { %{$args{PREREQ_PM} || {} }, @Existing, @Missing }
+ if $UnderCPAN or $TestOnly;
+
+ if ($args{EXE_FILES}) {
+ require ExtUtils::Manifest;
+ my $manifest = ExtUtils::Manifest::maniread('MANIFEST');
+
+ $args{EXE_FILES} = [
+ grep { exists $manifest->{$_} } @{$args{EXE_FILES}}
+ ];
+ }
+
+ $args{test}{TESTS} ||= 't/*.t';
+ $args{test}{TESTS} = join(' ', grep {
+ !exists($DisabledTests{$_})
+ } map { glob($_) } split(/\s+/, $args{test}{TESTS}));
+
+ my $missing = join(',', @Missing);
+ my $config = join(',',
+ UNIVERSAL::isa($Config, 'HASH') ? %{$Config} : @{$Config}
+ ) if $Config;
+
+ $PostambleActions = (
+ $missing ? "\$(PERL) $0 --config=$config --installdeps=$missing"
+ : "\@\$(NOOP)"
+ );
+
+ return %args;
+}
+
+# a wrapper to ExtUtils::MakeMaker::WriteMakefile
+sub Write {
+ require Carp;
+ Carp::croak "WriteMakefile: Need even number of args" if @_ % 2;
+
+ if ($CheckOnly) {
+ print << ".";
+*** Makefile not written in check-only mode.
+.
+ return;
+ }
+
+ my %args = _make_args(@_);
+
+ no strict 'refs';
+
+ $PostambleUsed = 0;
+ local *MY::postamble = \&postamble unless defined &MY::postamble;
+ ExtUtils::MakeMaker::WriteMakefile(%args);
+
+ print << "." unless $PostambleUsed;
+*** WARNING: Makefile written with customized MY::postamble() without
+ including contents from ExtUtils::AutoInstall::postamble() --
+ auto installation features disabled. Please contact the author.
+.
+
+ return 1;
+}
+
+sub postamble {
+ $PostambleUsed = 1;
+
+ return << ".";
+
+config :: installdeps
+\t\@\$(NOOP)
+
+checkdeps ::
+\t\$(PERL) $0 --checkdeps
+
+installdeps ::
+\t$PostambleActions
+
+.
+
+}
+
+1;
+
+__END__
+
+#line 929
Added: packages/libxml-feed-perl/branches/upstream/current/inc/Module/Install/AutoInstall.pm
===================================================================
--- packages/libxml-feed-perl/branches/upstream/current/inc/Module/Install/AutoInstall.pm 2006-02-09 19:28:39 UTC (rev 2106)
+++ packages/libxml-feed-perl/branches/upstream/current/inc/Module/Install/AutoInstall.pm 2006-02-10 22:39:48 UTC (rev 2107)
@@ -0,0 +1,62 @@
+#line 1 "inc/Module/Install/AutoInstall.pm - /Library/Perl/5.8.1/Module/Install/AutoInstall.pm"
+package Module::Install::AutoInstall;
+use Module::Install::Base; @ISA = qw(Module::Install::Base);
+
+sub AutoInstall { $_[0] }
+
+sub run {
+ my $self = shift;
+ $self->auto_install_now(@_);
+}
+
+sub write {
+ my $self = shift;
+ $self->auto_install(@_);
+}
+
+sub auto_install {
+ my $self = shift;
+ return if $self->{done}++;
+
+# ExtUtils::AutoInstall Bootstrap Code, version 7.
+AUTO:{my$p='ExtUtils::AutoInstall';my$v=0.49;$p->VERSION||0>=$v
+or+eval"use $p $v;1"or+do{my$e=$ENV{PERL_EXTUTILS_AUTOINSTALL};
+(!defined($e)||$e!~m/--(?:default|skip|testonly)/and-t STDIN or
+eval"use ExtUtils::MakeMaker;WriteMakefile(PREREQ_PM=>{'$p',$v}
+);1"and exit)and print"==> $p $v required. Install it from CP".
+"AN? [Y/n] "and<STDIN>!~/^n/i and print"*** Installing $p\n"and
+do{if (eval '$>' and lc(`sudo -V`) =~ /version/){system('sudo',
+$^X,"-MCPANPLUS","-e","CPANPLUS::install $p");eval"use $p $v;1"
+||system('sudo', $^X, "-MCPAN", "-e", "CPAN::install $p")}eval{
+require CPANPLUS;CPANPLUS::install$p};eval"use $p $v;1"or eval{
+require CPAN;CPAN::install$p};eval"use $p $v;1"||die"*** Please
+manually install $p $v from cpan.org first...\n"}}}
+
+ # Flatten array of arrays into a single array
+ my @core = map @$_, map @$_, grep ref,
+ $self->build_requires, $self->requires;
+
+ while ( @core and @_ > 1 and $_[0] =~ /^-\w+$/ ) {
+ push @core, splice(@_, 0, 2);
+ }
+
+ ExtUtils::AutoInstall->import(
+ (@core ? (-core => \@core) : ()), @_, $self->features
+ );
+
+ $self->makemaker_args( ExtUtils::AutoInstall::_make_args() );
+
+ my $class = ref($self);
+ $self->postamble(
+ "# --- $class section:\n" .
+ ExtUtils::AutoInstall::postamble()
+ );
+}
+
+sub auto_install_now {
+ my $self = shift;
+ $self->auto_install;
+ ExtUtils::AutoInstall::do_install();
+}
+
+1;
Added: packages/libxml-feed-perl/branches/upstream/current/inc/Module/Install/Base.pm
===================================================================
--- packages/libxml-feed-perl/branches/upstream/current/inc/Module/Install/Base.pm 2006-02-09 19:28:39 UTC (rev 2106)
+++ packages/libxml-feed-perl/branches/upstream/current/inc/Module/Install/Base.pm 2006-02-10 22:39:48 UTC (rev 2107)
@@ -0,0 +1,54 @@
+#line 1 "inc/Module/Install/Base.pm - /Library/Perl/5.8.1/Module/Install/Base.pm"
+package Module::Install::Base;
+
+#line 28
+
+sub new {
+ my ($class, %args) = @_;
+
+ foreach my $method (qw(call load)) {
+ *{"$class\::$method"} = sub {
+ +shift->_top->$method(@_);
+ } unless defined &{"$class\::$method"};
+ }
+
+ bless(\%args, $class);
+}
+
+#line 46
+
+sub AUTOLOAD {
+ my $self = shift;
+ goto &{$self->_top->autoload};
+}
+
+#line 57
+
+sub _top { $_[0]->{_top} }
+
+#line 68
+
+sub admin {
+ my $self = shift;
+ $self->_top->{admin} or Module::Install::Base::FakeAdmin->new;
+}
+
+sub is_admin {
+ my $self = shift;
+ $self->admin->VERSION;
+}
+
+sub DESTROY {}
+
+package Module::Install::Base::FakeAdmin;
+
+my $Fake;
+sub new { $Fake ||= bless(\@_, $_[0]) }
+sub AUTOLOAD {}
+sub DESTROY {}
+
+1;
+
+__END__
+
+#line 112
Added: packages/libxml-feed-perl/branches/upstream/current/inc/Module/Install/Build.pm
===================================================================
--- packages/libxml-feed-perl/branches/upstream/current/inc/Module/Install/Build.pm 2006-02-09 19:28:39 UTC (rev 2106)
+++ packages/libxml-feed-perl/branches/upstream/current/inc/Module/Install/Build.pm 2006-02-10 22:39:48 UTC (rev 2107)
@@ -0,0 +1,63 @@
+#line 1 "inc/Module/Install/Build.pm - /Library/Perl/5.8.1/Module/Install/Build.pm"
+package Module::Install::Build;
+$VERSION = '0.01';
+use strict;
+use vars qw(@ISA);
+use Module::Install::Base; @ISA = qw(Module::Install::Base);
+
+sub Build { $_[0] }
+
+sub write {
+ my $self = shift;
+ die "Build->write() takes no arguments\n" if @_;
+
+ my %args;
+ my $build;
+
+ $args{dist_name} = $self->name || $self->determine_NAME($self->{args});
+ $args{license} = $self->license;
+ $args{dist_version} = $self->version || $self->determine_VERSION($self->{args});
+ $args{dist_abstract} = $self->abstract;
+ $args{dist_author} = $self->author;
+ $args{sign} = $self->sign;
+ $args{no_index} = $self->no_index;
+
+ foreach my $key (qw(build_requires requires recommends conflicts)) {
+ my $val = eval "\$self->$key" or next;
+ $args{$key} = { map @$_, @$val };
+ }
+
+ %args = map {($_, $args{$_})} grep {defined($args{$_})} keys %args;
+
+ require Module::Build;
+ $build = Module::Build->new(%args);
+ $build->add_to_cleanup(split /\s+/, $self->clean_files);
+ $build->create_build_script;
+}
+
+sub ACTION_reset {
+ my ($self) = @_;
+ die "XXX - Can't get this working yet";
+ require File::Path;
+ warn "Removing inc\n";
+ rmpath('inc');
+}
+
+sub ACTION_dist {
+ my ($self) = @_;
+ die "XXX - Can't get this working yet";
+}
+
+# <ingy> DrMath: is there an OO way to add actions to Module::Build??
+# <DrMath> ingy: yeah
+# <DrMath> ingy: package MyBuilder; use w(Module::Build; @ISA = qw(w(Module::Build); sub ACTION_ingy
+# {...}
+# <DrMath> ingy: then my $build = new MyBuilder( ...parameters... );
+# $build->write_build_script;
+
+
+1;
+
+__END__
+
+#line 175
Added: packages/libxml-feed-perl/branches/upstream/current/inc/Module/Install/Can.pm
===================================================================
--- packages/libxml-feed-perl/branches/upstream/current/inc/Module/Install/Can.pm 2006-02-09 19:28:39 UTC (rev 2106)
+++ packages/libxml-feed-perl/branches/upstream/current/inc/Module/Install/Can.pm 2006-02-10 22:39:48 UTC (rev 2107)
@@ -0,0 +1,38 @@
+#line 1 "inc/Module/Install/Can.pm - /Library/Perl/5.8.1/Module/Install/Can.pm"
+package Module::Install::Can;
+use Module::Install::Base; @ISA = qw(Module::Install::Base);
+$VERSION = '0.01';
+
+use strict;
+use Config ();
+use File::Spec ();
+use ExtUtils::MakeMaker ();
+
+# 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}), '.') {
+ my $abs = File::Spec->catfile($dir, $_[1]);
+ return $abs if (-x $abs or $abs = MM->maybe_command($abs));
+ }
+
+ return;
+}
+
+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;
+}
+
+1;
Added: packages/libxml-feed-perl/branches/upstream/current/inc/Module/Install/Fetch.pm
===================================================================
--- packages/libxml-feed-perl/branches/upstream/current/inc/Module/Install/Fetch.pm 2006-02-09 19:28:39 UTC (rev 2106)
+++ packages/libxml-feed-perl/branches/upstream/current/inc/Module/Install/Fetch.pm 2006-02-10 22:39:48 UTC (rev 2107)
@@ -0,0 +1,86 @@
+#line 1 "inc/Module/Install/Fetch.pm - /Library/Perl/5.8.1/Module/Install/Fetch.pm"
+package Module::Install::Fetch;
+use Module::Install::Base; @ISA = qw(Module::Install::Base);
+
+$VERSION = '0.01';
+
+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 at 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/, << ".");
+open $host
+user anonymous anonymous\@example.com
+cd $path
+binary
+get $file $file
+quit
+.
+ 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;
Added: packages/libxml-feed-perl/branches/upstream/current/inc/Module/Install/Include.pm
===================================================================
--- packages/libxml-feed-perl/branches/upstream/current/inc/Module/Install/Include.pm 2006-02-09 19:28:39 UTC (rev 2106)
+++ packages/libxml-feed-perl/branches/upstream/current/inc/Module/Install/Include.pm 2006-02-10 22:39:48 UTC (rev 2107)
@@ -0,0 +1,10 @@
+#line 1 "inc/Module/Install/Include.pm - /Library/Perl/5.8.1/Module/Install/Include.pm"
+package Module::Install::Include;
+use Module::Install::Base; @ISA = qw(Module::Install::Base);
+
+sub include { +shift->admin->include(@_) };
+sub include_deps { +shift->admin->include_deps(@_) };
+sub auto_include { +shift->admin->auto_include(@_) };
+sub auto_include_deps { +shift->admin->auto_include_deps(@_) };
+
+1;
Added: packages/libxml-feed-perl/branches/upstream/current/inc/Module/Install/Makefile.pm
===================================================================
--- packages/libxml-feed-perl/branches/upstream/current/inc/Module/Install/Makefile.pm 2006-02-09 19:28:39 UTC (rev 2106)
+++ packages/libxml-feed-perl/branches/upstream/current/inc/Module/Install/Makefile.pm 2006-02-10 22:39:48 UTC (rev 2107)
@@ -0,0 +1,143 @@
+#line 1 "inc/Module/Install/Makefile.pm - /Library/Perl/5.8.1/Module/Install/Makefile.pm"
+package Module::Install::Makefile;
+use Module::Install::Base; @ISA = qw(Module::Install::Base);
+
+$VERSION = '0.01';
+
+use strict 'vars';
+use vars '$VERSION';
+
+use ExtUtils::MakeMaker ();
+
+sub Makefile { $_[0] }
+
+sub prompt {
+ shift;
+ goto &ExtUtils::MakeMaker::prompt;
+}
+
+sub makemaker_args {
+ my $self = shift;
+ my $args = ($self->{makemaker_args} ||= {});
+ %$args = ( %$args, @_ ) if @_;
+ $args;
+}
+
+sub clean_files {
+ my $self = shift;
+ my $clean = $self->makemaker_args->{clean} ||= {};
+ %$clean = (
+ %$clean,
+ FILES => join(" ", grep length, $clean->{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 write {
+ my $self = shift;
+ die "&Makefile->write() takes no arguments\n" if @_;
+
+ my $args = $self->makemaker_args;
+
+ $args->{DISTNAME} = $self->name;
+ $args->{NAME} = $self->module_name || $self->name || $self->determine_NAME($args);
+ $args->{VERSION} = $self->version || $self->determine_VERSION($args);
+ $args->{NAME} =~ s/-/::/g;
+
+ if ($] >= 5.005) {
+ $args->{ABSTRACT} = $self->abstract;
+ $args->{AUTHOR} = $self->author;
+ }
+ if ( eval($ExtUtils::MakeMaker::VERSION) >= 6.10 ) {
+ $args->{NO_META} = 1;
+ }
+ if ( eval($ExtUtils::MakeMaker::VERSION) > 6.17 ) {
+ $args->{SIGN} = 1 if $self->sign;
+ }
+ delete $args->{SIGN} unless $self->is_admin;
+
+ # merge both kinds of requires into prereq_pm
+ my $prereq = ($args->{PREREQ_PM} ||= {});
+ %$prereq = ( %$prereq, map { @$_ } map { @$_ } grep $_,
+ ($self->build_requires, $self->requires) );
+
+ # merge both kinds of requires into prereq_pm
+ my $dir = ($args->{DIR} ||= []);
+ if ($self->bundles) {
+ push @$dir, map "$_->[1]", @{$self->bundles};
+ delete $prereq->{$_->[0]} for @{$self->bundles};
+ }
+
+ 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";
+ }
+
+ my %args = map {($_ => $args->{$_})} grep {defined($args->{$_})} keys %$args;
+
+ if ($self->admin->preop) {
+ $args{dist} = $self->admin->preop;
+ }
+
+ ExtUtils::MakeMaker::WriteMakefile(%args);
+
+ $self->fix_up_makefile();
+}
+
+sub fix_up_makefile {
+ my $self = 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 || '');
+
+ open MAKEFILE, '< Makefile' or die $!;
+ my $makefile = do { local $/; <MAKEFILE> };
+ close MAKEFILE;
+
+ $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;
+
+ open MAKEFILE, '> Makefile' or die $!;
+ print MAKEFILE "$preamble$makefile$postamble";
+ close MAKEFILE;
+}
+
+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 273
Added: packages/libxml-feed-perl/branches/upstream/current/inc/Module/Install/Metadata.pm
===================================================================
--- packages/libxml-feed-perl/branches/upstream/current/inc/Module/Install/Metadata.pm 2006-02-09 19:28:39 UTC (rev 2106)
+++ packages/libxml-feed-perl/branches/upstream/current/inc/Module/Install/Metadata.pm 2006-02-10 22:39:48 UTC (rev 2107)
@@ -0,0 +1,187 @@
+#line 1 "inc/Module/Install/Metadata.pm - /Library/Perl/5.8.1/Module/Install/Metadata.pm"
+package Module::Install::Metadata;
+use Module::Install::Base; @ISA = qw(Module::Install::Base);
+
+$VERSION = '0.04';
+
+use strict 'vars';
+use vars qw($VERSION);
+
+sub Meta { shift }
+
+my @scalar_keys = qw(
+ name module_name version abstract author license
+ distribution_type sign perl_version
+);
+my @tuple_keys = qw(build_requires requires recommends bundles);
+
+foreach my $key (@scalar_keys) {
+ *$key = sub {
+ my $self = shift;
+ return $self->{'values'}{$key} unless @_;
+ $self->{'values'}{$key} = shift;
+ return $self;
+ };
+}
+
+foreach my $key (@tuple_keys) {
+ *$key = sub {
+ my $self = shift;
+ return $self->{'values'}{$key} unless @_;
+ my @rv;
+ while (@_) {
+ my $module = shift or last;
+ my $version = shift || 0;
+ if ($module eq 'perl') {
+ $version =~ s{^(\d+)\.(\d+)\.(\d+)}
+ {$1 + $2/1_000 + $3/1_000_000}e;
+ $self->perl_version($version);
+ next;
+ }
+ my $rv = [$module, $version];
+ push @{$self->{'values'}{$key}}, $rv;
+ push @rv, $rv;
+ }
+ return @rv;
+ };
+}
+
+sub features {
+ my $self = shift;
+ while (my ($name, $mods) = splice(@_, 0, 2)) {
+ my $count = 0;
+ push @{$self->{'values'}{'features'}}, ($name => [
+ map { (++$count % 2 and ref($_) and ($count += $#$_)) ? @$_ : $_ } @$mods
+ ] );
+ }
+ return @{$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 _dump {
+ my $self = shift;
+ my $package = ref($self->_top);
+ my $version = $self->_top->VERSION;
+ my %values = %{$self->{'values'}};
+
+ delete $values{sign};
+ if (my $perl_version = delete $values{perl_version}) {
+ # Always canonical to three-dot version
+ $perl_version =~ s{^(\d+)\.(\d\d\d)(\d*)}{join('.', $1, int($2), int($3))}e
+ if $perl_version >= 5.006;
+ $values{requires} = [
+ [perl => $perl_version],
+ @{$values{requires}||[]},
+ ];
+ }
+
+ warn "No license specified, setting license = 'unknown'\n"
+ unless $values{license};
+
+ $values{license} ||= 'unknown';
+ $values{distribution_type} ||= 'module';
+ $values{name} ||= do {
+ my $name = $values{module_name};
+ $name =~ s/::/-/g;
+ $name;
+ } if $values{module_name};
+
+ if ($values{name} =~ /::/) {
+ my $name = $values{name};
+ $name =~ s/::/-/g;
+ die "Error in name(): '$values{name}' should be '$name'!\n";
+ }
+
+ my $dump = '';
+ foreach my $key (@scalar_keys) {
+ $dump .= "$key: $values{$key}\n" if exists $values{$key};
+ }
+ foreach my $key (@tuple_keys) {
+ next unless exists $values{$key};
+ $dump .= "$key:\n";
+ foreach (@{$values{$key}}) {
+ $dump .= " $_->[0]: $_->[1]\n";
+ }
+ }
+
+ if (my $no_index = $values{no_index}) {
+ push @{$no_index->{'directory'}}, 'inc';
+ require YAML;
+ local $YAML::UseHeader = 0;
+ $dump .= YAML::Dump({ no_index => $no_index});
+ }
+ else {
+ $dump .= << "META";
+no_index:
+ directory:
+ - inc
+META
+ }
+
+ $dump .= "generated_by: $package version $version\n";
+ return $dump;
+}
+
+sub read {
+ my $self = shift;
+ $self->include_deps( 'YAML', 0 );
+ require YAML;
+ my $data = YAML::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->$key( $module => $version );
+ }
+ }
+ else {
+ $self->$key( $value );
+ }
+ }
+ return $self;
+}
+
+sub write {
+ my $self = shift;
+ return $self unless $self->is_admin;
+
+ META_NOT_OURS: {
+ local *FH;
+ if (open FH, "META.yml") {
+ while (<FH>) {
+ last META_NOT_OURS if /^generated_by: Module::Install\b/;
+ }
+ return $self if -s FH;
+ }
+ }
+
+ warn "Writing META.yml\n";
+ open META, "> META.yml" or warn "Cannot write to META.yml: $!";
+ print META $self->_dump;
+ close META;
+ return $self;
+}
+
+sub version_from {
+ my ($self, $version_from) = @_;
+ require ExtUtils::MM_Unix;
+ $self->version(ExtUtils::MM_Unix->parse_version($version_from));
+}
+
+sub abstract_from {
+ my ($self, $abstract_from) = @_;
+ require ExtUtils::MM_Unix;
+ $self->abstract(
+ bless( { DISTNAME => $self->name }, 'ExtUtils::MM_Unix')
+ ->parse_abstract($abstract_from)
+ );
+}
+
+1;
Added: packages/libxml-feed-perl/branches/upstream/current/inc/Module/Install/Win32.pm
===================================================================
--- packages/libxml-feed-perl/branches/upstream/current/inc/Module/Install/Win32.pm 2006-02-09 19:28:39 UTC (rev 2106)
+++ packages/libxml-feed-perl/branches/upstream/current/inc/Module/Install/Win32.pm 2006-02-10 22:39:48 UTC (rev 2107)
@@ -0,0 +1,63 @@
+#line 1 "inc/Module/Install/Win32.pm - /Library/Perl/5.8.1/Module/Install/Win32.pm"
+package Module::Install::Win32;
+use Module::Install::Base; @ISA = qw(Module::Install::Base);
+
+$VERSION = '0.02';
+
+use strict;
+
+# 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 (
+ $Config::Config{make} and
+ $Config::Config{make} =~ /^nmake\b/i and
+ $^O eq 'MSWin32' 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,
+ );
+
+ if (!$rv) {
+ die << '.';
+
+-------------------------------------------------------------------------------
+
+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.
+
+-------------------------------------------------------------------------------
+.
+ }
+}
+
+1;
+
+__END__
+
Added: packages/libxml-feed-perl/branches/upstream/current/inc/Module/Install/WriteAll.pm
===================================================================
--- packages/libxml-feed-perl/branches/upstream/current/inc/Module/Install/WriteAll.pm 2006-02-09 19:28:39 UTC (rev 2106)
+++ packages/libxml-feed-perl/branches/upstream/current/inc/Module/Install/WriteAll.pm 2006-02-10 22:39:48 UTC (rev 2107)
@@ -0,0 +1,36 @@
+#line 1 "inc/Module/Install/WriteAll.pm - /Library/Perl/5.8.1/Module/Install/WriteAll.pm"
+package Module::Install::WriteAll;
+use Module::Install::Base; @ISA = qw(Module::Install::Base);
+
+sub WriteAll {
+ my $self = shift;
+ my %args = (
+ meta => 1,
+ sign => 0,
+ inline => 0,
+ check_nmake => 1,
+ @_
+ );
+
+ $self->sign(1) if $args{sign};
+ $self->Meta->write if $args{meta};
+ $self->admin->WriteAll(%args) if $self->is_admin;
+
+ if ($0 =~ /Build.PL$/i) {
+ $self->Build->write;
+ }
+ else {
+ $self->check_nmake if $args{check_nmake};
+ $self->makemaker_args( PL_FILES => {} )
+ unless $self->makemaker_args->{'PL_FILES'};
+
+ if ($args{inline}) {
+ $self->Inline->write;
+ }
+ else {
+ $self->Makefile->write;
+ }
+ }
+}
+
+1;
Added: packages/libxml-feed-perl/branches/upstream/current/inc/Module/Install.pm
===================================================================
--- packages/libxml-feed-perl/branches/upstream/current/inc/Module/Install.pm 2006-02-09 19:28:39 UTC (rev 2106)
+++ packages/libxml-feed-perl/branches/upstream/current/inc/Module/Install.pm 2006-02-10 22:39:48 UTC (rev 2107)
@@ -0,0 +1,169 @@
+#line 1 "inc/Module/Install.pm - /Library/Perl/5.8.1/Module/Install.pm"
+package Module::Install;
+$VERSION = '0.36';
+
+die << "." unless $INC{join('/', inc => split(/::/, __PACKAGE__)).'.pm'};
+Please invoke ${\__PACKAGE__} with:
+
+ use inc::${\__PACKAGE__};
+
+not:
+
+ use ${\__PACKAGE__};
+
+.
+
+use strict 'vars';
+use Cwd ();
+use File::Find ();
+use File::Path ();
+
+ at inc::Module::Install::ISA = 'Module::Install';
+*inc::Module::Install::VERSION = *VERSION;
+
+#line 129
+
+sub import {
+ my $class = shift;
+ my $self = $class->new(@_);
+
+ if (not -f $self->{file}) {
+ 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"};
+ }
+
+ *{caller(0) . "::AUTOLOAD"} = $self->autoload;
+
+ # Unregister loader and worker packages so subdirs can use them again
+ delete $INC{"$self->{file}"};
+ delete $INC{"$self->{path}.pm"};
+}
+
+#line 156
+
+sub autoload {
+ my $self = shift;
+ my $caller = caller;
+
+ my $cwd = Cwd::cwd();
+ my $sym = "$caller\::AUTOLOAD";
+
+ $sym->{$cwd} = sub {
+ my $pwd = Cwd::cwd();
+ if (my $code = $sym->{$pwd}) {
+ goto &$code unless $cwd eq $pwd; # delegate back to parent dirs
+ }
+ $$sym =~ /([^:]+)$/ or die "Cannot autoload $caller";
+ unshift @_, ($self, $1);
+ goto &{$self->can('call')} unless uc($1) eq $1;
+ };
+}
+
+#line 181
+
+sub new {
+ my ($class, %args) = @_;
+
+ return $args{_self} if $args{_self};
+
+ $args{dispatch} ||= 'Admin';
+ $args{prefix} ||= 'inc';
+ $args{author} ||= '.author';
+ $args{bundle} ||= 'inc/BUNDLES';
+
+ $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{prefix}/$args{path}.pm";
+
+ bless(\%args, $class);
+}
+
+#line 210
+
+sub call {
+ my $self = shift;
+ my $method = shift;
+ my $obj = $self->load($method) or return;
+
+ unshift @_, $obj;
+ goto &{$obj->can($method)};
+}
+
+#line 225
+
+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";
+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
+
+ my $obj = $admin->load($method, 1);
+ push @{$self->{extensions}}, $obj;
+
+ $obj;
+}
+
+#line 255
+
+sub load_extensions {
+ my ($self, $path, $top_obj) = @_;
+
+ unshift @INC, $self->{prefix}
+ unless grep { $_ eq $self->{prefix} } @INC;
+
+ local @INC = ($path, @INC);
+ foreach my $rv ($self->find_extensions($path)) {
+ my ($file, $pkg) = @{$rv};
+ next if $self->{pathnames}{$pkg};
+
+ eval { require $file; 1 } or (warn($@), next);
+ $self->{pathnames}{$pkg} = delete $INC{$file};
+ push @{$self->{extensions}}, $pkg->new( _top => $top_obj );
+ }
+}
+
+#line 279
+
+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;
+ return if $1 eq $self->{dispatch};
+
+ $file = "$self->{path}/$1.pm";
+ my $pkg = "$self->{name}::$1"; $pkg =~ s!/!::!g;
+ push @found, [$file, $pkg];
+ }, $path) if -d $path;
+
+ @found;
+}
+
+1;
+
+__END__
+
+#line 617
Added: packages/libxml-feed-perl/branches/upstream/current/lib/XML/Feed/Atom.pm
===================================================================
--- packages/libxml-feed-perl/branches/upstream/current/lib/XML/Feed/Atom.pm 2006-02-09 19:28:39 UTC (rev 2106)
+++ packages/libxml-feed-perl/branches/upstream/current/lib/XML/Feed/Atom.pm 2006-02-10 22:39:48 UTC (rev 2107)
@@ -0,0 +1,177 @@
+# $Id: Atom.pm 1865 2005-08-09 20:15:31Z btrott $
+
+package XML::Feed::Atom;
+use strict;
+
+use base qw( XML::Feed );
+use XML::Atom::Feed;
+use XML::Atom::Util qw( iso2dt );
+use List::Util qw( first );
+
+sub init_empty {
+ my $feed = shift;
+ $feed->{atom} = XML::Atom::Feed->new;
+ $feed;
+}
+
+sub init_string {
+ my $feed = shift;
+ my($str) = @_;
+ if ($str) {
+ $feed->{atom} = XML::Atom::Feed->new(Stream => $str)
+ or return $feed->error(XML::Atom::Feed->errstr);
+ }
+ $feed;
+}
+
+sub format { 'Atom' }
+
+sub title { shift->{atom}->title(@_) }
+sub link {
+ my $feed = shift;
+ if (@_) {
+ $feed->{atom}->add_link({ rel => 'alternate', href => $_[0],
+ type => 'text/html', });
+ } else {
+ my $l = first { $_->rel eq 'alternate' } $feed->{atom}->link;
+ $l ? $l->href : undef;
+ }
+}
+sub description { shift->{atom}->tagline(@_) }
+sub copyright { shift->{atom}->copyright(@_) }
+sub language { shift->{atom}->language(@_) }
+sub generator { shift->{atom}->generator(@_) }
+
+sub author {
+ my $feed = shift;
+ if (@_ && $_[0]) {
+ my $person = XML::Atom::Person->new;
+ $person->name($_[0]);
+ $feed->{atom}->author($person);
+ } else {
+ $feed->{atom}->author ? $feed->{atom}->author->name : undef;
+ }
+}
+
+sub modified {
+ my $feed = shift;
+ if (@_) {
+ $feed->{atom}->modified($_[0]->iso8601 . 'Z');
+ } else {
+ iso2dt($feed->{atom}->modified);
+ }
+}
+
+sub entries {
+ my @entries;
+ for my $entry ($_[0]->{atom}->entries) {
+ push @entries, XML::Feed::Entry::Atom->wrap($entry);
+ }
+ @entries;
+}
+
+sub add_entry {
+ my $feed = shift;
+ my($entry) = @_;
+ $feed->{atom}->add_entry($entry->unwrap);
+}
+
+sub as_xml { $_[0]->{atom}->as_xml }
+
+package XML::Feed::Entry::Atom;
+use strict;
+
+use base qw( XML::Feed::Entry );
+use XML::Atom::Util qw( iso2dt );
+use XML::Feed::Content;
+use XML::Atom::Entry;
+use List::Util qw( first );
+
+sub init_empty {
+ my $entry = shift;
+ $entry->{entry} = XML::Atom::Entry->new;
+ 1;
+}
+
+sub title { shift->{entry}->title(@_) }
+sub link {
+ my $entry = shift;
+ if (@_) {
+ $entry->{entry}->add_link({ rel => 'alternate', href => $_[0],
+ type => 'text/html', });
+ } else {
+ my $l = first { $_->rel eq 'alternate' } $entry->{entry}->link;
+ $l ? $l->href : undef;
+ }
+}
+
+sub summary {
+ my $entry = shift;
+ if (@_) {
+ $entry->{entry}->summary(ref($_[0]) eq 'XML::Feed::Content' ?
+ $_[0]->body : $_[0]);
+ } else {
+ XML::Feed::Content->wrap({ type => 'text/html',
+ body => $entry->{entry}->summary });
+ }
+}
+
+sub content {
+ my $entry = shift;
+ if (@_) {
+ my %param;
+ if (ref($_[0]) eq 'XML::Feed::Content') {
+ %param = (Body => $_[0]->body, Type => $_[0]->type || 'text/html');
+ } else {
+ %param = (Body => $_[0], Type => 'text/html');
+ }
+ $entry->{entry}->content(XML::Atom::Content->new(%param));
+ } else {
+ my $c = $entry->{entry}->content;
+ XML::Feed::Content->wrap({ type => $c ? $c->type : undef,
+ body => $c ? $c->body : undef });
+ }
+}
+
+sub category {
+ my $entry = shift;
+ my $ns = XML::Atom::Namespace->new(dc => 'http://purl.org/dc/elements/1.1/');
+ if (@_) {
+ $entry->{entry}->set($ns, 'subject', $_[0]);
+ } else {
+ $entry->{entry}->get($ns, 'subject');
+ }
+}
+
+sub author {
+ my $entry = shift;
+ if (@_ && $_[0]) {
+ my $person = XML::Atom::Person->new;
+ $person->name($_[0]);
+ $entry->{entry}->author($person);
+ } else {
+ $entry->{entry}->author ? $entry->{entry}->author->name : undef;
+ }
+}
+
+sub id { shift->{entry}->id(@_) }
+
+sub issued {
+ my $entry = shift;
+ if (@_) {
+ $entry->{entry}->issued($_[0]->iso8601 . 'Z') if $_[0];
+ } else {
+ $entry->{entry}->issued ? iso2dt($entry->{entry}->issued) : undef;
+ }
+}
+
+sub modified {
+ my $entry = shift;
+ if (@_) {
+ $entry->{entry}->modified($_[0]->iso8601 . 'Z') if $_[0];
+ } else {
+ $entry->{entry}->modified ? iso2dt($entry->{entry}->modified) : undef;
+ }
+}
+
+1;
Added: packages/libxml-feed-perl/branches/upstream/current/lib/XML/Feed/Content.pm
===================================================================
--- packages/libxml-feed-perl/branches/upstream/current/lib/XML/Feed/Content.pm 2006-02-09 19:28:39 UTC (rev 2106)
+++ packages/libxml-feed-perl/branches/upstream/current/lib/XML/Feed/Content.pm 2006-02-10 22:39:48 UTC (rev 2107)
@@ -0,0 +1,64 @@
+# $Id: Content.pm 1862 2005-06-20 17:26:11Z btrott $
+
+package XML::Feed::Content;
+use strict;
+
+use base qw( Class::ErrorHandler );
+
+sub wrap {
+ my $class = shift;
+ my($c) = @_;
+ bless { %$c }, $class;
+}
+*new = \&wrap;
+
+sub _var {
+ my $content = shift;
+ my $var = shift;
+ $content->{$var} = shift if @_;
+ $content->{$var};
+}
+
+sub type { shift->_var('type', @_) }
+sub body { shift->_var('body', @_) }
+
+1;
+__END__
+
+=head1 NAME
+
+XML::Feed::Content - Wrapper for content objects
+
+=head1 SYNOPSIS
+
+ my $content = $entry->content;
+ print $content->body;
+
+=head1 DESCRIPTION
+
+I<XML::Feed::Content> represents a content object in an I<XML::Feed::Entry>
+entry in a syndication feed. This could be a I<E<lt>descriptionE<gt>>
+element in an RSS feed, a I<E<lt>contentE<gt>> element in an Atom feed,
+etc. In other words, any element where knowing both the actual data and the
+B<type> of data is useful.
+
+=head1 USAGE
+
+=head2 $content->body
+
+The actual data.
+
+=head2 $content->type
+
+The MIME type of the content in I<body>.
+
+This is really only useful in Atom feeds, because RSS feeds do not specify
+the type of content included in an entry. In RSS feeds, generally the MIME
+type defaults to I<text/html>.
+
+=head1 AUTHOR & COPYRIGHT
+
+Please see the I<XML::Feed> manpage for author, copyright, and license
+information.
+
+=cut
Added: packages/libxml-feed-perl/branches/upstream/current/lib/XML/Feed/Entry.pm
===================================================================
--- packages/libxml-feed-perl/branches/upstream/current/lib/XML/Feed/Entry.pm 2006-02-09 19:28:39 UTC (rev 2106)
+++ packages/libxml-feed-perl/branches/upstream/current/lib/XML/Feed/Entry.pm 2006-02-10 22:39:48 UTC (rev 2107)
@@ -0,0 +1,146 @@
+# $Id: Entry.pm 1872 2005-08-12 04:28:42Z btrott $
+
+package XML::Feed::Entry;
+use strict;
+use base qw( Class::ErrorHandler );
+
+use Carp;
+
+sub wrap {
+ my $class = shift;
+ my($item) = @_;
+ bless { entry => $item }, $class;
+}
+
+sub unwrap { $_[0]->{entry} }
+
+sub new {
+ my $class = shift;
+ my($format) = @_;
+ $format ||= 'Atom';
+ my $format_class = 'XML::Feed::' . $format;
+ eval "use $format_class";
+ Carp::croak("Unsupported format $format: $@") if $@;
+ my $entry = bless {}, join('::', __PACKAGE__, $format);
+ $entry->init_empty or return $class->error($entry->errstr);
+ $entry;
+}
+
+sub init_empty { 1 }
+
+sub convert {
+ my $entry = shift;
+ my($format) = @_;
+ my $new = __PACKAGE__->new($format);
+ for my $field (qw( title link content summary category author id issued modified )) {
+ my $val = $entry->$field();
+ next unless defined $val;
+ $new->$field($val);
+ }
+ $new;
+}
+
+sub title;
+sub link;
+sub content;
+sub summary;
+sub category;
+sub author;
+sub id;
+sub issued;
+sub modified;
+
+1;
+__END__
+
+=head1 NAME
+
+XML::Feed::Entry - Entry/item in a syndication feed
+
+=head1 SYNOPSIS
+
+ ## $feed is an XML::Feed object.
+ for my $entry ($feed->entries) {
+ print $entry->title, "\n", $entry->summary, "\n\n";
+ }
+
+=head1 DESCRIPTION
+
+I<XML::Feed::Entry> represents an entry/item in an I<XML::Feed> syndication
+feed.
+
+=head1 USAGE
+
+=head2 XML::Feed::Entry->new($format)
+
+Creates a new I<XML::Feed::Entry> object in the format I<$format>, which
+should be either I<RSS> or I<Atom>.
+
+=head2 $entry->convert($format)
+
+Converts the I<XML::Feed::Entry> object into the I<$format> format, and
+returns the new object.
+
+=head2 $entry->title([ $title ])
+
+The title of the entry.
+
+=head2 $entry->link([ $uri ])
+
+The permalink of the entry, in most cases, except in cases where it points
+instead to an offsite URI referenced in the entry.
+
+=head2 $entry->content([ $content ])
+
+Bn I<XML::Feed::Content> object representing the full entry body, or as
+much as is available in the feed.
+
+In RSS feeds, this method will look first for
+I<http://purl.org/rss/1.0/modules/content/#encoded> and
+I<http://www.w3.org/1999/xhtml#body> elements, then fall back to a
+I<E<lt>descriptionE<gt>> element.
+
+=head2 $entry->summary([ $summary ])
+
+An I<XML::Feed::Content> object representing a short summary of the entry.
+Possibly.
+
+Since RSS feeds do not have the idea of a summary separate from the entry
+body, this may not always be what you want. If the entry contains both a
+I<E<lt>descriptionE<gt>> element B<and> another element typically used for
+the full content of the entry--either I<http://www.w3.org/1999/xhtml/body>
+or I<http://purl.org/rss/1.0/modules/content/#encoded>--we treat that as
+the summary. Otherwise, we assume that there isn't a summary, and return
+an I<XML::Feed::Content> object with an empty string in the I<body>.
+
+=head2 $entry->category([ $category ])
+
+The category in which the entry was posted.
+
+=head2 $entry->author([ $author ])
+
+The name or email address of the person who posted the entry.
+
+=head2 $entry->id([ $id ])
+
+The unique ID of the entry.
+
+=head2 $entry->issued([ $issued ])
+
+A I<DateTime> object representing the date and time at which the entry
+was posted.
+
+If present, I<$issued> should be a I<DateTime> object.
+
+=head2 $entry->modified([ $modified ])
+
+A I<DateTime> object representing the last-modified date of the entry.
+
+If present, I<$modified> should be a I<DateTime> object.
+
+=head1 AUTHOR & COPYRIGHT
+
+Please see the I<XML::Feed> manpage for author, copyright, and license
+information.
+
+=cut
Added: packages/libxml-feed-perl/branches/upstream/current/lib/XML/Feed/RSS.pm
===================================================================
--- packages/libxml-feed-perl/branches/upstream/current/lib/XML/Feed/RSS.pm 2006-02-09 19:28:39 UTC (rev 2106)
+++ packages/libxml-feed-perl/branches/upstream/current/lib/XML/Feed/RSS.pm 2006-02-10 22:39:48 UTC (rev 2107)
@@ -0,0 +1,234 @@
+# $Id: RSS.pm 1865 2005-08-09 20:15:31Z btrott $
+
+package XML::Feed::RSS;
+use strict;
+
+use base qw( XML::Feed );
+use DateTime::Format::Mail;
+use DateTime::Format::W3CDTF;
+
+our $PREFERRED_PARSER = "XML::RSS";
+
+sub init_empty {
+ my $feed = shift;
+ eval "use $PREFERRED_PARSER"; die $@ if $@;
+ $feed->{rss} = $PREFERRED_PARSER->new( version => '2.0' );
+ $feed;
+}
+
+sub init_string {
+ my $feed = shift;
+ my($str) = @_;
+ $feed->init_empty;
+ if ($str) {
+ $feed->{rss}->parse($$str);
+ }
+ $feed;
+}
+
+sub format { 'RSS ' . $_[0]->{rss}->{'version'} }
+
+## The following elements are the same in all versions of RSS.
+sub title { shift->{rss}->channel('title', @_) }
+sub link { shift->{rss}->channel('link', @_) }
+sub description { shift->{rss}->channel('description', @_) }
+
+## This is RSS 2.0 only--what's the equivalent in RSS 1.0?
+sub copyright { shift->{rss}->channel('copyright', @_) }
+
+## The following all work transparently in any RSS version.
+sub language {
+ my $feed = shift;
+ if (@_) {
+ $feed->{rss}->channel('language', $_[0]);
+ $feed->{rss}->channel->{dc}{language} = $_[0];
+ } else {
+ $feed->{rss}->channel('language') ||
+ $feed->{rss}->channel->{dc}{language};
+ }
+}
+
+sub generator {
+ my $feed = shift;
+ if (@_) {
+ $feed->{rss}->channel('generator', $_[0]);
+ $feed->{rss}->channel->{'http://webns.net/mvcb/'}{generatorAgent} =
+ $_[0];
+ } else {
+ $feed->{rss}->channel('generator') ||
+ $feed->{rss}->channel->{'http://webns.net/mvcb/'}{generatorAgent};
+ }
+}
+
+sub author {
+ my $feed = shift;
+ if (@_) {
+ $feed->{rss}->channel('webMaster', $_[0]);
+ $feed->{rss}->channel->{dc}{creator} = $_[0];
+ } else {
+ $feed->{rss}->channel('webMaster') ||
+ $feed->{rss}->channel->{dc}{creator};
+ }
+}
+
+sub modified {
+ my $rss = shift->{rss};
+ if (@_) {
+ $rss->channel('pubDate',
+ DateTime::Format::Mail->format_datetime($_[0]));
+ ## XML::RSS is so weird... if I set this, it will try to use
+ ## the value for the lastBuildDate, which I don't want--because
+ ## this date is formatted for an RSS 1.0 feed. So it's commented out.
+ #$rss->channel->{dc}{date} =
+ # DateTime::Format::W3CDTF->format_datetime($_[0]);
+ } else {
+ if (my $ts = $rss->channel('pubDate')) {
+ return DateTime::Format::Mail->parse_datetime($ts);
+ } elsif ($ts = $rss->channel->{dc}{date}) {
+ return DateTime::Format::W3CDTF->parse_datetime($ts);
+ }
+ }
+}
+
+sub entries {
+ my $rss = $_[0]->{rss};
+ my @entries;
+ for my $item (@{ $rss->{items} }) {
+ push @entries, XML::Feed::Entry::RSS->wrap($item);
+ }
+ @entries;
+}
+
+sub add_entry {
+ my $feed = shift;
+ my($entry) = @_;
+ $feed->{rss}->add_item(%{ $entry->unwrap });
+}
+
+sub as_xml { $_[0]->{rss}->as_string }
+
+package XML::Feed::Entry::RSS;
+use strict;
+
+use XML::Feed::Content;
+
+use base qw( XML::Feed::Entry );
+
+sub init_empty { $_[0]->{entry} = { } }
+
+sub title {
+ my $entry = shift;
+ @_ ? $entry->{entry}{title} = $_[0] : $entry->{entry}{title};
+}
+
+sub link {
+ my $entry = shift;
+ if (@_) {
+ $entry->{entry}{link} = $_[0];
+ ## For RSS 2.0 output from XML::RSS. Sigh.
+ $entry->{entry}{permaLink} = $_[0];
+ } else {
+ $entry->{entry}{link} || $entry->{entry}{guid};
+ }
+}
+
+sub summary {
+ my $item = shift->{entry};
+ if (@_) {
+ $item->{description} = ref($_[0]) eq 'XML::Feed::Content' ?
+ $_[0]->body : $_[0];
+ ## Because of the logic below, we need to add some dummy content,
+ ## so that we'll properly recognize the description we enter as
+ ## the summary.
+ if (!$item->{'http://purl.org/rss/1.0/modules/content/'}{encoded} &&
+ !$item->{'http://www.w3.org/1999/xhtml'}{body}) {
+ $item->{'http://purl.org/rss/1.0/modules/content/'}{encoded} = ' ';
+ }
+ } else {
+ ## Some RSS feeds use <description> for a summary, and some use it
+ ## for the full content. Pretty gross. We don't want to return the
+ ## full content if the caller expects a summary, so the heuristic is:
+ ## if the <entry> contains both a <description> and one of the elements
+ ## typically used for the full content, use <description> as summary.
+ my $txt;
+ if ($item->{description} &&
+ ($item->{'http://purl.org/rss/1.0/modules/content/'}{encoded} ||
+ $item->{'http://www.w3.org/1999/xhtml'}{body})) {
+ $txt = $item->{description};
+ }
+ XML::Feed::Content->wrap({ type => 'text/plain', body => $txt });
+ }
+}
+
+sub content {
+ my $item = shift->{entry};
+ if (@_) {
+ my $c = ref($_[0]) eq 'XML::Feed::Content' ? $_[0]->body : $_[0];
+ $item->{'http://purl.org/rss/1.0/modules/content/'}{encoded} = $c;
+ } else {
+ my $body =
+ $item->{'http://purl.org/rss/1.0/modules/content/'}{encoded} ||
+ $item->{'http://www.w3.org/1999/xhtml'}{body} ||
+ $item->{description};
+ XML::Feed::Content->wrap({ type => 'text/html', body => $body });
+ }
+}
+
+sub category {
+ my $item = shift->{entry};
+ if (@_) {
+ $item->{category} = $item->{dc}{subject} = $_[0];
+ } else {
+ $item->{category} || $item->{dc}{subject};
+ }
+}
+
+sub author {
+ my $item = shift->{entry};
+ if (@_) {
+ $item->{author} = $item->{dc}{creator} = $_[0];
+ } else {
+ $item->{author} || $item->{dc}{creator};
+ }
+}
+
+## XML::RSS doesn't give us access to the rdf:about for the <item>,
+## so we have to fall back to the <link> element in RSS 1.0 feeds.
+sub id {
+ my $item = shift->{entry};
+ if (@_) {
+ $item->{guid} = $_[0];
+ } else {
+ $item->{guid} || $item->{link};
+ }
+}
+
+sub issued {
+ my $item = shift->{entry};
+ if (@_) {
+ $item->{dc}{date} = DateTime::Format::W3CDTF->format_datetime($_[0]);
+ $item->{pubDate} = DateTime::Format::Mail->format_datetime($_[0]);
+ } else {
+ if (my $ts = $item->{pubDate}) {
+ my $parser = DateTime::Format::Mail->new;
+ $parser->loose;
+ return $parser->parse_datetime($ts);
+ } elsif ($ts = $item->{dc}{date}) {
+ return DateTime::Format::W3CDTF->parse_datetime($ts);
+ }
+ }
+}
+
+sub modified {
+ my $item = shift->{entry};
+ if (@_) {
+ $item->{'http://purl.org/rss/1.0/modules/dcterms/'}{modified} =
+ DateTime::Format::W3CDTF->format_datetime($_[0]);
+ } else {
+ if (my $ts = $item->{'http://purl.org/rss/1.0/modules/dcterms/'}{modified}) {
+ return DateTime::Format::W3CDTF->parse_datetime($ts);
+ }
+ }
+}
+
+1;
Added: packages/libxml-feed-perl/branches/upstream/current/lib/XML/Feed.pm
===================================================================
--- packages/libxml-feed-perl/branches/upstream/current/lib/XML/Feed.pm 2006-02-09 19:28:39 UTC (rev 2106)
+++ packages/libxml-feed-perl/branches/upstream/current/lib/XML/Feed.pm 2006-02-10 22:39:48 UTC (rev 2107)
@@ -0,0 +1,316 @@
+# $Id: Feed.pm 1872 2005-08-12 04:28:42Z btrott $
+
+package XML::Feed;
+use strict;
+
+use base qw( Class::ErrorHandler );
+use Feed::Find;
+use URI::Fetch;
+use Carp;
+
+our $VERSION = '0.07';
+
+sub new {
+ my $class = shift;
+ my($format) = @_;
+ $format ||= 'Atom';
+ my $format_class = 'XML::Feed::' . $format;
+ eval "use $format_class";
+ Carp::croak("Unsupported format $format: $@") if $@;
+ my $feed = bless {}, join('::', __PACKAGE__, $format);
+ $feed->init_empty or return $class->error($feed->errstr);
+ $feed;
+}
+
+sub init_empty { 1 }
+
+sub parse {
+ my $class = shift;
+ my($stream) = @_;
+ return $class->error("Stream parameter is required") unless $stream;
+ my $feed = bless {}, $class;
+ my $xml = '';
+ if (UNIVERSAL::isa($stream, 'URI')) {
+ my $res = URI::Fetch->fetch($stream)
+ or return $class->error(URI::Fetch->errstr);
+ return $class->error("This feed has been permanently removed")
+ if $res->status == URI::Fetch::URI_GONE();
+ $xml = $res->content;
+ } elsif (ref($stream) eq 'SCALAR') {
+ $xml = $$stream;
+ } elsif (ref($stream)) {
+ while (read($stream, my($chunk), 8192)) {
+ $xml .= $chunk;
+ }
+ } else {
+ open my $fh, $stream
+ or return $class->error("Can't open $stream: $!");
+ while (read $fh, my($chunk), 8192) {
+ $xml .= $chunk;
+ }
+ close $fh;
+ }
+ return $class->error("Can't get feed XML content from $stream")
+ unless $xml;
+ my $format = $feed->identify_format(\$xml)
+ or return $class->error($feed->errstr);
+ my $format_class = join '::', __PACKAGE__, $format;
+ eval "use $format_class";
+ return $class->error("Unsupported format $format: $@") if $@;
+ bless $feed, $format_class;
+ $feed->init_string(\$xml) or return $class->error($feed->errstr);
+ $feed;
+}
+
+sub identify_format {
+ my $feed = shift;
+ my($xml) = @_;
+ ## Auto-detect feed type based on first element. This is prone
+ ## to breakage, but then again we don't want to parse the whole
+ ## feed ourselves.
+ my $tag;
+ while ($$xml =~ /<(\S+)/sg) {
+ (my $t = $1) =~ tr/a-zA-Z0-9:\-\?!//cd;
+ my $first = substr $t, 0, 1;
+ $tag = $t, last unless $first eq '?' || $first eq '!';
+ }
+ return $feed->error("Cannot find first element") unless $tag;
+ $tag =~ s/^.*://;
+ if ($tag eq 'rss' || $tag eq 'RDF') {
+ return 'RSS';
+ } elsif ($tag eq 'feed') {
+ return 'Atom';
+ } else {
+ return $feed->error("Cannot detect feed type");
+ }
+}
+
+sub find_feeds {
+ my $class = shift;
+ my($uri) = @_;
+ my @feeds = Feed::Find->find($uri)
+ or return $class->error(Feed::Find->errstr);
+ @feeds;
+}
+
+sub convert {
+ my $feed = shift;
+ my($format) = @_;
+ my $new = __PACKAGE__->new($format);
+ for my $field (qw( title link description language copyright modified generator )) {
+ my $val = $feed->$field();
+ next unless defined $val;
+ $new->$field($val);
+ }
+ for my $entry ($feed->entries) {
+ $new->add_entry($entry->convert($format));
+ }
+ $new;
+}
+
+sub splice {
+ my $feed = shift;
+ my($other) = @_;
+ my %ids = map { $_->id => 1 } $feed->entries;
+ for my $entry ($other->entries) {
+ $feed->add_entry($entry) unless $ids{$entry->id}++;
+ }
+}
+
+sub format;
+sub title;
+sub link;
+sub description;
+sub language;
+sub author;
+sub copyright;
+sub modified;
+sub generator;
+sub add_entry;
+sub entries;
+sub as_xml;
+
+sub tagline { shift->description(@_) }
+sub items { $_[0]->entries }
+
+1;
+__END__
+
+=head1 NAME
+
+XML::Feed - Syndication feed parser and auto-discovery
+
+=head1 SYNOPSIS
+
+ use XML::Feed;
+ my $feed = XML::Feed->parse(URI->new('http://example.com/atom.xml'))
+ or die XML::Feed->errstr;
+ print $feed->title, "\n";
+ for my $entry ($feed->entries) {
+ }
+
+ ## Find all of the syndication feeds on a given page, using
+ ## auto-discovery.
+ my @feeds = XML::Feed->find_feeds('http://example.com/');
+
+=head1 DESCRIPTION
+
+I<XML::Feed> is a syndication feed parser for both RSS and Atom feeds. It
+also implements feed auto-discovery for finding feeds, given a URI.
+
+I<XML::Feed> supports the following syndication feed formats:
+
+=over 4
+
+=item * RSS 0.91
+
+=item * RSS 1.0
+
+=item * RSS 2.0
+
+=item * Atom
+
+=back
+
+The goal of I<XML::Feed> is to provide a unified API for parsing and using
+the various syndication formats. The different flavors of RSS and Atom
+handle data in different ways: date handling; summaries and content;
+escaping and quoting; etc. This module attempts to remove those differences
+by providing a wrapper around the formats and the classes implementing
+those formats (I<XML::RSS> and I<XML::Atom::Feed>). For example, dates are
+handled differently in each of the above formats. To provide a unified API for
+date handling, I<XML::Feed> converts all date formats transparently into
+I<DateTime> objects, which it then returns to the caller.
+
+=head1 USAGE
+
+=head2 XML::Feed->new($format)
+
+Creates a new empty I<XML::Feed> object using the format I<$format>.
+
+=head2 XML::Feed->parse($stream)
+
+Parses a syndication feed identified by I<$stream>. I<$stream> can be any
+one of the following:
+
+=over 4
+
+=item * Scalar reference
+
+A reference to string containing the XML body of the feed.
+
+=item * Filehandle
+
+An open filehandle from which the feed XML will be read.
+
+=item * File name
+
+The name of a file containing the feed XML.
+
+=item * URI object
+
+A URI from which the feed XML will be retrieved.
+
+=back
+
+=head2 XML::Feed->find_feeds($uri)
+
+Given a URI I<$uri>, use auto-discovery to find all of the feeds linked
+from that page (using I<E<lt>linkE<gt>> tags).
+
+Returns a list of feed URIs.
+
+=head2 $feed->convert($format)
+
+Converts the I<XML::Feed> object into the I<$format> format, and returns
+the new object.
+
+=head2 $feed->splice($other_feed)
+
+Splices in all of the entries from the feed I<$other_feed> into I<$feed>,
+skipping posts that are already in I<$feed>.
+
+=head2 $feed->format
+
+Returns the format of the feed (C<Atom>, or some version of C<RSS>).
+
+=head2 $feed->title([ $title ])
+
+The title of the feed/channel.
+
+=head2 $feed->link([ $uri ])
+
+The permalink of the feed/channel.
+
+=head2 $feed->tagline([ $tagline ])
+
+The description or tagline of the feed/channel.
+
+=head2 $feed->description([ $description ])
+
+Alias for I<$feed-E<gt>tagline>.
+
+=head2 $feed->author([ $author ])
+
+The author of the feed/channel.
+
+=head2 $feed->language([ $language ])
+
+The language of the feed.
+
+=head2 $feed->copyright([ $copyright ])
+
+The copyright notice of the feed.
+
+=head2 $feed->modified([ $modified ])
+
+A I<DateTime> object representing the last-modified date of the feed.
+
+If present, I<$modified> should be a I<DateTime> object.
+
+=head2 $feed->generator([ $generator ])
+
+The generator of the feed.
+
+=head2 $feed->entries
+
+A list of the entries/items in the feed. Returns an array containing
+I<XML::Feed::Entry> objects.
+
+=head2 $feed->add_entry($entry)
+
+Adds an entry to the feed. I<$entry> should be an I<XML::Feed::Entry>
+object in the correct format for the feed.
+
+=head2 $feed->as_xml
+
+Returns an XML representation of the feed, in the format determined by
+the current format of the I<$feed> object.
+
+=head1 PACKAGE VARIABLES
+
+=over 4
+
+=item C<$XML::Feed::RSS::PREFERRED_PARSER>
+
+If you want to use another RSS parser class than XML::RSS (default), you can
+change the class by setting C<$PREFERRED_PARSER> variable in XML::Feed::RSS
+package.
+
+ $XML::Feed::RSS::PREFERRED_PARSER = "XML::RSS::LibXML";
+
+B<Note:> this will only work for parsing feeds, not creating feeds.
+
+=back
+
+=head1 LICENSE
+
+I<XML::Feed> is free software; you may redistribute it and/or modify it
+under the same terms as Perl itself.
+
+=head1 AUTHOR & COPYRIGHT
+
+Except where otherwise noted, I<XML::Feed> is Copyright 2004-2005
+Six Apart, cpan at sixapart.com. All rights reserved.
+
+=cut
Added: packages/libxml-feed-perl/branches/upstream/current/t/00-compile.t
===================================================================
--- packages/libxml-feed-perl/branches/upstream/current/t/00-compile.t 2006-02-09 19:28:39 UTC (rev 2106)
+++ packages/libxml-feed-perl/branches/upstream/current/t/00-compile.t 2006-02-10 22:39:48 UTC (rev 2107)
@@ -0,0 +1,9 @@
+# $Id: 00-compile.t 1867 2005-08-09 20:41:15Z btrott $
+
+use strict;
+use Test::More tests => 4;
+
+use_ok('XML::Feed');
+use_ok('XML::Feed::Entry');
+use_ok('XML::Feed::RSS');
+use_ok('XML::Feed::Atom');
Added: packages/libxml-feed-perl/branches/upstream/current/t/01-parse.t
===================================================================
--- packages/libxml-feed-perl/branches/upstream/current/t/01-parse.t 2006-02-09 19:28:39 UTC (rev 2106)
+++ packages/libxml-feed-perl/branches/upstream/current/t/01-parse.t 2006-02-10 22:39:48 UTC (rev 2107)
@@ -0,0 +1,70 @@
+# $Id: 01-parse.t 1867 2005-08-09 20:41:15Z btrott $
+
+use strict;
+use Test::More tests => 70;
+use XML::Feed;
+use URI;
+
+my %Feeds = (
+ 't/samples/atom.xml' => 'Atom',
+ 't/samples/rss10.xml' => 'RSS 1.0',
+ 't/samples/rss20.xml' => 'RSS 2.0',
+);
+
+## First, test all of the various ways of calling parse.
+my $feed;
+my $file = 't/samples/atom.xml';
+$feed = XML::Feed->parse($file);
+isa_ok($feed, 'XML::Feed::Atom');
+is($feed->title, 'First Weblog');
+open my $fh, $file or die "Can't open $file: $!";
+$feed = XML::Feed->parse($fh);
+isa_ok($feed, 'XML::Feed::Atom');
+is($feed->title, 'First Weblog');
+seek $fh, 0, 0;
+my $xml = do { local $/; <$fh> };
+$feed = XML::Feed->parse(\$xml);
+isa_ok($feed, 'XML::Feed::Atom');
+is($feed->title, 'First Weblog');
+$feed = XML::Feed->parse(URI->new("file:$file"));
+isa_ok($feed, 'XML::Feed::Atom');
+is($feed->title, 'First Weblog');
+
+## Then try calling all of the unified API methods.
+for my $file (sort keys %Feeds) {
+ my $feed = XML::Feed->parse($file) or die XML::Feed->errstr;
+ my($subclass) = $Feeds{$file} =~ /^(\w+)/;
+ isa_ok($feed, 'XML::Feed::' . $subclass);
+ is($feed->format, $Feeds{$file});
+ is($feed->language, 'en-us');
+ is($feed->title, 'First Weblog');
+ is($feed->link, 'http://localhost/weblog/');
+ is($feed->tagline, 'This is a test weblog.');
+ is($feed->description, 'This is a test weblog.');
+ my $dt = $feed->modified;
+ isa_ok($dt, 'DateTime');
+ $dt->set_time_zone('UTC');
+ is($dt->iso8601, '2004-05-30T07:39:57');
+ is($feed->author, 'Melody');
+
+ my @entries = $feed->entries;
+ is(scalar @entries, 2);
+ my $entry = $entries[0];
+ is($entry->title, 'Entry Two');
+ is($entry->link, 'http://localhost/weblog/2004/05/entry_two.html');
+ $dt = $entry->issued;
+ isa_ok($dt, 'DateTime');
+ $dt->set_time_zone('UTC');
+ is($dt->iso8601, '2004-05-30T07:39:25');
+ like($entry->content->body, qr/<p>Hello!<\/p>/);
+ is($entry->summary->body, 'Hello!...');
+ is($entry->category, 'Travel');
+ is($entry->author, 'Melody');
+ ok($entry->id);
+}
+
+$feed = XML::Feed->parse('t/samples/rss20-no-summary.xml')
+ or die XML::Feed->errstr;
+my $entry = ($feed->entries)[0];
+ok(!$entry->summary->body);
+like($entry->content->body, qr/<p>This is a test.<\/p>/);
Added: packages/libxml-feed-perl/branches/upstream/current/t/02-create.t
===================================================================
--- packages/libxml-feed-perl/branches/upstream/current/t/02-create.t 2006-02-09 19:28:39 UTC (rev 2106)
+++ packages/libxml-feed-perl/branches/upstream/current/t/02-create.t 2006-02-10 22:39:48 UTC (rev 2107)
@@ -0,0 +1,74 @@
+# $Id$
+
+use strict;
+use Test::More tests => 66;
+use XML::Feed;
+use XML::Feed::Entry;
+use XML::Feed::Content;
+use DateTime;
+
+for my $format (qw( Atom RSS )) {
+ my $feed = XML::Feed->new($format);
+ isa_ok($feed, 'XML::Feed::' . $format);
+ like($feed->format, qr/^$format/, 'Format is correct');
+ $feed->title('My Feed');
+ is($feed->title, 'My Feed', 'feed title is correct');
+ $feed->link('http://www.example.com/');
+ is($feed->link, 'http://www.example.com/', 'feed link is correct');
+ $feed->description('Wow!');
+ is($feed->description, 'Wow!', 'feed description is correct');
+ is($feed->tagline, 'Wow!', 'tagline works as alias');
+ $feed->tagline('Again');
+ is($feed->tagline, 'Again', 'setting via tagline works');
+ $feed->language('en_US');
+ is($feed->language, 'en_US', 'feed language is correct');
+ $feed->author('Ben');
+ is($feed->author, 'Ben', 'feed author is correct');
+ $feed->copyright('Copyright 2005 Me');
+ is($feed->copyright, 'Copyright 2005 Me', 'feed copyright is correct');
+ my $now = DateTime->now;
+ $feed->modified($now);
+ isa_ok($feed->modified, 'DateTime', 'modified returns a DateTime');
+ is($feed->modified->iso8601, $now->iso8601, 'feed modified is correct');
+ $feed->generator('Movable Type');
+ is($feed->generator, 'Movable Type', 'feed generator is correct');
+ ok($feed->as_xml, 'as_xml returns something');
+
+ my $entry = XML::Feed::Entry->new($format);
+ isa_ok($entry, 'XML::Feed::Entry::' . $format);
+ $entry->title('Foo Bar');
+ is($entry->title, 'Foo Bar', 'entry title is correct');
+ $entry->link('http://www.example.com/foo/bar.html');
+ is($entry->link, 'http://www.example.com/foo/bar.html', 'entry link is correct');
+ $entry->summary('This is a summary.');
+ isa_ok($entry->summary, 'XML::Feed::Content');
+ is($entry->summary->body, 'This is a summary.', 'entry summary is correct');
+ $entry->content('This is the content.');
+ isa_ok($entry->content, 'XML::Feed::Content');
+ is($entry->content->type, 'text/html', 'entry content type is correct');
+ is($entry->content->body, 'This is the content.', 'entry content body is correct');
+ $entry->content(XML::Feed::Content->new({
+ body => 'This is the content (again).',
+ type => 'text/plain',
+ }));
+ isa_ok($entry->content, 'XML::Feed::Content');
+ is($entry->content->body, 'This is the content (again).', 'setting with XML::Feed::Content works');
+ $entry->category('Television');
+ is($entry->category, 'Television', 'entry category is correct');
+ $entry->author('Foo Baz');
+ is($entry->author, 'Foo Baz', 'entry author is correct');
+ $entry->id('foo:bar-15132');
+ is($entry->id, 'foo:bar-15132', 'entry id is correct');
+ my $dt = DateTime->now;
+ $entry->issued($dt);
+ isa_ok($entry->issued, 'DateTime');
+ is($entry->issued->iso8601, $dt->iso8601, 'entry issued is correct');
+ $entry->modified($dt);
+ isa_ok($entry->modified, 'DateTime');
+ is($entry->modified->iso8601, $dt->iso8601, 'entry modified is correct');
+
+ $feed->add_entry($entry);
+ my @e = $feed->entries;
+ is(scalar @e, 1, 'One post in the feed');
+ is($e[0]->title, 'Foo Bar', 'Correct post');
+}
Added: packages/libxml-feed-perl/branches/upstream/current/t/04-splice.t
===================================================================
--- packages/libxml-feed-perl/branches/upstream/current/t/04-splice.t 2006-02-09 19:28:39 UTC (rev 2106)
+++ packages/libxml-feed-perl/branches/upstream/current/t/04-splice.t 2006-02-10 22:39:48 UTC (rev 2107)
@@ -0,0 +1,18 @@
+# $Id: 04-splice.t 1872 2005-08-12 04:28:42Z btrott $
+
+use strict;
+use Test::More tests => 3;
+use XML::Feed;
+
+my $feed = XML::Feed->new('Atom');
+
+my $other = XML::Feed->parse('t/samples/atom.xml');
+$feed->splice($other);
+is(scalar $feed->entries, 2, '2 entries in the feed after splicing');
+
+$feed->splice($other);
+is(scalar $feed->entries, 2, 'Still 2 entries after splicing again');
+
+$other = XML::Feed->parse('t/samples/rss10.xml')->convert('Atom');
+$feed->splice($other);
+is(scalar $feed->entries, 4, 'Now 4 entries after splicing in RSS 1.0 feed');
Added: packages/libxml-feed-perl/branches/upstream/current/t/samples/atom.xml
===================================================================
--- packages/libxml-feed-perl/branches/upstream/current/t/samples/atom.xml 2006-02-09 19:28:39 UTC (rev 2106)
+++ packages/libxml-feed-perl/branches/upstream/current/t/samples/atom.xml 2006-02-10 22:39:48 UTC (rev 2107)
@@ -0,0 +1,51 @@
+<?xml version="1.0" encoding="utf-8"?>
+<feed version="0.3" xmlns="http://purl.org/atom/ns#" xmlns:dc="http://purl.org/dc/elements/1.1/" xml:lang="en-us">
+<title>First Weblog</title>
+<link rel="alternate" type="text/html" href="http://localhost/weblog/" />
+<modified>2004-05-30T07:39:57Z</modified>
+<tagline>This is a test weblog.</tagline>
+<id>tag:localhost,2004:/weblog//1</id>
+<generator url="http://www.movabletype.org/" version="3.0D">Movable Type</generator>
+<copyright>Copyright (c) 2004, Melody</copyright>
+<entry>
+<title>Entry Two</title>
+<link rel="alternate" type="text/html" href="http://localhost/weblog/2004/05/entry_two.html" />
+<modified>2004-05-30T07:39:53Z</modified>
+<issued>2004-05-30T07:39:25Z</issued>
+<id>tag:localhost,2004:/weblog//1.28</id>
+<created>2004-05-30T07:39:25Z</created>
+<summary type="text/plain">Hello!...</summary>
+<author>
+<name>Melody</name>
+
+<email>melody at example.com</email>
+</author>
+<dc:subject>Travel</dc:subject>
+<content type="text/html" mode="escaped" xml:lang="en" xml:base="http://localhost/weblog/">
+<![CDATA[<p>Hello!</p>]]>
+
+</content>
+</entry>
+<entry>
+<title>Test</title>
+<link rel="alternate" type="text/html" href="http://localhost/weblog/2004/05/test.html" />
+<modified>2004-05-30T06:24:08Z</modified>
+<issued>2004-05-09T07:03:28Z</issued>
+<id>tag:localhost,2004:/weblog//1.1</id>
+<created>2004-05-09T07:03:28Z</created>
+<summary type="text/plain">This is a test. Why don't you come down to our place for a coffee and a chat?...</summary>
+<author>
+<name>Melody</name>
+
+<email>melody at example.com</email>
+</author>
+<dc:subject>Sports</dc:subject>
+<content type="text/html" mode="escaped" xml:lang="en" xml:base="http://localhost/weblog/">
+<![CDATA[<p>This is a test.</p>
+
+<p>Why don't you come down to our place for a coffee and a <strong>chat</strong>?</p>]]>
+
+</content>
+</entry>
+
+</feed>
Added: packages/libxml-feed-perl/branches/upstream/current/t/samples/rss10.xml
===================================================================
--- packages/libxml-feed-perl/branches/upstream/current/t/samples/rss10.xml 2006-02-09 19:28:39 UTC (rev 2106)
+++ packages/libxml-feed-perl/branches/upstream/current/t/samples/rss10.xml 2006-02-10 22:39:48 UTC (rev 2107)
@@ -0,0 +1,52 @@
+<?xml version="1.0" encoding="utf-8"?>
+
+<rdf:RDF
+xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#"
+xmlns:dc="http://purl.org/dc/elements/1.1/"
+xmlns:sy="http://purl.org/rss/1.0/modules/syndication/"
+xmlns:admin="http://webns.net/mvcb/"
+xmlns:cc="http://web.resource.org/cc/"
+xmlns:content="http://purl.org/rss/1.0/modules/content/"
+xmlns="http://purl.org/rss/1.0/">
+
+<channel rdf:about="http://localhost/weblog/">
+<title>First Weblog</title>
+<link>http://localhost/weblog/</link>
+<description>This is a test weblog.</description>
+<dc:language>en-us</dc:language>
+<dc:creator>Melody</dc:creator>
+<dc:date>2004-05-29T23:39:57-08:00</dc:date>
+<admin:generatorAgent rdf:resource="http://www.movabletype.org/?v=3.0D" />
+
+
+<items>
+<rdf:Seq><rdf:li rdf:resource="http://localhost/weblog/2004/05/entry_two.html" />
+<rdf:li rdf:resource="http://localhost/weblog/2004/05/test.html" />
+</rdf:Seq>
+</items>
+
+</channel>
+
+<item rdf:about="http://localhost/weblog/2004/05/entry_two.html">
+<title>Entry Two</title>
+<link>http://localhost/weblog/2004/05/entry_two.html</link>
+<description>Hello!...</description>
+<content:encoded><![CDATA[<p>Hello!</p>]]></content:encoded>
+<dc:subject>Travel</dc:subject>
+<dc:creator>Melody</dc:creator>
+<dc:date>2004-05-29T23:39:25-08:00</dc:date>
+</item>
+<item rdf:about="http://localhost/weblog/2004/05/test.html">
+<title>Test</title>
+<link>http://localhost/weblog/2004/05/test.html</link>
+<description>This is a test. Why don't you come down to our place for a coffee and a chat?...</description>
+<content:encoded><![CDATA[<p>This is a test.</p>
+
+<p>Why don't you come down to our place for a coffee and a <strong>chat</strong>?</p>]]></content:encoded>
+<dc:subject>Sports</dc:subject>
+<dc:creator>Melody</dc:creator>
+<dc:date>2004-05-08T23:03:28-08:00</dc:date>
+</item>
+
+
+</rdf:RDF>
Added: packages/libxml-feed-perl/branches/upstream/current/t/samples/rss20-no-summary.xml
===================================================================
--- packages/libxml-feed-perl/branches/upstream/current/t/samples/rss20-no-summary.xml 2006-02-09 19:28:39 UTC (rev 2106)
+++ packages/libxml-feed-perl/branches/upstream/current/t/samples/rss20-no-summary.xml 2006-02-10 22:39:48 UTC (rev 2107)
@@ -0,0 +1,16 @@
+<?xml version="1.0" encoding="utf-8"?>
+<rss version="2.0" xmlns:xhtml="http://www.w3.org/1999/xhtml">
+<channel>
+<title>First Weblog</title>
+<link>http://localhost/weblog/</link>
+<description>This is a test weblog.</description>
+
+<item>
+<title>Test</title>
+<description><p>This is a test.</p>
+
+<p>Why don't you come down to our place for a coffee and a <strong>chat</strong>?</p></description>
+<link>http://localhost/weblog/2004/05/test.html</link>
+</item>
+</channel>
+</rss>
Added: packages/libxml-feed-perl/branches/upstream/current/t/samples/rss20.xml
===================================================================
--- packages/libxml-feed-perl/branches/upstream/current/t/samples/rss20.xml 2006-02-09 19:28:39 UTC (rev 2106)
+++ packages/libxml-feed-perl/branches/upstream/current/t/samples/rss20.xml 2006-02-10 22:39:48 UTC (rev 2107)
@@ -0,0 +1,39 @@
+<?xml version="1.0" encoding="utf-8"?>
+<rss version="2.0" xmlns:xhtml="http://www.w3.org/1999/xhtml">
+<channel>
+<title>First Weblog</title>
+<link>http://localhost/weblog/</link>
+<description>This is a test weblog.</description>
+<language>en-us</language>
+<copyright>Copyright 2004</copyright>
+<lastBuildDate>Sat, 29 May 2004 23:39:25 -0800</lastBuildDate>
+<pubDate>Sat, 29 May 2004 23:39:57 -0800</pubDate>
+<generator>http://www.movabletype.org/?v=3.0D</generator>
+<docs>http://blogs.law.harvard.edu/tech/rss</docs>
+<webMaster>Melody</webMaster>
+
+<item>
+<title>Entry Two</title>
+<description>Hello!...</description>
+<xhtml:body><![CDATA[<p>Hello!</p>]]></xhtml:body>
+<link>http://localhost/weblog/2004/05/entry_two.html</link>
+<author>Melody</author>
+<guid>http://localhost/weblog/2004/05/entry_two.html</guid>
+<category>Travel</category>
+<pubDate>Sat, 29 May 2004 23:39:25 -0800</pubDate>
+</item>
+<item>
+<title>Test</title>
+<description>This is a test. Why don't you come down to our place for a coffee and a chat?...</description>
+<xhtml:body><![CDATA[<p>This is a test.</p>
+
+<p>Why don't you come down to our place for a coffee and a <strong>chat</strong>?</p>]]></xhtml:body>
+<link>http://localhost/weblog/2004/05/test.html</link>
+<guid>http://localhost/weblog/2004/05/test.html</guid>
+<category>Sports</category>
+<pubDate>Sat, 08 May 2004 23:03:28 -0800</pubDate>
+</item>
+
+
+</channel>
+</rss>
More information about the Pkg-perl-cvs-commits
mailing list