PAR::Repository::DBM - DBM tools for PAR::Repository

PAR-Repository documentation Contained in the PAR-Repository distribution.

Index

Code Index:

NAME

Top

PAR::Repository::DBM - DBM tools for PAR::Repository

SYNOPSIS

Top

  use PAR::Repository;

DESCRIPTION

Top

This module is for internal use only. It contains code for accessing the DBM files of a PAR repository.

EXPORT

None.

GLOBALS

This package has a few constants:

MODULES_DBM_FILE, SYMLINKS_DBM_FILE, and SCRIPTS_DBM_FILE, DEPENDENCIES_DBM_FILE, and DBM_CHECKSUMS_FILE. They are accessible as functions via PAR::Repository::DBM::.... They indicate the file names of the DBM databases and the DBM checksums file.

DATABASE STRUCTURE

Top

This section outlines the structure of the DBM::Deep database files used by PAR::Repository.

If you need to care about this, you should be a PAR::Repository developer.

MODULES-DISTS DBM

The DBM file is a hash at top level.

It associates namespaces (keys) with a number of file names and versions. The values of the top level hash are hashes again. These contain file names as keys and corresponding versions as values.

Example:

  {
    'Math::Symbolic::Derivative' => {
      'Math-Symbolic-0.502-x86_64-linux-gnu-thread-multi-5.8.7.par' => '0.502',
      'Math-Symbolic-0.200-x86_64-linux-gnu-thread-multi-5.8.6.par' => '0.200',
    },
  }

This example means that the Math::Symbolic::Derivative module can be found in the two listed distribution files in the repository with the listed versions. Note that the distribution version needs not be the same as the module version. The module version is the one separately indicated.

The DBM file is a hash at top level.

It associates real files in the repository (keys) with a number of symbolic links. The values of the top level hash are arrays of distribution file names which are symlinks.

Example: (with some extra linebreaks to keep the text width down)

  {
    'Math-Symbolic-0.502-x86_64-linux-gnu-thread-multi-5.8.7.par'
       => [
            'Math-Symbolic-0.502-any_arch-5.8.7.par',
            'Math-Symbolic-0.502-x86_64-linux-gnu-thread-multi-'
            .'any_version.par',
            'Math-Symbolic-0.502-any_arch-any_version.par'
          ],
  }

In the example, the first file is the real file and the paths/file names in the value array are the names of the symbolic links.

SCRIPTS-DISTS DBM

This DBM file is a hash at top level. It associates script (executable) names with distributions much like the modules_dists.dbm file.

Example:

  {
    'parrepo' => {
      'PAR-Repository-0.03-x86_64--5.8.7.par'        => '0.02',
      'PAR-Repository-0.02-any_arch-any_version.par' => '0.01',
    },
  }

DEPENDENCIES DBM

This DBM file stores distribution names and associates them with names of modules it depends on and their minimum versions. It does not differentiate between the various types of dependencies that can be found in a CPAN META.yml file.

Example:

 {
   'Distname-0.03-x86_64-any_version.par' => {
      'Module::It::Depends::On' => '1.00',
   },
 }

METHODS

Top

Following is a list of class and instance methods. (Instance methods until otherwise mentioned.)

There is no PAR::Repository::DBM object. PAR::Repository inherits from this class.

modules_dbm

Opens the modules_dists.dbm.zip file in the repository and returns a tied hash reference to that file. Second return value is the file name.

If the file does not exist, it returns the empty list.

You should know what you are doing when you use this method.

Opens the symlinks.dbm.zip file in the repository and returns a tied hash reference to that file. Second return value is the file name.

If the file does not exist, it returns the empty list.

You should know what you are doing when you use this method.

scripts_dbm

Opens the scripts_dists.dbm.zip file in the repository and returns a tied hash reference to that file. Second return value is the file name.

If the file does not exist, it returns the empty list.

You should know what you are doing when you use this method.

dependencies_dbm

Opens the dependencies.dbm.zip file in the repository and returns a tied hash reference to that file. Second return value is the file name.

