summaryrefslogtreecommitdiffabout
authorSergey Poznyakoff <gray@gnu.org.ua>2019-03-20 12:50:47 (GMT)
committer Sergey Poznyakoff <gray@gnu.org.ua>2019-03-20 13:57:30 (GMT)
commita297c865dd4611c4fd862e59c70ba1b72a142035 (patch) (unidiff)
tree1751891a3b93a8ce8a2260e0be9ddf8d9e90f6a0
parenta6040f631367a33f4e96759ce6ceefb759303f25 (diff)
downloadslackbuilder-a297c865dd4611c4fd862e59c70ba1b72a142035.tar.gz
slackbuilder-a297c865dd4611c4fd862e59c70ba1b72a142035.tar.bz2
Rewrite request loader.v1.0-
* lib/SlackBuild/Request.pm (load): New method. (new): Fall back to load() if given one argument. * lib/SlackBuild/Request/Auto.pm: Remove. * lib/SlackBuild/Request/Loader/dir.pm: New file. * lib/SlackBuild/Request/Loader/file.pm: New file. * lib/SlackBuild/Request/Loader/sbo.pm: New file. * lib/SlackBuild/Request/Loader/url.pm: New file. * slackbuilder: Use SlackBuild::Request->new instead of SlackBuild::Request::Auto->new * t/request.t: More tests.
Diffstat (more/less context) (ignore whitespace changes)
-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
@@ -7,6 +7,7 @@ use Text::ParseWords;
7use JSON; 7use JSON;
8use File::Basename; 8use File::Basename;
9use Safe; 9use Safe;
10use feature 'state';
10 11
11=head1 NAME 12=head1 NAME
12 13
@@ -199,15 +200,6 @@ my %generics = (
199 } 200 }
200); 201);
201 202
202sub _readfile {
203 my ($self,$file) = @_;
204 local $/ = undef;
205 open(my $fd, $file) or croak "can't open file $file: $!";
206 my $string = <$fd>;
207 close $fd;
208 decode_json($string);
209}
210
211sub strategy { 203sub strategy {
212 my ($self, $attr) = @_; 204 my ($self, $attr) = @_;
213 if ($attr) { 205 if ($attr) {
@@ -240,22 +232,25 @@ Build the request from the supplied attribute/value pairs. Allowed attributes
240are discussed in detail in the B<ATTRIBUTES> section. Empty argument list 232are discussed in detail in the B<ATTRIBUTES> section. Empty argument list
241is OK. 233is OK.
242 234
243 new SlackBuild::Request($file) 235 new SlackBuild::Request($URL)
244 236
245Read the request from the disk file B<$file>. The file must contain a single 237Loads request from the $URL. This is equivalent to
246request formatted as JSON. No empty lines or comments are allowed.
247 238
239 load SlackBuild::Request($URL)
240
241See the description of B<load>, below.
242
248=cut 243=cut
249 244
250sub new { 245sub new {
251 my $self = bless {}, shift; 246 my $class = shift;
252 my %a; 247 my %a;
253 if (@_ == 1) { 248 if (@_ == 1) {
254 my $file = shift; 249 my $file = shift;
255 if (ref($file) eq 'HASH') { 250 if (ref($file) eq 'HASH') {
256 %a = %$file; 251 %a = %$file;
257 } else { 252 } else {
258 %a = %{$self->_readfile($file)} 253 %a = return $class->load($file);
259 } 254 }
260 } elsif (@_ % 2) { 255 } elsif (@_ % 2) {
261 croak "bad number of arguments"; 256 croak "bad number of arguments";
@@ -263,12 +258,97 @@ sub new {
263 %a = @_; 258 %a = @_;
264 } 259 }
265 260
261 my $self = bless {}, $class;
266 while (my ($k,$v) = each %a) { 262 while (my ($k,$v) = each %a) {
267 $self->${\ "set_$k"}($v); 263 $self->${\ "set_$k"}($v);
268 } 264 }
269 return $self; 265 return $self;
270} 266}
271 267
268=head2 load
269
270 $req = load SlackBuild::Request($URL)
271
272Loads request from the supplied $URL. Allowed arguments are:
273
274=over 4
275
276=item Local file name
277
278If $URL is the name of an existing local file, the file is loaded to the
279memory and parsed as JSON object (if it begins with a curly brace), or as
280YAML document.
281
282=item Local directory name
283
284If $URL is the name of an existing local directory, it is searched for
285any files matching the shell globbing pattern C<*.SlackBuild>. If any
286such file is found, its base name is taken as the name of the package,
287and the full pathname of the directory itself as the B<slackbuild_uri>.
288
289=item URL of the remote tarball
290
291If $URL begins with any of C<http://>, C<https://>, C<ftp://>, C<ftps://>,
292and its path name component ends in C<.tar> with optional compression
293suffix (C<.gz>, C<.xz>, C<.lz>, or C<.bz2>), the file name part of the
294URL is taken as the package name and the $URL itself as B<slackbuild_uri>.
295
296=item SBo URL
297
298 sbo:///COMMIT/CATEGORY/PACKAGE
299
300This URL refers the definition of C<PACKAGE> in B<slackbuild.org> repository.
301For example:
302
303 sbo://HEAD/system/cronie
304
305=item Package name
306
307Unqualified package name is looked up in the B<slackbuild.org> repository.
308If it is found, the retrieved data are used to build the request.
309
310=back
311
312=cut
313
314sub load {
315 my ($class, $reqname) = @_;
316
317 my $ldpack = __PACKAGE__ . '::Loader';
318 my @comp = split /::/, $ldpack;
319
320 # Current (as of perl 5.28.0) implementation of "state" only permits
321 # the initialization of scalar variables in scalar context. Therefore
322 # this variable is an array ref.
323 state $loaders //=
324 [map { $_->[1] }
325 sort { $a->[0] <=> $b->[0] }
326 map {
327 my ($modname) = $ldpack . '::' . fileparse($_, '.pm');
328 eval {
329 no strict 'refs';
330 if (scalar %{ $modname.'::' }) {
331 die "INCLUDED $modname";
332 };
333 require $_;
334 my $prio = ${$modname.'::PRIORITY'};
335 die unless $prio && $modname->can('Load');
336 [ $prio, $modname ]
337 }
338 }
339 map { glob File::Spec->catfile($_, '*.pm') }
340 grep { -d $_ }
341 map { File::Spec->catfile($_, @comp) } @INC];
342
343 foreach my $ld (@$loaders) {
344 if (my $req = $ld->Load($reqname)) {
345 return $class->new($req);
346 }
347 }
348
349 croak "unrecognized request type";
350}
351
272=head1 STRING REPRESENTATION 352=head1 STRING REPRESENTATION
273 353
274When used is string context, objects of this class are represented as 354When used is string context, objects of this class are represented as
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
+++ b/dev/null
@@ -1,106 +0,0 @@
1package SlackBuild::Request::Auto;
2use strict;
3use warnings;
4use parent 'SlackBuild::Request';
5use File::Basename;
6use File::Spec;
7use Net::SBo;
8use JSON;
9use YAML;
10use Carp;
11
12sub req {
13 my ($class, $reqname) = @_;
14 my $req;
15
16 if (-f $reqname) {
17 local $/ = undef;
18 open(my $fd, $reqname) or croak "can't open file $reqname: $!";
19 my $string = <$fd>;
20 close $fd;
21 if ($string =~ /^\{/) {
22 return decode_json($string);
23 }
24 return YAML::Load($string);
25 }
26
27 if (-d $reqname) {
28 if (my $file =
29 (glob File::Spec->catfile($reqname, '*.SlackBuild'))[0]) {
30 my ($package,$path,$suffix) = fileparse($file, '.SlackBuild');
31 return { package => $package, slackbuild_uri => $path };
32 }
33 }
34
35 if ($reqname =~ m{^\w+://}) {
36 my $uri = new URI($reqname);
37 if ($uri->scheme =~ m{^(?:http|ftp)s?}
38 && $uri->path =~ m{.*/(.+?)\.tar(?:\.(?:[xgl]z|bz2))?}x) {
39 return { package => $1, slackbuild_uri => $reqname };
40 }
41 if ($uri->scheme eq 'sbo') {
42 return { package => $uri->package, slackbuild_uri => $reqname }
43 }
44 }
45
46 if (my ($dir,$commit) = Net::SBo->new->find($reqname)) {
47 return { package => $reqname, slackbuild_uri => "sbo://$commit/$dir"};
48 }
49
50 croak "unrecognized request type";
51}
52
53sub new {
54 my ($class, $arg) = @_;
55 return $class->SUPER::new(__PACKAGE__->req($arg));
56}
57
581;
59__END__
60
61=head1 NAME
62
63SlackBuild::Request::Auto - automatic request convertor for SlackBuilder
64
65=head1 SYNOPSIS
66
67 $req = new SlackBuild::Request::Auto($arg)
68
69=head1 DESCRIPTION
70
71Attempts to recognize the format of I<$arg> and convert it to the SlackBuilder
72build request.
73
74Argument can be any of:
75
76=over 4
77
78=item Name of an existing file
79
80The file is read and parsed as a JSON request file.
81
82=item Name of an existing directory
83
84If it contains a file B<*.SlackBuild>, a request referring to files
85in this directory is returned.
86
87=item A http, https, ftp, or ftps URL to a tar file
88
89The file component of the URL must end with B<.tar>, followed with a
90compression suffix (B<.gz>, B<.xz>, or B<.bz2>). The archive must contain
91at least the B<*.SlackBuild> file.
92
93Example:
94
95 https://slackbuilds.org/slackbuilds/14.2/system/mailutils.tar.gz
96
97=item An SBo URL
98
99Example:
100
101 sbo://HEAD/system/mailutils
102
103=back
104
105=cut
106
diff --git a/lib/SlackBuild/Request/Loader/dir.pm b/lib/SlackBuild/Request/Loader/dir.pm
new file mode 100644
index 0000000..5e2af9d
--- a/dev/null
+++ b/lib/SlackBuild/Request/Loader/dir.pm
@@ -0,0 +1,21 @@
1package SlackBuild::Request::Loader::dir;
2use strict;
3use warnings;
4use File::Basename;
5use File::Spec;
6
7our $PRIORITY = 20;
8
9sub Load {
10 my ($class, $reqname) = @_;
11 if (-d $reqname) {
12 if (my $file =
13 (glob File::Spec->catfile($reqname, '*.SlackBuild'))[0]) {
14 my ($package,$path) = fileparse($file, '.SlackBuild');
15 return { package => $package, slackbuild_uri => $path };
16 }
17 }
18}
19
201;
21
diff --git a/lib/SlackBuild/Request/Loader/file.pm b/lib/SlackBuild/Request/Loader/file.pm
new file mode 100644
index 0000000..2a8cae6
--- a/dev/null
+++ b/lib/SlackBuild/Request/Loader/file.pm
@@ -0,0 +1,25 @@
1package SlackBuild::Request::Loader::file;
2use strict;
3use warnings;
4use JSON;
5use YAML ();
6use Carp;
7
8our $PRIORITY = 10;
9
10sub Load {
11 my ($class, $reqname) = @_;
12 if (-f $reqname) {
13 local $/ = undef;
14 open(my $fd, $reqname) or croak "can't open file $reqname: $!";
15 my $string = <$fd>;
16 close $fd;
17 if ($string =~ /^\{/) {
18 return decode_json($string);
19 }
20 return YAML::Load($string);
21 }
22}
23
241;
25
diff --git a/lib/SlackBuild/Request/Loader/sbo.pm b/lib/SlackBuild/Request/Loader/sbo.pm
new file mode 100644
index 0000000..bb0ec77
--- a/dev/null
+++ b/lib/SlackBuild/Request/Loader/sbo.pm
@@ -0,0 +1,15 @@
1package SlackBuild::Request::Loader::sbo;
2use strict;
3use warnings;
4use Net::SBo;
5
6our $PRIORITY = 40;
7
8sub Load {
9 my ($class, $reqname) = @_;
10 if (my ($dir,$commit) = Net::SBo->new->find($reqname)) {
11 return { package => $reqname, slackbuild_uri => "sbo://$commit/$dir"};
12 }
13}
14
151;
diff --git a/lib/SlackBuild/Request/Loader/url.pm b/lib/SlackBuild/Request/Loader/url.pm
new file mode 100644
index 0000000..f8ff68f
--- a/dev/null
+++ b/lib/SlackBuild/Request/Loader/url.pm
@@ -0,0 +1,22 @@
1package SlackBuild::Request::Loader::url;
2use strict;
3use warnings;
4use URI;
5
6our $PRIORITY = 30;
7
8sub Load {
9 my ($class, $reqname) = @_;
10 if ($reqname =~ m{^\w+://}) {
11 my $uri = new URI($reqname);
12 if ($uri->scheme =~ m{^(?:http|ftp)s?}
13 && $uri->path =~ m{.*/(.+?)\.tar(?:\.(?:[xgl]z|bz2))?}x) {
14 return { package => $1, slackbuild_uri => $reqname };
15 }
16 if ($uri->scheme eq 'sbo') {
17 return { package => $uri->package, slackbuild_uri => $reqname }
18 }
19 }
20}
21
221;
diff --git a/slackbuilder b/slackbuilder
index 6e3ac47..9ad2722 100755
--- a/slackbuilder
+++ b/slackbuilder
@@ -9,7 +9,7 @@ use File::Basename;
9use File::Spec; 9use File::Spec;
10use Unix::Sysexits; 10use Unix::Sysexits;
11use SlackBuilder; 11use SlackBuilder;
12use SlackBuild::Request::Auto; 12use SlackBuild::Request;
13use Net::SBo; 13use Net::SBo;
14use JSON; 14use JSON;
15use Try::Tiny; 15use Try::Tiny;
@@ -35,15 +35,6 @@ sub error {
35 print STDERR "$_{prefix}: " if defined($_{prefix}); 35 print STDERR "$_{prefix}: " if defined($_{prefix});
36 print STDERR "$msg\n" 36 print STDERR "$msg\n"
37} 37}
38
39sub readfile {
40 my $file = shift;
41 local $/ = undef;
42 open(my $fd, $file) or abend(EX_NOINPUT, "can't open file $file: $!");
43 my $string = <$fd>;
44 close $fd;
45 return decode_json($string);
46}
47 38
48my %sbargs; 39my %sbargs;
49GetOptions("h" => sub { 40GetOptions("h" => sub {
@@ -64,7 +55,7 @@ GetOptions("h" => sub {
64abend(EX_USAGE, "bad number of arguments") unless @ARGV == 1; 55abend(EX_USAGE, "bad number of arguments") unless @ARGV == 1;
65my $reqname = shift @ARGV; 56my $reqname = shift @ARGV;
66my $req = try { 57my $req = try {
67 new SlackBuild::Request::Auto($reqname) 58 new SlackBuild::Request($reqname)
68} catch { 59} catch {
69 my $err = (split /\n/)[0]; 60 my $err = (split /\n/)[0];
70 $err =~ s{\s+at .* line \d+\.$}{}; 61 $err =~ s{\s+at .* line \d+\.$}{};
diff --git a/t/request.t b/t/request.t
index 3880229..9a7eeb7 100644
--- a/t/request.t
+++ b/t/request.t
@@ -7,7 +7,7 @@ use SlackBuild::Info;
7use File::Temp; 7use File::Temp;
8use Test; 8use Test;
9 9
10plan tests => 6; 10plan tests => 7;
11 11
12#1 12#1
13my $req = new SlackBuild::Request( 13my $req = new SlackBuild::Request(
@@ -88,8 +88,9 @@ ok("$req",
88 q{{"package":"foo","prereq":["bar","baz"],"slackbuild_uri":"foo.tar.gz","source_uri":["foo-1.0.tar.gz"],"strategy":{"prereq":"keep"},"version":"1.0"}}); 88 q{{"package":"foo","prereq":["bar","baz"],"slackbuild_uri":"foo.tar.gz","source_uri":["foo-1.0.tar.gz"],"strategy":{"prereq":"keep"},"version":"1.0"}});
89 89
90#6 90#6
91my $fh = new File::Temp(UNLINK => 1); 91{
92print $fh <<'EOT' 92 my $fh = new File::Temp(UNLINK => 1);
93 print $fh <<'EOT'
93{ 94{
94 "package": "foo", 95 "package": "foo",
95 "version": "1.0", 96 "version": "1.0",
@@ -98,10 +99,28 @@ print $fh <<'EOT'
98 "prereq": "quux" 99 "prereq": "quux"
99} 100}
100EOT 101EOT
102 ;
103 $fh->flush;
104 $req = load SlackBuild::Request($fh->filename);
105 ok("$req",
106 q{{"build":"2","package":"foo","prereq":["quux"],"source_uri":["foo-1.1.tar.gz","bar-1.0.tar.gz"],"version":"1.0"}});
107}
108#7
109{
110 my $fh = new File::Temp(UNLINK => 1);
111 print $fh <<'EOT'
112---
113package: foo
114version: 1.0
115source_uri:
116 - foo-1.1.tar.gz
117 - bar-1.0.tar.gz
118build: 2
119prereq: quux
120EOT
101; 121;
102$fh->flush; 122 $fh->flush;
103$req = new SlackBuild::Request($fh->filename); 123 $req = load SlackBuild::Request($fh->filename);
104ok("$req", 124 ok("$req",
105 q{{"build":"2","package":"foo","prereq":["quux"],"source_uri":["foo-1.1.tar.gz","bar-1.0.tar.gz"],"version":"1.0"}}); 125 q{{"build":"2","package":"foo","prereq":["quux"],"source_uri":["foo-1.1.tar.gz","bar-1.0.tar.gz"],"version":"1.0"}});
106 126}
107

Return to:

Send suggestions and report system problems to the System administrator.