File Coverage

blib/lib/Test/App/CPANIDX/Database.pm

Criterion	Covered	Total	%
statement	14	16	87.5
branch			n/a
condition			n/a
subroutine	6	6	100.0
pod			n/a
total	20	22	90.9

package Test::App::CPANIDX::Database;
BEGIN {
  $Test::App::CPANIDX::Database::VERSION = '0.04';
}

# ABSTRACT: generate a test database for App::CPANIDX

use strict;
use warnings;
use DBI;
use File::Spec;
use App::CPANIDX::Tables;

use constant CPANIDX => 'cpanidx.db';

sub new {
  my $package = shift;
  my %self = @_;
  $self{lc $_} = delete $self{$_} for keys %self;
  $self{unlink} = 1 unless defined $self{unlink} and !$self{unlink};
  die "Invalid dir specified\n" if
    defined $self{dir} and !( -d File::Spec->rel2abs($self{dir}) );
  $self{dir} = File::Spec->rel2abs($self{dir}) if defined $self{dir};
  my $db = $self{dir} ? File::Spec->catfile( $self{dir}, CPANIDX ) : CPANIDX;

  my $dbh = DBI->connect("dbi:SQLite:dbname=$db",'','') or die $DBI::errstr;

  foreach my $table ( App::CPANIDX::Tables->tables() ) {
    my $sql = App::CPANIDX::Tables->table( $table );
    $dbh->do($sql) or die $dbh->errstr;
    $dbh->do('DELETE FROM ' . $table) or die $dbh->errstr;
  }

  my $statements = {
    auths => qq{INSERT INTO auths values (?,?,?)},
    mods  => qq{INSERT INTO mods values (?,?,?,?,?)},
    dists => qq{INSERT INTO dists values (?,?,?,?)},
    timestamp => qq{INSERT INTO timestamp values(?,?)},
  };

  my $stamp = ( $self{time} || time() );
  my $data = [
    [ 'auths', 'FOOBAR', 'Foo Bar', '[e-mail]' ],
    [ 'mods',  'Foo::Bar','Foo-Bar','0.01','FOOBAR','0.01' ],
    [ 'dists', 'Foo-Bar','FOOBAR','F/FO/FOOBAR/Foo-Bar-0.01.tar.gz','0.01' ],
    [ 'timestamp', $stamp, $stamp  ],
  ];

  foreach my $datum ( @{ $data } ) {
    my $table = shift @{ $datum };
    my $sql = $statements->{ $table };
    my $sth = $dbh->prepare($sql) or die $dbh->errstr;
    $sth->execute( @{ $datum } );
  }

  return bless \%self, $package;
}

sub dbfile {
  my $self = shift;
  return
    $self->{dir} ? File::Spec->catfile( $self->{dir}, CPANIDX ) : CPANIDX;
}

sub DESTROY {
  my $self = shift;
  return unless $self->{unlink};
  my $db = $self->{dir} ? File::Spec->catfile( $self->{dir}, CPANIDX ) : CPANIDX;
  unlink $db;
}

1;


__END__