If the file does not exist, it returns the empty list.

You should know what you are doing when you use this method.

close_modules_dbm

Closes the modules_dists.dbm file committing any changes and then zips it back into modules_dists.dbm.zip.

This is called when the object is destroyed.

The same as close_modules_dbm() but for the file symlinks.dbm.zip.

Also called on object destruction.

close_scripts_dbm

Closes the scripts_dists.dbm file committing any changes and then zips it back into scripts_dists.dbm.zip.

This is called when the object is destroyed.

close_dependencies_dbm

Closes the dependencies.dbm file committing any changes and then zips it back into dependencies.dbm.zip.

This is called when the object is destroyed.

update_dbm_checksums

Updates the DBM checksums file dbm_checksums.txt with the checksums of the currently existing zipped DBM files.

This is called when the PAR::Repository object is destroyed.

Maintainer note: Very similar code lives in the PAR::Repository::Client::DBM::_calculate_cache_local_checksums method. Keep in sync or refactor.

_open_dbm

Opens the zipped dbm file given as first argument.

This is only for internal use.

_create_dbm

Creates a zipped dbm file given as first argument.

This is only for internal use.

AUTHOR

Top

Steffen M&0xfc;ller, <smueller@cpan.org>

COPYRIGHT AND LICENSE

Top

Copyright 2006-2009 by Steffen M&0xfc;ller

This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.6 or, at your option, any later version of Perl 5 you may have available.

PAR-Repository documentation Contained in the PAR-Repository distribution. 
package PAR::Repository::DBM;

use 5.006;
use strict;
use warnings;

use Carp qw/croak/;
use File::Spec::Functions qw/catfile splitpath/;
use DBM::Deep;
use Fcntl qw/:flock/;
use File::Copy qw();

our $VERSION = '0.20';
use constant 'MODULES_DBM_FILE'      => 'modules_dists.dbm';
use constant 'SYMLINKS_DBM_FILE'     => 'symlinks.dbm';
use constant 'SCRIPTS_DBM_FILE'      => 'scripts_dists.dbm';
use constant 'DEPENDENCIES_DBM_FILE' => 'dependencies.dbm';
use constant 'DBM_CHECKSUMS_FILE'    => 'dbm_checksums.txt';


sub modules_dbm {
  my $self = shift;
  $self->verbose(2, 'Entering modules_dbm()');

  if (defined $self->{modules_dbm_hash}) {
    return $self->{modules_dbm_hash};
  }

  my $old_dir = Cwd::cwd();
  chdir($self->{path});
  my $file = PAR::Repository::DBM::MODULES_DBM_FILE().'.zip';
  chdir($old_dir), return() if not -f $file;

  my ($hash, $tempfile) = $self->_open_dbm($file);
  chdir($old_dir), return() if not defined $hash;

  $self->{modules_dbm_hash} = $hash;
  $self->{modules_dbm_temp_file} = $tempfile;

  chdir($old_dir);

  return ($hash, $tempfile);
}



sub symlinks_dbm {
  my $self = shift;
  $self->verbose(2, 'Entering symlinks_dbm()');

  if (defined $self->{symlinks_dbm_hash}) {
    return $self->{symlinks_dbm_hash};
  }

  my $old_dir = Cwd::cwd();
  chdir($self->{path});

  my $file = PAR::Repository::DBM::SYMLINKS_DBM_FILE().'.zip';

  chdir($old_dir), return() if not -f $file;

  my ($hash, $tempfile) = $self->_open_dbm($file);
  chdir($old_dir), return() if not defined $hash;

  $self->{symlinks_dbm_hash} = $hash;
  $self->{symlinks_dbm_temp_file} = $tempfile;

  chdir($old_dir);

  return($hash, $tempfile);
}


