view release on metacpan or  search on metacpan

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

  my $ret = eval { $pkg->$action( $options, @argv ) || 0; };
  chdir $orig_dir;

  if ( !defined $ret )
  {
    error($@);
    return -1;
  }

  return $ret;
}

sub _git_str
{
  state $_git_str;

  if ( !defined $_git_str )
  {
    $_git_str = '';
    my $git_version_str = eval { run(qw/git --version/); };
    if ( defined $git_version_str )
    {
      ($_git_str) = $git_version_str =~ m/git version (\d+[.]\d+[.]\d+)/;
    }
  }

  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' );

  if ( !$can_https )
  {
    return qw/lwp httptiny httplite/;
  }

  return ();
}

sub can_https
{
  state $can_https;

  # track the blacklist for testing
  state $ff_blacklist;
  undef $can_https
    if $File::Fetch::BLACKLIST ne $ff_blacklist;

  if ( !defined $can_https )
  {
    my $test_url = 'https://get.mechacpan.us/latest';
    my $test_str = '';

    local $File::Fetch::WARN;
    local $@;

    my $ff = File::Fetch->new( uri => $test_url );
    return 0
      if !defined $ff;

    $ff_blacklist = $File::Fetch::BLACKLIST;

    # Make sure not to use methods that can't handle https
    local $File::Fetch::BLACKLIST = [ @$ff_blacklist, _https_blacklist ];
    $ff->scheme('http');
    $can_https = defined $ff->fetch( to => \$test_str );
  }

  return $can_https;
}

sub url_re
{
  state $url_re = qr[
    ^
    (?: ftp | http | https | file )
    : //
  ]xmsi;
  return $url_re;
}

sub git_re
{
  state $git_re = qr[
    ^ (?: git | ssh ) : [^:]
    |
    [.]git (?: @|$ )
  ]xmsi;
  return $git_re;
}