package CPAN::Testers::Data::Generator;

use warnings;
use strict;

use vars qw($VERSION);
$VERSION = '1.01';

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

use Config::IniFiles;
use CPAN::Testers::Common::Article;
use CPAN::Testers::Common::DBUtils;
use File::Basename;
use File::Path;
use File::Slurp;
use HTML::Entities;
use IO::File;
use JSON;
use Time::Local;
use XML::RSS;

use Metabase    0.004;
use Metabase::Fact;
use CPAN::Testers::Fact::LegacyReport;
use CPAN::Testers::Fact::TestSummary;
use CPAN::Testers::Metabase::AWS;
use CPAN::Testers::Report;

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

my %testers;

my $FROM    = 'CPAN Tester Report Server <do_not_reply@cpantesters.org>';
my $HOW     = '/usr/sbin/sendmail -bm';
my $HEAD    = 'To: EMAIL
From: FROM
Date: DATE
Subject: CPAN Testers Generator Error Report

';

my $BODY    = '
The following reports failed to parse into the cpanstats database:

INVALID

Thanks,
CPAN Testers Server.
';

my @admins = (
    'barbie@missbarbell.co.uk',
    #'david@dagolden.com'
);

my $OSNAMES;
my %OSNAMES = (
    'MacPPC'    => 'macos',
    'osf'       => 'dec_osf',
    'pa-risc'   => 'hpux',
    's390'      => 'os390',
    'VMS_'      => 'vms',
    'ARCHREV_0' => 'hpux',
    'linuxThis' => 'linux',
    'linThis'   => 'linux',
    'linuThis'  => 'linux',
    'lThis'     => 'linux',
    'xen-amd64' => 'linux',
    'openThis'  => 'openbsd',
);

my %mappings = (
    'WWW-Tumblr'                        => ['WWW-Tumblr','0'],
    'Text-Phonetic-MatchRatingCodex-1'  => ['Text-Phonetic-MatchRatingCodex','1-0'],
    'BitArray1'                         => ['BitArray','1-0'],
);

#----------------------------------------------------------------------------
# The Application Programming Interface

sub new {
    my $class = shift;
    my %hash  = @_;

    my $self = {
        meta_count  => 0,
        stat_count  => 0,
        last        => '',
    };
    bless $self, $class;

    # load configuration
    my $cfg = Config::IniFiles->new( -file => $hash{config} );

    # configure databases
    for my $db (qw(CPANSTATS LITESTATS METABASE)) {
        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;
        $self->{$db} = CPAN::Testers::Common::DBUtils->new(%opts);
        die "Cannot configure $db database\n" unless($self->{$db});
        $self->{$db}->{'mysql_enable_utf8'} = 1 if($opts{driver} =~ /mysql/i);
    }

    if($cfg->SectionExists('ADMINISTRATION')) {
        my @admins = $cfg->val('ADMINISTRATION','admins');
        $self->{admins} = \@admins;
    }

    # command line swtiches override configuration settings
    for my $key (qw(logfile poll_limit stopfile offset json_file rss_file rss_limit reportlink)) {
        $self->{$key} = $hash{$key} || $cfg->val('MAIN',$key);
    }

    $self->{offset}     ||= 1;
    $self->{poll_limit} ||= 1000;
    $self->{rss_limit}  ||= 1000;
    $self->{reportlink} ||= '';

    my @rows = $self->{METABASE}->get_query('hash','SELECT * FROM testers_email');
    for my $row (@rows) {
        $testers{$row->{resource}} = $row->{email};
    }

    # build OS names map
    @rows = $self->{CPANSTATS}->get_query('array','SELECT osname,ostitle FROM osname');
    for my $row (@rows) {
        $self->{OSNAMES}{lc $row->[0]} ||= $row->[1];
    }
    $OSNAMES = join('|',keys %{$self->{OSNAMES}})   if(keys %{$self->{OSNAMES}});

    if($cfg->SectionExists('DISABLE')) {
        my @values = $cfg->val('DISABLE','LIST');
        $self->{DISABLE}{$_} = 1    for(@values);
    }

    $self->{metabase} = CPAN::Testers::Metabase::AWS->new(
        bucket      => 'cpantesters',
        namespace   => 'beta2',
    );
    $self->{librarian} = $self->{metabase}->public_librarian;

    return $self;
}

sub DESTROY {
    my $self = shift;
}

#----------------------------------------------------------------------------
# Public Methods

sub generate {
    my $self    = shift;
    my $nonstop = shift || 0;
    my @reports;

    $self->{reparse} = 0;

    if($self->{json_file}) {
        my $json = read_file($self->{json_file});
        $self->{reports} = decode_json($json);
    }

$self->_log("START GENERATE nonstop=$nonstop\n");

    do {
        my $start = localtime(time);
        ($self->{processed},$self->{stored},$self->{cached}) = (0,0,0);
        my $limit = int($self->{rss_limit} / 5);
        $limit = 500;

        my $guids = $self->get_next_guids();
        $self->retrieve_reports($guids,$start,$limit);

        $nonstop = 0	if($self->{processed} == 0);
        $nonstop = 0	if($self->{stopfile} && -f $self->{stopfile});

$self->_log("CHECK nonstop=$nonstop\n");
    } while($nonstop);
$self->_log("STOP GENERATE nonstop=$nonstop\n");
}

