Browse files

disabled LITESTATS, updated scripts

  • Loading branch information...
1 parent ebb980f commit d9cc15da53c2cc024e9de03fbb611ba6627b3c07 @barbie committed Nov 11, 2012
Showing with 306 additions and 48 deletions.
  1. +10 −0 Changes
  2. +1 −0 MANIFEST
  3. +6 −5 bin/cpanstats
  4. +7 −7 bin/cpanstats-delete
  5. +7 −7 bin/cpanstats-select
  6. +219 −0 bin/cpanstats-sqlite
  7. +10 −10 bin/cpanstats-update
  8. +1 −1 examples/cpanstats-createdb
  9. +45 −18 lib/CPAN/Testers/Data/Generator.pm
View
10 Changes
@@ -1,5 +1,15 @@
Revision history for Perl module CPAN::Testers::Data::Generator.
+ - parse message fix.
+ - disabled SQLite updates.
+ - new script:
+ bin/cpanstats-sqlite (v0.01)
+ - script updates:
+ bin/cpanstats (v1.05)
+ bin/cpanstats-select (v0.12)
+ bin/cpanstats-update (v0.10)
+ bin/cpanstats-delete (v0.15)
+
1.04 2012-10-23
- script updates:
bin/cpanstats (v1.04)
View
1 MANIFEST
@@ -1,6 +1,7 @@
bin/cpanstats
bin/cpanstats-delete
bin/cpanstats-select
+bin/cpanstats-sqlite
bin/cpanstats-update
Changes
examples/cpanstats-createdb
View
11 bin/cpanstats
@@ -1,7 +1,7 @@
#!/usr/bin/perl -w
use strict;
-my $VERSION = '1.04';
+my $VERSION = '1.05';
#----------------------------------------------------------------------------
# Library Modules
@@ -11,7 +11,7 @@ use lib qw(../lib lib);
use Getopt::ArgvFile default=>1;
use Getopt::Long;
-use CPAN::Testers::Data::Generator '1.04';
+use CPAN::Testers::Data::Generator '1.05';
#----------------------------------------------------------------------------
# Variables
@@ -149,7 +149,7 @@ cpanstats - script to access the Metabase server and update the database.
cpanstats -c=data/settings.ini --regenerate --gstart=$guid1 --gend=$guid2
cpanstats -c=data/settings.ini --regenerate --dstart=$date1 --dend=$date2
cpanstats -c=data/settings.ini --regenerate --file=$file
-
+
# parse a single report from remote metabase
cpanstats -c=data/settings.ini --parse --guid=$guid1
cpanstats -c=data/settings.ini --parse --file=$file
@@ -184,14 +184,15 @@ 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
+Fixes are dependent upon their severity and my availability. 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::Testers::WWW::Reports>,
L<CPAN::Testers::WWW::Statistics>
F<http://www.cpantesters.org/>,
@@ -208,6 +209,6 @@ F<http://wiki.cpantesters.org/>
Copyright (C) 2005-2012 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.
+ modify it under the Artistic License 2.0.
=cut
View
14 bin/cpanstats-delete
@@ -2,7 +2,7 @@
use strict;
$|++;
-my $VERSION = '0.14';
+my $VERSION = '0.15';
#----------------------------------------------------------------------------
@@ -124,7 +124,7 @@ sub init_options {
help(1) if($options{help});
help(0) if($options{version});
- help(1,"Must specify the configuration file") unless($options{config});
+ help(1,"Must specify the configuration file") unless( $options{config});
help(1,"Configuration file [$options{config}] not found") unless(-f $options{config});
# load configuration
@@ -175,15 +175,15 @@ 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
+Fixes are dependent upon their severity and my availability. 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::Reports>,
L<CPAN::Testers::WWW::Statistics>
F<http://www.cpantesters.org/>,
@@ -197,10 +197,10 @@ F<http://wiki.cpantesters.org/>
=head1 COPYRIGHT AND LICENSE
- Copyright (C) 2005-2010 Barbie for Miss Barbell Productions.
+ Copyright (C) 2005-2012 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.
+ This module is free software; you can redistribute it and/or
+ modify it under the Artistic License 2.0.
=cut
View
14 bin/cpanstats-select
@@ -2,7 +2,7 @@
use strict;
$|++;
-my $VERSION = '0.11';
+my $VERSION = '0.12';
#----------------------------------------------------------------------------
@@ -27,7 +27,7 @@ cpanstats-select - select stats from the CPAN Testers Statistics database.
[--date|-y=<YYYYMM>] \
[--tester|-t=<email>] \
[--platform|-o=<platform>] \
- [--perl|-p=<perlversion>]
+ [--perl|-p=<perlversion>]
=head1 DESCRIPTION
@@ -145,7 +145,7 @@ sub init_options {
$options{grade} = lc $options{grade} if($options{grade});
- help(1,"Must specify the configuration file") unless($options{config});
+ help(1,"Must specify the configuration file") unless( $options{config});
help(1,"Configuration file [$options{config}] not found") unless(-f $options{config});
help(1,"Must specify the database code (CPANSTATS or LITESTATS)")
@@ -212,15 +212,15 @@ 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
+Fixes are dependent upon their severity and my availability. 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::Reports>,
L<CPAN::Testers::WWW::Statistics>
F<http://www.cpantesters.org/>,
@@ -234,10 +234,10 @@ for Miss Barbell Productions L<http://www.missbarbell.co.uk>.
=head1 COPYRIGHT AND LICENSE
- Copyright (C) 2005-2010 Barbie for Miss Barbell Productions
+ Copyright (C) 2005-2012 Barbie for Miss Barbell Productions
All Rights Reserved.
This module is free software; you can redistribute it and/or
- modify it under the same terms as Perl itself.
+ modify it under the Artistic License 2.0.
=cut
View
219 bin/cpanstats-sqlite
@@ -0,0 +1,219 @@
+#!/usr/bin/perl
+use strict;
+$|++;
+
+my $VERSION = '0.01';
+
+#----------------------------------------------------------------------------
+
+=head1 NAME
+
+cpanstats-update - script to update entries in the cpanstats database.
+
+=head1 SYNOPSIS
+
+ perl cpanstats-sqlite \
+ --config=<file> \
+ [-i=0] [--file=<file>]
+
+=head1 DESCRIPTION
+
+This program updates the SQLite version of the cpanstats database from the
+MySQL version. If a single id, or file of ids are provided, these specific
+ids only are updated, otherwise all the latest records will be updated.
+
+=head1 OPTIONS
+
+=over 4
+
+=item --config
+
+Configuration file contain database access details.
+
+=item -i | --id
+
+Display the record matching the given cpanstats id.
+
+=item --file
+
+The named file will be used to retrieve a list of cpanstats ids, one per
+line.
+
+=back
+
+=cut
+
+# -------------------------------------
+# Library Modules
+
+use Config::IniFiles;
+use CPAN::Testers::Common::DBUtils;
+use Getopt::ArgvFile default=>1;
+use Getopt::Long;
+use IO::File;
+
+# -------------------------------------
+# Variables
+
+my (%options,@rows);
+
+my %SQL = (
+ 'SelectMax' => 'SELECT MAX(id) FROM cpanstats',
+ 'SelectNew' => 'SELECT id,guid,state,postdate,tester,dist,version,platform,perl,osname,osvers,fulldate,type FROM cpanstats WHERE id > ?',
+ 'SelectByID' => 'SELECT id,guid,state,postdate,tester,dist,version,platform,perl,osname,osvers,fulldate,type FROM cpanstats WHERE id = ?',
+ 'Replace' => 'REPLACE INTO cpanstats (id,guid,state,postdate,tester,dist,version,platform,perl,osname,osvers,fulldate,type) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?)',
+ 'Insert' => 'INSERT INTO cpanstats (id,guid,state,postdate,tester,dist,version,platform,perl,osname,osvers,fulldate,type) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?)',
+);
+
+# -------------------------------------
+# Program
+
+##### INITIALISE #####
+
+init_options();
+
+##### MAIN #####
+
+if($options{id} || $options{file}) {
+
+ my @list = get_list();
+ push @list, {id=>$options{id}} if($options{id});
+
+ for my $item (@list) {
+ my @rows = $options{CPANSTATS}->get_query('array',$SQL{SelectByID},$item->{id});
+ next unless(@rows);
+ $options{LITESTATS}->do_query($SQL{Replace},@{$rows[0]});
+ }
+
+} else {
+
+ my @rows = $options{LITESTATS}->get_query('array',$SQL{SelectMax});
+ my $id = @rows ? $rows[0]->[0] : 0;
+ my $next = $options{CPANSTATS}->iterator('array',$SQL{SelectNew},$id);
+ while($row = $next->()) {
+ $options{LITESTATS}->do_query($SQL{Insert},@$row});
+ }
+
+}
+
+# -------------------------------------
+# Subroutines
+
+=item get_list
+
+Returns the list of cpanstats ids from the named file.
+
+=cut
+
+sub get_list {
+ my @list;
+ my $file = $options{file} || return ();
+ die "file [$file] not found" unless(-f $file);
+
+ my $fh = IO::File->new($file) or die "Cannot open file [$file]: $!";
+ while(<$fh>) {
+ next if(/^\s*$/); # ignore empty lines
+ s/\s+$//;
+ push @list, {id=>$id} if($id);
+ }
+ $fh->close;
+
+ return @list;
+}
+
+=item init_options
+
+Determine command line options and initialise any defaults.
+
+=cut
+
+sub init_options {
+ GetOptions( \%options,
+ 'config=s',
+ 'id|i=i',
+ 'file=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
+ for my $db (qw(CPANSTATS LITESTATS)) {
+ 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);
+ $options{$db} = CPAN::Testers::Common::DBUtils->new(%opts);
+ die "Cannot configure $db database\n" unless($options{$db});
+ }
+}
+
+sub help {
+ my ($full,$mess) = @_;
+
+ print "\n$mess\n\n" if($mess);
+
+ if($full) {
+ print <<HERE;
+
+Usage: $0
+ --config=<file> - configuration file
+
+ [--id=<num>] - refresh this id
+ [--file=<file>] - refresh these ids (1 per line)
+
+ [--help|-h] - this screen
+ [--Version|-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 dependent upon their severity and my availability. 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::Testers::WWW::Reports>,
+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) 2012 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
20 bin/cpanstats-update
@@ -2,7 +2,7 @@
use strict;
$|++;
-my $VERSION = '0.09';
+my $VERSION = '0.10';
#----------------------------------------------------------------------------
@@ -19,9 +19,9 @@ cpanstats-update - script to update entries in the cpanstats database.
=head1 DESCRIPTION
-Using a nominated cpanstats database, this program will search for records
-matching the given id on the command line, or the list provided in a named file.
-If the named file is correctly formatted, the nominated columns will also be
+Using a nominated cpanstats database, this program will search for records
+matching the given id on the command line, or the list provided in a named file.
+If the named file is correctly formatted, the nominated columns will also be
updated.
=head1 OPTIONS
@@ -125,7 +125,7 @@ sub get_list {
next if(/^\s*$/); # ignore empty lines
chomp;
my ($id,$str) = (m/^(\d+)(?:,(.*))?/);
- $str =~ s/fulldate/date/ if($options{driver} =~ /sqlite/i);
+ $str =~ s/fulldate/date/ if($options{driver} =~ /sqlite/i);
push @list, {id=>$id,set=>$str} if($id);
}
$fh->close;
@@ -152,7 +152,7 @@ sub init_options {
help(1) if($options{help});
help(0) if($options{version});
- help(1,"Must specify the configuration file") unless($options{config});
+ help(1,"Must specify the configuration file") unless( $options{config});
help(1,"Configuration file [$options{config}] not found") unless(-f $options{config});
help(1,"Must specify the database code (CPANSTATS or LITESTATS)")
@@ -207,15 +207,15 @@ 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
+Fixes are dependent upon their severity and my availability. 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::Reports>,
L<CPAN::Testers::WWW::Statistics>
F<http://www.cpantesters.org/>,
@@ -229,10 +229,10 @@ F<http://wiki.cpantesters.org/>
=head1 COPYRIGHT AND LICENSE
- Copyright (C) 2005-2010 Barbie for Miss Barbell Productions.
+ Copyright (C) 2005-2012 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.
+ modify it under the Artistic License 2.0.
=cut
View
2 examples/cpanstats-createdb
@@ -130,7 +130,7 @@ sub process {
pass int(10) default 0,
fail int(10) default 0,
na int(10) default 0,
- unknown int(10) default 0
+ unknown int(10) default 0,
PRIMARY KEY (id,guid),
INDEX (dist,version)
)',
View
63 lib/CPAN/Testers/Data/Generator.pm
@@ -4,7 +4,7 @@ use warnings;
use strict;
use vars qw($VERSION);
-$VERSION = '1.04';
+$VERSION = '1.05';
#----------------------------------------------------------------------------
# Library Modules
@@ -32,6 +32,8 @@ use CPAN::Testers::Report;
#----------------------------------------------------------------------------
# Variables
+my $DIFF = 60; # difference check in seconds
+
my %testers;
my $FROM = 'CPAN Tester Report Server <do_not_reply@cpantesters.org>';
@@ -77,7 +79,7 @@ sub new {
my $cfg = Config::IniFiles->new( -file => $hash{config} );
# configure databases
- for my $db (qw(CPANSTATS LITESTATS METABASE)) {
+ for my $db (qw(CPANSTATS METABASE)) { # LITESTATS
die "No configuration for $db database\n" unless($cfg->SectionExists($db));
my %opts = map {$_ => ($cfg->val($db,$_)||undef);} qw(driver database dbfile dbhost dbport dbuser dbpass);
$opts{AutoCommit} = 0;
@@ -245,18 +247,20 @@ $self->_log("start=$start, end=$end\n");
# sync, we have to look at previous entries to ensure we are starting
# from the right point
my ($update,$prev,$last) = ($start,$start,$start);
+ my @times = ($start);
while($update le $end && $prev le $end) {
# get list of guids from given start date
my $guids = $self->get_next_guids($start);
if($guids) {
- for my $guid (@$guids) {
+ @guids = grep { !$guids{$_} } @$guids;
+ for my $guid (@guids) {
$self->_log("GUID [$guid]");
$self->{processed}++;
- if($guids{$guid}) {
+ if($self->already_saved($guid)) {
$self->_log(".. already saved\n");
next;
}
@@ -274,9 +278,20 @@ $self->_log("start=$start, end=$end\n");
$self->_log(".. FAIL\n");
}
- last if($update gt $end && $last gt $end);
- $prev = $last;
- $last = $update;
+ shift @times if(@times > 4); # one off
+ push @times, $update; # one on ... max 5
+
+ my $times = 0;
+ for my $time (@times) {
+ next if(_date_diff($end,$time) <= 0);
+ $times++;
+ }
+
+ last if($times == @times); # stop if all past endh
+
+# last if($update gt $end && $last gt $end);
+# $prev = $last;
+# $last = $update;
}
}
@@ -381,7 +396,7 @@ $self->_log("START PARSE\n");
my ($report,$stored);
unless($hash->{force}) {
- $report = $self->load_fact($guid);
+ $report = $self->load_fact($guid,1);
$stored = $self->retrieve_report($guid);
}
@@ -498,7 +513,7 @@ $self->_log("STOP TAIL\n");
sub commit {
my $self = shift;
- for(qw(CPANSTATS LITESTATS)) {
+ for(qw(CPANSTATS)) { # LITESTATS
next unless($self->{$_});
$self->{$_}->do_commit;
}
@@ -527,6 +542,8 @@ sub get_next_guids {
my ($self,$start) = @_;
my ($guids,$time);
+ $self->_log("PRE time=[$self->{time}], last=[$self->{last}]\n");
+
if($start) {
$self->{time} = $start;
} else {
@@ -536,12 +553,8 @@ sub get_next_guids {
my @rows = $self->{METABASE}->get_query('array','SELECT updated FROM metabase ORDER BY updated DESC LIMIT 5');
for my $row (@rows) {
if($self->{time}) {
- my (@dt1) = $self->{time} =~ /(\d+)-(\d+)-(\d+)T(\d+):(\d+):(\d+)Z/;
- my (@dt2) = $row->[0] =~ /(\d+)-(\d+)-(\d+)T(\d+):(\d+):(\d+)Z/;
- my $dt1 = timelocal(reverse @dt1);
- my $dt2 = timelocal(reverse @dt2);
-
- next if($dt1-$dt2 < 60);
+ my $diff = _date_diff($self->{time},$row->[0]);
+ next if($diff < $DIFF);
}
$self->{time} = $row->[0];
@@ -642,11 +655,11 @@ sub already_saved {
}
sub load_fact {
- my ($self,$guid) = @_;
+ my ($self,$guid,$check) = @_;
my @rows = $self->{METABASE}->get_query('array','SELECT report FROM metabase WHERE guid=?',$guid);
return $rows[0]->[0] if(@rows);
- $self->_log(" ... no report [guid=$guid]\n");
+ $self->_log(" ... no report [guid=$guid]\n") unless($check);
return;
}
@@ -867,7 +880,7 @@ sub store_report {
return 1 if($self->{check});
# update the sqlite database
- $self->{LITESTATS}->do_query($SQL{REPLACE}{LITESTATS},$self->{report}{id},@values);
+# $self->{LITESTATS}->do_query($SQL{REPLACE}{LITESTATS},$self->{report}{id},@values);
# @rows = $self->{LITESTATS}->get_query('array',$SQL{SELECT}{LITESTATS},$values[0]);
# if(@rows) {
@@ -1277,6 +1290,20 @@ sub _make_rss {
return $rss->as_string;
}
+sub _date_diff {
+ my ($date1,$date2) = @_;
+
+ my (@dt1) = $date1 =~ /(\d+)-(\d+)-(\d+)T(\d+):(\d+):(\d+)Z/;
+ my (@dt2) = $date2 =~ /(\d+)-(\d+)-(\d+)T(\d+):(\d+):(\d+)Z/;
+
+ return -1 unless(@dt1 && @dt2);
+
+ my $dt1 = timelocal(reverse @dt1);
+ my $dt2 = timelocal(reverse @dt2);
+
+ return $dt2 - $dt1;
+}
+
sub _log {
my $self = shift;
my $log = $self->{logfile} or return;

0 comments on commit d9cc15d

Please sign in to comment.