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

my $VERSION = '0.05';

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

=head1 NAME

selectstats.pl - script to select stats from the CPAN Testers Statistics database.

=head1 SYNOPSIS

  perl selectstats.pl               \
    [--database=<db>]               \
    [--nntp|-n=<nntpid>]            \
    [--disto|-m=<distname>]         \
    [--dist|-d=<distname>]          \
    [--version|-v=<distversion>]    \
    [--date|-y=<YYYYMM>]            \
    [--tester|-t=<email>]           \
    [--platform|-o=<platform>]      \
    [--perl|-p=<perlversion>]       \
    [--help|-h]

=head1 DESCRIPTION

Using the cpanstats database, which should be in the local directory, extracts
all the required data.

=head1 OPTIONS

=over 4

=item --database

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

=back

=cut

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

use DBI;
use Getopt::Long;

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

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

use constant    DATABASE    => 'cpanstats.db';

my (%options);

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

##### INITIALISE #####

GetOptions(
	"database=s",
	"nntp|n=s",
	"distro|m=s",
	"dist|d=s",
	"help|h",
	"platform|o=s",
	"perl|p=s",
	"tester|t=s",
	"version|v=s",
	"date|y=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 #####

#		'(id,state,postdate,tester,dist,version,platform,perl) '.

my $sql = "SELECT * FROM cpanstats WHERE ";
my @where;

# only one of the following at a time
@where = ("dist like '%$options{distro}%'")         if(defined $options{distro});
@where = ("dist='$options{dist}'")                  if(defined $options{dist});
@where = ("id=$options{nntp}")                      if(defined $options{nntp});

push @where, "version='$options{version}'"          if(defined $options{version});
push @where, "postdate='$options{date}'"            if(defined $options{date});
push @where, "tester='$options{tester}'"            if(defined $options{tester});
push @where, "platform like '$options{platform}%'"  if(defined $options{platform} && $options{platform} ne '-');
push @where, "platform=''"                          if(defined $options{platform} && $options{platform} eq '-');
push @where, "perl='$options{perl}'"                if(defined $options{perl} && $options{perl} ne '-');
push @where, "perl=''"                              if(defined $options{perl} && $options{perl} eq '-');

usage()                                             if($options{help});

if(@where) {
    my @rows = $dbi->get_query($sql . join(' AND ',@where));
    for my $row (@rows) {
        print join(",",@$row) . "\n";
    }
}

=item usage

How to use this script.

=cut

sub usage {
    print <<HERE;
Usage: $0
    [--database=<db>]               - path to cpanstats database
    [--nntp|-n=<nntpid>]            - NNTP article id
    [--dist|-d=<distname>]          - distribution name
    [--disto|-m=<distname>]         - distribution name (partial match)
    [--version|-v=<distversion>]    - distribution version
    [--date|-y=<YYYYMM>]            - year/month
    [--tester|-t=<email>]           - tester email
    [--platform|-o=<platform>]      - platform (partial match)
    [--perl|-p=<perlversion>]       - perl version
    [--help|-h]                     - this screen

Notes:
    - combine options (except help) to refine your search
    - all entries (except distro and paltform) require an exact match
    - only one of nntp, dist or distro (in order of preference) is accepted
HERE

    exit;
}


__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, E<lt>barbie@cpan.orgE<gt>
for Miss Barbell Productions L<http://www.missbarbell.co.uk>.

=head1 COPYRIGHT AND LICENSE

  Copyright (C) 2005-2008 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.

=cut
