Initial Commit

database/perl/vendor/lib/CPAN/SQLite/DBI/Index.pm

@@ -0,0 +1,238 @@
+# $Id: Index.pm 84 2020-05-31 06:29:34Z stro $
+
+package CPAN::SQLite::DBI::Index;
+use strict;
+use warnings;
+
+BEGIN {
+  our $VERSION = '0.219';
+  $CPAN::SQLite::DBI::Index::info::VERSION  = $VERSION;
+  $CPAN::SQLite::DBI::Index::mods::VERSION  = $VERSION;
+  $CPAN::SQLite::DBI::Index::dists::VERSION = $VERSION;
+  $CPAN::SQLite::DBI::Index::auths::VERSION = $VERSION;
+}
+
+use CPAN::SQLite::DBI qw($dbh);
+use parent 'CPAN::SQLite::DBI';
+
+package CPAN::SQLite::DBI::Index::info;
+use parent 'CPAN::SQLite::DBI::Index';
+use CPAN::SQLite::DBI qw($dbh);
+
+package CPAN::SQLite::DBI::Index::mods;
+use parent 'CPAN::SQLite::DBI::Index';
+use CPAN::SQLite::DBI qw($dbh);
+
+package CPAN::SQLite::DBI::Index::dists;
+use parent 'CPAN::SQLite::DBI::Index';
+use CPAN::SQLite::DBI qw($dbh);
+
+sub fetch_ids {
+  my $self = shift;
+  my $sql  = sprintf(qq{SELECT %s,%s,%s FROM %s}, $self->{id}, $self->{name}, 'dist_vers', $self->{table});
+  my $sth  = $dbh->prepare($sql) or do {
+    $self->db_error();
+    return;
+  };
+  $sth->execute() or do {
+    $self->db_error($sth);
+    return;
+  };
+  my ($ids, $versions);
+  while (my ($id, $key, $vers) = $sth->fetchrow_array()) {
+    $ids->{$key}      = $id;
+    $versions->{$key} = $vers;
+  }
+  $sth->finish;
+  undef $sth;
+  return ($ids, $versions);
+}
+
+package CPAN::SQLite::DBI::Index::auths;
+use parent 'CPAN::SQLite::DBI::Index';
+use CPAN::SQLite::DBI qw($dbh);
+
+package CPAN::SQLite::DBI::Index;
+use CPAN::SQLite::DBI qw($tables);
+use CPAN::SQLite::DBI qw($dbh);
+
+sub fetch_ids {
+  my $self = shift;
+  my $sql  = sprintf(qq{SELECT %s,%s from %s}, $self->{id}, $self->{name}, $self->{table});
+  my $sth  = $dbh->prepare($sql) or do {
+    $self->db_error();
+    return;
+  };
+  $sth->execute() or do {
+    $self->db_error($sth);
+    return;
+  };
+  my $ids;
+  while (my ($id, $key) = $sth->fetchrow_array()) {
+    $ids->{$key} = $id;
+  }
+  $sth->finish;
+  undef $sth;
+  return $ids;
+}
+
+sub schema {
+  my ($self, $data) = @_;
+  my $schema = '';
+  foreach my $type (qw(primary other)) {
+    foreach my $column (keys %{ $data->{$type} }) {
+      $schema .= $column . ' ' . $data->{$type}->{$column} . ", ";
+    }
+  }
+  $schema =~ s{, $}{};
+  return $schema;
+}
+
+sub create_index {
+  my ($self, $data) = @_;
+  my $key   = $data->{key};
+  my $table = $self->{table};
+  return 1 unless (defined $key and ref($key) eq 'ARRAY');
+  foreach my $index (@$key) {
+    my $id_name = 'ix_' . $table . '_' . $index;
+    $id_name =~ s/\(\s*\d+\s*\)//;
+    my $sql = 'CREATE INDEX ' . $id_name . ' ON ' . $table . '( ' . $index . ' )';
+    my $sth = $dbh->prepare($sql);
+    $sth->execute() or do {
+      $self->db_error($sth);
+      return;
+    };
+    $sth->finish;
+    undef $sth;
+  }
+  return 1;
+}
+
+sub drop_table {
+  my $self  = shift;
+  my $table = $self->{table};
+  my $sql   = qq{SELECT name FROM sqlite_master } . qq{ WHERE type='table' AND name=?};
+  my $sth   = $dbh->prepare($sql);
+  $sth->execute($table);
+  if (defined $sth->fetchrow_array) {
+    $dbh->do(qq{drop table $table}) or do {
+      $self->db_error($sth);
+      return;
+    };
+  }
+  $sth->finish;
+  undef $sth;
+  return 1;
+}
+
+sub create_table {
+  my ($self, $schema) = @_;
+  return unless $schema;
+  my $sql = sprintf(qq{CREATE TABLE %s (%s)}, $self->{table}, $schema);
+  my $sth = $dbh->prepare($sql);
+  $sth->execute() or do {
+    $self->db_error($sth);
+    return;
+  };
+  $sth->finish;
+  undef $sth;
+  return 1;
+}
+
+sub create_tables {
+  my ($self, %args) = @_;
+  return unless $args{setup};
+  my $objs = $self->{objs};
+  foreach my $table (keys %$objs) {
+    next unless my $schema = $self->schema($tables->{$table});
+    my $obj = $objs->{$table};
+    $obj->drop_table                      or return;
+    $obj->create_table($schema)           or return;
+    $obj->create_index($tables->{$table}) or return;
+  }
+  return 1;
+}
+
+sub sth_insert {
+  my ($self, $fields) = @_;
+  my $flds = join ',', @{$fields};
+  my $vals = join ',', map { '?' } @{$fields};
+  my $sql = sprintf(qq{INSERT INTO %s (%s) VALUES (%s)}, $self->{table}, $flds, $vals);
+
+  my $sth = $dbh->prepare($sql) or do {
+    $self->db_error();
+    return;
+  };
+  return $sth;
+}
+
+sub sth_update {
+  my ($self, $fields, $id, $rep_id) = @_;
+  my $set = join ',', map { "$_=?" } @{$fields};
+  my $sql = sprintf(qq{UPDATE %s SET %s WHERE %s = %s}, $self->{table}, $set, $self->{id}, $id);
+  $sql .= qq { AND rep_id = $rep_id } if ($rep_id);
+  my $sth = $dbh->prepare($sql) or do {
+    $self->db_error();
+    return;
+  };
+  return $sth;
+}
+
+sub sth_delete {
+  my ($self, $table_id, $rep_id) = @_;
+  my $sql = sprintf(qq{DELETE FROM %s where %s = ?}, $self->{table}, $table_id);
+  $sql .= qq { AND rep_id = $rep_id } if ($rep_id);
+  my $sth = $dbh->prepare($sql) or do {
+    $self->db_error();
+    return;
+  };
+  return $sth;
+}
+
+1;
+
+=head1 NAME
+
+CPAN::SQLite::DBI::Index - DBI information for indexing the CPAN::SQLite database
+
+=head1 VERSION
+
+version 0.219
+
+=head1 DESCRIPTION
+
+This module provides various methods for L<CPAN::SQLite::Index> in
+indexing and populating the database from the index files.
+
+=over
+
+=item C<create_tables>
+
+This creates the database tables.
+
+=item C<drop_table>
+
+This drops a table.
+
+=item C<sth_insert>
+
+This returns an C<$sth> statement handle for inserting
+values into a table.
+
+=item C<sth_update>
+
+This returns an C<$sth> statement handle for updating
+values into a table.
+
+=item C<sth_delete>
+
+This returns an C<$sth> statement handle for deleting
+values from a table.
+
+=back
+
+=head1 SEE ALSO
+
+L<CPAN::SQLite::Index>
+
+=cut