view release on metacpan or  search on metacpan

lib/CPANPLUS/Internals/Source/SQLite.pm  view on Meta::CPAN

package CPANPLUS::Internals::Source::SQLite;

use strict;
use warnings;

use base 'CPANPLUS::Internals::Source';

use CPANPLUS::Error;
use CPANPLUS::Internals::Constants;
use CPANPLUS::Internals::Source::SQLite::Tie;

use Data::Dumper;
use DBIx::Simple;
use DBD::SQLite;

use Params::Check               qw[allow check];
use Locale::Maketext::Simple    Class => 'CPANPLUS', Style => 'gettext';

use vars qw[$VERSION];
$VERSION = "0.9916";

use constant TXN_COMMIT => 1000;

=head1 NAME

CPANPLUS::Internals::Source::SQLite - SQLite implementation

=cut

{   my $Dbh;
    my $DbFile;

    sub __sqlite_file {
        return $DbFile if $DbFile;

        my $self = shift;
        my $conf = $self->configure_object;

        $DbFile = File::Spec->catdir(
                        $conf->get_conf('base'),
                        SOURCE_SQLITE_DB
            );

        return $DbFile;
    };

    sub __sqlite_dbh {
        return $Dbh if $Dbh;

        my $self = shift;
        $Dbh     = DBIx::Simple->connect(
                        "dbi:SQLite:dbname=" . $self->__sqlite_file,
                        '', '',
                        { AutoCommit => 1 }
                    );
        #$Dbh->dbh->trace(1);
        $Dbh->query(qq{PRAGMA synchronous = OFF});

        return $Dbh;
    };

    sub __sqlite_disconnect {
      return unless $Dbh;
      $Dbh->disconnect;
      $Dbh = undef;
      return;
    }
}

{   my $used_old_copy = 0;

    sub _init_trees {
        my $self = shift;
        my $conf = $self->configure_object;
        my %hash = @_;

        my($path,$uptodate,$verbose,$use_stored);
        my $tmpl = {
            path        => { default => $conf->get_conf('base'), store => \$path },
            verbose     => { default => $conf->get_conf('verbose'), store => \$verbose },
            uptodate    => { required => 1, store => \$uptodate },
            use_stored  => { default  => 1, store => \$use_stored },
        };

        check( $tmpl, \%hash ) or return;

        ### if it's not uptodate, or the file doesn't exist, we need to create
        ### a new sqlite db
        if( not $uptodate or not -e $self->__sqlite_file ) {
            $used_old_copy = 0;

            ### chuck the file
            $self->__sqlite_disconnect;
            1 while unlink $self->__sqlite_file;

            ### and create a new one
            $self->__sqlite_create_db or do {
                error(loc("Could not create new SQLite DB"));
                return;
            }
        } else {
            $used_old_copy = 1;
        }

        ### set up the author tree
        {   my %at;
            tie %at, 'CPANPLUS::Internals::Source::SQLite::Tie',
                dbh => $self->__sqlite_dbh, table => 'author',
                key => 'cpanid',            cb => $self;

            $self->_atree( \%at  );
        }

        ### set up the author tree
        {   my %mt;
            tie %mt, 'CPANPLUS::Internals::Source::SQLite::Tie',
                dbh => $self->__sqlite_dbh, table => 'module',