diff options
Diffstat (limited to 'lib/SlackBuild')
-rw-r--r-- | lib/SlackBuild/Request.pm | 108 | ||||
-rw-r--r-- | lib/SlackBuild/Request/Auto.pm | 106 | ||||
-rw-r--r-- | lib/SlackBuild/Request/Loader/dir.pm | 21 | ||||
-rw-r--r-- | lib/SlackBuild/Request/Loader/file.pm | 25 | ||||
-rw-r--r-- | lib/SlackBuild/Request/Loader/sbo.pm | 15 | ||||
-rw-r--r-- | lib/SlackBuild/Request/Loader/url.pm | 22 |
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; | |||
7 | use JSON; | 7 | use JSON; |
8 | use File::Basename; | 8 | use File::Basename; |
9 | use Safe; | 9 | use Safe; |
10 | use feature 'state'; | ||
10 | 11 | ||
11 | =head1 NAME | 12 | =head1 NAME |
12 | 13 | ||
@@ -199,15 +200,6 @@ my %generics = ( | |||
199 | } | 200 | } |
200 | ); | 201 | ); |
201 | 202 | ||
202 | sub _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 | |||
211 | sub strategy { | 203 | sub 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 | |||
240 | are discussed in detail in the B<ATTRIBUTES> section. Empty argument list | 232 | are discussed in detail in the B<ATTRIBUTES> section. Empty argument list |
241 | is OK. | 233 | is OK. |
242 | 234 | ||
243 | new SlackBuild::Request($file) | 235 | new SlackBuild::Request($URL) |
244 | 236 | ||
245 | Read the request from the disk file B<$file>. The file must contain a single | 237 | Loads request from the $URL. This is equivalent to |
246 | request formatted as JSON. No empty lines or comments are allowed. | ||
247 | 238 | ||
239 | load SlackBuild::Request($URL) | ||
240 | |||
241 | See the description of B<load>, below. | ||
242 | |||
248 | =cut | 243 | =cut |
249 | 244 | ||
250 | sub new { | 245 | sub 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 | |||
272 | Loads request from the supplied $URL. Allowed arguments are: | ||
273 | |||
274 | =over 4 | ||
275 | |||
276 | =item Local file name | ||
277 | |||
278 | If $URL is the name of an existing local file, the file is loaded to the | ||
279 | memory and parsed as JSON object (if it begins with a curly brace), or as | ||
280 | YAML document. | ||
281 | |||
282 | =item Local directory name | ||
283 | |||
284 | If $URL is the name of an existing local directory, it is searched for | ||
285 | any files matching the shell globbing pattern C<*.SlackBuild>. If any | ||
286 | such file is found, its base name is taken as the name of the package, | ||
287 | and the full pathname of the directory itself as the B<slackbuild_uri>. | ||
288 | |||
289 | =item URL of the remote tarball | ||
290 | |||
291 | If $URL begins with any of C<http://>, C<https://>, C<ftp://>, C<ftps://>, | ||
292 | and its path name component ends in C<.tar> with optional compression | ||
293 | suffix (C<.gz>, C<.xz>, C<.lz>, or C<.bz2>), the file name part of the | ||
294 | URL 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 | |||
300 | This URL refers the definition of C<PACKAGE> in B<slackbuild.org> repository. | ||
301 | For example: | ||
302 | |||
303 | sbo://HEAD/system/cronie | ||
304 | |||
305 | =item Package name | ||
306 | |||
307 | Unqualified package name is looked up in the B<slackbuild.org> repository. | ||
308 | If it is found, the retrieved data are used to build the request. | ||
309 | |||
310 | =back | ||
311 | |||
312 | =cut | ||
313 | |||
314 | sub 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 | ||
274 | When used is string context, objects of this class are represented as | 354 | When 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 @@ | |||
1 | package SlackBuild::Request::Auto; | ||
2 | use strict; | ||
3 | use warnings; | ||
4 | use parent 'SlackBuild::Request'; | ||
5 | use File::Basename; | ||
6 | use File::Spec; | ||
7 | use Net::SBo; | ||
8 | use JSON; | ||
9 | use YAML; | ||
10 | use Carp; | ||
11 | |||
12 | sub 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 | |||