summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/CPANPLUS/Internals/Source/SQLite.pm
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlperl/lib/CPANPLUS/Internals/Source/SQLite.pm')
-rw-r--r--Master/tlpkg/tlperl/lib/CPANPLUS/Internals/Source/SQLite.pm383
1 files changed, 0 insertions, 383 deletions
diff --git a/Master/tlpkg/tlperl/lib/CPANPLUS/Internals/Source/SQLite.pm b/Master/tlpkg/tlperl/lib/CPANPLUS/Internals/Source/SQLite.pm
deleted file mode 100644
index 50f82f485c9..00000000000
--- a/Master/tlpkg/tlperl/lib/CPANPLUS/Internals/Source/SQLite.pm
+++ /dev/null
@@ -1,383 +0,0 @@
-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;