view release on metacpan or  search on metacpan

lib/DarkPAN/Indexer/Format/SQLite.pm  view on Meta::CPAN

      rename $database, $backup
        or croak sprintf "unable to back up '%s' to '%s': %s\n", $database, $backup, $OS_ERROR;
    }
  }

  my $dbh = DBI->connect(
    sprintf( 'dbi:SQLite:dbname=%s', $database ),
    q{}, q{},
    { AutoCommit => $FALSE,
      RaiseError => $TRUE,
      PrintError => $FALSE,
    },
  );

  if ($create) {
    $dbh->do(
      q{
      CREATE TABLE modules (
        distribution TEXT NOT NULL,
        module       TEXT NOT NULL,
        version      TEXT NOT NULL
      )
    }
    );

    $dbh->do('CREATE INDEX modules_module_idx ON modules (module)');
    $dbh->do('CREATE INDEX modules_distribution_idx ON modules (distribution)');
  }

  croak "ERROR: no input or distribution\n"
    if !$input && !$distribution;

  my $row_count = eval {
    if ($input) {
      return $self->_load_from_file( $input, $dbh );
    }
    elsif ($distribution) {
      return $self->update_index(
        distribution => $distribution,
        dbh          => $dbh,
        database     => $database,
      );
    }
  };

  my $err = $EVAL_ERROR;

  if ( !$err ) {
    $dbh->commit;
    $dbh->disconnect;
    return $row_count;
  }

  $dbh->rollback;
  $dbh->disconnect;

  croak $err;
}

########################################################################
sub update_index {
########################################################################
  my ( $self, %args ) = @_;

  my ( $distribution, $database, $delete_only, $fetch ) = @args{qw(distribution database delete_only fetch)};

  my $dbh = DBI->connect( "dbi:SQLite:dbname=$database", q{}, q{}, { AutoCommit => 1, RaiseError => 1, PrintError => 0 } );

  $dbh->do( 'delete from modules where distribution = ?', undef, $distribution );
  return if $delete_only;

  my $index = q{};

  open my $output_fh, '>', \$index
    or croak "ERROR: could open scalar \$index for writing\n$OS_ERROR";

  $self->index_distribution(
    fetch        => $fetch,
    distribution => $distribution,
    output_fh    => $output_fh,
  );

  close $output_fh;

  open my $input_fh, '<', \$index ## no critic
    or croak "ERROR: could not open scalar \$index for reading\n$OS_ERROR";

  return $self->_load_from_fh( $input_fh, $dbh );
}

########################################################################
sub _load_from_file {
########################################################################
  my ( $self, $input, $dbh ) = @_;

  open my $input_fh, '<', $input ## no critic
    or die sprintf "unable to open '%s' for reading: %s\n", $input, $OS_ERROR;

  return $self->_load_from_fh( $input_fh, $dbh );
}

########################################################################
sub _load_from_fh {
########################################################################
  my ( $self, $input_fh, $dbh ) = @_;

  my $insert_sth = $dbh->prepare(
    q{
      INSERT INTO modules (distribution, module, version)
      VALUES (?, ?, ?)
    }
  );

  my $rows_loaded = 0;
  my $line_number = 0;

  while ( my $line = <$input_fh> ) {
    $line_number++;
    chomp $line;

    next