sub scripts_dbm {
  my $self = shift;
  $self->verbose(2, 'Entering scripts_dbm()');

  if (defined $self->{scripts_dbm_hash}) {
    return $self->{scripts_dbm_hash};
  }

  my $old_dir = Cwd::cwd();
  chdir($self->{path});
  my $file = PAR::Repository::DBM::SCRIPTS_DBM_FILE().'.zip';
  chdir($old_dir), return() if not -f $file;

  my ($hash, $tempfile) = $self->_open_dbm($file);
  chdir($old_dir), return() if not defined $hash;

  $self->{scripts_dbm_hash} = $hash;
  $self->{scripts_dbm_temp_file} = $tempfile;

  chdir($old_dir);

  return($hash, $tempfile);
}


sub dependencies_dbm {
  my $self = shift;
  $self->verbose(2, 'Entering dependencies_dbm()');

  if (defined $self->{dependencies_dbm_hash}) {
    return $self->{dependencies_dbm_hash};
  }

  my $old_dir = Cwd::cwd();
  chdir($self->{path});
  my $file = PAR::Repository::DBM::DEPENDENCIES_DBM_FILE().'.zip';
  chdir($old_dir), return() if not -f $file;

  my ($hash, $tempfile) = $self->_open_dbm($file);
  chdir($old_dir), return() if not defined $hash;

  $self->{dependencies_dbm_hash} = $hash;
  $self->{dependencies_dbm_temp_file} = $tempfile;

  chdir($old_dir);

  return ($hash, $tempfile);
}



sub close_modules_dbm {
  my $self = shift;
  $self->verbose(2, 'Entering close_modules_dbm()');
  my $hash = $self->{modules_dbm_hash};
  return if not defined $hash;

  my $obj = tied($hash);
  $self->{modules_dbm_hash} = undef;
  undef $hash;
  undef $obj;

  $self->_zip_file(
      $self->{modules_dbm_temp_file},
      catfile($self->{path}, PAR::Repository::DBM::MODULES_DBM_FILE().'.zip'),
      PAR::Repository::DBM::MODULES_DBM_FILE(),
  );

  unlink $self->{modules_dbm_temp_file};
  $self->{modules_dbm_temp_file} = undef;

  return 1;
}



sub close_symlinks_dbm {
  my $self = shift;
  $self->verbose(2, 'Entering close_symlinks_dbm()');
  my $hash = $self->{symlinks_dbm_hash};
  return if not defined $hash;

  my $obj = tied($hash);
  $self->{symlinks_dbm_hash} = undef;
  undef $hash;
  undef $obj;

  $self->_zip_file(
      $self->{symlinks_dbm_temp_file},
      catfile($self->{path}, PAR::Repository::DBM::SYMLINKS_DBM_FILE().'.zip'),
      PAR::Repository::DBM::SYMLINKS_DBM_FILE(),
  );

  unlink $self->{symlinks_dbm_temp_file};
  $self->{symlinks_dbm_temp_file} = undef;

  return 1;
}


sub close_scripts_dbm {
  my $self = shift;
  $self->verbose(2, 'Entering close_scripts_dbm()');
  my $hash = $self->{scripts_dbm_hash};
  return if not defined $hash;

  my $obj = tied($hash);
  $self->{scripts_dbm_hash} = undef;
  undef $hash;
  undef $obj;

  $self->_zip_file(
      $self->{scripts_dbm_temp_file},
      catfile($self->{path}, PAR::Repository::DBM::SCRIPTS_DBM_FILE().'.zip'),
      PAR::Repository::DBM::SCRIPTS_DBM_FILE()
  );

  unlink $self->{scripts_dbm_temp_file};
  $self->{scripts_dbm_temp_file} = undef;

  return 1;
}



sub close_dependencies_dbm {
  my $self = shift;
  $self->verbose(2, 'Entering close_dependencies_dbm()');
  my $hash = $self->{dependencies_dbm_hash};
  return if not defined $hash;

  my $obj = tied($hash);
  $self->{dependencies_dbm_hash} = undef;
  undef $hash;
  undef $obj;

  $self->_zip_file(
      $self->{dependencies_dbm_temp_file},
      catfile($self->{path}, PAR::Repository::DBM::DEPENDENCIES_DBM_FILE().'.zip'),
      PAR::Repository::DBM::DEPENDENCIES_DBM_FILE(),
  );

  unlink $self->{dependencies_dbm_temp_file};
  $self->{dependencies_dbm_temp_file} = undef;

  return 1;
}



