Permalink
Browse files

give test results access to index dbs

...and use it
  • Loading branch information...
1 parent e9f848f commit 19521efa9207898fd0519f3a9a60ff98895c0695 @rjbs rjbs committed Aug 13, 2011
Showing with 50 additions and 1 deletion.
  1. +4 −1 t/lib/PAUSE/TestPAUSE.pm
  2. +27 −0 t/lib/PAUSE/TestPAUSE/Result.pm
  3. +19 −0 t/mldistwatch.t
View
@@ -44,13 +44,14 @@ sub test {
mkdir File::Spec->catdir($tmpdir, 'db');
my $db_root = File::Spec->catdir($tmpdir, 'db');
- my $dsnbase = "DBI:SQLite:dbname=$db_root";
my $pid_dir = File::Spec->catdir($tmpdir, 'run');
mkdir $pid_dir;
$self->deploy_schemas_at($db_root);
+ my $dsnbase = "DBI:SQLite:dbname=$db_root";
+
my %overrides = (
AUTHEN_DATA_SOURCE_NAME => "$dsnbase/authen.sqlite",
CHECKSUMS_SIGNING_PROGRAM => "\0",
@@ -78,6 +79,8 @@ sub test {
return PAUSE::TestPAUSE::Result->new({
tmpdir => $tmpdir,
config_overrides => \%overrides,
+ authen_db_file => File::Spec->catfile($db_root, 'authen.sqlite'),
+ mod_db_file => File::Spec->catfile($db_root, 'mod.sqlite'),
});
}
@@ -2,6 +2,7 @@ package PAUSE::TestPAUSE::Result;
use Moose;
use MooseX::StrictConstructor;
+use DBI;
use Path::Class;
use namespace::autoclean;
@@ -23,4 +24,30 @@ has config_overrides => (
required => 1,
);
+has [ qw(authen_db_file mod_db_file) ] => (
+ is => 'ro',
+ isa => 'Str',
+ required => 1,
+);
+
+sub __connect {
+ my ($self, $file) = @_;
+
+ return DBI->connect(
+ 'dbi:SQLite:dbname=' . $file,
+ undef,
+ undef,
+ ) or die "can't connect to db at $file: $DBI::errstr";
+}
+
+sub connect_authen_db {
+ my ($self) = @_;
+ return $self->__connect( $self->authen_db_file );
+}
+
+sub connect_mod_db {
+ my ($self) = @_;
+ return $self->__connect( $self->mod_db_file );
+}
+
1;
View
@@ -7,6 +7,7 @@ use File::Spec;
use PAUSE;
use PAUSE::TestPAUSE;
+use Test::Deep;
use Test::More;
my $result = PAUSE::TestPAUSE->new({
@@ -18,4 +19,22 @@ ok(
"our indexer indexed",
);
+my $pkg_rows = $result->connect_mod_db->selectall_arrayref(
+ 'SELECT * FROM packages ORDER BY package, version',
+ { Slice => {} },
+);
+
+my @want = (
+ { package => 'Bug::Gold', version => '9.001' },
+ { package => 'Hall::MtKing', version => '0.01' },
+ { package => 'XForm::Rollout', version => '1.00' },
+ { package => 'Y', version => 2 },
+);
+
+cmp_deeply(
+ $pkg_rows,
+ [ map {; superhashof($_) } @want ],
+ "we indexed exactly the dists we expected to",
+);
+
done_testing;

0 comments on commit 19521ef

Please sign in to comment.