sub regenerate {
    my ($self,$hash) = @_;

    $self->{reparse} = 0;

    my @date = localtime(time);
    my $maxdate = sprintf '%04d-%02d-%02dT00:00:00Z', $date[5]+1900, $date[4]+1,$date[3];

$self->_log("START REGENERATE\n");

    my @data;
    if($hash->{file}) {
        my $fh = IO::File->new($hash->{file},'r') or die "Cannot open file [$hash->{file}]: $!\n";
        while(<$fh>) {
            s/\s+$//;
            my ($fval,$tval) = split(/,/,$_,2);
            my %data;
            $data{gstart} = $fval   if($fval =~ /^\w+-\w+-\w+-\w+$/);
            $data{dstart} = $fval   if($fval =~ /^\d+-\d+-\d+T\d+:\d+:\d+Z$/);
            $data{gend}   = $tval   if($tval =~ /^\w+-\w+-\w+-\w+$/);
            $data{dend}   = $tval   if($tval =~ /^\d+-\d+-\d+T\d+:\d+:\d+Z$/);
            push @data, \%data;
        }
        $fh->close;
    } else {
        push @data, {   gstart => $hash->{gstart}, gend => $hash->{gend},
                        dstart => $hash->{dstart}, dend => $hash->{dend} };
    }

    for my $data (@data) {
        my $start = $self->_get_createdate( $data->{gstart}, $data->{dstart} );
        my $end   = $self->_get_createdate( $data->{gend},   $data->{dend} );

        unless($start && $end) {
$self->_log("BAD DATES: start=$start, end=$end [missing dates]\n");
            next;
        }
        if($start ge $end) {
$self->_log("BAD DATES: start=$start, end=$end [end before start]\n");
            next;
        }
        if($end gt $maxdate) {
$self->_log("BAD DATES: start=$start, end=$end [exceeds $maxdate]\n");
            next;
        }

$self->_log("start=$start, end=$end\n");

        ($self->{processed},$self->{stored},$self->{cached}) = (0,0,0);

        # what guids do we already have?
        my @where;
        push @where, "updated >= '$data->{dstart}'";
        push @where, "updated <= '$data->{dend}'";
        
        my $sql =   'SELECT guid FROM metabase' . 
                    (@where ? ' WHERE ' . join(' AND ',@where) : '') .
                    ' ORDER BY updated asc';

        my @guids = $self->{METABASE}->get_query('hash',$sql);
        my %guids = map {$_->{guid} => 1} @guids;

        while($start le $end) {
            # get list of guids from given start date
            my $guids = $self->get_next_guids($start);

            if($guids) {
                for my $guid (@$guids) {
                    $self->_log("GUID [$guid]");

                    $self->{processed}++;

                    if($guids{$guid}) {
                        $self->_log(".. already saved\n");
                        next;
                    }

                    if(my $report = $self->get_fact($guid)) {
                        $start = $report->{metadata}{core}{update_time};
                        $self->{report}{guid}   = $guid;
                        next    if($self->parse_report(report => $report)); # true if invalid report

                        if($self->store_report()) { $self->_log(".. stored"); $self->{stored}++;    }
                        else                      { $self->_log(".. already stored");       }
                        if($self->cache_report()) { $self->_log(".. cached\n"); $self->{cached}++;  }
                        else                      { $self->_log(".. bad cache data\n");     }
                    } else {
                        $self->_log(".. FAIL\n");
                    }

                    last    if($start gt $end);
                }
            }

            $self->commit();
        }

        $self->commit();
        my $invalid = $self->{invalid} ? scalar(@{$self->{invalid}}) : 0;
        my $stop = localtime(time);
        $self->_log("MARKER: processed=$self->{processed}, stored=$self->{stored}, cached=$self->{cached}, invalid=$invalid, start=$start, stop=$stop\n");
    }

    # only email invalid reports during the generate process
    $self->_send_email()    if($self->{invalid});

$self->_log("STOP REGENERATE\n");
}

sub rebuild {
    my ($self,$hash) = @_;

    my $start = localtime(time);
    ($self->{processed},$self->{stored},$self->{cached}) = (0,0,0);
    $self->{reparse} = 1;

$self->_log("START REBUILD\n");

    # selection choices:
    # 1) from guid [to guid]
    # 2) from date [to date]

    $hash->{dstart} = $self->_get_createdate( $hash->{gstart}, $hash->{dstart} );
    $hash->{dend}   = $self->_get_createdate( $hash->{gend},   $hash->{dend} );

    my @where;
    push @where, "updated >= '$hash->{dstart}'"  if($hash->{dstart});
    push @where, "updated <= '$hash->{dend}'"    if($hash->{dend});
    
    my $sql =   'SELECT * FROM metabase' . 
                (@where ? ' WHERE ' . join(' AND ',@where) : '') .
                ' ORDER BY updated ASC';

$self->_log("START sql=[$sql]\n");

#    $self->{CPANSTATS}->do_query("DELETE FROM cpanstats WHERE id >= $start AND id <= $end");
#    $self->{LITESTATS}->do_query("DELETE FROM cpanstats WHERE id >= $start AND id <= $end");

    my $iterator = $self->{METABASE}->iterator('hash',$sql);
    while(my $row = $iterator->()) {
        $self->_log("GUID [$row->{guid}]");
        $self->{processed}++;

        # no article for that id!
        unless($row->{report}) {
            $self->_log(" ... no report\n");
            warn "No report returned [$row->{id},$row->{guid}]\n";
            next;
        }

        $self->{report}{id}       = $row->{id};
        $self->{report}{guid}     = $row->{guid};
        $self->{report}{metabase} = decode_json($row->{report});

        # corrupt cached report?
        if($self->reparse_report()) { # true if invalid report
            $self->_log(".. cannot parse metabase cache report\n");
            warn "Cannot parse cached report [$row->{id},$row->{guid}]\n";
            next;
        }

        if($self->store_report())   { $self->_log(".. cpanstats stored\n") }
        else                        { $self->_log(".. cpanstats not stored\n") }
        if($self->cache_update())   { $self->_log(".. metabase stored\n") }
        else                        { $self->_log(".. bad metabase cache data\n") }

        $self->{stored}++;
        $self->{cached}++;
    }

    my $invalid = $self->{invalid} ? scalar(@{$self->{invalid}}) : 0;
    my $stop = localtime(time);
    $self->_log("MARKER: processed=$self->{processed}, stored=$self->{stored}, cached=$self->{cached}, invalid=$invalid, start=$start, stop=$stop\n");

    $self->commit();
$self->_log("STOP REBUILD\n");
}

