App-MechaCPAN

 view release on metacpan or  search on metacpan

lib/App/MechaCPAN.pm  view on Meta::CPAN

use File::Fetch;
use File::Spec qw//;
use Getopt::Long qw//;

use Exporter qw/import/;

BEGIN
{
  our @EXPORT_OK = qw/
    url_re git_re git_extract_re
    has_git has_updated_git min_git_ver
    can_https
    logmsg info success error
    dest_dir get_project_dir
    fetch_file inflate_archive
    humane_tmpname humane_tmpfile humane_tmpdir
    parse_cpanfile
    run restart_script
    rel_start_to_abs
    /;
  our %EXPORT_TAGS = ( go => [@EXPORT_OK] );

lib/App/MechaCPAN.pm  view on Meta::CPAN

  }

  return $_git_str;
}

sub min_git_ver
{
  return '1.7.7';
}

sub has_updated_git
{
  my $git_version_str = _git_str;
  if ($git_version_str)
  {
    use version 0.77;
    if ( version->parse($git_version_str) >= version->parse(min_git_ver) )
    {
      return 1;
    }
  }

  return;
}

sub has_git
{
  return _git_str && has_updated_git;
}

# Give a list of https-incapable File::Fetch methods when https is unavailable
sub _https_blacklist
{
  require Module::Load::Conditional;

  state $can_https
    = Module::Load::Conditional::can_load( modules => 'IO::Socket::SSL' );

lib/App/MechaCPAN/Install.pm  view on Meta::CPAN

    return $src;
  }

  my $url;

  # git
  if ( $src =~ git_re )
  {
    my $min_git_ver = min_git_ver;
    croak "System has git version < $min_git_ver, cannot retrieve git URL"
      unless has_updated_git;

    croak "System does not have git, cannot retrieve git URL"
      unless has_git;

    my ( $git_url, $commit ) = $src =~ git_extract_re;
    my ($descr) = $git_url =~ m{ ([^/]*) $}xms;

    my $dir  = humane_tmpdir($descr);
    my $fh   = humane_tmpfile($descr);
    my $file = $fh->filename;

t/gh6_git_min_ver.t  view on Meta::CPAN

my $above_git = &App::MechaCPAN::min_git_ver + 1;
my $below_git = &App::MechaCPAN::min_git_ver - 1;

{
  no strict 'refs';
  no warnings 'redefine';
  local *App::MechaCPAN::_git_str = sub {$above_git};

  is( &App::MechaCPAN::has_git, 1, 'A newer git is allowed' );

  is( &App::MechaCPAN::has_updated_git, 1, 'has_updated_git reports correctly' );
}

{
  no strict 'refs';
  no warnings 'redefine';
  local *App::MechaCPAN::_git_str = sub {$below_git};

  is( &App::MechaCPAN::has_git, undef, 'A older git is not allowed' );

  is( &App::MechaCPAN::has_updated_git, undef, 'has_updated_git prevents an older version' );
}

{
  no strict 'refs';
  no warnings 'redefine';
  local *App::MechaCPAN::min_git_ver = sub {$above_git};

  is( &App::MechaCPAN::has_git, undef, 'Can make it look like git is not new enough' );

  is( &App::MechaCPAN::has_updated_git, undef, 'has_updated_git reports the version outdatedness' );
}

is( &App::MechaCPAN::has_git, 1, 'Can go back to the built in min_git_ver without any caching' );

done_testing;