package CPANPLUS::Internals::Source::SQLite; use deprecate; 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.9135"; 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', key => 'module', cb => $self; $self->_mtree( \%mt ); } ### start a transaction $self->__sqlite_dbh->query('BEGIN'); return 1; } sub _standard_trees_completed { return $used_old_copy } sub _custom_trees_completed { return } ### finish transaction sub _finalize_trees { $_[0]->__sqlite_dbh->commit; return 1 } ### saves current memory state, but not implemented in sqlite sub _save_state { error(loc("%1 has not implemented writing state to disk", __PACKAGE__)); return; } } { my $txn_count = 0; ### XXX move this outside the sub, so we only compute it once my $class; my @keys = qw[ author cpanid email ]; my $tmpl = { class => { default => 'CPANPLUS::Module::Author', store => \$class }, map { $_ => { required => 1 } } @keys }; ### dbix::simple's expansion of (??) is REALLY expensive, so do it manually my $ph = join ',', map { '?' } @keys; sub _add_author_object { my $self = shift; my %hash = @_; my $dbh = $self->__sqlite_dbh; my $href = do { local $Params::Check::NO_DUPLICATES = 1; local $Params::Check::SANITY_CHECK_TEMPLATE = 0; check( $tmpl, \%hash ) or return; }; ### keep counting how many we inserted unless( ++$txn_count % TXN_COMMIT ) { #warn "Committing transaction $txn_count"; $dbh->commit or error( $dbh->error ); # commit previous transaction $dbh->begin_work or error( $dbh->error ); # and start a new one } $dbh->query( "INSERT INTO author (". join(',',keys(%$href)) .") VALUES ($ph)", values %$href ) or do { error( $dbh->error ); return; }; return 1; } } { my $txn_count = 0; ### XXX move this outside the sub, so we only compute it once my $class; my @keys = qw[ module version path comment author package description dslip mtime ]; my $tmpl = { class => { default => 'CPANPLUS::Module', store => \$class }, map { $_ => { required => 1 } } @keys }; ### dbix::simple's expansion of (??) is REALLY expensive, so do it manually my $ph = join ',', map { '?' } @keys; sub _add_module_object { my $self = shift; my %hash = @_; my $dbh = $self->__sqlite_dbh; my $href = do { local $Params::Check::NO_DUPLICATES = 1; local $Params::Check::SANITY_CHECK_TEMPLATE = 0; check( $tmpl, \%hash ) or return; }; ### fix up author to be 'plain' string $href->{'author'} = $href->{'author'}->cpanid; ### keep counting how many we inserted unless( ++$txn_count % TXN_COMMIT ) { #warn "Committing transaction $txn_count"; $dbh->commit or error( $dbh->error ); # commit previous transaction $dbh->begin_work or error( $dbh->error ); # and start a new one } $dbh->query( "INSERT INTO module (". join(',',keys(%$href)) .") VALUES ($ph)", values %$href ) or do { error( $dbh->error ); return; }; return 1; } } { my %map = ( _source_search_module_tree => [ module => module => 'CPANPLUS::Module' ], _source_search_author_tree => [ author => cpanid => 'CPANPLUS::Module::Author' ], ); while( my($sub, $aref) = each %map ) { no strict 'refs'; my($table, $key, $class) = @$aref; *$sub = sub { my $self = shift; my %hash = @_; my($list,$type); my $tmpl = { allow => { required => 1, default => [ ], strict_type => 1, store => \$list }, type => { required => 1, allow => [$class->accessors()], store => \$type }, }; check( $tmpl, \%hash ) or return; ### we aliased 'module' to 'name', so change that here too $type = 'module' if $type eq 'name'; my $meth = $table .'_tree'; { my $throw = $self->$meth; } my $dbh = $self->__sqlite_dbh; my $res = $dbh->query( "SELECT * from $table" ); my @rv = map { $self->$meth( $_->{$key} ) } grep { allow( $_->{$type} => $list ) } $res->hashes; return @rv; } } } sub __sqlite_create_db { my $self = shift; my $dbh = $self->__sqlite_dbh; ### we can ignore the result/error; not all sqlite implementations ### support this $dbh->query( qq[ DROP TABLE IF EXISTS author; \n] ) or do { msg( $dbh->error ); }; $dbh->query( qq[ DROP TABLE IF EXISTS module; \n] ) or do { msg( $dbh->error ); }; $dbh->query( qq[ /* the author information */ CREATE TABLE author ( id INTEGER PRIMARY KEY AUTOINCREMENT, author varchar(255), email varchar(255), cpanid varchar(255) ); \n] ) or do { error( $dbh->error ); return; }; $dbh->query( qq[ /* the module information */ CREATE TABLE module ( id INTEGER PRIMARY KEY AUTOINCREMENT, module varchar(255), version varchar(255), path varchar(255), comment varchar(255), author varchar(255), package varchar(255), description varchar(255), dslip varchar(255), mtime varchar(255) ); \n] ) or do { error( $dbh->error ); return; }; $dbh->query( qq[ /* the module index */ CREATE INDEX IX_module_module ON module ( module ); \n] ) or do { error( $dbh->error ); return; }; $dbh->query( qq[ /* the version index */ CREATE INDEX IX_module_version ON module ( version ); \n] ) or do { error( $dbh->error ); return; }; $dbh->query( qq[ /* the module-version index */ CREATE INDEX IX_module_module_version ON module ( module, version ); \n] ) or do { error( $dbh->error ); return; }; return 1; } 1;