Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

first official packaged release

  • Loading branch information...
commit 9c37ffa395f9a530597f321ce0af345b4a3f1128 0 parents
barbie authored
15 CHANGES
@@ -0,0 +1,15 @@
+Revision history for Perl module CPAN::Testers::Data::Uploads.
+
+0.04 current
+ - changed to more formal package release.
+
+0.03 29/12/2008
+ - renamed Article reference.
+
+0.02 18/11/2008
+ - added multiple backup mechanism.
+ - added documentation.
+ - abstracted sources into configuration file.
+
+0.01 10/11/2008
+ - initial release
22 MANIFEST
@@ -0,0 +1,22 @@
+CHANGES
+examples/uploads.ini
+examples/uploads.pl
+examples/uploads.sh
+examples/uploads.sql
+lib/CPAN/Testers/Data/Uploads.pm
+Makefile.PL
+MANIFEST
+META.yml
+t/01base.t
+t/05setup_db-uploads.t
+t/09setup-expected.t
+t/20attributes.t
+t/50logging.ini
+t/50logging.t
+t/52lastid.t
+t/59cleanup.t
+t/90podtest.t
+t/91podcover.t
+t/94metatest.t
+t/CTDU_Testing.pm
+t/Expected.zip
51 META.yml
@@ -0,0 +1,51 @@
+--- #YAML:1.0
+name: CPAN-Testers-Data-Uploads
+version: 0.04
+abstract: CPAN Testers Uploads Database Generator
+author:
+ - Barbie <barbie@cpan.org>
+
+license: perl
+distribution_type: module
+installdirs: site
+
+requires:
+ Class::Accessor::Fast: 0
+ CPAN::DistnameInfo: 0
+ CPAN::Testers::Common::Article: 0
+ CPAN::Testers::Common::DBUtils: 0
+ Config::IniFiles: 0
+ File::Basename: 0
+ File::Find::Rule: 0
+ File::Path: 0
+ File::Slurp: 0
+ Getopt::Long: 0
+ IO::File: 0
+ Net::NNTP: 0
+recommends:
+ Test::More: 0.70
+ Test::Pod: 1.00
+ Test::Pod::Coverage: 0.08
+ Test::CPAN::Meta: 0.12
+build_requires:
+ Test::More: 0.01
+ Archive::Extract: 0
+
+provides:
+ CPAN::Testers::Data::Uploads:
+ file: lib/CPAN/Testers/Data/Uploads.pm
+ version: 0.04
+
+no_index:
+ directory:
+ - t
+ - examples
+
+resources:
+ license: http://dev.perl.org/licenses/
+ bugtracker: http://rt.cpan.org/Public/Dist/Display.html?Name=CPAN-Testers-Data-Generator
+
+meta-spec:
+ version: 1.4
+ url: http://module-build.sourceforge.net/META-spec-v1.4.html
+generated_by: Hand 1.0
31 Makefile.PL
@@ -0,0 +1,31 @@
+use ExtUtils::MakeMaker;
+WriteMakefile(
+ 'NAME' => 'CPAN::Testers::Data::Uploads',
+ 'VERSION_FROM' => 'lib/CPAN/Testers/Data/Uploads.pm',
+ 'PREREQ_PM' => {
+
+ 'Class::Accessor::Fast' => 0,
+ 'CPAN::DistnameInfo' => 0,
+ 'CPAN::Testers::Common::Article' => 0,
+ 'CPAN::Testers::Common::DBUtils' => 0,
+ 'Config::IniFiles' => 0,
+ 'File::Basename' => 0,
+ 'File::Find::Rule' => 0,
+ 'File::Path' => 0,
+ 'File::Slurp' => 0,
+ 'Getopt::Long' => 0,
+ 'IO::File' => 0,
+ 'Net::NNTP' => 0,
+
+ 'Test::More' => 0, # only for testing
+ 'Archive::Extract' => 0, # only for testing
+ },
+
+ 'PL_FILES' => {},
+ 'INSTALLDIRS' => 'site',
+ NO_META => 1,
+
+ ($] >= 5.005 ? ## Add these new keywords supported since 5.005
+ (ABSTRACT => 'CPAN Testers Uploads Database Generator',
+ AUTHOR => 'Barbie <barbie@cpan.org>') : ()),
+);
25 examples/uploads.ini
@@ -0,0 +1,25 @@
+[MASTER]
+BACKPAN=/opt/projects/BACKPAN/authors/id
+CPAN=/opt/projects/CPAN/authors/id
+logfile=logs/uploads.log
+
+[UPLOADS]
+driver=mysql
+database=uploads
+dbhost=localhost
+dbuser=dandan
+dbpass=d4nd4n
+
+[BACKUPS]
+drivers=<<EOT
+SQLite
+CSV
+EOT
+
+[SQLite]
+driver=SQLite
+database=data/uploads.db
+
+[CSV]
+driver=CSV
+dbfile=data/uploads.csv
106 examples/uploads.pl
@@ -0,0 +1,106 @@
+#!/usr/bin/perl -w
+use strict;
+
+use vars qw($VERSION);
+
+$VERSION = '0.02';
+
+$|++;
+
+#----------------------------------------------------------------------------
+# Library Modules
+
+use lib qw(./lib ../lib);
+
+use CPAN::Testers::Data::Uploads;
+
+#----------------------------------------------------------------------------
+# The Application Programming Interface
+
+my $obj = CPAN::Testers::Data::Uploads->new();
+$obj->process();
+
+__END__
+
+#----------------------------------------------------------------------------
+
+=head1 NAME
+
+uploads.pl - creates, updates and/or backs up the uploads database.
+
+=head1 SYNOPSIS
+
+ perl uploads.pl --config=<file> (-generate | -update | -backup | -h | -v)
+
+=head1 DESCRIPTION
+
+This program allows the user to create, update and backup the uploads database,
+either as separate commands, or a combination of all three. The process order
+will always be CREATE->UPDATE->BACKUP, regardless of the order the options
+appear on the command line.
+
+The Uploads database contains basic information about the history of CPAN. It
+records the release dates of everything that is uploaded to CPAN, both within
+a BACKPAN repository, a current CPAN repository and the latest uploads posted
+by PAUSE, which may not have yet reached the CPAN mirrors.
+
+A simple schema for the MySQL database is below:
+
+ CREATE TABLE `uploads` (
+ `type` varchar(10) NOT NULL,
+ `author` varchar(32) NOT NULL,
+ `dist` varchar(100) NOT NULL,
+ `version` varchar(100) NOT NULL,
+ `filename` varchar(255) NOT NULL,
+ `released` int(16) NOT NULL,
+ PRIMARY KEY (`author`,`dist`,`version`)
+ ) ENGINE=MyISAM;
+
+The 'type' field can be one of three values, 'backpan', 'cpan' or 'upload',
+which incates whether the release has been archived to BACKPAN, currently on
+CPAN or has recently been uploaded and may not have reached the CPAN mirrors
+yet.
+
+The 'author', 'dist', 'version' and 'filename' fields contain the breakdown of
+the distribution component parts used to locate the distribution. Although in
+most cases the filename could be considered a primary key, it is possible that
+two or more authors could upload a distribution with the same name.
+
+The 'released' field holds the date of the distribution release as the number
+of seconds since the epoch. This is extremely useful for sorting distributions
+based on their release date rather than the version string. Due to many authors
+having different version schemes, this is perhaps the only reliable method with
+which to sort distribution releases.
+
+=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 an email to barbie@cpan.org. However, it would help
+greatly if you are able to pinpoint problems or even supply a patch.
+
+Fixes are dependant upon their severity and my availablity. Should a fix not
+be forthcoming, please feel free to (politely) remind me.
+
+=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) 2008-2009 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
26 examples/uploads.sh
@@ -0,0 +1,26 @@
+#!/usr/bin/bash
+
+BASE=/opt/projects/cpantesters
+
+cd $BASE/uploads
+mkdir -p logs
+mkdir -p data
+
+date_format="%Y/%m/%d %H:%M:%S"
+echo `date +"$date_format"` "START" >>logs/uploads.log
+
+perl uploads.pl --config=uploads.ini -u -b
+
+echo `date +"$date_format"` "Compressing Uploads data..." >>logs/uploads.log
+
+cd $BASE/dbx
+rm -f uploads.*
+cp $BASE/uploads/data/uploads.db . ; gzip uploads.db
+cp $BASE/uploads/data/uploads.db . ; bzip2 uploads.db
+cp $BASE/uploads/data/uploads.csv . ; gzip uploads.csv
+cp $BASE/uploads/data/uploads.csv . ; bzip2 uploads.csv
+
+mkdir -p /var/www/devel/uploads
+mv uploads.* /var/www/devel/uploads
+
+echo `date +"$date_format"` "STOP" >>logs/uploads.log
25 examples/uploads.sql
@@ -0,0 +1,25 @@
+## MySQL
+
+DROP TABLE IF EXISTS `uploads`;
+CREATE TABLE `uploads` (
+ `type` varchar(10) NOT NULL,
+ `author` varchar(32) NOT NULL,
+ `dist` varchar(100) NOT NULL,
+ `version` varchar(100) NOT NULL,
+ `filename` varchar(255) NOT NULL,
+ `released` int(16) NOT NULL,
+ PRIMARY KEY (`author`,`dist`,`version`)
+) ENGINE=MyISAM;
+
+
+## SQLite
+
+CREATE TABLE `uploads` (
+ `type` text NOT NULL,
+ `author` text NOT NULL,
+ `dist` text NOT NULL,
+ `version` text NOT NULL,
+ `filename` text NOT NULL,
+ `released` int NOT NULL,
+ PRIMARY KEY (`author`,`dist`,`version`)
+);
518 lib/CPAN/Testers/Data/Uploads.pm
@@ -0,0 +1,518 @@
+package CPAN::Testers::Data::Uploads;
+
+use strict;
+use warnings;
+
+use vars qw($VERSION);
+$VERSION = '0.04';
+$|++;
+
+#----------------------------------------------------------------------------
+# Library Modules
+
+use base qw(Class::Accessor::Fast);
+
+use CPAN::DistnameInfo;
+use CPAN::Testers::Common::DBUtils;
+use CPAN::Testers::Common::Article;
+use Config::IniFiles;
+use File::Basename;
+use File::Find::Rule;
+use File::Path;
+use File::Slurp;
+use Getopt::Long;
+use IO::File;
+use Net::NNTP;
+
+#----------------------------------------------------------------------------
+# Variables
+
+my (%backups);
+use constant LASTMAIL => '_lastmail';
+
+my %phrasebook = (
+ 'FindDistVersion' => 'SELECT * FROM uploads WHERE author=? AND dist=? AND version=?',
+ 'InsertDistVersion' => 'INSERT INTO uploads (type,author,dist,version,filename,released) VALUES (?,?,?,?,?,?)',
+ 'UpdateDistVersion' => 'UPDATE uploads SET type=? WHERE author=? AND dist=? AND version=?',
+ 'FindDistTypes' => 'SELECT * FROM uploads WHERE type=?',
+ 'DeleteAll' => 'DELETE FROM uploads',
+ 'SelectAll' => 'SELECT * FROM uploads',
+
+ 'CreateTable' => 'CREATE TABLE uploads (type text, author text, dist text, version text, filename text, released int)',
+);
+
+my $extn = qr/\.(tar\.(gz|bz2)|tgz|zip)$/;
+
+#----------------------------------------------------------------------------
+# The Application Programming Interface
+
+sub new {
+ my $class = shift;
+
+ my $self = {};
+ bless $self, $class;
+
+ $self->_init_options(@_);
+ return $self;
+}
+
+sub DESTROY {
+ my $self = shift;
+}
+
+__PACKAGE__->mk_accessors(
+ qw( uploads backpan cpan logfile logclean lastfile
+ mgenerate mupdate mbackup ));
+
+sub process {
+ my $self = shift;
+ $self->generate() if($self->mgenerate);
+ $self->update() if($self->mupdate);
+ $self->backup() if($self->mbackup);
+}
+
+sub generate {
+ my $self = shift;
+ my $db = $self->uploads;
+
+ $self->_log("Restarting uploads database");
+ $db->do_query($phrasebook{'DeleteAll'});
+
+ $self->_log("Creating BACKPAN entries");
+ my @files = File::Find::Rule->file()->name($extn)->in($self->backpan);
+ $self->_parse_archive('backpan',$_) for(@files);
+
+ $self->_log("Creating CPAN entries");
+ @files = File::Find::Rule->file()->name($extn)->in($self->cpan);
+ $self->_parse_archive('cpan',$_) for(@files);
+}
+
+sub update {
+ my $self = shift;
+ my $db = $self->uploads;
+
+ # get list of db known CPAN distributions
+ my @rows = $db->get_query('hash',$phrasebook{'FindDistTypes'},'cpan');
+ my %cpan = map {$_->{filename} => $_} @rows;
+
+ # get currently mirrored CPAN entries
+ $self->_log("Updating CPAN entries");
+ my @files = File::Find::Rule->file()->name($extn)->in($self->cpan);
+ for(@files) {
+ my $file = $self->_parse_archive('cpan',$_);
+ delete $cpan{$file} if($file);
+ }
+
+ # demote any distributions no longer on CPAN
+ $self->_log("Updating BACKPAN entries");
+ for my $file (keys %cpan) {
+ #$self->_log("backpan => $cpan{$file}->{dist} => $cpan{$file}->{version} => $cpan{$file}->{author} => $cpan{$file}->{released}");
+ $db->do_query($phrasebook{'UpdateDistVersion'},'backpan',$cpan{$file}->{author},$cpan{$file}->{dist},$cpan{$file}->{version});
+ }
+
+ # read NNTP
+ $self->_log("Updating NNTP entries");
+ my ($nntp,$num,$first,$last) = $self->_nntp_connect();
+ my $lastid = $self->_lastid();
+ next if($last <= $lastid);
+
+ $self->_log(".. from $lastid to $last");
+ for(my $id = $lastid+1; $id <= $last; $id++) {
+ #$self->_log("NNTP ID = $id");
+ my $article = join "", @{$nntp->article($id) || []};
+ my $object = CPAN::Testers::Common::Article->new($article);
+ next unless($object);
+ $self->_log("... [$id] subject=".($object->subject()));
+
+ my ($name,$version,$cpanid,$date,$filename);
+ if($object->parse_upload()) {
+ $name = $object->distribution;
+ $version = $object->version;
+ $cpanid = $object->author;
+ $date = $object->epoch;
+ $filename = $object->filename;
+ }
+
+ #$self->_log("... name=$name");
+ #$self->_log("... version=$version");
+ #$self->_log("... cpanid=$cpanid");
+ #$self->_log("... date=$date");
+
+ next unless($name && $version && $cpanid && $date);
+ #$self->_log("upload => $name => $version => $cpanid => $date");
+
+ my @rows = $db->get_query('array',$phrasebook{'FindDistVersion'},$cpanid,$name,$version);
+ next if(@rows);
+ $db->do_query($phrasebook{'InsertDistVersion'},'upload',$cpanid,$name,$version,$filename,$date);
+ }
+
+ $self->_lastid($last);
+}
+
+sub backup {
+ my $self = shift;
+ my $db = $self->uploads;
+
+ for my $driver (keys %backups) {
+ if($backups{$driver}{'exists'}) {
+ $backups{$driver}{db}->do_query($phrasebook{'DeleteAll'});
+ } elsif($driver =~ /(CSV|SQLite)/i) {
+ $backups{$driver}{db}->do_query($phrasebook{'CreateTable'});
+ }
+ }
+
+ $self->_log("Backup via DBD drivers");
+
+ my $rows = $db->iterator('array',$phrasebook{'SelectAll'});
+ while(my $row = $rows->()) {
+ for my $driver (keys %backups) {
+ $backups{$driver}{db}->do_query($phrasebook{'InsertDistVersion'},@$row);
+ }
+ }
+
+ # handle the CSV exception
+ if($backups{CSV}) {
+ $self->_log("Backup to CSV file");
+ $backups{CSV}{db} = undef; # close db handle
+ my $fh1 = IO::File->new('uploads','r') or die "Cannot read temporary database file 'uploads'\n";
+ my $fh2 = IO::File->new($backups{CSV}{dbfile},'w+') or die "Cannot write to CSV database file $backups{CSV}{dbfile}\n";
+ while(<$fh1>) { print $fh2 $_ }
+ $fh1->close;
+ $fh2->close;
+ unlink('uploads');
+ }
+}
+
+sub help {
+ my ($self,$full,$mess) = @_;
+
+ print "\n$mess\n\n" if($mess);
+
+ if($full) {
+ print <<HERE;
+
+Usage: $0 \\
+ -config=<file> [-g] [-u] [-b] [-h] [-v]
+
+ --config=<file> database configuration file
+ -g generate new database
+ -u update existing database
+ -b backup database to portable files
+ -h this help screen
+ -v program version
+
+HERE
+
+ }
+
+ print "$0 v$VERSION\n";
+ exit(0);
+}
+
+#----------------------------------------------------------------------------
+# Private Methods
+
+sub _parse_archive {
+ my ($self,$type,$file) = @_;
+ my $db = $self->uploads;
+ my $dist = CPAN::DistnameInfo->new($file);
+
+ my $name = $dist->dist; # "CPAN-DistnameInfo"
+ my $version = $dist->version; # "0.02"
+ my $cpanid = $dist->cpanid; # "GBARR"
+ my $filename = $dist->filename; # "CPAN-DistnameInfo-0.02.tar.gz"
+ my $date = (stat($file))[9];
+
+ return unless($name && $version && $cpanid && $date);
+ #$self->_log("$type => $name => $version => $cpanid => $date");
+
+ my @rows = $db->get_query('array',$phrasebook{'FindDistVersion'},$cpanid,$name,$version);
+ if(@rows) {
+ $db->do_query($phrasebook{'UpdateDistVersion'},$type,$cpanid,$name,$version);
+ } else {
+ $db->do_query($phrasebook{'InsertDistVersion'},$type,$cpanid,$name,$version,$filename,$date);
+ }
+
+ return $filename;
+}
+
+sub _nntp_connect {
+ # connect to NNTP server
+ my $nntp = Net::NNTP->new("nntp.perl.org") or die "Cannot connect to nntp.perl.org";
+ my ($num,$first,$last) = $nntp->group("perl.cpan.uploads");
+
+ return ($nntp,$num,$first,$last);
+}
+
+sub _lastid {
+ my ($self,$id) = @_;
+ my $f = $self->lastfile;
+
+ unless( -f $f) {
+ mkpath(dirname($f));
+ overwrite_file( $f, 0 );
+ $id ||= 0;
+ }
+
+ if($id) { overwrite_file( $f, $id ); }
+ else { $id = read_file($f); }
+
+ return $id;
+}
+
+sub _init_options {
+ my $self = shift;
+ my %hash = @_;
+ my %options;
+
+ GetOptions( \%options,
+ 'config=s',
+ 'generate|g',
+ 'update|u',
+ 'backup|b',
+ 'help|h',
+ 'version|v'
+ );
+
+ # default to API settings if no command line option
+ for(qw(config generate update backup help version)) {
+ $options{$_} ||= $hash{$_} if(defined $hash{$_});
+ }
+
+ $self->help(1) if($options{help});
+ $self->help(0) if($options{version});
+
+ $self->help(1,"Must specify at least one option from 'generate' (-g), 'update' (-u) and/or 'backup' (-b)")
+ unless($options{generate} || $options{update} || $options{backup});
+ $self->help(1,"Must specific the configuration file") unless($options{config});
+ $self->help(1,"Configuration file [$options{config}] not found") unless(-f $options{config});
+
+ # load configuration
+ my $cfg = Config::IniFiles->new( -file => $options{config} );
+
+ # configure sources
+ if($options{generate}) {
+ my $dir = $cfg->val('MASTER','BACKPAN');
+ $self->help(1,"No source location for 'BACKPAN' in config file") if(! $dir);
+ $self->help(1,"Cannot find source location for 'BACKPAN': [$dir]") if(!-d $dir);
+ $self->backpan($dir);
+ $self->mgenerate(1);
+ }
+ if($options{generate} || $options{update}) {
+ my $dir = $cfg->val('MASTER','CPAN');
+ $self->help(1,"No source location for 'CPAN' in config file") if(! $dir);
+ $self->help(1,"Cannot find source location for 'CPAN': [$dir]") if(!-d $dir);
+ $self->cpan($dir);
+ }
+
+ $self->mupdate(1) if($options{update});
+ $self->logfile( $cfg->val('MASTER','logfile' ) );
+ $self->logclean( $cfg->val('MASTER','logclean' ) || 0 );
+ $self->lastfile( $cfg->val('MASTER','lastfile' ) || LASTMAIL );
+
+ # configure upload DB
+ $self->help(1,"No configuration for UPLOADS database") unless($cfg->SectionExists('UPLOADS'));
+ my %opts = map {$_ => $cfg->val('UPLOADS',$_);} qw(driver database dbfile dbhost dbport dbuser dbpass);
+ my $db = CPAN::Testers::Common::DBUtils->new(%opts);
+ $self->help(1,"Cannot configure UPLOADS database") unless($db);
+ $self->uploads($db);
+
+ # configure backup DBs
+ if($options{backup}) {
+ $self->help(1,"No configuration for BACKUPS with backup option") unless($cfg->SectionExists('BACKUPS'));
+
+ $self->mbackup(1);
+ my @drivers = $cfg->val('BACKUPS','drivers');
+ for my $driver (@drivers) {
+ $self->help(1,"No configuration for backup option '$driver'") unless($cfg->SectionExists($driver));
+
+ my %opt = map {$_ => $cfg->val($driver,$_);} qw(driver database dbfile dbhost dbport dbuser dbpass);
+ $backups{$driver}{'exists'} = $driver =~ /SQLite/i ? -f $opt{database} : 1;
+
+ # CSV is a bit of an oddity!
+ if($driver =~ /CSV/i) {
+ $backups{$driver}{'exists'} = 0;
+ $backups{$driver}{'dbfile'} = $opt{dbfile};
+ $opt{dbfile} = 'uploads';
+ unlink($opt{dbfile});
+ }
+
+ $backups{$driver}{db} = CPAN::Testers::Common::DBUtils->new(%opt);
+ $self->help(1,"Cannot configure BACKUPS database for '$driver'") unless($backups{$driver}{db});
+ }
+ }
+}
+
+sub _log {
+ my $self = shift;
+ my $log = $self->logfile or return;
+ mkpath(dirname($log)) unless(-f $log);
+
+ my $mode = $self->logclean ? 'w+' : 'a+';
+ $self->logclean(0);
+
+ my @dt = localtime(time);
+ my $dt = sprintf "%04d/%02d/%02d %02d:%02d:%02d", $dt[5]+1900,$dt[4]+1,$dt[3],$dt[2],$dt[1],$dt[0];
+
+ my $fh = IO::File->new($log,$mode) or die "Cannot write to log file [$log]: $!\n";
+ print $fh "$dt ", @_, "\n";
+ $fh->close;
+}
+
+q!Will code for a damn fine Balti!;
+
+__END__
+
+#----------------------------------------------------------------------------
+
+=head1 NAME
+
+CPAN::Testers::Data::Uploads - CPAN Testers Uploads Database Generator
+
+=head1 SYNOPSIS
+
+ perl uploads.pl --config=<file> [--generate] [--update] [--backup]
+
+=head1 DESCRIPTION
+
+This program allows the user to create, update and backup the uploads database,
+either as separate commands, or a combination of all three. The process order
+will always be CREATE->UPDATE->BACKUP, regardless of the order the options
+appear on the command line.
+
+The Uploads database contains basic information about the history of CPAN. It
+records the release dates of everything that is uploaded to CPAN, both within
+a BACKPAN repository, a current CPAN repository and the latest uploads posted
+by PAUSE, which may not have yet reached the CPAN mirrors.
+
+A simple schema for the MySQL database is below:
+
+ CREATE TABLE `uploads` (
+ `type` varchar(10) NOT NULL,
+ `author` varchar(32) NOT NULL,
+ `dist` varchar(100) NOT NULL,
+ `version` varchar(100) NOT NULL,
+ `filename` varchar(255) NOT NULL,
+ `released` int(16) NOT NULL,
+ PRIMARY KEY (`author`,`dist`,`version`)
+ ) ENGINE=MyISAM;
+
+The 'type' field can be one of three values, 'backpan', 'cpan' or 'upload',
+which incates whether the release has been archived to BACKPAN, currently on
+CPAN or has recently been uploaded and may not have reached the CPAN mirrors
+yet.
+
+The 'author', 'dist', 'version' and 'filename' fields contain the breakdown of
+the distribution component parts used to locate the distribution. Although in
+most cases the filename could be considered a primary key, it is possible that
+two or more authors could upload a distribution with the same name.
+
+The 'released' field holds the date of the distribution release as the number
+of seconds since the epoch. This is extremely useful for sorting distributions
+based on their release date rather than the version string. Due to many authors
+having different version schemes, this is perhaps the only reliable method with
+which to sort distribution releases.
+
+=head1 INTERFACE
+
+=head2 The Constructor
+
+=over
+
+=item * new
+
+Instatiates the object CPAN::Testers::Data::Uploads:
+
+ my $obj = CPAN::Testers::Data::Uploads->new();
+
+=back
+
+=head2 Public Methods
+
+=over
+
+=item * process
+
+=item * generate
+
+=item * update
+
+=item * backup
+
+=item * help
+
+=back
+
+=head2 Private Methods
+
+=over
+
+=item * _parse_archive
+
+=item * _nntp_connect
+
+Sets up the connection to the NNTP server.
+
+=item * _lastid
+
+=item * _init_options
+
+=back
+
+=head1 BECOME A TESTER
+
+Whether you have a common platform or a very unusual one, you can help by
+testing modules you install and submitting reports. There are plenty of
+module authors who could use test reports and helpful feedback on their
+modules and distributions.
+
+If you'd like to get involved, please take a look at the CPAN Testers Wiki,
+where you can learn how to install and configure one of the recommended
+smoke tools.
+
+For further help and advice, please subscribe to the the CPAN Testers
+discussion mailing list.
+
+ CPAN Testers Wiki
+ - http://wiki.cpantesters.org
+ CPAN Testers Discuss mailing list
+ - http://lists.cpan.org/showlist.cgi?name=cpan-testers-discuss
+
+=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 an email to barbie@cpan.org. However, it would help
+greatly if you are able to pinpoint problems or even supply a patch.
+
+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-Uploads
+
+=head1 SEE ALSO
+
+L<CPAN::Testers::Common::Article>,
+L<CPAN::Testers::Common::DBUtils>
+L<CPAN::Testers::Data::Generate>
+L<CPAN::Testers::WWW::Statistics>
+L<CPAN::WWW::Testers>,
+
+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) 2008-2009 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
8 t/01base.t
@@ -0,0 +1,8 @@
+#!/usr/bin/perl -w
+use strict;
+
+use Test::More tests => 1;
+
+BEGIN {
+ use_ok( 'CPAN::Testers::Data::Uploads' );
+}
101 t/05setup_db-uploads.t
@@ -0,0 +1,101 @@
+#!perl
+
+use strict;
+use warnings;
+use Test::More tests => 1;
+use CPAN::Testers::Common::DBUtils;
+use File::Path;
+use File::Basename;
+
+my $f = 't/_DBDIR/test.db';
+unlink $f if -f $f;
+mkpath( dirname($f) );
+
+my $dbh = CPAN::Testers::Common::DBUtils->new(driver => 'SQLite', database => $f);
+$dbh->do_query(q{
+ CREATE TABLE `uploads` (
+ `type` text NOT NULL,
+ `author` text NOT NULL,
+ `dist` text NOT NULL,
+ `version` text NOT NULL,
+ `filename` text NOT NULL,
+ `released` int NOT NULL,
+ PRIMARY KEY (`author`,`dist`,`version`)
+ );
+});
+
+while(<DATA>){
+ chomp;
+ $dbh->do_query('INSERT INTO uploads ( type, author, dist, version, filename, released ) VALUES ( ?, ?, ?, ?, ?, ? )', split(/\|/,$_) );
+}
+
+my @ct = $dbh->get_query('array','select count(*) from uploads');
+is($ct[0]->[0], 63, "row ct");
+
+
+#select * from uploads where dist in ('AEAE', 'AI-NeuralNet-BackProp', 'AI-NeuralNet-Mesh', 'AI-NeuralNet-SOM', 'AOL-TOC', 'Abstract-Meta-Class', 'Acme', 'Acme-Anything', 'Acme-BOPE', 'Acme-Brainfuck', 'Acme-Buffy', 'Acme-CPANAuthors-Canadian', 'Acme-CPANAuthors-CodeRepos', 'Acme-CPANAuthors-French', 'Acme-CPANAuthors-Japanese');
+#type|author|dist|version|filename|released
+__DATA__
+cpan|LBROCARD|Acme-Buffy|1.3|Acme-Buffy-1.3.tar.gz|1017236268
+cpan|LBROCARD|Acme-Buffy|1.5|Acme-Buffy-1.5.tar.gz|1177769034
+cpan|LBROCARD|Acme-Buffy|1.4|Acme-Buffy-1.4.tar.gz|1157733085
+backpan|LBROCARD|Acme-Buffy|1.1|Acme-Buffy-1.1.tar.gz|990548103
+backpan|LBROCARD|Acme-Buffy|1.2|Acme-Buffy-1.2.tar.gz|997617194
+cpan|DRRHO|AI-NeuralNet-SOM|0.04|AI-NeuralNet-SOM-0.04.tar.gz|1182080003
+cpan|DRRHO|AI-NeuralNet-SOM|0.06|AI-NeuralNet-SOM-0.06.tar.gz|1211531083
+cpan|DRRHO|AI-NeuralNet-SOM|0.05|AI-NeuralNet-SOM-0.05.tar.gz|1200513667
+cpan|DRRHO|AI-NeuralNet-SOM|0.01|AI-NeuralNet-SOM-0.01.tar.gz|1181057025
+cpan|DRRHO|AI-NeuralNet-SOM|0.03|AI-NeuralNet-SOM-0.03.tar.gz|1181848391
+cpan|DRRHO|AI-NeuralNet-SOM|0.07|AI-NeuralNet-SOM-0.07.tar.gz|1211612835
+cpan|DRRHO|AI-NeuralNet-SOM|0.02|AI-NeuralNet-SOM-0.02.tar.gz|1181487612
+cpan|VOISCHEV|AI-NeuralNet-SOM|0.01|AI-NeuralNet-SOM-0.01.tar.gz|970252633
+cpan|VOISCHEV|AI-NeuralNet-SOM|0.02|AI-NeuralNet-SOM-0.02.tar.gz|970684892
+cpan|INGY|Acme|1.11111|Acme-1.11111.tar.gz|1137626100
+backpan|INGY|Acme|1.111|Acme-1.111.tar.gz|1079905156
+backpan|INGY|Acme|1.11|Acme-1.11.tar.gz|1079870865
+backpan|INGY|Acme|1.00|Acme-1.00.tar.gz|1079868743
+backpan|INGY|Acme|1.1111|Acme-1.1111.tar.gz|1111906013
+cpan|ISHIGAKI|Acme-CPANAuthors-Japanese|0.071226|Acme-CPANAuthors-Japanese-0.071226.tar.gz|1198658704
+cpan|ISHIGAKI|Acme-CPANAuthors-Japanese|0.080522|Acme-CPANAuthors-Japanese-0.080522.tar.gz|1211389830
+cpan|ISHIGAKI|Acme-CPANAuthors-CodeRepos|0.080522|Acme-CPANAuthors-CodeRepos-0.080522.tar.gz|1211390902
+cpan|SAPER|Acme-CPANAuthors-French|0.04|Acme-CPANAuthors-French-0.04.tar.gz|1221955693
+backpan|SAPER|Acme-CPANAuthors-French|0.01|Acme-CPANAuthors-French-0.01.tar.gz|1221268256
+cpan|SAPER|Acme-CPANAuthors-French|0.05|Acme-CPANAuthors-French-0.05.tar.gz|1222119306
+backpan|SAPER|Acme-CPANAuthors-French|0.02|Acme-CPANAuthors-French-0.02.tar.gz|1221355420
+backpan|SAPER|Acme-CPANAuthors-French|0.03|Acme-CPANAuthors-French-0.03.tar.gz|1221696260
+cpan|SAPER|Acme-CPANAuthors-French|0.06|Acme-CPANAuthors-French-0.06.tar.gz|1225315698
+upload|SAPER|Acme-CPANAuthors-French|0.07|Acme-CPANAuthors-French-0.07.tar.gz|1225662681
+upload|ZOFFIX|Acme-CPANAuthors-Canadian|0.0101|Acme-CPANAuthors-Canadian-0.0101.tar.gz|1225664601
+cpan|GARU|Acme-BOPE|0.01|Acme-BOPE-0.01.tar.gz|1222060546
+backpan|JESSE|Acme-Buffy|1.3|Acme-Buffy-1.3.tar.gz|1065349193
+cpan|JETEVE|AEAE|0.02|AEAE-0.02.tar.gz|1139566791
+cpan|JETEVE|AEAE|0.01|AEAE-0.01.tar.gz|1138724959
+backpan|JJORE|Acme-Anything|0.01|Acme-Anything-0.01.tar.gz|1186005823
+cpan|JJORE|Acme-Anything|0.02|Acme-Anything-0.02.tar.gz|1194827066
+cpan|JBRYAN|AI-NeuralNet-Mesh|0.43|AI-NeuralNet-Mesh-0.43.zip|968921615
+cpan|JBRYAN|AI-NeuralNet-BackProp|0.40|AI-NeuralNet-BackProp-0.40.zip|964250318
+cpan|JBRYAN|AI-NeuralNet-Mesh|0.31|AI-NeuralNet-Mesh-0.31.zip|967191936
+cpan|JBRYAN|AI-NeuralNet-BackProp|0.77|AI-NeuralNet-BackProp-0.77.zip|966067868
+cpan|JBRYAN|AI-NeuralNet-BackProp|0.42|AI-NeuralNet-BackProp-0.42.zip|964604318
+cpan|JBRYAN|AI-NeuralNet-Mesh|0.44|AI-NeuralNet-Mesh-0.44.zip|968964981
+cpan|JBRYAN|AI-NeuralNet-BackProp|0.89|AI-NeuralNet-BackProp-0.89.zip|966496907
+cpan|JBRYAN|AI-NeuralNet-Mesh|0.20|AI-NeuralNet-Mesh-0.20.zip|967009309
+backpan|JALDHAR|Acme-Brainfuck|1.1.0|Acme-Brainfuck-1.1.0.tar.gz|1081229428
+cpan|JALDHAR|Acme-Brainfuck|1.1.1|Acme-Brainfuck-1.1.1.tar.gz|1081268735
+backpan|JALDHAR|Acme-Brainfuck|1.0.0|Acme-Brainfuck-1.0.0.tar.gz|1031080554
+cpan|JHARDING|AOL-TOC|0.32|AOL-TOC-0.32.tar.gz|962207388
+cpan|JHARDING|AOL-TOC|0.340|AOL-TOC-0.340.tar.gz|966917420
+cpan|JHARDING|AOL-TOC|0.33|AOL-TOC-0.33.tar.gz|962694743
+cpan|ADRIANWIT|Abstract-Meta-Class|0.09|Abstract-Meta-Class-0.09.tar.gz|1212364076
+backpan|ADRIANWIT|Abstract-Meta-Class|0.07|Abstract-Meta-Class-0.07.tar.gz|1212267288
+backpan|ADRIANWIT|Abstract-Meta-Class|0.04|Abstract-Meta-Class-0.04.tar.gz|1211589222
+cpan|ADRIANWIT|Abstract-Meta-Class|0.08|Abstract-Meta-Class-0.08.tar.gz|1212345949
+backpan|ADRIANWIT|Abstract-Meta-Class|0.01|Abstract-Meta-Class-0.01.tar.gz|1210001395
+backpan|ADRIANWIT|Abstract-Meta-Class|0.05|Abstract-Meta-Class-0.05.tar.gz|1211645127
+cpan|ADRIANWIT|Abstract-Meta-Class|0.10|Abstract-Meta-Class-0.10.tar.gz|1212962154
+cpan|ADRIANWIT|Abstract-Meta-Class|0.12|Abstract-Meta-Class-0.12.tar.gz|1224423414
+cpan|ADRIANWIT|Abstract-Meta-Class|0.11|Abstract-Meta-Class-0.11.tar.gz|1220826243
+backpan|ADRIANWIT|Abstract-Meta-Class|0.03|Abstract-Meta-Class-0.03.tar.gz|1210105676
+backpan|ADRIANWIT|Abstract-Meta-Class|0.06|Abstract-Meta-Class-0.06.tar.gz|1211732184
+upload|ADRIANWIT|Abstract-Meta-Class|0.13|Abstract-Meta-Class-0.13.tar.gz|1227483540
+cpan|ISHIGAKI|Acme-CPANAuthors-Japanese|0.090101|Acme-CPANAuthors-Japanese-0.090101.tar.gz|1230748955
12 t/09setup-expected.t
@@ -0,0 +1,12 @@
+#!perl
+
+use strict;
+use warnings;
+$|=1;
+
+use Test::More tests => 1;
+use Archive::Extract;
+
+my $EXPECTEDPATH = 't';
+my $ae = Archive::Extract->new( archive => 't/Expected.zip' );
+ok( $ae->extract(to => $EXPECTEDPATH), 'extracted expected files' );
53 t/20attributes.t
@@ -0,0 +1,53 @@
+#!perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 37;
+use CPAN::Testers::Data::Uploads;
+
+use lib 't';
+use CTDU_Testing;
+
+ok( my $obj = CTDU_Testing::getObj(), "got object" );
+
+# test the attributes generated by Class::Accessor::Chained::Fast
+
+# predefined attributes
+foreach my $k ( qw/
+ uploads
+ cpan
+ logfile
+ logclean
+ lastfile
+ mupdate
+/ ){
+ my $label = "[$k]";
+ SKIP: {
+ ok( $obj->can($k), "$label can" )
+ or skip "'$k' attribute missing", 3;
+ isnt( $obj->$k(), undef, "$label has default" );
+ is( $obj->$k(123), 123, "$label set" ); # chained, so returns object, not value.
+ is( $obj->$k, 123, "$label get" );
+ };
+}
+
+# undefined attributes
+foreach my $k ( qw/
+ backpan
+ mgenerate
+ mbackup
+/ ){
+ my $label = "[$k]";
+ SKIP: {
+ ok( $obj->can($k), "$label can" )
+ or skip "'$k' attribute missing", 3;
+ is( $obj->$k(), undef, "$label has no default" );
+ is( $obj->$k(123), 123, "$label set" ); # chained, so returns object, not value.
+ is( $obj->$k, 123, "$label get" );
+ };
+}
+
+# TODO -- test these:
+# $MAX_ID;
+
10 t/50logging.ini
@@ -0,0 +1,10 @@
+[MASTER]
+BACKPAN=t/_DBDIR/BACKPAN/authors/id
+CPAN=t/_DBDIR/CPAN/authors/id
+logfile=50logging.log
+lastfile=t/_DBDIR/lastid.txt
+
+[UPLOADS]
+driver=SQLite
+database=t/_DBDIR/test.db
+
72 t/50logging.t
@@ -0,0 +1,72 @@
+#!perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 23;
+use File::Path;
+
+use lib 't';
+use CTDU_Testing;
+
+unlink('50logging.log') if(-f '50logging.log');
+
+{
+ ok( my $obj = CTDU_Testing::getObj(config => 't/50logging.ini'), "got object" );
+
+ is($obj->logfile, '50logging.log', 'logfile default set');
+ is($obj->logclean, 0, 'logclean default set');
+
+ $obj->_log("Hello");
+ $obj->_log("Goodbye");
+
+ ok( -f '50logging.log', '50logging.log created in current dir' );
+
+ my @log = do { open FILE, '<', '50logging.log'; <FILE> };
+ chomp @log;
+
+ is(scalar(@log),2, 'log written');
+ like($log[0], qr!\d{4}/\d\d/\d\d \d\d:\d\d:\d\d Hello!, 'line 2 of log');
+ like($log[1], qr!\d{4}/\d\d/\d\d \d\d:\d\d:\d\d Goodbye!, 'line 3 of log');
+}
+
+
+{
+ ok( my $obj = CTDU_Testing::getObj(config => 't/50logging.ini'), "got object" );
+
+ is($obj->logfile, '50logging.log', 'logfile default set');
+ is($obj->logclean, 0, 'logclean default set');
+
+ $obj->_log("Back Again");
+
+ ok( -f '50logging.log', '50logging.log created in current dir' );
+
+ my @log = do { open FILE, '<', '50logging.log'; <FILE> };
+ chomp @log;
+
+ is(scalar(@log),3, 'log written');
+ like($log[0], qr!\d{4}/\d\d/\d\d \d\d:\d\d:\d\d Hello!, 'line 2 of log');
+ like($log[1], qr!\d{4}/\d\d/\d\d \d\d:\d\d:\d\d Goodbye!, 'line 3 of log');
+ like($log[2], qr!\d{4}/\d\d/\d\d \d\d:\d\d:\d\d Back Again!, 'line 5 of log');
+}
+
+{
+ ok( my $obj = CTDU_Testing::getObj(config => 't/50logging.ini'), "got object" );
+
+ is($obj->logfile, '50logging.log', 'logfile default set');
+ is($obj->logclean, 0, 'logclean default set');
+ $obj->logclean(1);
+ is($obj->logclean, 1, 'logclean reset');
+
+ $obj->_log("Start Again");
+
+ ok( -f '50logging.log', '50logging.log created in current dir' );
+
+ my @log = do { open FILE, '<', '50logging.log'; <FILE> };
+ chomp @log;
+
+ is(scalar(@log),1, 'log written');
+ like($log[0], qr!\d{4}/\d\d/\d\d \d\d:\d\d:\d\d Start Again!, 'line 1 of log');
+}
+
+ok( unlink('50logging.log'), 'removed 50logging.log' );
25 t/52lastid.t
@@ -0,0 +1,25 @@
+#!perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 8;
+
+use lib 't';
+use CTDU_Testing;
+
+ok( my $obj = CTDU_Testing::getObj(), "got object" );
+
+my $f = 't/_DBDIR/lastid.txt';
+unlink($f) if(-f $f);
+
+ok( ! -f $f, 'lastid.txt absent' );
+is( $obj->_lastid, 0, "retrieve from absent file" );
+ok( -f $f, 'lastid.txt now exists' );
+is( $obj->_lastid, 0, "retrieve 0" );
+is( $obj->_lastid(3), 3, "set 3" );
+is( $obj->_lastid, 3, "retreive 3" );
+
+ok( unlink($f), 'removed last_id.txt' );
+
+
13 t/59cleanup.t
@@ -0,0 +1,13 @@
+#!perl
+
+use strict;
+use warnings;
+$|=1;
+
+use Test::More tests => 2;
+use File::Path;
+
+for my $d ('t/_DBDIR') {
+ ok( rmtree( $d ), "removed '$d'" );
+ ok( ! -d $d, "removed '$d' verified" );
+}
10 t/90podtest.t
@@ -0,0 +1,10 @@
+use Test::More;
+
+# Skip if doing a regular install
+plan skip_all => "Author tests not required for installation"
+ unless ( $ENV{AUTOMATED_TESTING} );
+
+eval "use Test::Pod 1.00";
+plan skip_all => "Test::Pod 1.00 required for testing POD" if $@;
+all_pod_files_ok();
+
9 t/91podcover.t
@@ -0,0 +1,9 @@
+use Test::More;
+
+# Skip if doing a regular install
+plan skip_all => "Author tests not required for installation"
+ unless ( $ENV{AUTOMATED_TESTING} );
+
+eval "use Test::Pod::Coverage 0.08";
+plan skip_all => "Test::Pod::Coverage 0.08 required for testing POD coverage" if $@;
+all_pod_coverage_ok();
11 t/94metatest.t
@@ -0,0 +1,11 @@
+use Test::More;
+
+# Skip if doing a regular install
+plan skip_all => "Author tests not required for installation"
+ unless ( $ENV{AUTOMATED_TESTING} );
+
+eval "use Test::CPAN::Meta 0.12";
+plan skip_all => "Test::CPAN::Meta 0.12 required for testing META.yml" if $@;
+meta_yaml_ok();
+
+
77 t/CTDU_Testing.pm
@@ -0,0 +1,77 @@
+package CTDU_Testing;
+
+use strict;
+use warnings;
+
+use CPAN::Testers::Data::Uploads;
+use File::Path;
+use File::Temp;
+use File::Find;
+
+sub getObj {
+ my %opts = @_;
+ $opts{config} ||= \*DATA;
+ $opts{update} = 1 unless(defined $opts{update});
+
+ my $obj = CPAN::Testers::Data::Uploads->new(%opts);
+
+ return $obj;
+}
+
+sub _cleanDir {
+ my $dir = shift;
+ if( -d $dir ){
+ rmtree($dir) or return;
+ }
+ mkpath($dir) or return;
+ return 1;
+}
+
+sub cleanDir {
+ my $obj = shift;
+ return _cleanDir( $obj->directory );
+}
+
+sub whackDir {
+ my $obj = shift;
+ my $dir = $obj->directory;
+ if( -d $dir ){
+ rmtree($dir) or return;
+ }
+ return 1;
+}
+
+sub listFiles {
+ my $dir = shift;
+ my @files;
+ find({ wanted => sub { push @files, File::Spec->abs2rel($File::Find::name,$dir) if -f $_ } }, $dir);
+ return sort @files;
+}
+
+1;
+
+__DATA__
+
+[MASTER]
+BACKPAN=t/_DBDIR/BACKPAN/authors/id
+CPAN=t/_DBDIR/CPAN/authors/id
+logfile=logs/uploads.log
+lastfile=t/_DBDIR/lastid.txt
+
+[UPLOADS]
+driver=SQLite
+database=t/_DBDIR/test.db
+
+[BACKUPS]
+drivers=<<EOT
+SQLite
+CSV
+EOT
+
+[SQLite]
+driver=SQLite
+database=t/_DBDIR/uploads.db
+
+[CSV]
+driver=CSV
+dbfile=t/_DBDIR/uploads.csv
BIN  t/Expected.zip
Binary file not shown
Please sign in to comment.
Something went wrong with that request. Please try again.