Handle remote directory archives

* lib/SlackBuild/URI.pm: Switch to delegation technique.
* lib/SlackBuild/Archive.pm: New module.
* lib/SlackBuild/Archive/Extractor.pm: New module.
* lib/SlackBuild/Archive/Extractor/HTTP.pm: New module.
* lib/SlackBuild/Archive/Extractor/Tar.pm: New module.
* lib/SlackBuilder.pm: Use SlackBuild::Archive to download
and extract SlackBuild archives.

1 files changed, 51 insertions, 9 deletions

diff --git a/lib/SlackBuild/URI.pm b/lib/SlackBuild/URI.pm
index feac355..8556783 100644
--- a/lib/SlackBuild/URI.pm
+++ b/lib/SlackBuild/URI.pm
@@ -1,14 +1,31 @@
 package SlackBuild::URI;
-use URI;
-use parent 'URI';
 use strict;
 use warnings;
+use URI;
 use Carp;
 use LWP::UserAgent;
 # use LWP::Protocol::https;
 # use LWP::Protocol::file;
 # use LWP::Protocol::ftp;
 
+our $AUTOLOAD;
+
+sub AUTOLOAD {
+    my $self = shift;
+
+    # The Perl interpreter places the name of the
+    # message in a variable called $AUTOLOAD.
+
+    # DESTROY messages should never be propagated.
+    return if $AUTOLOAD =~ /::DESTROY$/;
+
+    # Remove the package name.
+    $AUTOLOAD =~ s/^.*:://;
+    
+    # Pass the message to the delegate.
+    return $self->{_uri}->$AUTOLOAD(@_);
+}
+
 sub _valid_scheme {
     my $scheme = shift->scheme;
     return eval { require "LWP/Protocol/$scheme.pm" }; 
@@ -16,14 +33,23 @@ sub _valid_scheme {
 
 sub new {
     my $class = shift;
-    my $uri = $class->SUPER::new(@_);
+    my $uri = new URI(@_);
     $uri->scheme('file') unless $uri->scheme;
-    my $self = bless $uri, $class;
-    croak "$self: invalid scheme"
+    my $self = bless { _uri => $uri }, $class;
+    croak "$self: unsupported scheme"
     	unless $self->_valid_scheme;
     return $self;
 }
 
+sub new_abs {
+    my ($self, $arg) = @_;
+    my $s = $self->as_string;
+    $s .= '/' unless $s =~ m{/$};
+    return new SlackBuild::URI($s . $arg);
+}
+
+use overload '""' => sub { shift->as_string };
+
 sub download {
     croak "bad number of arguments" unless @_ == 2;
     my ($self, $dst) = @_;
@@ -32,11 +58,27 @@ sub download {
     print "downloading $self to $dst\n";
     my $ua = LWP::UserAgent->new();
     my $response = $ua->get($self->as_string, ':content_file' => $dst);
-    if (wantarray) {
-	return ($response->is_success, $response->status_line);
-    } else {
-	return $response->is_success;
+    $self->download_response($response);
+    return $response->is_success;
+}
+
+sub download_response {
+    my $self = shift;
+    croak "too many arguments" if (@_ > 1);
+    if (my $v = shift) {
+	$self->{_response} = $v;
     }
+    return $self->{_response};
+}
+
+sub download_success {
+    my $self = shift;
+    return $self->download_response->is_success;
 }
 
+sub download_status {
+    my $self = shift;
+    return $self->download_response->status_line;
+}
+    
 1;