view release on metacpan or  search on metacpan

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

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

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

our $VERSION = '0.220';

use English qw/-no_match_vars/;

use CPAN::SQLite::DBI qw($dbh);
use CPAN::SQLite::DBI::Index;
use CPAN::SQLite::Util qw(has_hash_data print_debug);
use Scalar::Util 'weaken';

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

our $dbh = $CPAN::SQLite::DBI::dbh;

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

  if ($args{setup}) {
    die "No state information available under 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 $cdbi = CPAN::SQLite::DBI::Index->new(%args);

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

sub state {
  my $self = shift;
  unless ($self->create_objs()) {
    print_debug("Cannot create objects");
    return;
  }
  unless ($self->state_info()) {
    print_debug("Getting state information 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();
    }
    $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}->{$_};
    }
  }
  return 1;
}

sub state_info {
  my $self    = shift;
  my @methods = qw(ids state);
  my @tables  = qw(dists auths 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, $/);
        }
      }
    }
  }

  # Check "info"
  if (my $obj = $self->{'obj'}->{'info'}) {
    return unless $obj->state;
  }
  return 1;
}

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

sub new {
  my ($class, %args) = @_;
  my $info = $args{info};
  die "No author info available" unless has_hash_data($info);
  my $cdbi = $args{cdbi};
  die "No dbi object available"
    unless ($cdbi and ref($cdbi) eq 'CPAN::SQLite::DBI::Index::auths');
  my $self = {
    info      => $info,
    insert    => {},
    update    => {},
    delete    => {},
    ids       => {},
    obj       => {},
    cdbi      => $cdbi,
    error_msg => '',
    info_msg  => '',
  };
  return bless $self, $class;
}

sub ids {
  my $self = shift;
  my $cdbi = $self->{cdbi};