Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

added new scripts, better osname/osvers checks in Article.pm

  • Loading branch information...
commit 5008ab178602e86a2a6006326d05f275ab16bfd4 1 parent 90db952
barbie authored
View
228 CHANGES
@@ -1,77 +1,85 @@
Revision history for Perl module CPAN::Testers::Data::Generator.
-0.31 18/12/2008
- - name change to fit below the CPAN::Testers namespace.
- - added epoch to date extraction from article.
- - added filename reference from CPAN-DistnameInfo.
- - added ability to provide SQL string in bin/cpanstats-select.
- - added better command line option parsing to bin/cpanstats-reparse.
- - convert to use CPAN::Testers::Common::DBUtils.
- - added MySQL cpanstats database to codebase.
- - new scripts added to examples to handle database creation:
- examples/cpanstats-createdb (v0.01)
- examples/cpanstats-convert (v0.01)
- - update to bin scripts with latest code changes:
- bin/cpanstats (v0.05)
- bin/cpanstats-delete (v0.12)
- bin/cpanstats-reparse (v0.08)
- bin/cpanstats-select (v0.09)
- bin/cpanstats-update (v0.07)
- bin/cpanstats-verify (v0.21)
+0.32 19/12/2008
+ - added progress option to bin/cpanstats-verify (v0.22)
+ - fixes to Article.pm to attempt to correct missing osnames and osvers.
+ - added articles scripts that have been used behind the scenes for
+ sometime:
+ bin/articles-verify (v0.02)
+ bin/articles-view (v0.02)
-0.30 01/10/2008
- - ensure upload pattern matching is for the end of the string.
- - add more option validation in bin/cpanstats-verify (v0.20).
+0.31 18/12/2008
+ - name change to fit below the CPAN::Testers namespace.
+ - added epoch to date extraction from article.
+ - added filename reference from CPAN-DistnameInfo.
+ - added ability to provide SQL string in bin/cpanstats-select.
+ - added better command line option parsing to bin/cpanstats-reparse.
+ - convert to use CPAN::Testers::Common::DBUtils.
+ - added MySQL cpanstats database to codebase.
+ - new scripts added to examples to handle database creation:
+ examples/cpanstats-createdb (v0.01)
+ examples/cpanstats-convert (v0.01)
+ - update to bin scripts with latest code changes:
+ bin/cpanstats (v0.05)
+ bin/cpanstats-delete (v0.12)
+ bin/cpanstats-reparse (v0.08)
+ bin/cpanstats-select (v0.09)
+ bin/cpanstats-update (v0.07)
+ bin/cpanstats-verify (v0.21)
-0.29 19/09/2008
- - ignore any uploads that are not in a supported archive format used
- for testing.
+0.30 01/10/2008
+ - ensure upload pattern matching is for the end of the string.
+ - add more option validation in bin/cpanstats-verify (v0.20).
-0.28 18/09/2008
- - added SQLite pragma 'auto_vacuum' to database creation.
- - created an _init function to generate db/nntp objects in one place
- - add --localonly option to help screen in bin/cpanstats-verify (v0.19)
- - fixed test script to correctly do cmp_ok :)
+0.29 19/09/2008
+ - ignore any uploads that are not in a supported archive format used
+ for testing.
-0.27 11/09/2008
- - added 'grade' option to search in bin/cpanstats-select (v0.08)
- - fixed help text in bin/cpanstats-update (v0.06)
- - fixed test bug in 12generate.t (I can't count!)
+0.28 18/09/2008
+ - added SQLite pragma 'auto_vacuum' to database creation.
+ - created an _init function to generate db/nntp objects in one place
+ - add --localonly option to help screen in bin/cpanstats-verify (v0.19)
+ - fixed test script to correctly do cmp_ok :)
-0.26 02/09/2008
- - abstracted all database functionality out of Generator.pm into
- Database.pm, including database creation. All scripts updated too.
- - database links changed to reference CPAN Testers development site.
- - corrections to the database schema in POD
- - several POD updates across all files, including
- bin/cpanstats (v0.04)
- bin/cpanstats-delete (v0.11)
- bin/cpanstats-reparse (v0.07)
- bin/cpanstats-select (v0.07)
- bin/cpanstats-update (v0.05)
- bin/cpanstats-verify (v0.18)
- - fixed dependency in cpanstats
- - consistently provided help|h and version|V options to all scripts
- - fix to support old form of PAUSE uploads
- - abstracted reparse code into Generator.pm from cpanstats-reparse
- - more tests
+0.27 11/09/2008
+ - added 'grade' option to search in bin/cpanstats-select (v0.08)
+ - fixed help text in bin/cpanstats-update (v0.06)
+ - fixed test bug in 12generate.t (I can't count!)
-0.25 28/08/2008
- - added POD about bugs and see also sections.
- - fixed POD in scripts.
- - added author to upload metadata, to save lookups elsewhere.
- - renamed several supporting scripts:
- delstats => bin/cpanstats-delete (v0.10)
- selectstats => bin/cpanstats-select (v0.06)
- upstats => bin/cpanstats-update (v0.04)
- readstats => bin/cpanstats-verify (v0.17)
- - added further functionality to cpanstats-select.
- - added bin/cpanstats-reparse (v0.06) to distribution
- - added nostore option to not retain old articles in the articles
- database.
+0.26 02/09/2008
+ - abstracted all database functionality out of Generator.pm into
+ Database.pm, including database creation. All scripts updated too.
+ - database links changed to reference CPAN Testers development site.
+ - corrections to the database schema in POD
+ - several POD updates across all files, including
+ bin/cpanstats (v0.04)
+ bin/cpanstats-delete (v0.11)
+ bin/cpanstats-reparse (v0.07)
+ bin/cpanstats-select (v0.07)
+ bin/cpanstats-update (v0.05)
+ bin/cpanstats-verify (v0.18)
+ - fixed dependency in cpanstats
+ - consistently provided help|h and version|V options to all scripts
+ - fix to support old form of PAUSE uploads
+ - abstracted reparse code into Generator.pm from cpanstats-reparse
+ - more tests
-0.24 19/08/2008
- - added bin/readstats (v0.16), bin/delstats (v0.09),
+0.25 28/08/2008
+ - added POD about bugs and see also sections.
+ - fixed POD in scripts.
+ - added author to upload metadata, to save lookups elsewhere.
+ - renamed several supporting scripts:
+ delstats => bin/cpanstats-delete (v0.10)
+ selectstats => bin/cpanstats-select (v0.06)
+ upstats => bin/cpanstats-update (v0.04)
+ readstats => bin/cpanstats-verify (v0.17)
+ - added further functionality to cpanstats-select.
+ - added bin/cpanstats-reparse (v0.06) to distribution
+ - added nostore option to not retain old articles in the articles
+ database.
+
+0.24 19/08/2008
+ - added bin/readstats (v0.16), bin/delstats (v0.09),
bin/selectstats (v0.05) and bin/upstats (v0.03) from the non-CPAN
cpanstats distribution.
- updated all scripts to use an options hash rather than individual
@@ -79,52 +87,52 @@ Revision history for Perl module CPAN::Testers::Data::Generator.
- added new Database.pm module to handle all local DB interaction.
- fixed test bug in t/12generate.t (thanks to Slaven Rezic).
-0.23 18/08/2008
- - new maintainer: Barbie.
- - major overhaul to draw in CPAN Testers Statistics code.
- - added version to Article.pm.
- - added ability to decode QuotedPrintable and Base64 (Article.pm)
- - added functionality to parse the upload articles as well as the
- report articles (Article.pm).
- - added more reliable subject parsing.
- - added more reliable Perl -V parsing.
- - testers.db now renamed to cpanstats.db.
- - news.db now renamed to articles.db.
- - field names changed:
- status => state,
- distribution => dist,
- archname => platform.
- - new fields added: postdate,tester.
- - fixed prerequisites in modules, Makefile.PL and META.yml.
- - bin/cpan_www_testers_generate replaced with bin/cpanstats.pl
- - added more test samples
- - added more tests
+0.23 18/08/2008
+ - new maintainer: Barbie.
+ - major overhaul to draw in CPAN Testers Statistics code.
+ - added version to Article.pm.
+ - added ability to decode QuotedPrintable and Base64 (Article.pm)
+ - added functionality to parse the upload articles as well as the
+ report articles (Article.pm).
+ - added more reliable subject parsing.
+ - added more reliable Perl -V parsing.
+ - testers.db now renamed to cpanstats.db.
+ - news.db now renamed to articles.db.
+ - field names changed:
+ status => state,
+ distribution => dist,
+ archname => platform.
+ - new fields added: postdate,tester.
+ - fixed prerequisites in modules, Makefile.PL and META.yml.
+ - bin/cpan_www_testers_generate replaced with bin/cpanstats.pl
+ - added more test samples
+ - added more tests
-0.22 Thu Feb 3 15:27:41 GMT 2005
- - now includes perl + OS version in the testers.db
- - use SQLite 3.0
- - bin/cpan_www_testers_generate expanded to give more
- flexibility for execution
- - added Makefile.PL (as per TODO)
- - added tests
- - added more POD
- - (thanks to Barbie)
+0.22 Thu Feb 3 15:27:41 GMT 2005
+ - now includes perl + OS version in the testers.db
+ - use SQLite 3.0
+ - bin/cpan_www_testers_generate expanded to give more
+ flexibility for execution
+ - added Makefile.PL (as per TODO)
+ - added tests
+ - added more POD
+ - (thanks to Barbie)
-0.21 Sun Mar 7 18:31:35 GMT 2004
- - the NNTP cache now uses SQLite instead of DB_File
- - rename Changes to CHANGES
+0.21 Sun Mar 7 18:31:35 GMT 2004
+ - the NNTP cache now uses SQLite instead of DB_File
+ - rename Changes to CHANGES
-0.20 Wed Aug 13 21:52:06 BST 2003
- - make sure to HTML escape everything
- - design update, now with CSS
- - Fix bug where reports are use A/AM/AMS/Crypt-TEA-1.22.tar.gz
- instead of Crypt-TEA-1.22.tar.gz
- - added a TODO
- - sort using version, not Sort::Version
- - renamed to CPAN::WWW::Testers::Generator
- - included HISTORY section by Elaine Ashton
- - moved examples/generate.pl to an installed script,
- bin/cpan_www_testers_generate
+0.20 Wed Aug 13 21:52:06 BST 2003
+ - make sure to HTML escape everything
+ - design update, now with CSS
+ - Fix bug where reports are use A/AM/AMS/Crypt-TEA-1.22.tar.gz
+ instead of Crypt-TEA-1.22.tar.gz
+ - added a TODO
+ - sort using version, not Sort::Version
+ - renamed to CPAN::WWW::Testers::Generator
+ - included HISTORY section by Elaine Ashton
+ - moved examples/generate.pl to an installed script,
+ bin/cpan_www_testers_generate
-0.10 Thu Jul 31 23:09:25 BST 2003
- - initial release
+0.10 Thu Jul 31 23:09:25 BST 2003
+ - initial release
View
2  MANIFEST
@@ -3,6 +3,8 @@ MANIFEST This list of files
Makefile.PL
META.yml
README
+bin/articles-verify
+bin/articles-view
bin/cpanstats
bin/cpanstats-delete
bin/cpanstats-reparse
View
6 META.yml
@@ -1,6 +1,6 @@
--- #YAML:1.0
name: CPAN-Testers-Data-Generator
-version: 0.31
+version: 0.32
abstract: Download and summarize CPAN Testers data
author:
- Barbie <barbie@cpan.org>
@@ -38,10 +38,10 @@ build_requires:
provides:
CPAN::Testers::Data::Generator:
file: lib/CPAN/Testers/Data/Generator.pm
- version: 0.31
+ version: 0.32
CPAN::Testers::Data::Generator::Article:
file: lib/CPAN/Testers/Data/Generator/Article.pm
- version: 0.31
+ version: 0.32
no_index:
directory:
View
343 bin/articles-verify
@@ -0,0 +1,343 @@
+#!/usr/bin/perl
+use strict;
+$|++;
+
+my $VERSION = '0.02';
+
+#----------------------------------------------------------------------------
+
+=head1 NAME
+
+articles-verify - script to verify the contents of the articles database.
+
+=head1 SYNOPSIS
+
+ perl articles-verify --config=<file> \
+ [--file=<file> | --start=0 [--end=0] ] \
+ [--update | --verify | --check]
+
+=head1 DESCRIPTION
+
+Reads the articles database and verifies the contents.
+
+=head1 OPTIONS
+
+=over 4
+
+=item --config
+
+Configuration file contain database access details.
+
+=item --file
+
+File containing one NNTP ID per line, where each line can be CSV formatted,
+provided the ID is the first field.
+
+=item --start --end
+
+Start and end NNTP ids. If the end option is missing all subsequent ids are
+listed.
+
+=item --update
+
+For the given list of ids, update the articles database by retrieving renewed
+copies from the NNTP server.
+
+=item --verify
+
+For the given list of ids, verify the articles in the database.
+
+=item --check
+
+For the given list of ids, find missing or invalid entries in the database.
+
+=back
+
+=cut
+
+# -------------------------------------
+# Library Modules
+
+use Config::IniFiles;
+use CPAN::Testers::Common::DBUtils;
+use Email::Simple;
+use Getopt::ArgvFile default=>1;
+use Getopt::Long;
+use IO::File;
+use Net::NNTP;
+
+# -------------------------------------
+# Variables
+
+my ($nntp,$num,$first,$last);
+my (%log,%options,$dbi);
+my $PROGRESS = 0;
+
+use constant NNTPSTART => 1;
+
+# -------------------------------------
+# Program
+
+##### INITIALISE #####
+
+init_options();
+
+##### MAIN #####
+
+if($options{update}) { update_articles() }
+elsif($options{verify}) { verify_articles() }
+elsif($options{check}) { check_articles() }
+
+# -------------------------------------
+# Subroutines
+
+=item check_articles
+
+Report on the database entries which are either missing, or have reported bad
+processing.
+
+=cut
+
+sub check_articles {
+ my @list = get_list();
+ for my $id (@list) {
+ my @rows = $dbi->get_query('array',"SELECT * FROM articles WHERE id=$id");
+ if(@rows) {
+ my ($xref) = ($rows[0]->[1] =~ /Xref:.*perl\.cpan\.testers:($id)\b/is);
+ print "$id,invalid\n" unless($xref);
+ } else {
+ print "$id,missing\n";
+ }
+ }
+}
+
+=item verify_articles
+
+Report on the requested database entries as to whether they are found or
+missing.
+
+=cut
+
+sub verify_articles {
+ my @list = get_list();
+ for my $id (@list) {
+ my @rows = $dbi->get_query('array',"SELECT * FROM articles WHERE id=$id");
+ if(@rows) {
+ my $subject = get_subject($rows[0]->[1]);
+ print "$id,found - $subject\n";
+ } else {
+ print "$id,missing\n";
+ }
+ }
+}
+
+=item update_articles
+
+=cut
+
+sub update_articles {
+ $nntp = Net::NNTP->new("nntp.perl.org")
+ || die "Cannot connect to nntp.perl.org";
+ ($num, $first, $last) = $nntp->group("perl.cpan.testers");
+
+ my @list = get_list();
+ for my $id (@list) {
+ my $article = get_article($id);
+ next unless($article);
+
+ my @rows = $dbi->get_query('array',"SELECT id FROM articles WHERE id = $id");
+ if(@rows) {
+ $dbi->do_query("UPDATE articles SET article=? WHERE id=?",$article,$id);
+ } else {
+ $dbi->do_query("INSERT INTO articles VALUES (?,?)",$id,$article);
+ }
+ print "$id,updated\n";
+ }
+}
+
+
+=item get_subject
+
+Extract the subject from the given article..
+
+=cut
+
+sub get_subject {
+ my $article = shift;
+
+ # parse the resulting headers
+ my $mail = Email::Simple->new($article);
+ return $mail->header("Subject");
+}
+
+=item get_article
+
+Access the NNTP server to get the real subject recorded for the article,
+unless we can short cut the network by accessing the information from the
+project log file.
+
+=cut
+
+sub get_article {
+ my $id = shift;
+
+ # talk NNTP
+ my $article = join "", @{$nntp->article($id) || []};
+ return "" unless($article);
+ return $article;
+}
+
+=item get_list
+
+Returns the list of NNTP ids from the named file.
+
+=cut
+
+sub get_list {
+ my @list;
+
+ if($options{start}) {
+ my $end = $options{end} || get_lastid();
+ @list = ($options{start} .. $end);
+ print STDERR "START: $options{start}\nEND: $options{end}\n";
+
+ } elsif($options{file}) {
+ die "file [$options{file}] not found" unless(-f $options{file});
+
+ my $fh = IO::File->new($options{file}) or die "Cannot open file [$options{file}]: $!";
+ while(<$fh>) {
+ chomp;
+ my ($num) = (m/^(\d+)/);
+ push @list, $num;
+ }
+ $fh->close;
+ printf STDERR "FILE: %d ids found\n", scalar(@list);
+
+ } else {
+ die "No start/end or file list specified\n"
+ }
+
+ return @list;
+}
+
+=item get_lastid
+
+Returns the last NNTP id recorded in the database.
+
+=cut
+
+sub get_lastid {
+ my @rows = $dbi->get_query('array',"SELECT MAX(id) FROM articles");
+ return $rows[0]->[0];
+}
+
+=item init_options
+
+Determine command line options and initialise any defaults.
+
+=cut
+
+sub init_options {
+ GetOptions( \%options,
+ 'config=s',
+ 'file=s',
+ 'start=i',
+ 'end=i',
+ 'update',
+ 'verify',
+ 'check',
+ 'help|h',
+ 'version|v'
+ );
+
+ help(1) if($options{help});
+ help(0) if($options{version});
+
+ help(1,"Must specify the configuration file") unless($options{config});
+ help(1,"Configuration file [$options{config}] not found") unless(-f $options{config});
+
+ # load configuration
+ my $cfg = Config::IniFiles->new( -file => $options{config} );
+
+ # configure databases
+ my $db = 'LITEARTS';
+ die "No configuration for $db database\n" unless($cfg->SectionExists($db));
+ my %opts = map {$_ => $cfg->val($db,$_);} qw(driver database dbfile dbhost dbport dbuser dbpass);
+ $dbi = CPAN::Testers::Common::DBUtils->new(%opts);
+ die "Cannot configure $db database\n" unless($dbi);
+}
+
+sub help {
+ my ($full,$mess) = @_;
+
+ print "\n$mess\n\n" if($mess);
+
+ if($full) {
+ print <<HERE;
+
+Usage: $0 \\
+ --config=<file> \\
+ [ ( --start=n [--end=n] | --file=<file> ) ] \\
+ [ --update | --verify | --check ] \\
+ [-h] [-v]
+
+ --config=<file> - configuration file
+
+ --start - verify from id
+ --end - verify to id
+ --file=<file> - verify these ids (1 per line)
+
+ --update - update articles
+ --verify - verify articles
+ --check - check articles
+
+ -h - this help screen
+ -v - program version
+
+HERE
+
+ }
+
+ print "$0 v$VERSION\n";
+ exit(0);
+}
+
+__END__
+
+=back
+
+=head1 BUGS, PATCHES & FIXES
+
+There are no known bugs at the time of this release. However, if you spot a
+bug or are experiencing difficulties, that is not explained within the POD
+documentation, please send bug reports and patches to the RT Queue (see below).
+
+Fixes are dependant upon their severity and my availablity. Should a fix not
+be forthcoming, please feel free to (politely) remind me.
+
+RT Queue -
+http://rt.cpan.org/Public/Dist/Display.html?Name=CPAN-Testers-Data-Generator
+
+=head1 SEE ALSO
+
+L<CPAN::WWW::Testers>,
+L<CPAN::Testers::WWW::Statistics>
+
+F<http://www.cpantesters.org/>,
+F<http://stats.cpantesters.org/>,
+F<http://wiki.cpantesters.org/>
+
+=head1 AUTHOR
+
+ Barbie, <barbie@cpan.org>
+ for Miss Barbell Productions <http://www.missbarbell.co.uk>.
+
+=head1 COPYRIGHT AND LICENSE
+
+ Copyright (C) 2005-2008 Barbie for Miss Barbell Productions.
+
+ This module is free software; you can redistribute it and/or
+ modify it under the same terms as Perl itself.
+
+=cut
+
View
192 bin/articles-view
@@ -0,0 +1,192 @@
+#!/usr/bin/perl
+use strict;
+$|++;
+
+my $VERSION = '0.02';
+
+#----------------------------------------------------------------------------
+
+=head1 NAME
+
+articles-view - script to view an article from the articles database.
+
+=head1 SYNOPSIS
+
+ perl articles-verify --config=<file> [--ids=0,0,0]
+
+=head1 DESCRIPTION
+
+Reads name artcoles from the articles database.
+
+=head1 OPTIONS
+
+=over 4
+
+=item --config
+
+Configuration file contain database access details.
+
+=item --ids
+
+Comma separated list of NNTP ids.
+
+=back
+
+=cut
+
+# -------------------------------------
+# Library Modules
+
+use lib qw(./lib ../lib);
+
+use Config::IniFiles;
+use CPAN::Testers::Common::DBUtils;
+use Net::NNTP;
+use Getopt::ArgvFile default=>1;
+use Getopt::Long;
+use IO::File;
+
+# -------------------------------------
+# Variables
+
+my (%log,%options,$dbi);
+
+use constant NNTPSTART => 0;
+
+# -------------------------------------
+# Program
+
+##### INITIALISE #####
+
+init_options();
+
+$options{ids} or die "No ids given\n";
+
+##### MAIN #####
+
+view_articles();
+
+# -------------------------------------
+# Subroutines
+
+=item get_lastid
+
+Returns the last NNTP id recorded in the database.
+
+=cut
+
+sub get_lastid {
+ my @rows = $dbi->get_query('array',"SELECT MAX(id) FROM articles");
+ return $rows[0]->[0];
+}
+
+=item view_articles
+
+Report on the database entries which are either missing, or have reported bad
+processing.
+
+=cut
+
+sub view_articles {
+ my $count = $options{start};
+ my $iterator = $dbi->iterator('array',"SELECT * FROM articles WHERE id IN ($options{ids}) ORDER BY id asc");
+ while(my $row = $iterator->()) {
+ print "ID:$row->[0]\nARTICLE:\n$row->[1]\n";
+ }
+}
+
+=item init_options
+
+Determine command line options and initialise any defaults.
+
+=cut
+
+sub init_options {
+ GetOptions( \%options,
+ 'config=s',
+ 'ids=s',
+ 'help|h',
+ 'version|v'
+ );
+
+ help(1) if($options{help});
+ help(0) if($options{version});
+
+ help(1,"Must specify the configuration file") unless($options{config});
+ help(1,"Configuration file [$options{config}] not found") unless(-f $options{config});
+
+ # load configuration
+ my $cfg = Config::IniFiles->new( -file => $options{config} );
+
+ # configure databases
+ my $db = 'LITEARTS';
+ die "No configuration for $db database\n" unless($cfg->SectionExists($db));
+ my %opts = map {$_ => $cfg->val($db,$_);} qw(driver database dbfile dbhost dbport dbuser dbpass);
+ $dbi = CPAN::Testers::Common::DBUtils->new(%opts);
+ die "Cannot configure $db database\n" unless($dbi);
+}
+
+sub help {
+ my ($full,$mess) = @_;
+
+ print "\n$mess\n\n" if($mess);
+
+ if($full) {
+ print <<HERE;
+
+Usage: $0 \\
+ --config=<file> \\
+ [--ids=<string>] [-h] [-v]
+
+ --config=<file> - configuration file
+ --ids=<string> - article ids to view (CSV)
+ -h - this help screen
+ -v - program version
+
+HERE
+
+ }
+
+ print "$0 v$VERSION\n";
+ exit(0);
+}
+
+__END__
+
+=back
+
+=head1 BUGS, PATCHES & FIXES
+
+There are no known bugs at the time of this release. However, if you spot a
+bug or are experiencing difficulties, that is not explained within the POD
+documentation, please send bug reports and patches to the RT Queue (see below).
+
+Fixes are dependant upon their severity and my availablity. Should a fix not
+be forthcoming, please feel free to (politely) remind me.
+
+RT Queue -
+http://rt.cpan.org/Public/Dist/Display.html?Name=CPAN-Testers-Data-Generator
+
+=head1 SEE ALSO
+
+L<CPAN::WWW::Testers>,
+L<CPAN::Testers::WWW::Statistics>
+
+F<http://www.cpantesters.org/>,
+F<http://stats.cpantesters.org/>,
+F<http://wiki.cpantesters.org/>
+
+=head1 AUTHOR
+
+ Barbie, <barbie@cpan.org>
+ for Miss Barbell Productions <http://www.missbarbell.co.uk>.
+
+=head1 COPYRIGHT AND LICENSE
+
+ Copyright (C) 2005-2008 Barbie for Miss Barbell Productions.
+
+ This module is free software; you can redistribute it and/or
+ modify it under the same terms as Perl itself.
+
+=cut
+
View
11 bin/cpanstats-verify
@@ -2,7 +2,7 @@
use strict;
$|++;
-my $VERSION = '0.21';
+my $VERSION = '0.22';
#----------------------------------------------------------------------------
@@ -92,7 +92,6 @@ use IO::File;
# Variables
my (%log,%options,$dbi);
-my $PROGRESS = 0;
use constant NNTPSTART => 872391;
@@ -378,7 +377,7 @@ Simple audit logging function.
my $lasttime = time;
sub progress {
- return unless($PROGRESS);
+ return unless($options{progress});
my $msg = shift;
my $time = time;
@@ -396,6 +395,7 @@ sub init_options {
'missing|m',
'check|c',
'verify|v',
+ 'progress|p',
'search|s',
'start=i',
'end=i',
@@ -442,7 +442,7 @@ Usage: $0 \\
[-c] [-m] [-v] [-s] \\
[--file=<file>] [--start=n] [--end=n] \\
[--log=<file>] [-out=<file>] [-h] [-V] \\
- [--localonly]
+ [--localonly] [--progress]
--config=<file> - configuration file
--database=<dbcode> - CPANSTATS or LITESTATS
@@ -457,6 +457,9 @@ Usage: $0 \\
--log - log file for shortcut reference for -m and -c
--out - results output file
+ --localonly - no NNTP lookups, use local logs only
+ --progress - print progress messages to STDOUT
+
-h - this help screen
-V - program version
View
2  lib/CPAN/Testers/Data/Generator.pm
@@ -4,7 +4,7 @@ use warnings;
use strict;
use vars qw($VERSION);
-$VERSION = '0.31';
+$VERSION = '0.32';
#----------------------------------------------------------------------------
# Library Modules
View
25 lib/CPAN/Testers/Data/Generator/Article.pm
@@ -4,7 +4,7 @@ use warnings;
use strict;
use vars qw($VERSION);
-$VERSION = '0.31';
+$VERSION = '0.32';
#----------------------------------------------------------------------------
# Library Modules
@@ -37,6 +37,7 @@ 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)/i;
#----------------------------------------------------------------------------
# The Application Programming Interface
@@ -160,7 +161,7 @@ sub parse_report {
my $from = $self->{from};
my $subject = $self->{subject};
- my ($status, $distversion, $platform) = split /\s+/, $subject;
+ my ($status, $distversion, $platform, $osver) = split /\s+/, $subject;
return 0 unless $status =~ /^(PASS|FAIL|UNKNOWN|NA)$/i;
$platform ||= "";
@@ -182,9 +183,9 @@ sub parse_report {
my $perl = $self->_extract_perl_version(\$body);
- my ($osname) = $body =~ /Summary of my perl5.*osname=([^\s\n,<\']+)/s;
- my ($osvers) = $body =~ /Summary of my perl5.*osvers=([^\s\n,<\']+)/s;
- my ($archname) = $body =~ /Summary of my perl5.*archname=([^\s\n&,<\']+)/s;
+ my ($osname) = $body =~ /(?:Summary of my perl5|Platform:).*?osname=([^\s\n,<\']+)/s;
+ my ($osvers) = $body =~ /(?:Summary of my perl5|Platform:).*?osvers=([^\s\n,<\']+)/s;
+ my ($archname) = $body =~ /(?:Summary of my perl5|Platform:).*?archname=([^\s\n&,<\']+)/s;
$archname =~ s/\n.*// if($archname);
$self->status($status);
@@ -192,8 +193,6 @@ sub parse_report {
$self->version($version);
$self->from($from || "");
$self->perl($perl);
- $self->osname($osname || "");
- $self->osvers($osvers || "");
$self->filename($d->filename);
unless($archname || $platform) {
@@ -201,6 +200,18 @@ sub parse_report {
elsif($osname) { $platform = $osname }
}
+ unless($osname) {
+ if($platform && $platform =~ $OSNAMES) {
+ $osname = $1;
+ } elsif($archname && $archname =~ $OSNAMES) {
+ $osname = $1;
+ }
+ }
+
+ $osvers ||= $osver;
+
+ $self->osname($osname || "");
+ $self->osvers($osvers || "");
$self->archname($archname || $platform);
return 1;
Please sign in to comment.
Something went wrong with that request. Please try again.