CPAN-Testers-Data-Release

 view release on metacpan or  search on metacpan

Changes  view on Meta::CPAN

        - change file dates changed to meet W3CDTF standards.
        - Artistic License v2 now sole license.
        - added explicit LICENSE file.
        - added META.json.
        - added minimum perl version (5.006).
        - reworked Makefile.PL for clarity.
        - more tests.

0.03    2011-02-02
        - added clean functionality to help remove any decrepancies.
        - initial revision of backup process.
        - removed support for CSV backups.
        - added ability to continue backup process from known point.
        - updated examples.

0.02    2009-07-13
        - Configuration fixes.
        - Runtime checks added.
        - Backup logic changed due to too large a resource drain on MySQL DB.

0.01    2009-06-07
        - Initial release.

lib/CPAN/Testers/Data/Release.pm  view on Meta::CPAN

sub DESTROY {
    my $self = shift;
}

__PACKAGE__->mk_accessors(qw( idfile logfile logclean ));

sub process {
    my $self = shift;
    if($self->{clean}) 		        { $self->clean() }
    elsif($self->{RELEASE}{exists}) { $self->backup_from_last() }
    else               		        { $self->backup_from_start() }
}

sub backup_from_last {
    my $self = shift;

    $self->_log("Find new start");

    my $lastid = 0;
    my $idfile = $self->idfile();
    if($idfile && -f $idfile) {
        if(my $fh = IO::File->new($idfile,'r')) {
            my @lines = <$fh>;
            ($lastid) = $lines[0] =~ /(\d+)/;

lib/CPAN/Testers/Data/Release.pm  view on Meta::CPAN

    if($idfile) {
        if(my $fh = IO::File->new($idfile,'w+')) {
            print $fh "$lastid\n";
            $fh->close;
        }
    }

    $self->_log("Backup completed");
}

sub backup_from_start {
    my $self = shift;
    my $lastid = 0;

    $self->_log("Create backup database");

    # start with a clean slate
    $self->{RELEASE}{dbh}->do_query($phrasebook{'DeleteTable'});
    $self->{RELEASE}{dbh}->do_query($phrasebook{'CreateTable'});
    $self->{RELEASE}{dbh}->do_query($phrasebook{'CreateDistIndex'});
    $self->{RELEASE}{dbh}->do_query($phrasebook{'CreateVersIndex'});

    $self->_log("Generate backup data");

    # store data from master database
    my %data;
    my $dist = '';
    my $rows = $self->{CPANSTATS}{dbh}->iterator('hash',$phrasebook{'SelectAll'});
    while(my $row = $rows->()) {
        if($dist && $dist ne $row->{dist}) {
            $self->_log("... dist=$dist");
            for my $vers (keys %data) {
                $self->{RELEASE}{dbh}->do_query($phrasebook{'InsertRelease'},@{ $data{$vers} });

lib/CPAN/Testers/Data/Release.pm  view on Meta::CPAN

=back

=head2 Public Methods

=over

=item * process

Shorthand function to run methods based on command line options.

=item * backup_from_last

Run backup processes from the last known update.

=item * backup_from_start

Run backup processes recreating the complete backup database from scratch.

=item * clean

Run database table clean processes.

=item * help

Provides basic help screen.

=back

t/21process2.t  view on Meta::CPAN

        # reset DB
        $obj->{CPANSTATS}{dbh}->do_query('delete from release_summary');
        insert_records($obj,\@ROWS);

        is(-f $idfile,undef,'.. no idfile at start');

        my @rows = $obj->{CPANSTATS}{dbh}->get_query('hash','select count(*) as count from release_summary');
        is($rows[0]->{count}, 22, "row count for release_summary");

        $obj->backup_from_start;  # from start
        
        is(-f $idfile,undef,'.. no idfile after from start');

        @rows = $obj->{RELEASE}{dbh}->get_query('hash','select count(*) as count from release');
        is($rows[0]->{count}, 9, "row count for release");

        $obj->backup_from_last;  # from last

        @rows = $obj->{RELEASE}{dbh}->get_query('hash','select count(*) as count from release');
        is($rows[0]->{count}, 9, "row count for release");

        is(-f $idfile,undef,'.. no idfile after from last');


        # check logs
        my $log = 't/_DBDIR/release.log';
        my $fh = IO::File->new($log,'r');
        SKIP: {
            skip "Unable to open log file: $!", 3 unless($fh);

            my $text;
            while (<$fh>) { $text .= $_ }

            like($text, qr!\d+/\d+/\d+ \d+:\d+:\d+ Create backup database!);
            like($text, qr!\d+/\d+/\d+ \d+:\d+:\d+ Find new start!);
            like($text, qr!\d+/\d+/\d+ \d+:\d+:\d+ Backup completed!);

            $fh->close;
        }
    }
}

sub insert_records {
    my ($obj,$rows) = @_;