sub reparse {
    my ($self,$hash,@guids) = @_;
$self->_log("START REPARSE\n");
    return  unless(@guids);

    $self->{reparse} = 1;

    for my $guid (@guids) {
        if(my $report = $self->get_fact($guid)) {
            $self->{report}{guid} = $guid;
            $hash->{report} = $report;
            if($self->parse_report(%$hash)) {	# true if invalid report
		        $self->_log(".. cannot parse report [$guid]\n");
		        return 0;
		    }

		    if($self->store_report()) { $self->_log(".. stored"); }
		    else                      {
		        if($self->{time} gt $self->{report}{updated}) {
		            $self->_log(".. FAIL: older than requested [$self->{time}]\n");
		            return 0;
                }
            
            	$self->_log(".. already stored");
        	}
        	if($self->cache_report()) { $self->_log(".. cached\n"); }
        	else                      { $self->_log(".. FAIL: bad cache data\n"); }
    	} else {
        	$self->_log(".. FAIL\n");
        	return 0;
    	}
	}

    $self->commit();
$self->_log("STOP REPARSE\n");
    return 1;
}

#----------------------------------------------------------------------------
# Private Methods

sub commit {
    my $self = shift;
    for(qw(CPANSTATS LITESTATS)) {
        next    unless($self->{$_});
        $self->{$_}->do_commit;
    }
}

sub get_next_guids {
    my ($self,$start) = @_;
    my ($guids,$time);

    if($start) {
        $self->{time} = $start;
    } else {
        my @rows = $self->{METABASE}->get_query('array','SELECT MAX(updated) FROM metabase');
        $self->{time} = $rows[0]->[0]	if(@rows);

        $self->{time} ||= '1999-01-01T00:00:00Z';
        if($self->{last} ge $self->{time}) {
            my @ts = $self->{last} =~ /(\d+)-(\d+)-(\d+)T(\d+):(\d+):(\d+)Z/;
            $ts[1]--;
            my $ts = timelocal(reverse @ts);
            @ts = localtime($ts + $self->{offset}); # increment the offset for next time
            $self->{time} = sprintf "%04d-%02d-%02dT%02d:%02d:%02dZ", $ts[5]+1900,$ts[4]+1,$ts[3], $ts[2],$ts[1],$ts[0];
        }
    }

    $self->_log("START time=[$self->{time}], last=[$self->{last}]\n");
    $self->{last} = $self->{time};

    eval {
    	$guids = $self->{librarian}->search(
        	'core.type'         => 'CPAN-Testers-Report',
        	'core.update_time'  => { ">=", $self->{time} },
        	'-asc'              => 'core.update_time',
        	'-limit'            => $self->{poll_limit},
    	);
    };

    $self->_log(" ... Metabase Search Failed [$@]\n") if($@);
    $self->_log("Retrieved ".($guids ? scalar(@$guids) : 0)." guids\n");

    return $guids;
}

sub retrieve_reports {
    my ($self,$guids,$start,$limit) = @_;
    $limit ||= 0;
    my $count = 0;

    my @reports = $self->{reports} ? @{ $self->{reports} } : ();

    if($guids) {
        for my $guid (@$guids) {
            $self->_log("GUID [$guid]");
            $self->{processed}++;

            if(my $report = $self->get_fact($guid)) {
                $self->{report}{guid}   = $guid;
                next    if($self->parse_report(report => $report)); # true if invalid report

                if($self->store_report()) { 
                    $self->_log(".. stored"); $self->{stored}++; 
                    unshift @reports, $report;
                    $count++;

                } else {
                    if($self->{time} gt $self->{report}{updated}) {
                        $self->_log(".. FAIL: older than requested [$self->{time}]\n");
                        next;
                    }
                    $self->_log(".. already stored");
                }
                if($self->cache_report()) { $self->_log(".. cached\n"); $self->{cached}++; }
                else                      { $self->_log(".. bad cache data\n"); }
            } else {
                $self->_log(".. FAIL\n");
            }

            if($limit && $count % $limit == 0) {
                splice(@reports,0,$self->{rss_limit})   if(scalar(@reports) > $self->{rss_limit});
                overwrite_file( $self->{rss_file}, $self->make_rss( \@reports ) )      if($self->{rss_file});
            }
        }
    }

    # store recent files
    if($limit){
        splice(@reports,0,$self->{rss_limit})   if(scalar(@reports) > $self->{rss_limit});
        overwrite_file( $self->{json_file}, $self->make_json( \@reports ) )    if($self->{json_file});
        overwrite_file( $self->{rss_file}, $self->make_rss( \@reports ) )      if($self->{rss_file});
    }

    $self->commit();
    my $invalid = $self->{invalid} ? scalar(@{$self->{invalid}}) : 0;
    my $stop = localtime(time);
    $self->_log("MARKER: processed=$self->{processed}, stored=$self->{stored}, cached=$self->{cached}, invalid=$invalid, start=$start, stop=$stop\n");

    # only email invalid reports during the generate process
    $self->_send_email()    if($self->{invalid});
}

sub already_saved {
    my ($self,$guid) = @_;
    my @rows = $self->{METABASE}->get_query('array','SELECT id FROM metabase WHERE guid=?',$guid);
    return 1	if(@rows);
    return 0;
}

sub get_fact {
    my ($self,$guid) = @_;
    my $fact;
    #print STDERR "guid=$guid\n";
    eval { $fact = $self->{librarian}->extract( $guid ) };
    return $fact    if($fact);

    $self->_log(" ... no report [guid=$guid] [$@]\n");
    return;
}

