PAR::Repository::Client::HTTP - PAR repository via HTTP

  use PAR::Repository::Client;

  my $client = PAR::Repository::Client->new(
    uri => 'http:///foo/repository',
    http_timeout => 20, # but default is 180s
  );

package PAR::Repository::Client::HTTP;

use 5.006;
use strict;
use warnings;

use vars qw/$ua/;
require LWP::Simple;
LWP::Simple->import('$ua');

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

use Carp qw/croak/;

our $VERSION = '0.24';

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

  my $url = $self->{uri};
  $url =~ s/\/$//;

  my ($n, $v, $a, $p) = PAR::Dist::parse_dist_name($dist);
  $url .= "/$a/$p/$n-$v-$a-$p.par";

  my $file = $self->_fetch_file($url);

  if (not defined $file) {
    $self->{error} = "Could not fetch distribution from URI '$url'";
    return();
  }

  return $file;
}


{
  my %escapes;
  sub _fetch_file {
    my $self = shift;
    $self->{error} = undef;
    my $file = shift;
    #warn "FETCHING FILE: $file";

    my $cache_dir = $self->{cache_dir}; # used to be PAR_TEMP, but now configurable
    %escapes = map { chr($_) => sprintf("%%%02X", $_) } 0..255 unless %escapes;

    $file =~ m!/([^/]+)$!;
    my $local_file = (defined($1) ? $1 : $file);
    $local_file =~ s/([^\w\._])/$escapes{$1}/g;
    $local_file = File::Spec->catfile( $self->{cache_dir}, $local_file );

    my $timeout = $self->{http_timeout};
    my $old_timeout = $ua->timeout();
    $ua->timeout($timeout) if defined $timeout;
    my $rc = LWP::Simple::mirror( $file, $local_file );
    $ua->timeout($old_timeout) if defined $timeout;
    if (!LWP::Simple::is_success($rc) and not $rc == HTTP::Status::RC_NOT_MODIFIED()) {
      $self->{error} = "Error $rc: " . LWP::Simple::status_message($rc) . " ($file)\n";
      return();
    }

    return $local_file if -f $local_file;
    return();
  }
}


sub _fetch_as_data {
  my $self = shift;
  $self->{error} = undef;
  my $file = shift;
  #warn "FETCHING DATA: $file";

  my $timeout = $self->{http_timeout};
  my $old_timeout = $ua->timeout();
  $ua->timeout($timeout) if defined $timeout;
  my $data = LWP::Simple::get( $file );
  $ua->timeout($old_timeout) if defined $timeout;

  return $data if defined $data;

  $self->{error} = "Could not get '$file' from repository";
  return();
}

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

  my $mod_db = $self->modules_dbm;
  return() if not defined $mod_db;

  return() if not $self->validate_repository_version;

  return 1;
}

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

  my $url = $self->{uri};
  $url =~ s/\/$//;

  my $file = $self->_fetch_file(
    $url.'/'.PAR::Repository::Client::REPOSITORY_INFO_FILE()
  );

  return() if not defined $file;

  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;
}

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

  my $url = $self->{uri};
  $url =~ s/\/$//;

  my $local = $self->_fetch_file("$url/$file");
  return() if not defined $local or not -f $local;

  return $local;
}

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

  my $url = $self->{uri};
  $url =~ s/\/$//;

  # 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 $data = $self->_fetch_as_data(
    $url.'/'.PAR::Repository::Client::DBM_CHECKSUMS_FILE()
  );

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

  return $self->_parse_dbm_checksums(\$data);
}

sub _init {
  my $self = shift;
  my $args = shift || {};
  # We implement additional object attributes here
  $self->{http_timeout} = $args->{http_timeout};
  $self->{http_timeout} = 180 if not defined $self->{http_timeout};

  return 1;
}



1;
__END__