File Coverage

blib/lib/PAR/Repository/Client/Local.pm

Criterion	Covered	Total	%
statement	67	82	81.7
branch	13	26	50.0
condition	4	9	44.4
subroutine	11	11	100.0
pod	2	2	100.0
total	97	130	74.6

package PAR::Repository::Client::Local;

use 5.006;
use strict;
use warnings;

use base 'PAR::Repository::Client';

use Carp qw/croak/;
require File::Copy;

our $VERSION = '0.24';

=head1 NAME

PAR::Repository::Client::Local - PAR repo. on the local file system

=head1 SYNOPSIS

  use PAR::Repository::Client;

  my $client = PAR::Repository::Client->new(
    uri => 'file:///foo/repository',
  );

=head1 DESCRIPTION

This module implements repository accesses on the local filesystem.

If you create a new L object and pass it
an uri parameter which starts with C or just a path,
it will create an object of this class. It inherits from
C.

=head2 EXPORT

None.

=head1 METHODS

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

=cut

=head2 fetch_par

Fetches a .par distribution from the repository and stores it
locally. Returns the name of the local file or the empty list on
failure.

First argument must be the distribution name to fetch.

=cut

sub fetch_par {
  my $self = shift;
  $self->{error} = undef;
  my $dist = shift;
  if (not defined $dist) {
    $self->{error} = "undef passed as argument to fetch_par()";
    return();
  }

  my $path = $self->{uri};
  $path =~ s/(?:\/|\\)$//;
  $path =~ s!^file://!!i;

  my ($dname, $vers, $arch, $perl) = PAR::Dist::parse_dist_name($dist);
  my $file = File::Spec->catfile(
    File::Spec->catdir($path, $arch, $perl),
    "$dname-$vers-$arch-$perl.par"
  );

  if (not -f $file) {
    $self->{error} = "Could not find distribution in local repository at '$file'";
    return();
  }

  return $file;
}

=head2 validate_repository

Makes sure the repository is valid. Returns the empty list
if that is not so and a true value if the repository is valid.

Checks that the repository version is compatible.

The error message is available as C<$client->error()> on
failure.

=cut

sub validate_repository {
  my $self = shift;
  $self->{error} = undef;

  my $mod_db = $self->modules_dbm;

  return() unless defined $mod_db;

  return() unless $self->validate_repository_version;

  return 1;
}

=head2 _repository_info

Returns a YAML::Tiny object representing the repository meta
information.

This is a private method.

=cut

sub _repository_info {
  my $self = shift;
  $self->{error} = undef;
  return $self->{info} if defined $self->{info};

  my $path = $self->{uri};
  $path =~ s/(?:\/|\\)$//;
  $path =~ s!^file://!!i;

  my $file = File::Spec->catfile($path, PAR::Repository::Client::REPOSITORY_INFO_FILE());

  if (not defined $file or not -f $file) {
    $self->{error} = "File '$file' does not exist in repository.";
    return();
  }

  my $yaml = YAML::Tiny->new->read($file);
  if (not defined $yaml) {
    $self->{error} = "Error reading repository info from YAML file.";
    return();
  }

  # workaround for possible YAML::Syck/YAML::Tiny bug
  # This is not the right way to do it!
  @$yaml = ($yaml->[1]) if @$yaml > 1;
  $self->{info} = $yaml;
  return $yaml;
}

=head2 _fetch_dbm_file

This is a private method.

Fetches a dbm (index) file from the repository and
returns the name of the local file or the
empty list on failure.

An error message is available via the C
method in case of failure.

=cut

sub _fetch_dbm_file {
  my $self = shift;
  $self->{error} = undef;
  my $file = shift;
  return if not defined $file;

  my $path = $self->{uri};
  $path =~ s/(?:\/|\\)$//;
  $path =~ s!^file://!!i;

  my $url = File::Spec->catfile( $path, $file );

  if (not -f $url) {
    $self->{error} = "Could not find dbm file in local repository at '$url'";
    return();
  }

  my ($tempfh, $tempfile) = File::Temp::tempfile(
    'temp_zip_dbm_XXXXX',
    UNLINK => 1, # because we cache the suckers by default
    DIR => $self->{cache_dir},
    EXLOCK => 0, # FIXME no exclusive locking or else we block on BSD. What's the right solution?
  );

  File::Copy::copy($url, $tempfile);

  return $tempfile;
}



=head2 _dbm_checksums

This is a private method.

If the repository has a checksums file (new feature of
C 0.15), this method returns a hash
associating the DBM file names (e.g. C)
with their MD5 hashes (base 64).

This method B queries the repository and never caches
the information locally. That's the whole point of having the
checksums.

In case the repository does not have checksums, this method
returns the empty list, so check the return value!
The error message (see the C method) will be
I<"Repository does not support checksums"> in that case.

=cut

sub _dbm_checksums {
  my $self = shift;
  $self->{error} = undef;

  my $path = $self->{uri};
  $path =~ s/(?:\/|\\)$//;
  $path =~ s!^file://!!i;

  # if we're running on a "trust-the-checksums-for-this-long" basis...
  # ... return if the timeout hasn't elapsed
  if ($self->{checksums} and $self->{checksums_timeout}) {
    my $time = time();
    if ($time - $self->{last_checksums_refresh} < $self->{checksums_timeout}) {
      return($self->{checksums});
    }
  }

  my $file = File::Spec->catfile($path, PAR::Repository::Client::DBM_CHECKSUMS_FILE());

  if (not defined $file or not -f $file) {
    $self->{error} = "Repository does not support checksums";
    return();
  }

  return $self->_parse_dbm_checksums($file);
}


=head2 _init

This private method is called by the C method of
L. It is used to initialize
the client object and C passes it a hash ref to
its arguments.

Should return a true value on success.

=cut

sub _init {
  # We implement additional object attributes here
  # Currently no extra attributes...
  return 1;
}


1;
__END__