sub parse_report {
    my ($self,%hash) = @_;
    my $options = $hash{options};
    my $report  = $hash{report};
    my $guid    = $self->{report}{guid};
    my $invalid;

    $self->{report}{created} = $report->{metadata}{core}{creation_time};
    $self->{report}{updated} = $report->{metadata}{core}{update_time};

    my @facts = $report->facts();
    for my $fact (@facts) {
        if(ref $fact eq 'CPAN::Testers::Fact::TestSummary') {
            $self->{report}{metabase}{'CPAN::Testers::Fact::TestSummary'} = $fact->as_struct ;

            $self->{report}{state}      = lc $fact->{content}{grade};
            $self->{report}{platform}   = $fact->{content}{archname};
            $self->{report}{osname}     = $self->_osname($fact->{content}{osname});
            $self->{report}{osvers}     = $fact->{content}{osversion};
            $self->{report}{perl}       = $fact->{content}{perl_version};
            #$self->{report}{created}    = $fact->{metadata}{core}{creation_time};
            #$self->{report}{updated}    = $fact->{metadata}{core}{update_time};

            my $dist                    = Metabase::Resource->new( $fact->resource );
            $self->{report}{dist}       = $dist->metadata->{dist_name};
            $self->{report}{version}    = $dist->metadata->{dist_version};

            # some distros are a pain!
	    	if($self->{report}{version} eq '' && $mappings{$self->{report}{dist}}) {
                $self->{report}{version}    = $mappings{$self->{report}{dist}}->[1];
                $self->{report}{dist}       = $mappings{$self->{report}{dist}}->[0];
            } elsif($self->{report}{version} eq '') {
                $self->{report}{version}    = 0;
            }

            $self->{report}{from}       = $self->_get_tester( $fact->creator->resource );

            # alternative API
            #my $profile                 = $fact->creator->user;                                                                                                                                                                          
            #$self->{report}{from}       = $profile->{email};
            #$self->{report}{from}       =~ s/'/''/g; #'
            #$self->{report}{dist}       = $fact->resource->dist_name;                                                                                                                                                                 
            #$self->{report}{version}    = $fact->resource->dist_version;          

        } elsif(ref $fact eq 'CPAN::Testers::Fact::LegacyReport') {
            $self->{report}{metabase}{'CPAN::Testers::Fact::LegacyReport'} = $fact->as_struct;
            $invalid = 'missing textreport' if(length $fact->{content}{textreport} < 10);   # what is the smallest report?

            $self->{report}{perl}       = $fact->{content}{perl_version};
        }
    }

    if($invalid) {
        push @{$self->{invalid}}, {msg => $invalid, guid => $guid};
        return 1;
    }

    # fixes from metabase formatting
    $self->{report}{perl} =~ s/^v//;    # no leading 'v'
    $self->_check_arch_os();

    if($self->{report}{created}) {
        my @created = $self->{report}{created} =~ /(\d+)-(\d+)-(\d+)T(\d+):(\d+):(\d+)Z/; # 2010-02-23T20:33:52Z
        $self->{report}{postdate}   = sprintf "%04d%02d", $created[0], $created[1];
        $self->{report}{fulldate}   = sprintf "%04d%02d%02d%02d%02d", $created[0], $created[1], $created[2], $created[3], $created[4];
    } else {
        my @created = localtime(time);
        $self->{report}{postdate}   = sprintf "%04d%02d", $created[5]+1900, $created[4]+1;
        $self->{report}{fulldate}   = sprintf "%04d%02d%02d%02d%02d", $created[5]+1900, $created[4]+1, $created[3], $created[2], $created[1];
    }

$self->_log(".. time [$self->{report}{created}][$self->{report}{updated}]");

    $self->{report}{type}       = 2;
    if($self->{DISABLE} && $self->{DISABLE}{$self->{report}{from}}) {
        $self->{report}{state} .= ':invalid';
        $self->{report}{type}   = 3;
    }

    #use Data::Dumper;
    #print STDERR "\n====\nreport=".Dumper($self->{report});

    return 1  unless($self->_valid_field($guid, 'dist'     => $self->{report}{dist})     || ($options && $options->{exclude}{dist}));
    return 1  unless($self->_valid_field($guid, 'version'  => $self->{report}{version})  || ($options && $options->{exclude}{version}));
    return 1  unless($self->_valid_field($guid, 'from'     => $self->{report}{from})     || ($options && $options->{exclude}{from}));
    return 1  unless($self->_valid_field($guid, 'perl'     => $self->{report}{perl})     || ($options && $options->{exclude}{perl}));
    return 1  unless($self->_valid_field($guid, 'platform' => $self->{report}{platform}) || ($options && $options->{exclude}{platform}));
    return 1  unless($self->_valid_field($guid, 'osname'   => $self->{report}{osname})   || ($options && $options->{exclude}{osname}));
    return 1  unless($self->_valid_field($guid, 'osvers'   => $self->{report}{osvers})   || ($options && $options->{exclude}{osname}));

    return 0
}

sub reparse_report {
    my ($self,%hash) = @_;
    my $fact = 'CPAN::Testers::Fact::TestSummary';
    my $options = $hash{options};
    my $report  = CPAN::Testers::Fact::TestSummary->from_struct( $self->{report}{metabase}{$fact} );
    my $guid    = $self->{report}{guid};

    $self->{report}{state}      = lc $report->{content}{grade};
    $self->{report}{platform}   = $report->{content}{archname};
    $self->{report}{osname}     = $self->_osname($report->{content}{osname});
    $self->{report}{osvers}     = $report->{content}{osversion};
    $self->{report}{perl}       = $report->{content}{perl_version};
    $self->{report}{created}    = $report->{metadata}{core}{creation_time};

    my $dist                    = Metabase::Resource->new( $report->{metadata}{core}{resource} );
    $self->{report}{dist}       = $dist->metadata->{dist_name};
    $self->{report}{version}    = $dist->metadata->{dist_version};

    $self->{report}{from}       = $self->_get_tester( $report->{metadata}{core}{creator}{resource} );

    if($self->{report}{created}) {
        my @created = $self->{report}{created} =~ /(\d+)-(\d+)-(\d+)T(\d+):(\d+):(\d+)Z/; # 2010-02-23T20:33:52Z
        $self->{report}{postdate}   = sprintf "%04d%02d", $created[0], $created[1];
        $self->{report}{fulldate}   = sprintf "%04d%02d%02d%02d%02d", $created[0], $created[1], $created[2], $created[3], $created[4];
    } else {
        my @created = localtime(time);
        $self->{report}{postdate}   = sprintf "%04d%02d", $created[5]+1900, $created[4]+1;
        $self->{report}{fulldate}   = sprintf "%04d%02d%02d%02d%02d", $created[5]+1900, $created[4]+1, $created[3], $created[2], $created[1];
    }

    $self->{report}{type}       = 2;
    if($self->{DISABLE} && $self->{DISABLE}{$self->{report}{from}}) {
        $self->{report}{state} .= ':invalid';
        $self->{report}{type}   = 3;
    }

    return 1  unless($self->_valid_field($guid, 'dist'     => $self->{report}{dist})     || ($options && $options->{exclude}{dist}));
    return 1  unless($self->_valid_field($guid, 'version'  => $self->{report}{version})  || ($options && $options->{exclude}{version}));
    return 1  unless($self->_valid_field($guid, 'from'     => $self->{report}{from})     || ($options && $options->{exclude}{from}));
    return 1  unless($self->_valid_field($guid, 'perl'     => $self->{report}{perl})     || ($options && $options->{exclude}{perl}));
    return 1  unless($self->_valid_field($guid, 'platform' => $self->{report}{platform}) || ($options && $options->{exclude}{platform}));
    return 1  unless($self->_valid_field($guid, 'osname'   => $self->{report}{osname})   || ($options && $options->{exclude}{osname}));
    return 1  unless($self->_valid_field($guid, 'osvers'   => $self->{report}{osvers})   || ($options && $options->{exclude}{osname}));

    return 0;
}

