File Coverage

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

Criterion	Covered	Total	%
statement	42	53	79.2
branch	10	20	50.0
condition	1	3	33.3
subroutine	6	8	75.0
pod	0	1	0.0
total	59	85	69.4

package PAR::Repository::Client::Util;

use 5.006;
use strict;
use warnings;

our $VERSION = '0.24';

use Carp qw/croak/;

=head1 NAME

PAR::Repository::Client::Util - Small helper methods common to all implementations

=head1 SYNOPSIS

  use PAR::Repository::Client;

=head1 DESCRIPTION

This module implements small helper methods which are common to all
L implementations.

=head1 PRIVATE METHODS

These private methods should not be relied upon from the outside of
the module.

=head2 _unzip_file

This is a private method. Callable as class or instance method.

Unzips the file given as first argument to the file
given as second argument.
If a third argument is used, the zip member of that name
is extracted. If the zip member name is omitted, it is
set to the target file name.

Returns the name of the unzipped file.

=cut

sub _unzip_file {
  my $class = shift;
  my $file = shift;
  my $target = shift;
  my $member = shift;
  $member = $target if not defined $member;
  return unless -f $file;

  my $zip = Archive::Zip->new;
  local %SIG;
  $SIG{__WARN__} = sub { print STDERR $_[0] unless $_[0] =~ /\bstat\b/ };

  return unless $zip->read($file) == Archive::Zip::AZ_OK()
    and $zip->extractMember($member, $target) == Archive::Zip::AZ_OK();

  return $target;
}


# given a distribution name, recursively determines all distributions
# it depends on
sub _resolve_static_dependencies {
  my $self = shift;
  my $distribution = shift;

  my ($deph) = $self->dependencies_dbm();
  return([]) if not exists $deph->{$distribution};

  my ($modh) = $self->modules_dbm();

  my @module_queue = (keys %{$deph->{$distribution}});
  my @dep_dists;
  my %module_seen;
  my %dist_seen;

  while (@module_queue) {
    #use Data::Dumper; warn Dumper \@module_queue;
    my $module = shift @module_queue;
    next if $module_seen{$module}++;
    next if not exists $modh->{$module}; # FIXME should this be somehow reported?
    my $dist = $self->prefered_distribution($module, $modh->{$module});
    next if not defined $dist;
    next if $dist_seen{$dist}++;
    push @dep_dists, $dist;
    push @module_queue, keys %{$deph->{$dist}} if exists $deph->{$dist};
  }

  return \@dep_dists;
}

sub generate_private_cache_dir {
  my $self = shift;
  my $uri = $self->{uri};
  my $digester = PAR::SetupTemp::_get_digester(); # requires PAR 0.987!
  $digester->add($uri);
  my $digest = $digester->b64digest();
  $digest =~ s/\W/_/g;
  my $user_temp_dir = PAR::SetupTemp::_get_par_user_tempdir();
  my $priv_cache_dir = File::Spec->catdir($user_temp_dir, "par-repo-$digest");
  return $priv_cache_dir;
}

1;
__END__