Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

updated patterns for perl version and osname

  • Loading branch information...
commit 335564c76034a6022255a46d09a3d06fcc9f1427 1 parent 22dbe90
barbie authored
View
5 CHANGES
@@ -1,5 +1,10 @@
Revision history for Perl module CPAN::Testers::Data::Generator.
+0.35 29/01/2009
+ - updated patterns when extracting perl version (Article.pm).
+ - updated patterns when extracting osname (Article.pm).
+ - updated cannot connect to NNTP server error message.
+
0.34 12/01/2009
- updated Copyright info, minor fixes and added 'Getopt::ArgvFile', if
not already used:
View
6 META.yml
@@ -1,6 +1,6 @@
--- #YAML:1.0
name: CPAN-Testers-Data-Generator
-version: 0.34
+version: 0.35
abstract: Download and summarize CPAN Testers data
author:
- Barbie <barbie@cpan.org>
@@ -41,10 +41,10 @@ build_requires:
provides:
CPAN::Testers::Data::Generator:
file: lib/CPAN/Testers/Data/Generator.pm
- version: 0.34
+ version: 0.35
CPAN::Testers::Data::Generator::Article:
file: lib/CPAN/Testers/Data/Generator/Article.pm
- version: 0.34
+ version: 0.35
no_index:
directory:
View
4 lib/CPAN/Testers/Data/Generator.pm
@@ -4,7 +4,7 @@ use warnings;
use strict;
use vars qw($VERSION);
-$VERSION = '0.34';
+$VERSION = '0.35';
#----------------------------------------------------------------------------
# Library Modules
@@ -187,7 +187,7 @@ sub nntp_connect {
my $self = shift;
# connect to NNTP server
- my $nntp = Net::NNTP->new("nntp.perl.org") or die "Cannot connect to nntp.perl.org";
+ my $nntp = Net::NNTP->new("nntp.perl.org") or die "Cannot connect to NNTP server [nntp.perl.org]\n";
($self->{nntp_num}, $self->{nntp_first}, $self->{nntp_last}) = $nntp->group("perl.cpan.testers");
return $nntp;
View
63 lib/CPAN/Testers/Data/Generator/Article.pm
@@ -4,7 +4,7 @@ use warnings;
use strict;
use vars qw($VERSION);
-$VERSION = '0.34';
+$VERSION = '0.35';
#----------------------------------------------------------------------------
# Library Modules
@@ -37,7 +37,15 @@ my %regexes = (
6 => { re => qr/(\w+)?\s+(\d+),?\s+(\d+)/, f => [qw(month day year)] }, # September 22, 1999 06:29
);
-my $OSNAMES = qr/(cygwin|freebsd|netbsd|openbsd|darwin|linux|cygwin|darwin|MSWin32|dragonfly|solaris|MacOS|irix)/i;
+my $OSNAMES = qr/(cygwin|freebsd|netbsd|openbsd|darwin|linux|cygwin|darwin|MSWin32|dragonfly|solaris|MacOS|irix|mirbsd|gnu|bsdos|aix|sco|os2)/i;
+my %OSNAMES = (
+ 'MacPPC' => 'macos',
+ 'osf' => 'dec_osf',
+ 'pa-risc' => 'hpux',
+ 's390' => 'os390',
+ 'VMS_' => 'vms',
+ 'ARCHREV_0' => 'hpux',
+);
#----------------------------------------------------------------------------
# The Application Programming Interface
@@ -201,10 +209,19 @@ sub parse_report {
}
unless($osname) {
- if($platform && $platform =~ $OSNAMES) {
- $osname = $1;
- } elsif($archname && $archname =~ $OSNAMES) {
- $osname = $1;
+ for my $text ($platform, $archname) {
+ next unless($text);
+ if($text =~ $OSNAMES) {
+ $osname = $1;
+ } else {
+ for my $rx (keys %OSNAMES) {
+ if($text =~ /$rx/i) {
+ $osname = $OSNAMES{$rx};
+ last;
+ }
+ }
+ }
+ last if($osname);
}
}
@@ -237,22 +254,32 @@ sub _extract_perl_version {
# Summary of my perl5 (revision 5.0 version 6 subversion 1) configuration:
# Summary of my perl5 (revision 5 version 10 subversion 0) configuration:
my ($rev, $ver, $sub, $extra) =
- $$body =~ /Summary of my (?:perl\d+)? \((?:revision )?(\d+(?:\.\d+)?) (?:version|patchlevel) (\d+) subversion\s+(\d+) ?(.*?)\) configuration/s;
+ $$body =~ /Summary of my (?:perl(?:\d+)?)? \((?:revision )?(\d+(?:\.\d+)?) (?:version|patchlevel) (\d+) subversion\s+(\d+) ?(.*?)\) configuration/si;
+
+ if(defined $rev) {
+ my $perl = $rev + ($ver / 1000) + ($sub / 1000000);
+ $rev = int($perl);
+ $ver = int(($perl*1000)%1000);
+ $sub = int(($perl*1000000)%1000);
+
+ my $version = sprintf "%d.%d.%d", $rev, $ver, $sub;
+ $version .= " $extra" if $extra;
+ return $version;
+ # return sprintf "%0.6f", $perl; # an alternate format
+ }
+
+ # the following is experimental and may provide incorrect data
- unless(defined $rev) {
-# warn "Cannot parse perl version for article:\n$body";
- return 0;
+ ($rev, $ver, $sub) =
+ $$body =~ m!/(?:(?:site_perl|perl|perl5|\.?cpanplus)/|perl-)(5)\.?([6-9]|1[0-2])\.?(\d+)/!;
+ if(defined $rev) {
+ my $version = sprintf "%d.%d.%d", $rev, $ver, $sub;
+ return $version;
}
- my $perl = $rev + ($ver / 1000) + ($sub / 1000000);
- $rev = int($perl);
- $ver = int(($perl*1000)%1000);
- $sub = int(($perl*1000000)%1000);
- my $version = sprintf "%d.%d.%d", $rev, $ver, $sub;
- $version .= " $extra" if $extra;
- return $version;
-# return sprintf "%0.6f", $perl; # an alternate format
+# warn "Cannot parse perl version for article:\n$body";
+ return 0;
}
1;
Please sign in to comment.
Something went wrong with that request. Please try again.