sub retrieve_report {
    my $self = shift;
    my $guid = shift or return;

    my @rows = $self->{CPANSTATS}->get_query('hash','SELECT * FROM cpanstats WHERE guid=?',$guid);
    return $rows[0] if(@rows);
    return;
}

sub store_report {
    my $self    = shift;
    my @fields  = qw(guid state postdate from dist version platform perl osname osvers fulldate type);

    my %fields = map {$_ => $self->{report}{$_}} @fields;
    $fields{$_} ||= 0   for(qw(type));
    $fields{$_} ||= '0' for(qw(perl));
    $fields{$_} ||= ''  for(@fields);

    my @values = map {$fields{$_}} @fields;

    my %SQL = (
        'SELECT' => {
            CPANSTATS => 'SELECT id FROM cpanstats WHERE guid=?',
            LITESTATS => 'SELECT id FROM cpanstats WHERE guid=?',
            RELEASE   => 'SELECT id FROM release_data WHERE guid=?',
        },
        'INSERT' => {
            CPANSTATS => 'INSERT INTO cpanstats (guid,state,postdate,tester,dist,version,platform,perl,osname,osvers,fulldate,type) VALUES (?,?,?,?,?,?,?,?,?,?,?,?)',
            LITESTATS => 'INSERT INTO cpanstats (id,guid,state,postdate,tester,dist,version,platform,perl,osname,osvers,date,type) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?)',
            RELEASE   => 'INSERT INTO release_data (id,guid,dist,version,oncpan,distmat,perlmat,patched,pass,fail,na,unknown) VALUES (?,?,?,?,?,?,?,?,?,?,?,?)',
        },
        'UPDATE' => {
            CPANSTATS => 'UPDATE cpanstats SET state=?,postdate=?,tester=?,dist=?,version=?,platform=?,perl=?,osname=?,osvers=?,fulldate=?,type=? WHERE guid=?',
            LITESTATS => 'UPDATE cpanstats SET state=?,postdate=?,tester=?,dist=?,version=?,platform=?,perl=?,osname=?,osvers=?,date=?,type=? WHERE guid=?',
            RELEASE   => 'UPDATE release_data SET id=?,dist=?,version=?,oncpan=?,distmat=?,perlmat=?,patched=?,pass=?,fail=?,na=?,unknown=? WHERE guid=?',
        },
    );

    # update the mysql database
    my @rows = $self->{CPANSTATS}->get_query('array',$SQL{SELECT}{CPANSTATS},$values[0]);
    if(@rows) {
        if($self->{reparse}) {
            my ($guid,@update) = @values;
            $self->{CPANSTATS}->do_query($SQL{UPDATE}{CPANSTATS},@update,$guid);
        } else {
            $self->{report}{id} = $rows[0]->[0];
            return 0;
        }
    } else {
        $self->{report}{id} = $self->{CPANSTATS}->id_query($SQL{INSERT}{CPANSTATS},@values);
    }

    # update the sqlite database
    @rows = $self->{LITESTATS}->get_query('array',$SQL{SELECT}{LITESTATS},$values[0]);
    if(@rows) {
        if($self->{reparse}) {
            my ($guid,@update) = @values;
            $self->{LITESTATS}->do_query($SQL{UPDATE}{LITESTATS},@update,$guid);
        }
    } else {
        $self->{LITESTATS}->do_query($SQL{INSERT}{LITESTATS},$self->{report}{id},@values);
    }

    # update perl version table
    my $patch  = $fields{perl} =~ /^5.(7|9|[1-9][13579])/   ? 1 : 0,    # odd numbers now mark development releases
    my $devel  = $fields{perl} =~ /(RC\d+|patch)/           ? 1 : 0,
    my ($perl) = $fields{perl} =~ /(5\.\d+(?:\.\d+)?)/;
    unless($self->{CPANSTATS}->get_query('array',"SELECT * FROM perl_version WHERE version=?",$fields{perl})) {
        $self->{CPANSTATS}->do_query("INSERT INTO perl_version (version,perl,patch,devel) VALUES (?,?,?,?)",$fields{perl},$perl,$patch,$devel);
    }

    # only valid reports
    if($self->{report}{type} == 2) {
        $fields{id} =  $self->{report}{id};

        # push page requests
        # - note we only update the author if this is the *latest* version of the distribution
        my $author = $self->{report}{pauseid} || $self->_get_author($fields{dist},$fields{version});
        $self->{CPANSTATS}->do_query("INSERT INTO page_requests (type,name,weight,id) VALUES ('author',?,1,?)",$author,$fields[0])  if($author);
        $self->{CPANSTATS}->do_query("INSERT INTO page_requests (type,name,weight,id) VALUES ('distro',?,1,?)",$fields[5],$fields[0]);

        my @rows = $self->{CPANSTATS}->get_query('array',$SQL{SELECT}{RELEASE},$fields{guid});
        #print STDERR "# select release $SQL{SELECT}{RELEASE},$fields{guid}\n";
        if(@rows) {
            if($self->{reparse}) {
                $self->{CPANSTATS}->do_query($SQL{UPDATE}{RELEASE},
                    $fields{id},                        # id,
                    $fields{dist},$fields{version},     # dist, version

                    $self->_oncpan($fields{dist},$fields{version}) ? 1 : 2,

                    $fields{version} =~ /_/     ? 2 : 1,
                    $devel                      ? 2 : 1,
                    $patch                      ? 2 : 1,

                    $fields{state} eq 'pass'    ? 1 : 0,
                    $fields{state} eq 'fail'    ? 1 : 0,
                    $fields{state} eq 'na'      ? 1 : 0,
                    $fields{state} eq 'unknown' ? 1 : 0,

                    $fields{guid});             # guid
            }
        } else {
        #print STDERR "# insert release $SQL{INSERT}{RELEASE},$fields[0],$fields[1]\n";
            $self->{CPANSTATS}->do_query($SQL{INSERT}{RELEASE},
                $fields{id},$fields{guid},          # id, guid
                $fields{dist},$fields{version},     # dist, version

                $self->_oncpan($fields{dist},$fields{version}) ? 1 : 2,

                $fields{version} =~ /_/     ? 2 : 1,
                $devel                      ? 2 : 1,
                $patch                      ? 2 : 1,

                $fields{state} eq 'pass'    ? 1 : 0,
                $fields{state} eq 'fail'    ? 1 : 0,
                $fields{state} eq 'na'      ? 1 : 0,
                $fields{state} eq 'unknown' ? 1 : 0);
        }
    }

    if((++$self->{stat_count} % 500) == 0) {
        $self->commit;
    }

    return 1;
}

