Test::App::CPANIDX::Database - generate a test database for App::CPANIDX


Test-App-CPANIDX-Database documentation Contained in the Test-App-CPANIDX-Database distribution.

Index


Code Index:

NAME

Top

Test::App::CPANIDX::Database - generate a test database for App::CPANIDX

VERSION

Top

version 0.04

SYNOPSIS

Top

  use strict;
  use warnings;

  use Test::App::CPANIDX::Database;

  # Create a test database in the current working directory

  my $tdb = Test::App::CPANIDX::Database->new();

  # Get the name of the test database file generated

  my $dbfile = $tdb->dbfile;

  # The test database will be automagically removed when the 
  # object goes out of scope.

DESCRIPTION

Top

Test::App::CPANIDX::Database will generate a test database for use with App::CPANIDX deriatives.

It generates a very simple DBD::SQLite database which contains a single CPAN author FOOBAR, a single distribution Foo-Bar-0.01.tar.gz and a single module Foo::Bar.

CONSTRUCTOR

Top

new

Generates a test database called cpanidx.db and returns an object reference.

Without any parameters this database file will be located in the current working directory and will be automatically removed when the object falls out of scope.

You may provide parameters to affect this behaviour.

Set this to a false value to disable the automatic removal of the test database file.

  my $tdb = Test::App::CPANIDX::Database->new( unlink => 0 );

dir

Set this to an existing directory path where the database file should be created.

  my $tdb = Test::App::CPANIDX::Database->new( dir => '/some/funky/path' );

METHODS

Top

dbfile

Returns the name of the database file that was generated.

SEE ALSO

Top

App::CPANIDX

App::CPANIDX::Tables

DBD::SQLite

AUTHOR

Top

Chris Williams <chris@bingosnet.co.uk>

COPYRIGHT AND LICENSE

Top


Test-App-CPANIDX-Database documentation Contained in the Test-App-CPANIDX-Database distribution.

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', 'foobar@cpan.org' ],
    [ '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__