summaryrefslogtreecommitdiff
path: root/lib/SlackBuild
diff options
context:
space:
mode:
Diffstat (limited to 'lib/SlackBuild')
-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
6 files changed, 177 insertions, 120 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
+++ /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)) {