sub cache_report {
    my $self = shift;
    return  unless($self->{report}{guid} && $self->{report}{metabase});

    $self->{'METABASE'}->do_query('INSERT IGNORE INTO metabase (guid,id,updated,report) VALUES (?,?,?,?)',
        $self->{report}{guid},$self->{report}{id},$self->{report}{updated},encode_json($self->{report}{metabase}));

    if((++$self->{meta_count} % 500) == 0) {
        $self->{CPANSTATS}->do_commit;
    }

    return 1;
}

sub cache_update {
    my $self = shift;
    return  unless($self->{report}{guid} && $self->{report}{id});

    $self->{'METABASE'}->do_query('UPDATE metabase SET id=? WHERE guid=?',$self->{report}{id},$self->{report}{guid});

    if((++$self->{meta_count} % 500) == 0) {
        $self->{CPANSTATS}->do_commit;
    }

    return 1;
}

#----------------------------------------------------------------------------
# Private Functions

sub _get_createdate {
    my ($self,$guid,$date) = @_;

    return  unless($guid || $date);
    if($guid) {
        my @rows = $self->{METABASE}->get_query('hash','SELECT updated FROM metabase WHERE guid=?',$guid);
        $date = $rows[0]->{updated}  if(@rows);
    }

    return          unless($date && $date =~ /^\d{4}-\d{2}-\d{2}T\d{2}:\d{2}:\d{2}Z$/);
    return $date;        
}

sub _get_tester {
    my ($self,$creator) = @_;
    return $testers{$creator}   if($testers{$creator});

    my $profile  = Metabase::Resource->new( $creator );
    return $creator unless($profile);

    my $user;
    eval { $user = $self->{librarian}->extract( $profile->guid ) };
    return $creator unless($user);

    my ($name,@emails);
    for my $fact ($user->facts()) {
        if(ref $fact eq 'Metabase::User::EmailAddress') {
            push @emails, $fact->{content};
        } elsif(ref $fact eq 'Metabase::User::FullName') {
            $name = encode_entities($fact->{content});
        }
    }

    $name ||= 'NONAME'; # shouldn't happen, but allows for checks later

    for my $em (@emails) {
        $self->{METABASE}->do_query('INSERT INTO testers_email (resource,fullname,email) VALUES (?,?,?)',$creator,$name,$em);
    }

    $testers{$creator} = @emails ? $emails[0] : $creator;
    $testers{$creator} =~ s/\'/''/g if($testers{$creator});
    return $testers{$creator};
}

sub _get_author {
    my ($self,$dist,$version) = @_;
    my @rows = $self->{CPANSTATS}->get_query('array','SELECT author FROM ixlatest WHERE dist=? AND version=? LIMIT 1',$dist,$version);
    return @rows ? $rows[0]->[0] : '';
}

sub _valid_field {
    my ($self,$id,$name,$value) = @_;
    return 1    if(defined $value);
    $self->_log(" . [$id] ... missing field: $name\n");
    return 0;
}

sub _get_lastid {
    my $self = shift;

    my @rows = $self->{METABASE}->get_query('array',"SELECT MAX(id) FROM metabase");
    return 0    unless(@rows);
    return $rows[0]->[0] || 0;
}

sub _oncpan {
    my ($self,$dist,$vers) = @_;

    my @rows = $self->{CPANSTATS}->get_query('array','SELECT DISTINCT(type) FROM uploads WHERE dist=? AND version=?',$dist,$vers);
    my $type = @rows ? $rows[0]->[0] : undef;

    return 1    unless($type);          # assume it's a new release
    return 0    if($type eq 'backpan'); # on backpan only
    return 1;                           # on cpan or new upload
}

sub _osname {
    my $self = shift;
    my $name = shift || return '';

    my $lname = lc $name;
    my $uname = uc $name;
    $self->{OSNAMES}{$lname} ||= do {
        $self->{CPANSTATS}->do_query(qq{INSERT INTO osname (osname,ostitle) VALUES ('$name','$uname')});
        $uname;
    };

    return $self->{OSNAMES}{$lname};
}