sub update_dbm_checksums {
  my $self = shift;
  $self->verbose(2, 'Entering update_dbm_checksums()');

  # find a working base64 MD5 implementation
  my $md5_function;
  eval { require Digest::MD5; $md5_function = \&Digest::MD5::md5_base64; };
  eval { require Digest::Perl::MD5;  $md5_function = \&Digest::Perl::MD5::md5_base64; } if $@;
  if ($@) {
    die "Could load neither Digest::MD5 nor Digest::Perl::MD5. Please upgrade your perl or install either of those modules.";
  }
  
  # Prepare temporary copy of the checkums file
  my ($tempfh, $tempfile) = File::Temp::tempfile(
      'temporary_dbm_checksum_XXXXX',
      UNLINK => 0,
      DIR    => File::Spec->tmpdir(),
  );
  print $tempfh <<'HERE';
# This checksums file has the format
# FILENAME BASE64_MD5_HASH
# where the file name and the MD5 hash are separated
# by a TAB character, not arbitrary whitespace!
HERE

  # calculate hashes and write them to the temp file
  foreach my $dbmfile (
      PAR::Repository::DBM::MODULES_DBM_FILE(),
      PAR::Repository::DBM::SCRIPTS_DBM_FILE(),
      PAR::Repository::DBM::SYMLINKS_DBM_FILE(),
      PAR::Repository::DBM::DEPENDENCIES_DBM_FILE(),
    ) {
    my $filepath = catfile($self->{path}, $dbmfile.'.zip');
    open my $fh, '<', $filepath or die "Could not open DBM file '$filepath' for reading: $!";
    flock $fh, LOCK_SH;
    local $/ = undef;
    my $hash = $md5_function->(<$fh>);
    close $fh;
    print $tempfh "$dbmfile.zip\t$hash\n";
  } # end foreach dbm files

  close $tempfh;
  # move temp file to destination
  my $target_file = catfile($self->{path}, PAR::Repository::DBM::DBM_CHECKSUMS_FILE());
  File::Copy::move($tempfile, $target_file)
    or die "Could not move checksums file '$tempfile' to '$target_file': $!";
  # FIXME, could this be done more user friendly? But somehow, the file ended up being 600 by default...
  chmod(0644, $target_file);

  return 1;
}



sub _open_dbm {
  my $self = shift;
  $self->verbose(2, 'Entering _open_dbm()');
  my $file = shift;
  my ($tempfh, $tempfile) = File::Temp::tempfile(
      'temporary_dbm_XXXXX',
      UNLINK => 0,
      DIR    => File::Spec->tmpdir(),
      EXLOCK => 0,
  );
  my ($v, $p, $f) = splitpath($file);
  $f =~ s/\.zip$//;
  $self->_unzip_file($file, $tempfile, $f) or return undef;
  my %hash;
  my $obj = tie %hash, "DBM::Deep", {
    file    => $tempfile,
    locking => 1,
  }; 

  return (\%hash, $tempfile);
}


sub _create_dbm {
  my $self = shift;
  $self->verbose(2, 'Entering _create_dbm()');
  my $file = shift;
  $file .= '.zip' unless $file =~ /\.zip$/i;

  my ($tempfh, $tempfile) = File::Temp::tempfile(
      'temporary_dbm_XXXXX',
      UNLINK => 0,
      DIR    => File::Spec->tmpdir(),
      EXLOCK => 0,
  );
  {
    my %hash;
    my $obj = tie %hash, "DBM::Deep", {
      file    => $tempfile,
      locking => 1,
    }; 
  }

  my ($v, $p, $f) = splitpath($file);
  $f =~ s/\.zip$//i;
  $self->_zip_file($tempfile, $file, $f) or unlink($tempfile), return();

  unlink($tempfile);

  return 1;
}

1;
__END__