view release on metacpan or  search on metacpan

lib/CPAN/SQLite/Populate.pm  view on Meta::CPAN

# $Id: Populate.pm 85 2022-10-29 05:44:36Z stro $

package CPAN::SQLite::Populate;
use strict;
use warnings;
no warnings qw(redefine);

our $VERSION = '0.220';

use English qw/-no_match_vars/;

use CPAN::SQLite::Util qw($table_id has_hash_data print_debug);
use CPAN::SQLite::DBI::Index;
use CPAN::SQLite::DBI qw($dbh);
use File::Find;
use File::Basename;
use File::Spec::Functions;
use File::Path;
use Scalar::Util 'weaken';

our $dbh = $CPAN::SQLite::DBI::dbh;
my ($setup);

my %tbl2obj;
$tbl2obj{$_} = __PACKAGE__ . '::' . $_ foreach (qw(dists mods auths info));
my %obj2tbl = reverse %tbl2obj;

sub new {
  my ($class, %args) = @_;

  $setup = $args{setup};

  my $index  = $args{index};
  my @tables = qw(dists mods auths info);
  foreach my $table (@tables) {
    my $obj = $index->{$table};
    die "Please supply a CPAN::SQLite::Index::$table object"
      unless ($obj and ref($obj) eq "CPAN::SQLite::Index::$table");
  }
  my $state = $args{state};
  unless ($setup) {
    die "Please supply a CPAN::SQLite::State object"
      unless ($state and ref($state) eq 'CPAN::SQLite::State');
  }
  my $cdbi = CPAN::SQLite::DBI::Index->new(%args);

  my $self = {
    index   => $index,
    state   => $state,
    obj     => {},
    cdbi    => $cdbi,
    db_name => $args{db_name},
  };
  return bless $self, $class;
}

sub populate {
  my $self = shift;

  if ($setup) {
    unless ($self->{cdbi}->create_tables(setup => $setup)) {
      warn "Creating tables failed";
      return;
    }
  }
  unless ($self->create_objs()) {
    warn "Cannot create objects";
    return;
  }
  unless ($self->populate_tables()) {
    warn "Populating tables failed";
    return;
  }
  return 1;
}

sub create_objs {
  my $self   = shift;
  my @tables = qw(dists auths mods info);

  foreach my $table (@tables) {
    my $obj;
    my $pack  = $tbl2obj{$table};
    my $index = $self->{index}->{$table};
    if ($index and ref($index) eq "CPAN::SQLite::Index::$table") {
      my $info = $index->{info};
      if ($table ne 'info') {
        return unless has_hash_data($info);
      }
      $obj = $pack->new(
        info => $info,
        cdbi => $self->{cdbi}->{objs}->{$table});
    } else {
      $obj = $pack->new(cdbi => $self->{cdbi}->{objs}->{$table});
    }
    $self->{obj}->{$table} = $obj;
  }

  foreach my $table (@tables) {
    my $obj = $self->{obj}->{$table};
    foreach (@tables) {
      next if ref($obj) eq $tbl2obj{$_};
      $obj->{obj}->{$_} = $self->{obj}->{$_};
      weaken $obj->{obj}->{$_};
    }
  }

  unless ($setup) {
    my $state  = $self->{state};
    my @tables = qw(auths dists mods);
    my @data   = qw(ids insert update delete);

    foreach my $table (@tables) {
      my $state_obj = $state->{obj}->{$table};
      my $pop_obj   = $self->{obj}->{$table};
      $pop_obj->{$_} = $state_obj->{$_} for (@data);
    }
  }
  return 1;
}

sub populate_tables {
  my $self = shift;
  my @methods = $setup ? qw(insert) : qw(insert update delete);

  # Reset status
  my $info_obj = $self->{'obj'}->{'info'};
  unless ($info_obj->delete) {
    print_debug('Fatal error from ', ref($info_obj), ':', $info_obj->{'error_msg'});
    return;
  }

  my @tables = qw(auths dists mods);
  for my $method (@methods) {
    for my $table (@tables) {
      my $obj = $self->{obj}->{$table};
      unless ($obj->$method()) {
        if (my $error = $obj->{error_msg}) {
          print_debug("Fatal error from ", ref($obj), ": ", $error, $/);
          return;
        } else {
          my $info = $obj->{info_msg};
          print_debug("Info from ", ref($obj), ": ", $info, $/);
        }
      }
    }
  }

  # Update status
  unless ($info_obj->insert) {
    print_debug('Fatal error from ', ref($info_obj), ':', $info_obj->{'error_msg'});
    return;
  }

  return 1;
}

package CPAN::SQLite::Populate::auths;
use parent 'CPAN::SQLite::Populate';
use CPAN::SQLite::Util qw(has_hash_data print_debug);

sub new {
  my ($class, %args) = @_;
  my $info = $args{info};