Fix prerequisite search

* lib/SlackBuild/Archive.pm: Add changes pertaining to 17b5bf54.
* slackbuilder: Likewise.
* lib/SlackBuilder.pm: Likewise.
(new): Don't use host's uname to get architecture name.
(ospkgdir,os_release,os_probe): New methods.

8 files changed, 105 insertions, 169 deletions

diff --git a/.gitignore b/.gitignore
index 0e4670f..063f4c1 100644
--- a/.gitignore
+++ b/.gitignore
@@ -13 +13,3 @@ core
 /Makefile
+/blib
+/pm_to_blib
diff --git a/Makefile.PL b/Makefile.PL
index 90614b3..64e1ba8 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -12,9 +12,9 @@ WriteMakefile(NAME => 'slackbuilder',
 	      PREREQ_PM    => {
-		  HTML::Parser => '3.72',
-		  LWP::UserAgent => '6.29',
-		  List::Regexp => '1.03',
-		  POSIX::Run::Capture => 0,
-		  Scalar::Util => 0,
-		  URI => 0,
-		  JSON => 0
+		  'HTML::Parser' => '3.72',
+		  'LWP::UserAgent' => '6.29',
+		  'List::Regexp' => '1.03',
+		  'POSIX::Run::Capture' => 0,
+		  'Scalar::Util' => 0,
+		  'URI' => 0,
+		  'JSON' => 0
       	      },
diff --git a/lib/SlackBuild/Archive.pm b/lib/SlackBuild/Archive.pm
index 83001f5..2f3663e 100644
--- a/lib/SlackBuild/Archive.pm
+++ b/lib/SlackBuild/Archive.pm
@@ -5,2 +5,3 @@ use parent 'SlackBuild::URI';
 use SlackBuild::Archive::Extractor;
+use SlackBuild::Info;
 use File::Temp qw/ tempfile tempdir /;
@@ -79,14 +80,3 @@ sub _read_info {
     return unless $self->has_file($info);
-    open(my $fd, '<', File::Spec->catfile($dst, $info))
-	or return;
-    my %info;
-    while (<$fd>) {
-	chomp;
-	s/^\s+//;
-	next if /^(#.*)?$/;
-	return unless /^(?<kw>[A-Za-z_][A-Za-z_0-9]*)="(?<val>.*)"$/;
-	$info{$+{kw}} = $+{val};
-    }
-    close $fd;
-    $self->{_info} = \%info;
+    $self->{_info} = new SlackBuild::Info(File::Spec->catfile($dst, $info));
 }
@@ -94,5 +84,4 @@ sub _read_info {
 sub info {
-    my ($self, $kw) = @_;
-    return undef unless exists $self->{_info};
-    return $self->{_info}{$kw};
+    my ($self) = @_;
+    return $self->{_info} ||= new SlackBuild::Info;
 }
diff --git a/lib/SlackBuilder.pm b/lib/SlackBuilder.pm
index 688a697..ff3ade4 100644
--- a/lib/SlackBuilder.pm
+++ b/lib/SlackBuilder.pm
@@ -47,4 +47,2 @@ sub new {
 
-    $self->{_arch} = (uname)[4];
-    
     $self->clear;
@@ -59,2 +57,6 @@ sub logdir   { shift->{_logdir} };
 sub pkgdir   { shift->{_pkgdir} };
+sub ospkgdir {
+    my $self = shift;
+    File::Spec->catfile($self->pkgdir, $self->osversion, @_);
+}
 sub image    { shift->{_image} };
@@ -98,69 +100,3 @@ sub clear {
 
-my %kws = (
-    package => {
-	mandatory => 1,
-	set => \&package_name
-    },
-    version => {
-	mandatory => 1,
-	set => \&package_version
-    },
-    build => {
-	mandatory => 0,
-	set => \&package_build
-    },
-    slackbuild_uri => {
-	mandatory => 1,
-	set => \&slackbuild_uri
-    },
-    source_uri => {
-	mandatory => 0,
-	set => sub {
-	    my ($self, $v) = @_;
-	    $self->source_uri(new SlackBuild::URI($v));
-	}
-    },
-    source_archive_name => {
-	mandatory => 0,
-	set => \&source_archive_name
-    },
-    prereq => {
-	mandatory => 0,
-	set => sub {
-	    my ($self, $v) = @_;
-	    if (ref($v) ne 'ARRAY') {
-		$self->error("prereq: bad data type");
-	    } else {
-		$self->prereq($v);
-	    }
-	}
-    },
-    rc => {
-	mandatory => 0,
-	set => \&rc
-    }
-);
-
-my @ATTRIBUTES = qw(package_name
-                    package_version
-                    package_build
-                    rc
-                    slackbuild_uri
-                    source_uri);
-{
-    no strict 'refs';
-    use feature 'state';
-    foreach my $attr (@ATTRIBUTES) {
-	*{ __PACKAGE__ . '::' . $attr } = sub {
-	    my $self = shift;
-	    croak "too many arguments" if @_ > 1;
-	    if (my $v = shift) {
-		$self->{_request}{$attr} = $v;
-	    }
-	    return $self->{_request}{$attr};
-	}
-    }
-}
-
-sub prereq {
+sub request {
     my $self = shift;
@@ -168,17 +104,14 @@ sub prereq {
     if (my $v = shift) {
-	$self->{_request}{prereq} = $v;
+	$self->{_request} = $v;
     }
-    $self->{_request}{prereq} = [] unless exists $self->{_request}{prereq};
-    return $self->{_request}{prereq};
+    return $self->{_request};
 }
 
-sub request_environ {
-    my $self = shift;
-    croak "too many arguments" if @_ > 1;
-    if (my $v = shift) {
-	$self->{_request}{environ} = $v;
-    }
-    $self->{_request}{environ} = {} unless exists $self->{_request}{environ};
-    return $self->{_request}{environ};
-}
+sub package_name { shift->request->package }
+sub package_version { shift->request->version }
+sub package_build { shift->request->build }
+sub rc { shift->request->rc }
+sub slackbuild_uri { shift->request->slackbuild_uri }
+sub source_uri { shift->request->source_uri }
+sub prereq { shift->request->prereq || []}
 
@@ -186,3 +119,3 @@ sub environ {
     my $self = shift;
-    my $env = {%{$self->request_environ},
+    my $env = {%{$self->request->environ // {}},
 	       VERSION => $self->package_version};
@@ -197,3 +130,3 @@ sub file {
     my $src = File::Spec->catfile($self->tmpdir, $name);
-    my $dst = File::Spec->catfile($self->pkgdir, $self->osversion, $name);
+    my $dst = $self->ospkgdir($name);
 
@@ -215,14 +148,43 @@ sub file {
     }
-    push @{$self->{_result}{output_files}}, $name;
+    push @{$self->{_result}{output_files}}, $dst;
 }
 
-sub osversion {
+sub os_probe {
     my $self = shift;
-    croak "too many arguments" if @_ > 1;
-    if (my $v = shift) {
-	$self->{_osversion} = $v;
+
+    unless (exists($self->{_os_release})) {
+	my @args = ( 'docker',
+		     'run',
+		     '--rm=true',
+		     $self->image,
+		     '/bin/sh',
+		     '-c',
+		     'uname -m; cat /etc/os-release' );
+
+	my $obj = new POSIX::Run::Capture(argv => \@args);
+	if ($obj->run) {
+	    $self->_runcap_diag($obj);
+	} else {
+	    $self->error("can't run docker: ".strerror($obj->errno));
+	    return $self->errno(E_EXEC);
+	}
+	$obj->rewind(SD_STDOUT);
+	chomp($self->{_arch} = $obj->next_line(SD_STDOUT));
+	while (my $s = $obj->next_line(SD_STDOUT)) {
+	    chomp($s);
+	    my ($name,$value)=split /=/, $s, 2;
+	    $value =~ s/^"(.*)"\s*$/$1/;
+	    $self->{_os}{$name} = $value;
+	}
     }
-    return $self->{_osversion} // "UNKNOWN";
+    return E_OK;
 }
 
+sub os_release {
+    my ($self, $value) = @_;
+    return $self->{_os}{$value};
+}
+
+sub osversion { shift->os_release('VERSION') }
+
 sub output_files {
@@ -251,41 +213,12 @@ sub slackbuild_name {
 
-sub source_archive_name {
-    my $self = shift;
-    croak "too many arguments" if @_ > 1;
-    if (my $v = shift) {
-	$self->{_request}{source_archive_name} = $v;
-    }
-    my $res;
-    if (exists($self->{_request}{source_archive_name})) {
-	$res = $self->{_request}{source_archive_name};
-    } else {
-	$res = basename($self->source_uri->path);
-    }
-    return File::Spec->catfile($self->wd, $res);
-}	
-    
 sub run {
-    my $self = shift;
-    my %args;
-    if (@_ == 1) {
-	my $var = shift;
-	%args = %{$var};
-    } else {
-	%args = @_;
-    }
+    my ($self, $req) = @_;
 
     $self->clear;
-    while (my ($k,$d) = each %kws) {
-	my $v = delete $args{$k};
-	if (defined($v)) {
-	    $self->${\ $d->{set}}($v);
-	} elsif ($d->{mandatory}) {
-	    $self->error("$k: not present");
-	}
+    unless ($req->package) {
+	$self->error("package: not present");
     }
-
-    foreach my $k (keys %args) {
-	$self->error("$k: unknown parameter");
+    unless ($req->slackbuild_uri) {
+	$self->error("slackbuild_uri: not present");
     }
-    
     if ($self->errors) {
@@ -293,2 +226,4 @@ sub run {
     }
+    
+    $self->request($req);
 
@@ -303,12 +238,6 @@ sub run {
 
-    if ($self->source_uri) {
-	unless ($self->source_uri->download($self->source_archive_name)) {
-	    $self->error("can't download "
-			 . $self->source_archive_name
-			 . ": "
-			 . $self->source_uri->download_status);
-	    return $self->errno(E_FAIL);
-	}
-    } elsif (my $d = $archive->info('DOWNLOAD')) {
-	foreach my $s (split /\s+/, $d) {
+    $self->request->addinfo($archive->info);
+
+    if (my $urilist = $self->request->source_uri) {
+	foreach my $s (@$urilist) {
 	    my $uri = new SlackBuild::URI($s);
@@ -363,3 +292,3 @@ sub _prepare {
     # FIXME: registry type should be configurable
-    my $reg = new SlackBuild::Registry('FS', dir => $self->pkgdir);
+    my $reg = new SlackBuild::Registry('FS', dir => $self->ospkgdir);
 
@@ -372,4 +301,6 @@ sub _build {
     my $self = shift;
+    
+    $self->os_probe;
     return $self->errno if $self->errno;
-
+    
     my $contname = $self->package_name . '_slackbuild';
@@ -382,3 +313,3 @@ sub _build {
 		 '-v', $self->tmpdir . ':/tmp',
-		 '-v', $self->pkgdir . ':/var/pkg:ro',
+		 '-v', $self->ospkgdir . ':/var/pkg:ro',
 		 $self->image,
@@ -388,3 +319,7 @@ sub _build {
 
-    print "building ".$self->package_name."\n";
+    printf("building %s on %s version %s (%s)\n",
+	   $self->package_name,
+	   $self->os_release('NAME'),
+	   $self->os_release('VERSION'),
+	   $self->arch);
 
@@ -423,5 +358,3 @@ sub _build {
 	chomp($s);
-	if ($s =~ s{^SLACKBUILDER: VERSION }{}) {
-	    $self->osversion($s);
-	} elsif ($s =~ m{^Slackware package /tmp/(.+?) created}) {
+	if ($s =~ m{^Slackware package /tmp/(.+?) created}) {
 	    $self->file($1);
diff --git a/slackbuilder b/slackbuilder
index c987d54..bf4c081 100644
--- a/slackbuilder
+++ b/slackbuilder
@@ -3,3 +3,2 @@ use strict;
 use warnings;
-use JSON;
 use Data::Dumper;
@@ -11,2 +10,4 @@ use Unix::Sysexits;
 use SlackBuilder;
+use SlackBuild::Request;
+use JSON;
 
@@ -40,3 +41,3 @@ sub readfile {
     close $fd;
-    return $string;
+    return decode_json($string);
 }
@@ -60,7 +61,18 @@ GetOptions("h" => sub {
 abend(EX_USAGE, "bad number of arguments") unless @ARGV == 1;
+my $reqname = shift @ARGV;
+my $req;
 
-my $text = readfile($ARGV[0]);
+unless (-f $reqname) {
+    if ($reqname =~ m{(?:http|ftp)s?://.*/
+                      (.+?) \.tar(?:\.(?:[xgl]z|bz2))?}x) {
+	$req = { package => $1, slackbuild_uri => $reqname };
+    } else {
+	abend(EX_NOINPUT, "request file $reqname does not exist");
+    }
+} else {
+    $req = readfile($reqname);
+}
 
 my $builder = new SlackBuilder(%sbargs);
-$builder->run(decode_json($text));
+$builder->run(new SlackBuild::Request($req));
 if ($builder->is_success) {
diff --git a/t/regrec.t b/t/regrec.t
index 6035c49..f50ba44 100644
--- a/t/regrec.t
+++ b/t/regrec.t
@@ -1,3 +1,3 @@
 # -*- perl -*-
-use lib 't';
+use lib qw(t lib);
 use strict;
diff --git a/t/vercmp.t b/t/vercmp.t
index 54b1c80..327e2f1 100644
--- a/t/vercmp.t
+++ b/t/vercmp.t
@@ -1,3 +1,3 @@
 # -*- perl -*-
-use lib 't';
+use lib qw(t lib);
 use strict;
diff --git a/t/version.t b/t/version.t
index 26c7d3e..804bedb 100644
--- a/t/version.t
+++ b/t/version.t
@@ -1,3 +1,3 @@
 # -*- perl -*-
-use lib 't';
+use lib qw(t lib);
 use strict;