sub _check_arch_os {
    my $self = shift;

    my $text = $self->_platform_to_osname($self->{report}{platform});
#print STDERR "_check: text=$text\n";
#print STDERR "_check: platform=$self->{report}{platform}\n";
#print STDERR "_check: osname=$self->{report}{osname}\n";
    return	if($text && $self->{report}{osname} && lc $text eq lc $self->{report}{osname});

#use Data::Dumper;
#print STDERR "_check: metabase=".Dumper($self->{report}{metabase})."\n";
    my $fact = decode_json($self->{report}{metabase}{'CPAN::Testers::Fact::LegacyReport'}{content});
    my $textreport = $fact->{textreport};

    # create a fake mail, as CTC::Article parses a mail like text block
    my $mail = <<EMAIL;
From: fake\@example.com
To: fake\@example.com
Subject: PASS Fake-0.01
Date: 01-01-2010 01:01:01 Z

$textreport
EMAIL
    my $object = CPAN::Testers::Common::Article->new( $mail ) or return;
    $object->parse_report();

    $self->{report}{osname}   = $object->osname;
    $self->{report}{platform} = $object->archname;
}

sub _platform_to_osname {
    my $self = shift;
    my $arch = shift || return '';

    $OSNAMES = join('|',keys %{$self->{OSNAMES}})   if(keys %{$self->{OSNAMES}});

    return $1	if($arch =~ /($OSNAMES)/i);

    for my $rx (keys %OSNAMES) {
        return $OSNAMES{$rx} if($arch =~ /$rx/i);
    }

    return '';
}

sub _send_email {
    my $self = shift;
    my $t = localtime;
    my $DATE = $t->strftime("%a, %d %b %Y %H:%M:%S +0000");
    $DATE =~ s/\s+$//;
    my $INVALID = join("\n",@{$self->{invalid}});
    $self->_log("INVALID:\n$INVALID\n");

    for my $admin (@{$self->{admins}}) {
        my $cmd = qq!| $HOW $admin!;

        my $body = $HEAD . $BODY;
        $body =~ s/FROM/$FROM/g;
        $body =~ s/EMAIL/$admin/g;
        $body =~ s/DATE/$DATE/g;
        $body =~ s/INVALID/$INVALID/g;

        if(my $fh = IO::File->new($cmd)) {
            print $fh $body;
            $fh->close;
            $self->_log(".. MAIL SEND - SUCCESS - $admin\n");
        } else {
            $self->_log(".. MAIL SEND - FAILED - $admin\n");
        }
    }
}

sub _make_json {
    my ( $self, $data ) = @_;
    return encode_json( $data );
}

sub _make_rss {
    my ( $self, $data ) = @_;

    my $title = "Recent CPAN Testers Reports";
    my $link  = "http://www.cpantesters.org/static/recent.html";
    my $desc  = "Recent CPAN Testers reports";

    my @date = $data->[0]->{fulldate} =~ /^(\d{4})(\d{2})(\d{2})(\d{2})(\d{2})/;
    my $date = sprintf "%04d-%02d-%02dT%02d:%02d+01:00", @date;

    my $rss = XML::RSS->new( version => '1.0' );
    $rss->channel(
        title       => $title,
        link        => $link,
        description => $desc,
        syn         => {
            updatePeriod    => "daily",
            updateFrequency => "1",
            updateBase      => "1901-01-01T00:00+00:00",
        },
        dc          => {
            date            => $date,
            subject         => $desc,
            creator         => 'barbie@cpantesters.org',
            publisher       => 'barbie@cpantesters.org',
            rights          => 'Copyright ' . $date[0] . ', CPAN Testers',
            language        => 'en-gb'
        }
    );

    for my $test (@$data) {
        $rss->add_item(
            title => sprintf(
                "%s %s-%s %s on %s %s (%s)",
                map {$_||''}
                @{$test}{
                    qw( status dist version perl osname osvers platform )
                    }
            ),
            link => "$self->{reportlink}/" . ($test->{guid} || $test->{id}),
        );
    }

    return $rss->as_string;
}

sub _log {
    my $self = shift;
    my $log = $self->{logfile} or return;
    mkpath(dirname($log))   unless(-f $log);
    my $fh = IO::File->new($log,'a+') or die "Cannot append to log file [$log]: $!\n";
    print $fh @_;
    $fh->close;
}

1;

__END__

=head1 NAME

CPAN::Testers::Data::Generator - Download and summarize CPAN Testers data

=head1 SYNOPSIS

  % cpanstats
  # ... wait patiently, very patiently
  # ... then use cpanstats.db, an SQLite database
  # ... or the MySQL database

=head1 DESCRIPTION

This distribution was originally written by Leon Brocard to download and
summarize CPAN Testers data. However, all of the original code has been
rewritten to use the CPAN Testers Statistics database generation code. This
now means that all the CPAN Testers sites including the Reports site, the
Statistics site and the CPAN Dependencies site, can use the same database.

This module downloads articles from the cpan-testers newsgroup, generating or
updating an SQLite database containing all the most important information. You
can then query this database, or use CPAN::WWW::Testers to present it over the
web.

A good example query for Acme-Colour would be:

  SELECT version, status, count(*) FROM cpanstats WHERE
  distribution = "Acme-Colour" group by version, state;

To create a database from scratch can take several days, as there are now over
2 million articles in the newgroup. As such updating from a known copy of the
database is much more advisable. If you don't want to generate the database
yourself, you can obtain the latest official copy (compressed with gzip) at
http://devel.cpantesters.org/cpanstats.db.gz

With over 6 million articles in the archive, if you do plan to run this
software to generate the databases it is recommended you utilise a high-end
processor machine. Even with a reasonable processor it can take a week!

=head1 SQLite DATABASE SCHEMA

The cpanstats database schema is very straightforward, one main table with
several index tables to speed up searches. The main table is as below:

  +--------------------------------+
  | cpanstats                      |
  +----------+---------------------+
  | id       | INTEGER PRIMARY KEY |
  | state    | TEXT                |
  | postdate | TEXT                |
  | tester   | TEXT                |
  | dist     | TEXT                |
  | version  | TEXT                |
  | platform | TEXT                |
  | perl     | TEXT                |
  | osname   | TEXT                |
  | osvers   | TEXT                |
  | date     | TEXT                |
  | guid     | TEXT                |
  | type     | INTEGER             |
  +----------+---------------------+

It should be noted that 'postdate' refers to the YYYYMM formatted date, whereas
the 'date' field refers to the YYYYMMDDhhmm formatted date and time.

