summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--lib/SlackBuild/Request.pm108
-rw-r--r--lib/SlackBuild/Request/Auto.pm106
-rw-r--r--lib/SlackBuild/Request/Loader/dir.pm21
-rw-r--r--lib/SlackBuild/Request/Loader/file.pm25
-rw-r--r--lib/SlackBuild/Request/Loader/sbo.pm15
-rw-r--r--lib/SlackBuild/Request/Loader/url.pm22
-rwxr-xr-xslackbuilder13
-rw-r--r--t/request.t37
8 files changed, 207 insertions, 140 deletions
diff --git a/lib/SlackBuild/Request.pm b/lib/SlackBuild/Request.pm
index 6b8e132..4ae81d3 100644
--- a/lib/SlackBuild/Request.pm
+++ b/lib/SlackBuild/Request.pm
@@ -9,2 +9,3 @@ use File::Basename;
use Safe;
+use feature 'state';
@@ -201,11 +202,2 @@ my %generics = (
-sub _readfile {
- my ($self,$file) = @_;
- local $/ = undef;
- open(my $fd, $file) or croak "can't open file $file: $!";
- my $string = <$fd>;
- close $fd;
- decode_json($string);
-}
-
sub strategy {
@@ -242,7 +234,10 @@ is OK.
- new SlackBuild::Request($file)
+ new SlackBuild::Request($URL)
-Read the request from the disk file B<$file>. The file must contain a single
-request formatted as JSON. No empty lines or comments are allowed.
+Loads request from the $URL. This is equivalent to
+ load SlackBuild::Request($URL)
+
+See the description of B<load>, below.
+
=cut
@@ -250,3 +245,3 @@ request formatted as JSON. No empty lines or comments are allowed.
sub new {
- my $self = bless {}, shift;
+ my $class = shift;
my %a;
@@ -257,3 +252,3 @@ sub new {
} else {
- %a = %{$self->_readfile($file)}
+ %a = return $class->load($file);
}
@@ -265,2 +260,3 @@ sub new {
+ my $self = bless {}, $class;
while (my ($k,$v) = each %a) {
@@ -271,2 +267,86 @@ sub new {
+=head2 load
+
+ $req = load SlackBuild::Request($URL)
+
+Loads request from the supplied $URL. Allowed arguments are:
+
+=over 4
+
+=item Local file name
+
+If $URL is the name of an existing local file, the file is loaded to the
+memory and parsed as JSON object (if it begins with a curly brace), or as
+YAML document.
+
+=item Local directory name
+
+If $URL is the name of an existing local directory, it is searched for
+any files matching the shell globbing pattern C<*.SlackBuild>. If any
+such file is found, its base name is taken as the name of the package,
+and the full pathname of the directory itself as the B<slackbuild_uri>.
+
+=item URL of the remote tarball
+
+If $URL begins with any of C<http://>, C<https://>, C<ftp://>, C<ftps://>,
+and its path name component ends in C<.tar> with optional compression
+suffix (C<.gz>, C<.xz>, C<.lz>, or C<.bz2>), the file name part of the
+URL is taken as the package name and the $URL itself as B<slackbuild_uri>.
+
+=item SBo URL
+
+ sbo:///COMMIT/CATEGORY/PACKAGE
+
+This URL refers the definition of C<PACKAGE> in B<slackbuild.org> repository.
+For example:
+
+ sbo://HEAD/system/cronie
+
+=item Package name
+
+Unqualified package name is looked up in the B<slackbuild.org> repository.
+If it is found, the retrieved data are used to build the request.
+
+=back
+
+=cut
+
+sub load {
+ my ($class, $reqname) = @_;
+
+ my $ldpack = __PACKAGE__ . '::Loader';
+ my @comp = split /::/, $ldpack;
+
+ # Current (as of perl 5.28.0) implementation of "state" only permits
+ # the initialization of scalar variables in scalar context. Therefore
+ # this variable is an array ref.
+ state $loaders //=
+ [map { $_->[1] }
+ sort { $a->[0] <=> $b->[0] }
+ map {
+ my ($modname) = $ldpack . '::' . fileparse($_, '.pm');
+ eval {
+ no strict 'refs';
+ if (scalar %{ $modname.'::' }) {
+ die "INCLUDED $modname";
+ };
+ require $_;
+ my $prio = ${$modname.'::PRIORITY'};
+ die unless $prio && $modname->can('Load');
+ [ $prio, $modname ]
+ }
+ }
+ map { glob File::Spec->catfile($_, '*.pm') }
+ grep { -d $_ }
+ map { File::Spec->catfile($_, @comp) } @INC];
+
+ foreach my $ld (@$loaders) {
+ if (my $req = $ld->Load($reqname)) {
+ return $class->new($req);
+ }
+ }
+
+ croak "unrecognized request type";
+}
+
=head1 STRING REPRESENTATION
diff --git a/lib/SlackBuild/Request/Auto.pm b/lib/SlackBuild/Request/Auto.pm
deleted file mode 100644
index 576d39d..0000000
--- a/lib/SlackBuild/Request/Auto.pm
+++ /dev/null
@@ -1,106 +0,0 @@
-package SlackBuild::Request::Auto;
-use strict;
-use warnings;
-use parent 'SlackBuild::Request';
-use File::Basename;
-use File::Spec;
-use Net::SBo;
-use JSON;
-use YAML;
-use Carp;
-
-sub req {
- my ($class, $reqname) = @_;
- my $req;
-
- if (-f $reqname) {
- local $/ = undef;
- open(my $fd, $reqname) or croak "can't open file $reqname: $!";
- my $string = <$fd>;
- close $fd;
- if ($string =~ /^\{/) {
- return decode_json($string);
- }
- return YAML::Load($string);
- }
-
- if (-d $reqname) {
- if (my $file =
- (glob File::Spec->catfile($reqname, '*.SlackBuild'))[0]) {
- my ($package,$path,$suffix) = fileparse($file, '.SlackBuild');
- return { package => $package, slackbuild_uri => $path };
- }
- }
-
- if ($reqname =~ m{^\w+://}) {
- my $uri = new URI($reqname);
- if ($uri->scheme =~ m{^(?:http|ftp)s?}
- && $uri->path =~ m{.*/(.+?)\.tar(?:\.(?:[xgl]z|bz2))?}x) {
- return { package => $1, slackbuild_uri => $reqname };
- }
- if ($uri->scheme eq 'sbo') {
- return { package => $uri->package, slackbuild_uri => $reqname }
- }
- }
-
- if (my ($dir,$commit) = Net::SBo->new->find($reqname)) {
- return { package => $reqname, slackbuild_uri => "sbo://$commit/$dir"};
- }
-
- croak "unrecognized request type";
-}
-
-sub new {
- my ($class, $arg) = @_;
- return $class->SUPER::new(__PACKAGE__->req($arg));
-}
-
-1;
-__END__
-
-=head1 NAME
-
-SlackBuild::Request::Auto - automatic request convertor for SlackBuilder
-
-=head1 SYNOPSIS
-
- $req = new SlackBuild::Request::Auto($arg)
-
-=head1 DESCRIPTION
-
-Attempts to recognize the format of I<$arg> and convert it to the SlackBuilder
-build request.
-
-Argument can be any of:
-
-=over 4
-
-=item Name of an existing file
-
-The file is read and parsed as a JSON request file.
-
-=item Name of an existing directory
-
-If it contains a file B<*.SlackBuild>, a request referring to files
-in this directory is returned.
-
-=item A http, https, ftp, or ftps URL to a tar file
-
-The file component of the URL must end with B<.tar>, followed with a
-compression suffix (B<.gz>, B<.xz>, or B<.bz2>). The archive must contain
-at least the B<*.SlackBuild> file.
-
-Example:
-
- https://slackbuilds.org/slackbuilds/14.2/system/mailutils.tar.gz
-
-=item An SBo URL
-
-Example:
-
- sbo://HEAD/system/mailutils
-
-=back
-
-=cut
-
diff --git a/lib/SlackBuild/Request/Loader/dir.pm b/lib/SlackBuild/Request/Loader/dir.pm
new file mode 100644
index 0000000..5e2af9d
--- /dev/null
+++ b/lib/SlackBuild/Request/Loader/dir.pm
@@ -0,0 +1,21 @@
+package SlackBuild::Request::Loader::dir;
+use strict;
+use warnings;
+use File::Basename;
+use File::Spec;
+
+our $PRIORITY = 20;
+
+sub Load {
+ my ($class, $reqname) = @_;
+ if (-d $reqname) {
+ if (my $file =
+ (glob File::Spec->catfile($reqname, '*.SlackBuild'))[0]) {
+ my ($package,$path) = fileparse($file, '.SlackBuild');
+ return { package => $package, slackbuild_uri => $path };
+ }
+ }
+}
+
+1;
+
diff --git a/lib/SlackBuild/Request/Loader/file.pm b/lib/SlackBuild/Request/Loader/file.pm
new file mode 100644
index 0000000..2a8cae6
--- /dev/null
+++ b/lib/SlackBuild/Request/Loader/file.pm
@@ -0,0 +1,25 @@
+package SlackBuild::Request::Loader::file;
+use strict;
+use warnings;
+use JSON;
+use YAML ();
+use Carp;
+
+our $PRIORITY = 10;
+
+sub Load {
+ my ($class, $reqname) = @_;
+ if (-f $reqname) {
+ local $/ = undef;
+ open(my $fd, $reqname) or croak "can't open file $reqname: $!";
+ my $string = <$fd>;
+ close $fd;
+ if ($string =~ /^\{/) {
+ return decode_json($string);
+ }
+ return YAML::Load($string);
+ }
+}
+
+1;
+
diff --git a/lib/SlackBuild/Request/Loader/sbo.pm b/lib/SlackBuild/Request/Loader/sbo.pm
new file mode 100644
index 0000000..bb0ec77
--- /dev/null
+++ b/lib/SlackBuild/Request/Loader/sbo.pm
@@ -0,0 +1,15 @@
+package SlackBuild::Request::Loader::sbo;
+use strict;
+use warnings;
+use Net::SBo;
+
+our $PRIORITY = 40;
+
+sub Load {
+ my ($class, $reqname) = @_;
+ if (my ($dir,$commit) = Net::SBo->new->find($reqname)) {
+ return { package => $reqname, slackbuild_uri => "sbo://$commit/$dir"};
+ }
+}
+
+1;
diff --git a/lib/SlackBuild/Request/Loader/url.pm b/lib/SlackBuild/Request/Loader/url.pm
new file mode 100644
index 0000000..f8ff68f
--- /dev/null
+++ b/lib/SlackBuild/Request/Loader/url.pm
@@ -0,0 +1,22 @@
+package SlackBuild::Request::Loader::url;
+use strict;
+use warnings;
+use URI;
+
+our $PRIORITY = 30;
+
+sub Load {
+ my ($class, $reqname) = @_;
+ if ($reqname =~ m{^\w+://}) {
+ my $uri = new URI($reqname);
+ if ($uri->scheme =~ m{^(?:http|ftp)s?}
+ && $uri->path =~ m{.*/(.+?)\.tar(?:\.(?:[xgl]z|bz2))?}x) {
+ return { package => $1, slackbuild_uri => $reqname };
+ }
+ if ($uri->scheme eq 'sbo') {
+ return { package => $uri->package, slackbuild_uri => $reqname }
+ }
+ }
+}
+
+1;
diff --git a/slackbuilder b/slackbuilder
index 6e3ac47..9ad2722 100755
--- a/slackbuilder
+++ b/slackbuilder
@@ -11,3 +11,3 @@ use Unix::Sysexits;
use SlackBuilder;
-use SlackBuild::Request::Auto;
+use SlackBuild::Request;
use Net::SBo;
@@ -37,11 +37,2 @@ sub error {
}
-
-sub readfile {
- my $file = shift;
- local $/ = undef;
- open(my $fd, $file) or abend(EX_NOINPUT, "can't open file $file: $!");
- my $string = <$fd>;
- close $fd;
- return decode_json($string);
-}
@@ -66,3 +57,3 @@ my $reqname = shift @ARGV;
my $req = try {
- new SlackBuild::Request::Auto($reqname)
+ new SlackBuild::Request($reqname)
} catch {
diff --git a/t/request.t b/t/request.t
index 3880229..9a7eeb7 100644
--- a/t/request.t
+++ b/t/request.t
@@ -9,3 +9,3 @@ use Test;
-plan tests => 6;
+plan tests => 7;
@@ -90,4 +90,5 @@ ok("$req",
#6
-my $fh = new File::Temp(UNLINK => 1);
-print $fh <<'EOT'
+{
+ my $fh = new File::Temp(UNLINK => 1);
+ print $fh <<'EOT'
{
@@ -100,8 +101,26 @@ print $fh <<'EOT'
EOT
+ ;
+ $fh->flush;
+ $req = load SlackBuild::Request($fh->filename);
+ ok("$req",
+ q{{"build":"2","package":"foo","prereq":["quux"],"source_uri":["foo-1.1.tar.gz","bar-1.0.tar.gz"],"version":"1.0"}});
+}
+#7
+{
+ my $fh = new File::Temp(UNLINK => 1);
+ print $fh <<'EOT'
+---
+package: foo
+version: 1.0
+source_uri:
+ - foo-1.1.tar.gz
+ - bar-1.0.tar.gz
+build: 2
+prereq: quux
+EOT
;
-$fh->flush;
-$req = new SlackBuild::Request($fh->filename);
-ok("$req",
- q{{"build":"2","package":"foo","prereq":["quux"],"source_uri":["foo-1.1.tar.gz","bar-1.0.tar.gz"],"version":"1.0"}});
-
-
+ $fh->flush;
+ $req = load SlackBuild::Request($fh->filename);
+ ok("$req",
+ q{{"build":"2","package":"foo","prereq":["quux"],"source_uri":["foo-1.1.tar.gz","bar-1.0.tar.gz"],"version":"1.0"}});
+}

Return to:

Send suggestions and report system problems to the System administrator.