#!/usr/bin/perl
use strict;
$|++;

my $VERSION = '0.03';

#----------------------------------------------------------------------------

=head1 NAME

upstats.pl - script to update entries in the cpanstats database.

=head1 SYNOPSIS

  perl upstats.pl [-i=0] [--database=$db] [--file=$file]

=head1 DESCRIPTION

Using the cpanstats database, which should in the local directory, 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

=over 4

=item -i | --id

Display the record matching the given NNTP id.

=item --database

Specify the exact path to the cpanstats database if not ./cpanstats.db.

=item --file

The named file will be used to retrieve a list of NNTP ids, and if correctly
formatted will update columns for the nominated id.

To display records for a list of ids, the file should look like:

  1
  2
  3
  4

To update columns for given ids, the file should look like:

  1,state='pass'
  2,state='pass',dist='MyDist'

Note that the second entry will update multiple columns

=back

=cut

# -------------------------------------
# Library Modules

use DBI;
use Getopt::Long;
use IO::File;

Use CPAN::WWW::Testers::Generator::Database;

# -------------------------------------
# Variables

use constant    DATABASE    => 'cpanstats.db';

my (%options,@rows);

# -------------------------------------
# Program

##### INITIALISE #####

GetOptions( \%options,
            "id|i=i",
            "database=s",
            "file=s"
);

$options{database} ||= DATABASE;

my $dbi = CPAN::WWW::Testers::Generator::Database->new(database => $options{database});
print STDERR "Cannot connect to database [$options{database}]\n"	unless($dbi);


##### MAIN #####

print "#id,state,postdate,tester,dist,version,platform,perl\n";
my @list = get_list();
push @list, {id=>$options{id}}    if($options{id});

for my $item (@list) {
    if($item->{set}) {
        $dbi->do_query("UPDATE cpanstats SET $item->{set} WHERE id=$item->{id}");
    }

    @rows = $dbi->get_query("SELECT * FROM cpanstats WHERE id=$item->{id}");
    print join(",",@$_)."\n"   for(@rows);
}

@rows = $dbi->get_query("SELECT max(id) FROM cpanstats");
print "\n#MAX ID=$rows[0][0]\n" if(@rows);

# -------------------------------------
# Subroutines

=item get_list

Returns the list of NNTP 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
		chomp;
		my ($id,$str) = (m/^(\d+)(?:,(.*))?/);
		push @list, {id=>$id,set=>$str} if($id);
	}
	$fh->close;
	return @list;
}

__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 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

F<http://www.cpantesters.org/>,
F<http://stats.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