The metabase database schema is again very straightforward, and consists of one
table, as below:

  +--------------------------------+
  | metabase                       |
  +----------+---------------------+
  | guid     | TEXT PRIMARY KEY    |
  | report   | TEXT                |
  +----------+---------------------+

The report field is JSON encoded, and is a cached version of the one extracted
from Metabase::Librarian.

=head1 SIGNIFICANT CHANGES

=head2 v0.31 CHANGES

With the release of v0.31, a number of changes to the codebase were made as
a further move towards CPAN Testers 2.0. The first change is the name for this
distribution. Now titled 'CPAN-Testers-Data-Generator', this now fits more
appropriately within the CPAN-Testers namespace on CPAN.

The second significant change is to now reference a MySQL cpanstats database.
The SQLite version is still updated as before, as a number of other websites
and toolsets still rely on that database file format. However, in order to make
the CPAN Testers Reports website more dynamic, an SQLite database is not really
appropriate for a high demand website.

The database creation code is now available as a standalone program, in the
examples directory, and all the database communication is now handled by the
new distribution CPAN-Testers-Common-DBUtils.

=head2 v0.41 CHANGES

In the next stage of development of CPAN Testers 2.0, the id field used within
the database schema above for the cpanstats table no longer matches the NNTP
ID value, although the id in the articles does still reference the NNTP ID.

In order to correctly reference the id in the articles table, you will need to
use the function guid_to_nntp() with CPAN::Testers::Common::Utils, using the
new guid field in the cpanstats table.

As of this release the cpanstats id field is a unique auto incrementing field.

The next release of this distribution will be focused on generation of stats
using the Metabase storage API.

=head2 v1.00 CHANGES

Moved to Metabase API. The change to a definite major version number hopefully
indicates that this is a major interface change. All previous NNTP access has
been dropped and is no longer relavent. All report updates are now fed from
the Metabase API.

=head1 INTERFACE

=head2 The Constructor

=over

=item * new

Instatiates the object CPAN::Testers::Data::Generator. Accepts a hash containing
values to prepare the object. These are described as:

  my $obj = CPAN::Testers::Data::Generator->new(
                logfile => './here/logfile',
                config  => './here/config.ini'
  );

Where 'logfile' is the location to write log messages. Log messages are only
written if a logfile entry is specified, and will always append to any existing
file. The 'config' should contain the path to the configuration file, used
to define the database access and general operation settings.

=back

=head2 Public Methods

=over

=item * generate

Starting from the last cached report, retrieves all the more recent reports
from the Metabase Report Submission server, parsing each and recording each
report in both the cpanstats databases (MySQL & SQLite) and the metabase cache
database.

=item * regenerate

For a given date range, retrieves all the reports from the Metabase Report 
Submission server, parsing each and recording each report in both the cpanstats
databases (MySQL & SQLite) and the metabase cache database.

Note that as only 2500 can be returned at any one time due to Amazon SimpleDB
restrictions, this method will only process the guids returned from a given
start data, up to a maxiumu of 2500 guids.

This method will return the guid of the last report processed.

=item * rebuild

In the event that the cpanstats database needs regenerating, either in part or
for the whole database, this method allow you to do so. You may supply
parameters as to the 'start' and 'end' values (inclusive), where all records
are assumed by default. Records are rebuilt using the local metabase cache
database.

=item * reparse

Rather than a complete rebuild the option to selective reparse selected entries
is useful if there are reports which were previously unable to correctly supply
a particular field, which now has supporting parsing code within the codebase.

In addition there is the option to exclude fields from parsing checks, where
they may be corrupted, and can be later amended using the 'cpanstats-update'
tool.

=back

=head2 Private Methods

=over

=item * commit

To speed up the transaction process, a commit is performed every 500 inserts.
This method is used as part of the clean up process to ensure all transactions
are completed.

=item * get_next_guids

Get the list of GUIDs for the reports that have been submitted since the last
cached report.

=item * retrieve_reports

Abstracted loop of requesting GUIDs, then parsing, storing and caching each 
report as appropriate. Updates Recent JSON & RSS files.

=item * already_saved

Given a guid, determines whether it has already been saved in the local
metabase cache.

=item * get_fact

Get a specific report factfor a given GUID.

=item * parse_report

Parses a report extracting the metadata required for the cpanstats database.

=item * reparse_report

Parses a report (from a local metabase cache) extracting the metadata required
for the stats database.

=item * retrieve_report

Given a guid will attempt to return the report metadata from the cpanstats 
database.

=item * store_report

Inserts the components of a parsed report into the cpanstats database.

=item * cache_report

Inserts a serialised report into a local metabase cache database.

=item * cache_update

For the current report will update the local metabase cache with the id used
within the cpanstats database.

=back

=head1 HISTORY

The CPAN testers was conceived back in May 1998 by Graham Barr and Chris
Nandor as a way to provide multi-platform testing for modules. Today there
are over 2 million tester reports and more than 100 testers each month
giving valuable feedback for users and authors alike.

=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 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::Testers::Report>,
L<Metabase>,
L<Metabase::Fact>,
L<CPAN::Testers::Fact::LegacyReport>,
L<CPAN::Testers::Fact::TestSummary>,
L<CPAN::Testers::Metabase::AWS>

L<CPAN::Testers::WWW::Statistics>

F<http://www.cpantesters.org/>,
F<http://stats.cpantesters.org/>,
F<http://wiki.cpantesters.org/>

=head1 AUTHOR

It should be noted that the original code for this distribution began life
under another name. The original distribution generated data for the original
CPAN Testers website. However, in 2008 the code was reworked to generate data
in the format for the statistics data analysis, which in turn was reworked to
drive the redesign of the all the CPAN Testers websites. To reflect the code
changes, a new name was given to the distribution.

=head2 CPAN-WWW-Testers-Generator

  Original author:    Leon Brocard <acme@astray.com>   (C) 2002-2008
  Current maintainer: Barbie       <barbie@cpan.org>   (C) 2008-2010

=head2 CPAN-Testers-Data-Generator

  Original author:    Barbie       <barbie@cpan.org>   (C) 2008-2011

=head1 LICENSE

This code is distributed under the Artistic License 2.0.
