view release on metacpan or  search on metacpan

sa-update.raw  view on Meta::CPAN

  while (($number_of_bytes = $file->read($buffer, 16384)) > 0) {
    $content .= $buffer;
  }
  if (!defined $number_of_bytes) {
    dbg("read_content: Error reading from file $file_name: $!");
    return undef; ## no critic (ProhibitExplicitReturnUndef)
  }
  $file->close;

  return $content;
}

##############################################################################

# choose a random integer between 0 and the total weight of all mirrors
# loop through the mirrors from largest to smallest weight
# if random number is < largest weight, use it
# otherwise, random number -= largest, remove mirror from list, try again
# eventually, there'll just be 1 mirror left in $mirrors[0] and it'll be used
# 
sub choose_mirror {
  my($mirror_list) = @_;

  # Sort the mirror list by reverse weight (largest first)
  my @mirrors = sort { $mirror_list->{$b}->{weight} <=> $mirror_list->{$a}->{weight} } keys %{$mirror_list};

  return unless @mirrors;

  if (keys %{$mirror_list} > 1) {
    # Figure out the total weight
    my $weight_total = 0;
    foreach (@mirrors) {
      $weight_total += $mirror_list->{$_}->{weight};
    }

    # Pick a random int
    my $value = int(rand($weight_total));

    # loop until we find the right mirror, or there's only 1 left
    while (@mirrors > 1) {
      if ($value < $mirror_list->{$mirrors[0]}->{weight}) {
        last;
      }
      $value -= $mirror_list->{$mirrors[0]}->{weight};
      shift @mirrors;
    }
  }

  return $mirrors[0];
}

##############################################################################

sub check_mirror_af {
    my ($mirror) = @_;
    # RFC 3986:  scheme = ALPHA *( ALPHA / DIGIT / "+" / "-" / "." )
    $mirror =~ s{^([a-z][a-z0-9.+-]*)://}{}si;  # strip scheme like http://
    my $scheme = lc($1);
    # No DNS check needed for proxied connections (caveat: no_proxy is not checked)
    my $http_proxy = (defined $ENV{"http_proxy"} && $ENV{"http_proxy"} =~ /\S/) ||
                     (defined $ENV{"HTTP_PROXY"} && $ENV{"HTTP_PROXY"} =~ /\S/);
    my $https_proxy = (defined $ENV{"https_proxy"} && $ENV{"https_proxy"} =~ /\S/) ||
                      (defined $ENV{"HTTPS_PROXY"} && $ENV{"HTTPS_PROXY"} =~ /\S/);
    return 1 if $scheme eq "http" && $http_proxy;
    return 1 if $scheme eq "https" && $https_proxy;
    # No DNS check needed for IPv4 or IPv6 address literal
    return 1 if $use_inet4 && $mirror =~ m{^\d+\.\d+\.\d+\.\d+(?:[:/]|$)};
    return 1 if $use_inet6 && $mirror =~ m{^\[};
    $mirror =~ s{[:/].*}{}s;  # strip all starting from :port or /path
    return 1 if $use_inet4 && do_dns_query($mirror, "A");
    return 1 if $use_inet6 && do_dns_query($mirror, "AAAA");
    return 0;
}

##############################################################################

sub print_version {
  printf("sa-update version %s\n  running on Perl version %s\n", $VERSION, 
         join(".", map( 0+($_||0), ( $] =~ /(\d)\.(\d{3})(\d{3})?/ ))));
}

##############################################################################

sub print_usage_and_exit {
  my ( $message, $exitval ) = @_;
  $exitval ||= 64;
  
  if ($exitval == 0) {
    print_version();
    print("\n");
  }
  pod2usage(
    -verbose => 0,
    -message => $message,
    -exitval => $exitval,
  );
}

##############################################################################

sub usage {
  my ( $verbose, $message ) = @_;
  print "sa-update version $VERSION\n";
  pod2usage( -verbose => $verbose, -message => $message, -exitval => 64 );
}

##############################################################################

sub interpolate_gpghomedir {
  my $gpghome = '';
  if ($opt{'gpghomedir'}) {
    $gpghome = $opt{'gpghomedir'};
    if (am_running_on_windows()) {
      # windows is single-quote-phobic; bug 4958 cmt 7
      $gpghome =~ s/\"/\\\"/gs;
      $gpghome = "--homedir=\"$gpghome\"";
    } else {
      $gpghome =~ s/\'/\\\'/gs;
      $gpghome = "--homedir='$gpghome'";
    }
  }