Merge pull request #31 from zmughal/fix/http-abs-uri

fix for repository paths that are not relative

lib/Alien/Base/ModuleBuild/File.pm

@@ -23,7 +23,7 @@ sub has_version {
 sub get {
   my $self = shift;
   my $filename = $self->filename;
-  $self->repository->get_file($filename);
+  $filename = $self->repository->get_file($filename);
   return $filename;
 }
 

lib/Alien/Base/ModuleBuild/Repository.pm

@@ -80,6 +80,7 @@ sub probe {
 # subclasses are expected to provide 
 sub connection { croak "$_[0] doesn't provide 'connection' method" }
 sub list_files { croak "$_[0] doesn't provide 'list_files' method" }
+# must return filename if different from the one passed in
 sub get_file  { croak "$_[0] doesn't provide 'get_files' method"  }
 
 1;

lib/Alien/Base/ModuleBuild/Repository/FTP.pm

@@ -48,7 +48,7 @@ sub get_file {
 
   $ftp->get( $file ) or croak "Download failed: " . $ftp->message();
 
-  return 1;
+  return $file;
 }
 
 sub list_files {

lib/Alien/Base/ModuleBuild/Repository/HTTP.pm

@@ -43,10 +43,12 @@ sub get_file {
   my $from = $self->location;
 
   my $uri = $self->build_uri($host, $from, $file);
+  # if it is an absolute URI, then use the filename from the URI
+  $file = ($uri->path_segments())[-1] if $file =~ /^http:/;
   my $response = $self->connection->mirror($uri, $file);
   croak "Download failed: " . $response->{reason} unless $response->{success};
 
-  return 1;
+  return $file;
 }
 
 sub list_files {
@@ -112,10 +114,13 @@ sub build_uri {
   my $self = shift;
   my ($host, $path, $file) = @_;
 
+  my $uri = URI->new($file);
+  return $uri if $uri->scheme; # if an absolute URI
+
   unless ( $host =~ m'^http://' ) {
     $host = "http://$host";
   }
-  my $uri = URI->new( $host );
+  $uri = URI->new( $host );
   return $uri unless defined $path;
 
   $path =~ s'/$'';

lib/Alien/Base/ModuleBuild/Repository/Local.pm

@@ -50,7 +50,7 @@ sub get_file  {
 
   copy $full_file, $CWD;
 
-  return 1;
+  return $file;
 }
 
 1;

t/http_uri.t

@@ -32,5 +32,15 @@ my $repo = Alien::Base::ModuleBuild::Repository::HTTP->new;
   is $uri, 'http://host.com/path/file.ext', 'file with path';
 }
 
+{
+  my $uri = $repo->build_uri('host.com/', '/path/', 'http://host.com/other/file.ext');
+  is $uri, 'http://host.com/other/file.ext', 'absolute URI found in link';
+}
+
+{
+  my $uri = $repo->build_uri('host.com/', '/path/', 'http://example.org/other/file.ext');
+  is $uri, 'http://example.org/other/file.ext', 'absolute URI on different host';
+}
+
 done_testing;