r31445 - in /branches/upstream/libwww-freshmeat-perl/current: Build.PL Changes MANIFEST META.yml Makefile.PL lib/WWW/Freshmeat.pm t/project.t xt/ xt/project1.t
antonio-guest at users.alioth.debian.org
antonio-guest at users.alioth.debian.org
Thu Mar 5 00:37:55 UTC 2009
Author: antonio-guest
Date: Thu Mar 5 00:37:52 2009
New Revision: 31445
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=31445
Log:
[svn-upgrade] Integrating new upstream version, libwww-freshmeat-perl (0.12)
Added:
branches/upstream/libwww-freshmeat-perl/current/xt/
branches/upstream/libwww-freshmeat-perl/current/xt/project1.t
Modified:
branches/upstream/libwww-freshmeat-perl/current/Build.PL
branches/upstream/libwww-freshmeat-perl/current/Changes
branches/upstream/libwww-freshmeat-perl/current/MANIFEST
branches/upstream/libwww-freshmeat-perl/current/META.yml
branches/upstream/libwww-freshmeat-perl/current/Makefile.PL
branches/upstream/libwww-freshmeat-perl/current/lib/WWW/Freshmeat.pm
branches/upstream/libwww-freshmeat-perl/current/t/project.t
Modified: branches/upstream/libwww-freshmeat-perl/current/Build.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libwww-freshmeat-perl/current/Build.PL?rev=31445&op=diff
==============================================================================
--- branches/upstream/libwww-freshmeat-perl/current/Build.PL (original)
+++ branches/upstream/libwww-freshmeat-perl/current/Build.PL Thu Mar 5 00:37:52 2009
@@ -1,4 +1,4 @@
-use 5.006;
+use 5.008;
use strict;
use warnings;
use Module::Build;
@@ -6,15 +6,16 @@
my $builder = Module::Build->new(
module_name => 'WWW::Freshmeat',
license => 'perl',
- dist_author => 'Cedric Bouvier <cbouvi at cpan.org>',
+ dist_author => 'Alexandr Ciornii <alexchorny at gmail.com>',
dist_version_from => 'lib/WWW/Freshmeat.pm',
requires => {
'LWP::UserAgent' => 0,
'XML::Simple' => 0,
- 'perl' => 5.006,
+ 'perl' => 5.008,
+ 'HTML::TreeBuilder::XPath' => 0.09,
},
build_requires => {
- 'Test::More' => 0,
+ 'Test::More' => 0.17, #isa_ok
'LWP::Online' => 1.06,
},
add_to_cleanup => [ 'WWW-Freshmeat-*' ],
Modified: branches/upstream/libwww-freshmeat-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libwww-freshmeat-perl/current/Changes?rev=31445&op=diff
==============================================================================
--- branches/upstream/libwww-freshmeat-perl/current/Changes (original)
+++ branches/upstream/libwww-freshmeat-perl/current/Changes Thu Mar 5 00:37:52 2009
@@ -1,4 +1,22 @@
Revision history for WWW-Freshmeat
+
+0.12 2009-02-18
+ - added $WWW::Freshmeat::Project::project_re - regexp for project name
+ - url_list will work with projects containing '.'
+ - added real_author to fetch name of author (not maintainer)
+
+0.11 2009-02-15
+ - url_list has argument to try to floow Freshmeat redirect links
+ - rewrote redir_url not to fetch page it was redirected to
+
+0.10 2009-02-14
+ - 5.008 only (due to 'ISO-8859-1' encoding of XML file)
+ - projectname_short project method for retrieving project string id
+ - HTML::TreeBuilder::XPath is now required
+ - supports fetching branch list
+ - url_list project method for retrieving project URL list
+ - popularity project method for retrieving project popularity data
+ - redir_url in WWW::Freshmeat to fetch url which link will redirect to
0.03 2009-02-03
- retrieve_project for project that does not exist will return undef
Modified: branches/upstream/libwww-freshmeat-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libwww-freshmeat-perl/current/MANIFEST?rev=31445&op=diff
==============================================================================
--- branches/upstream/libwww-freshmeat-perl/current/MANIFEST (original)
+++ branches/upstream/libwww-freshmeat-perl/current/MANIFEST Thu Mar 5 00:37:52 2009
@@ -10,3 +10,4 @@
t/pod.t
t/project.t
t/nonexistingproject.t
+xt/project1.t
Modified: branches/upstream/libwww-freshmeat-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libwww-freshmeat-perl/current/META.yml?rev=31445&op=diff
==============================================================================
--- branches/upstream/libwww-freshmeat-perl/current/META.yml (original)
+++ branches/upstream/libwww-freshmeat-perl/current/META.yml Thu Mar 5 00:37:52 2009
@@ -1,19 +1,20 @@
--- #YAML:1.0
name: WWW-Freshmeat
-version: 0.03
+version: 0.12
abstract: automates searches on Freshmeat.net
author:
- - Cedric Bouvier <cbouvi at cpan.org>
+ - Alexandr Ciornii <alexchorny at gmail.com>
license: perl
distribution_type: module
configure_requires:
ExtUtils::MakeMaker: 0
requires:
- LWP::Online: 1.06
- LWP::UserAgent: 0
- perl: 5.006
- Test::More: 0
- XML::Simple: 0
+ HTML::TreeBuilder::XPath: 0.09
+ LWP::Online: 1.06
+ LWP::UserAgent: 0
+ perl: 5.008
+ Test::More: 0.17
+ XML::Simple: 0
no_index:
directory:
- t
Modified: branches/upstream/libwww-freshmeat-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libwww-freshmeat-perl/current/Makefile.PL?rev=31445&op=diff
==============================================================================
--- branches/upstream/libwww-freshmeat-perl/current/Makefile.PL (original)
+++ branches/upstream/libwww-freshmeat-perl/current/Makefile.PL Thu Mar 5 00:37:52 2009
@@ -1,24 +1,25 @@
-use 5.006;
+use 5.008;
use strict;
use warnings;
use ExtUtils::MakeMaker;
WriteMakefile(
NAME => 'WWW::Freshmeat',
- AUTHOR => 'Cedric Bouvier <cbouvi at cpan.org>',
+ AUTHOR => 'Alexandr Ciornii <alexchorny at gmail.com>',
VERSION_FROM => 'lib/WWW/Freshmeat.pm',
ABSTRACT_FROM => 'lib/WWW/Freshmeat.pm',
PL_FILES => {},
PREREQ_PM => {
- 'Test::More' => 0,
+ 'Test::More' => 0.17, #isa_ok
'LWP::UserAgent' => 0,
'XML::Simple' => 0,
'LWP::Online' => 1.06,
+ 'HTML::TreeBuilder::XPath' => 0.09,
},
($ExtUtils::MakeMaker::VERSION ge '6.31'?
('LICENSE' => 'perl', ) : ()),
($ExtUtils::MakeMaker::VERSION ge '6.48'?
- ('MIN_PERL_VERSION' => 5.006,) : ()),
+ ('MIN_PERL_VERSION' => 5.008,) : ()),
dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', },
clean => { FILES => 'WWW-Freshmeat-*' },
);
Modified: branches/upstream/libwww-freshmeat-perl/current/lib/WWW/Freshmeat.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libwww-freshmeat-perl/current/lib/WWW/Freshmeat.pm?rev=31445&op=diff
==============================================================================
--- branches/upstream/libwww-freshmeat-perl/current/lib/WWW/Freshmeat.pm (original)
+++ branches/upstream/libwww-freshmeat-perl/current/lib/WWW/Freshmeat.pm Thu Mar 5 00:37:52 2009
@@ -1,6 +1,6 @@
package WWW::Freshmeat;
-use 5.006;
+use 5.008;
use strict;
use warnings;
@@ -10,11 +10,11 @@
=head1 VERSION
-Version 0.03
-
-=cut
-
-our $VERSION = '0.03';
+Version 0.12
+
+=cut
+
+our $VERSION = '0.12';
use XML::Simple qw();
@@ -26,11 +26,11 @@
my $project = $fm->retrieve_project('project_id');
- foreach ( @projects, $project ) {
- print $_->name(), "\n";
- print $_->url(), "\n";
- print $_->version(), "\n";
- print $_->description(), "\n";
+ foreach my $p ( @projects, $project ) {
+ print $p->name(), "\n";
+ print $p->url(), "\n";
+ print $p->version(), "\n";
+ print $p->description(), "\n";
}
=cut
@@ -47,7 +47,7 @@
return $self;
}
-foreach my $field ( qw( url_project_page url_homepage projectname_full desc_short desc_full license www_freshmeat ) ) {
+foreach my $field ( qw( url_project_page url_homepage projectname_full desc_short desc_full license www_freshmeat projectname_short) ) {
no strict 'refs';
*$field = sub {
my $self = shift;
@@ -67,18 +67,126 @@
sub trove_id { $_[0]{descriminators}{trove_id} }
sub url {
-
my $self = shift;
return $self->{url} if $self->{url};
my $freshmeat_url = $self->{url_project_page};
my $url = $self->url_homepage() or return;
- my $res = $self->www_freshmeat()->get($url) or return $self->{url} = $freshmeat_url;
- my $req = $res->request() or return $self->{url} = $freshmeat_url;
- my $uri = $req->uri() or return $self->{url} = $freshmeat_url;
- return $self->{url} = $uri->as_string();
-}
+ $self->{url} = $self->www_freshmeat()->redir_url($url);
+ return $self->{url};
+}
+
+sub init_html {
+ my $self = shift;
+ my $html = shift;
+ require HTML::TreeBuilder::XPath;
+ $self->{_html}=HTML::TreeBuilder::XPath->new_from_content($html);
+}
+
+sub _html_tree {
+ my $self = shift;
+ if (!$self->{_html}) {
+ my $id=$self->projectname_short();
+ my $url = "http://freshmeat.net/projects/$id/";
+ $self->www_freshmeat()->agent('User-Agent: Mozilla/5.0 (Windows; U; Windows NT 5.1; ru; rv:1.8.1.19) Gecko/20081201 Firefox/2.0.0.19');
+ my $response = $self->www_freshmeat()->get($url);
+ my $html = $response->content();
+ if ($response->is_success) {
+ $self->init_html($html);
+ } else {
+ die "Could not GET $url (".$response->status_line.", $html)";
+ }
+ }
+ return $self->{_html};
+}
+
+sub branches {
+ my $self = shift;
+ my $tree=$self->_html_tree();
+ my $nodes=$tree->findnodes(q{//table/tr/th/b[text()='Branch']/../../following-sibling::tr/td[1]/a});
+ my %list;
+ while (my $node=$nodes->shift) {
+ if ($node->attr('href') =~m#/branches/(\d+)/#) {
+ $list{$1}=$node->as_text();
+ } else {
+ die;
+ }
+ }
+ return %list;
+}
+
+our $project_re=qr/[a-z0-9_\-\.]+/;
+sub url_list {
+ my $self = shift;
+ my $real=(@_>0?1:0);
+ my $tree=$self->_html_tree();
+ my $nodes=$tree->findnodes(q{/html/body/div/table/tr/td/table/tr/td/p/a[@href=~/\/redir/]}); #/
+ my %list;
+ while (my $node=$nodes->shift) {
+ if ($node->attr('href') =~m#/redir/$project_re/\d+/(url_\w+)/#) {
+ my $type=$1;
+ my $text=$node->as_text();
+ if ($text=~/\Q[..]\E/) {
+ if ($real) {
+ $list{$type}=$self->www_freshmeat()->redir_url('http://freshmeat.net'.$node->attr('href'));
+ } else {
+ $list{$type}=$node->attr('href');
+ }
+ } else {
+ $list{$type}=$text;
+ }
+ } else {
+ die "bad link:".$node->attr('href');
+ }
+ }
+ return %list;
+}
+
+my %popularity_conv=('Record hits'=>'record_hits','URL hits'=>'url_hits','Subscribers'=>'subscribers');
+sub popularity {
+ my $self = shift;
+ my $tree=$self->_html_tree();
+ my $nodes=$tree->findnodes(q{/html/body/div[1]/table/tr/td[2]/table/tr[3]/td[3]/table[2]/tr/td/small});
+ my %list;
+ if (my $node=$nodes->shift) {
+ my $text=$node->as_text();
+ $text=~s/ / /g;
+ my @list=grep {$_} split /<br(?: \/)?>|\s{4}/,$text;
+ foreach my $s (@list) {
+ $s=~s/^(?:^ |\s)+//s;
+ $s=~s/\s+$//s;
+ #print "F:$s\n";
+ if ($s=~/(\w[\w\s]+\w):\s+([\d,]+)/ and exists $popularity_conv{$1}) {
+ my $type=$popularity_conv{$1};
+ my $num=$2;
+ $num=~s/,//g;
+ $list{$type}=$num;
+ } else {
+ die "Cannot find popularity record: '$s'";
+ }
+
+ }
+ } else {
+ die "Cannot find popularity data";
+ }
+ return %list;
+}
+
+sub real_author {
+ my $self = shift;
+ my $tree=$self->_html_tree();
+ my $nodes=$tree->findnodes(q{/html/body/div[1]/table/tr/td[2]/table/tr[3]/td[1]/p[2]/b/..});
+ my %list;
+ if (my $node=$nodes->shift) {
+ my $text=$node->as_text;
+ $text=~s/^Author:\s+//s;
+ $text=~s/\s+\Q[contact developer]\E\s*$//s;
+ $text=~s/\s+<[^<>]+>\s*$//s;
+ return $text;
+ }
+}
+
package WWW::Freshmeat;
@@ -136,6 +244,35 @@
return WWW::Freshmeat::Project->new($data->{'project'}, $self);
}
+
+=item B<redir_url> I<STRING>
+
+Receives URL and returns URL which it redirects to.
+
+=cut
+
+sub redir_url {
+ my $self = shift;
+ my $url=shift;
+ $self->requests_redirectable([]);
+ my $response = $self->get($url) or return $url;
+ if ($response->is_redirect) {
+ #http://www.perlmonks.org/?node_id=147608
+ my $referral_uri = $response->header('Location');
+ {
+ # Some servers erroneously return a relative URL for redirects,
+ # so make it absolute if it not already is.
+ local $URI::ABS_ALLOW_RELATIVE_SCHEME = 1;
+ my $base = $response->base;
+ $referral_uri = $HTTP::URI_CLASS->new($referral_uri, $base)
+ ->abs($base);
+ }
+ return $referral_uri;
+ } else {
+ return $url;
+ }
+}
+
=back
=head2 WWW::Freshmeat::Project methods
@@ -156,6 +293,10 @@
=item B<desc_full>
=item B<license>
+
+=item B<trove_id>
+
+=item B<projectname_short>
=item B<www_freshmeat>
@@ -183,7 +324,27 @@
returns the actual homepage URL if it can be found, or the URL to the
freshmeat.net entry for the project.
+=item B<branches>
+
+List of branches for project. Returns hash in form of (branch id => branch name).
+
+=item B<popularity>
+
+Freshmeat popularity data for project. Returns hash with keys
+record_hits, url_hits, subscribers
+
+=item B<url_list>
+
+Returns list of URLs for project. You may need to use redir_url to get real link
+or just pass 1 as argument.
+
+=item B<real_author>
+
+Returns name of author (not maintainer).
+
=back
+
+
=head1 SEE ALSO
Modified: branches/upstream/libwww-freshmeat-perl/current/t/project.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libwww-freshmeat-perl/current/t/project.t?rev=31445&op=diff
==============================================================================
--- branches/upstream/libwww-freshmeat-perl/current/t/project.t (original)
+++ branches/upstream/libwww-freshmeat-perl/current/t/project.t Thu Mar 5 00:37:52 2009
@@ -1,11 +1,11 @@
-#!perl -T
+#!perl
use strict;
use warnings;
use LWP::Online ':skip_all';
-use Test::More tests => 12;
+use Test::More tests => 18;
-use WWW::Freshmeat;
+use WWW::Freshmeat 0.12;
my $fm = WWW::Freshmeat->new;
isa_ok($fm,'WWW::Freshmeat');
@@ -14,7 +14,7 @@
isa_ok($project,'WWW::Freshmeat::Project');
is($project->name(),'Hook::LexWrap');
-is($project->url(),'http://search.cpan.org/dist/Hook-LexWrap/');
+#is($project->url(),'http://search.cpan.org/dist/Hook-LexWrap/');
is($project->license(),'Perl License');
my @trove=@{$project->trove_id()};
my %hash;
@@ -25,3 +25,15 @@
#902 - OSI Approved :: Perl License
#176 - Perl
#910 - Software Development :: Libraries :: Perl Modules
+is($project->projectname_short(),'hook_lexwrap');
+is_deeply({$project->branches()},{'77120'=>'Default'},'branches');
+#%hash=$project->url_list;
+is_deeply({$project->url_list()},{
+'url_homepage'=>'http://search.cpan.org/dist/Hook-LexWrap/',
+'url_bugtracker'=>'http://rt.cpan.org/NoAuth/Bugs.html?Dist=Hook-LexWrap',
+},'URLs');
+my %pop=$project->popularity();
+cmp_ok($pop{'record_hits'},'>=',442);
+cmp_ok($pop{'url_hits'},'>=',216);
+cmp_ok($pop{'subscribers'},'>=',0);
+is($project->real_author(),'Damian Conway');
Added: branches/upstream/libwww-freshmeat-perl/current/xt/project1.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libwww-freshmeat-perl/current/xt/project1.t?rev=31445&op=file
==============================================================================
--- branches/upstream/libwww-freshmeat-perl/current/xt/project1.t (added)
+++ branches/upstream/libwww-freshmeat-perl/current/xt/project1.t Thu Mar 5 00:37:52 2009
@@ -1,0 +1,26 @@
+#!perl
+
+use strict;
+use warnings;
+use LWP::Online ':skip_all';
+use Test::More tests => 7;
+
+use WWW::Freshmeat;
+
+my $fm = WWW::Freshmeat->new;
+isa_ok($fm,'WWW::Freshmeat');
+
+my $project = $fm->retrieve_project('proc_reliable');
+
+isa_ok($project,'WWW::Freshmeat::Project');
+is($project->name(),'Proc::Reliable');
+is($project->url(),'http://www.zblob.com/software/dan_soft.html');
+is($project->license(),'Perl License');
+my @trove=@{$project->trove_id()};
+my %hash;
+ at hash{@trove}=();
+#902 - OSI Approved :: Perl License
+#176 - Perl
+#910 - Software Development :: Libraries :: Perl Modules
+is($project->projectname_short(),'proc_reliable');
+is_deeply({$project->branches()},{'38190'=>'Default'});
More information about the Pkg-perl-cvs-commits
mailing list