1 package CPANPLUS::Internals::Source::SQLite;
6 use base 'CPANPLUS::Internals::Source';
9 use CPANPLUS::Internals::Constants;
10 use CPANPLUS::Internals::Source::SQLite::Tie;
16 use Params::Check qw[allow check];
17 use Locale::Maketext::Simple Class => 'CPANPLUS', Style => 'gettext';
19 use constant TXN_COMMIT => 1000;
23 CPANPLUS::Internals::Source::SQLite - SQLite implementation
31 return $DbFile if $DbFile;
34 my $conf = $self->configure_object;
36 $DbFile = File::Spec->catdir(
37 $conf->get_conf('base'),
48 $Dbh = DBIx::Simple->connect(
49 "dbi:SQLite:dbname=" . $self->__sqlite_file,
59 { my $used_old_copy = 0;
63 my $conf = $self->configure_object;
66 my($path,$uptodate,$verbose,$use_stored);
68 path => { default => $conf->get_conf('base'), store => \$path },
69 verbose => { default => $conf->get_conf('verbose'), store => \$verbose },
70 uptodate => { required => 1, store => \$uptodate },
71 use_stored => { default => 1, store => \$use_stored },
74 check( $tmpl, \%hash ) or return;
76 ### if it's not uptodate, or the file doesn't exist, we need to create
78 if( not $uptodate or not -e $self->__sqlite_file ) {
82 1 while unlink $self->__sqlite_file;
84 ### and create a new one
85 $self->__sqlite_create_db or do {
86 error(loc("Could not create new SQLite DB"));
93 ### set up the author tree
95 tie %at, 'CPANPLUS::Internals::Source::SQLite::Tie',
96 dbh => $self->__sqlite_dbh, table => 'author',
97 key => 'cpanid', cb => $self;
99 $self->_atree( \%at );
102 ### set up the author tree
104 tie %mt, 'CPANPLUS::Internals::Source::SQLite::Tie',
105 dbh => $self->__sqlite_dbh, table => 'module',
106 key => 'module', cb => $self;
108 $self->_mtree( \%mt );
111 ### start a transaction
112 $self->__sqlite_dbh->query('BEGIN');
118 sub _standard_trees_completed { return $used_old_copy }
119 sub _custom_trees_completed { return }
120 ### finish transaction
121 sub _finalize_trees { $_[0]->__sqlite_dbh->query('COMMIT'); return 1 }
123 ### saves current memory state, but not implemented in sqlite
125 error(loc("%1 has not implemented writing state to disk", __PACKAGE__));
132 ### XXX move this outside the sub, so we only compute it once
134 my @keys = qw[ author cpanid email ];
136 class => { default => 'CPANPLUS::Module::Author', store => \$class },
137 map { $_ => { required => 1 } } @keys
140 ### dbix::simple's expansion of (??) is REALLY expensive, so do it manually
141 my $ph = join ',', map { '?' } @keys;
144 sub _add_author_object {
147 my $dbh = $self->__sqlite_dbh;
150 local $Params::Check::NO_DUPLICATES = 1;
151 local $Params::Check::SANITY_CHECK_TEMPLATE = 0;
152 check( $tmpl, \%hash ) or return;
155 ### keep counting how many we inserted
156 unless( ++$txn_count % TXN_COMMIT ) {
157 #warn "Committing transaction $txn_count";
158 $dbh->query('COMMIT') or error( $dbh->error ); # commit previous transaction
159 $dbh->query('BEGIN') or error( $dbh->error ); # and start a new one
163 "INSERT INTO author (". join(',',keys(%$href)) .") VALUES ($ph)",
166 error( $dbh->error );
176 ### XXX move this outside the sub, so we only compute it once
178 my @keys = qw[ module version path comment author package description dslip mtime ];
180 class => { default => 'CPANPLUS::Module', store => \$class },
181 map { $_ => { required => 1 } } @keys
184 ### dbix::simple's expansion of (??) is REALLY expensive, so do it manually
185 my $ph = join ',', map { '?' } @keys;
187 sub _add_module_object {
190 my $dbh = $self->__sqlite_dbh;
193 local $Params::Check::NO_DUPLICATES = 1;
194 local $Params::Check::SANITY_CHECK_TEMPLATE = 0;
195 check( $tmpl, \%hash ) or return;
198 ### fix up author to be 'plain' string
199 $href->{'author'} = $href->{'author'}->cpanid;
201 ### keep counting how many we inserted
202 unless( ++$txn_count % TXN_COMMIT ) {
203 #warn "Committing transaction $txn_count";
204 $dbh->query('COMMIT') or error( $dbh->error ); # commit previous transaction
205 $dbh->query('BEGIN') or error( $dbh->error ); # and start a new one
209 "INSERT INTO module (". join(',',keys(%$href)) .") VALUES ($ph)",
212 error( $dbh->error );
221 _source_search_module_tree
222 => [ module => module => 'CPANPLUS::Module' ],
223 _source_search_author_tree
224 => [ author => cpanid => 'CPANPLUS::Module::Author' ],
227 while( my($sub, $aref) = each %map ) {
230 my($table, $key, $class) = @$aref;
234 my $dbh = $self->__sqlite_dbh;
238 allow => { required => 1, default => [ ], strict_type => 1,
240 type => { required => 1, allow => [$class->accessors()],
244 check( $tmpl, \%hash ) or return;
247 ### we aliased 'module' to 'name', so change that here too
248 $type = 'module' if $type eq 'name';
250 my $res = $dbh->query( "SELECT * from $table" );
252 my $meth = $table .'_tree';
253 my @rv = map { $self->$meth( $_->{$key} ) }
254 grep { allow( $_->{$type} => $list ) } $res->hashes;
263 sub __sqlite_create_db {
265 my $dbh = $self->__sqlite_dbh;
267 ### we can ignore the result/error; not all sqlite implemantation
270 DROP TABLE IF EXISTS author;
276 DROP TABLE IF EXISTS module;
285 /* the author information */
286 CREATE TABLE author (
287 id INTEGER PRIMARY KEY AUTOINCREMENT,
296 error( $dbh->error );
301 /* the module information */
302 CREATE TABLE module (
303 id INTEGER PRIMARY KEY AUTOINCREMENT,
306 version varchar(255),
308 comment varchar(255),
310 package varchar(255),
311 description varchar(255),
319 error( $dbh->error );