From ce8f088c658b7a07f491b72a9aa18f5504e6430c Mon Sep 17 00:00:00 2001 From: Alad Wenter Date: Thu, 22 Dec 2022 21:32:32 +0100 Subject: [PATCH] add AUR.pm This commit extracts common functionality in aur-query, aur-search, aur-depends and aur-format and places it in a perl module. --- Makefile | 1 + completions/command_opts.sh | 6 +- completions/zsh/_aur | 1 - lib/aur-depends | 76 +++++-------------------- lib/aur-format | 52 ++---------------- lib/aur-query | 131 ++++++++++++++------------------------------ lib/aur-search | 90 +++++++++--------------------- makepkg/aurutils.changelog | 9 ++- man1/aur-depends.1 | 55 ++++++++----------- man1/aur-query.1 | 12 ++-- perl/AUR.pm | 4 ++ perl/AUR/Json.pm | 97 ++++++++++++++++++++++++++++++++ perl/AUR/Query.pm | 111 +++++++++++++++++++++++++++++++++++++ perl/Makefile | 8 +++ tests/parseopt-consistency | 5 +- 15 files changed, 345 insertions(+), 313 deletions(-) rewrite lib/aur-query (85%) create mode 100644 perl/AUR.pm create mode 100644 perl/AUR/Json.pm create mode 100644 perl/AUR/Query.pm create mode 100644 perl/Makefile diff --git a/Makefile b/Makefile index 52a88a35..47b7414b 100644 --- a/Makefile +++ b/Makefile @@ -40,3 +40,4 @@ install: install-aur @install -Dm644 examples/* -t '$(DESTDIR)$(SHRDIR)/doc/$(PROGNM)/examples' @install -dm755 aurutils '$(DESTDIR)$(ETCDIR)/$(PROGNM)' @$(MAKE) -C completions DESTDIR='$(DESTDIR)' install-bash install-zsh + @$(MAKE) -C perl DESTDIR='$(DESTDIR)' install-perl \ No newline at end of file diff --git a/completions/command_opts.sh b/completions/command_opts.sh index 37a50996..59a06106 100644 --- a/completions/command_opts.sh +++ b/completions/command_opts.sh @@ -1,8 +1,8 @@ #!/bin/bash -have_optdump=('build' 'chroot' 'depends' 'fetch' 'pkglist' 'repo' 'repo-filter' - 'search' 'srcver' 'sync' 'vercmp' 'view') -no_optdump=('graph' 'format' 'repo-parse' 'query') +have_optdump=('build' 'chroot' 'fetch' 'pkglist' 'repo' 'repo-filter' + 'srcver' 'sync' 'vercmp' 'view') +no_optdump=('graph' 'format' 'repo-parse' 'query' 'depends' 'search') default_opts() { local cmd corecommands=() opts=() diff --git a/completions/zsh/_aur b/completions/zsh/_aur index 0eab047d..cc564210 100644 --- a/completions/zsh/_aur +++ b/completions/zsh/_aur @@ -217,7 +217,6 @@ _aur-query() { '(-b --by)'{-b,--by=}'[argument for package search (--type=search)]:by:(name name-desc maintainer depends makedepends optdepends checkdepends)' '(-r --raw)'{-r,--raw}'[do not process results (implied by --type=info)]' '(-t --type)'{-t,--type=}'[type of request]:type:(search info)' - '(-n --dry-run)'{-n,--dry-run}'[show curl command-lines instead of running them]' '*:pkgname: _aur_packages' ) _arguments -s $args diff --git a/lib/aur-depends b/lib/aur-depends index 077c9c19..2b27366d 100755 --- a/lib/aur-depends +++ b/lib/aur-depends @@ -3,64 +3,12 @@ use strict; use warnings; use v5.20; +use AUR::Json qw(parse_json_aur write_json); +use AUR::Query qw(query_multi); my $argv0 = 'depends'; -my $aur_json; - -# Fallback to slower perl-based JSON parsing -if (eval { require JSON::XS; 1 }) { - $aur_json = JSON::XS->new; -} else { - require JSON::PP; - $aur_json = JSON::PP->new; -} - -sub parse_json { - my $row = shift; - - my $obj = $aur_json->incr_parse($row) - or die $argv0 . ": expected JSON object or array at beginning of string"; - $aur_json->incr_reset(); - - return $obj; -} - -# Remove outer layer of AurJson responses -sub get_results { - my $obj = shift; - - if ($obj->{'type'} eq 'error') { - say STDERR "$argv0: $obj->{'error'}"; - exit(4); - } - return $obj->{'results'}; -} - -# Retrieve AurJson responses in every level of the dependency DAG -sub query { - return if scalar @_ == 0; - my @results; - - my @command = ('aur', 'query', '--type', 'info', @_); - my $child_pid = open(my $fh, "-|", @command) or die $!; - - if ($child_pid) { # parent process - while (my $row = <$fh>) { - chomp $row; - - # single JSON structure per request (max. 5000 packages per request) - push(@results, @{get_results(parse_json($row))}); - } - die if $!; - - waitpid($child_pid, 0); - } - exit(2) if $?; - - return @results; -} sub chain { - my ($targets, $types, $max_req, $handler) = @_; + my ($targets, $types, $max_req) = @_; my @depends = @{$targets}; my (%results, %reqby, %shlibs); @@ -75,9 +23,13 @@ sub chain { say STDERR "$argv0: total requests: $a (out of range)"; exit(34); } - my @level = $handler->(@depends); + my @level = query_multi(pkgs => \@depends, type => 'info', callback => \&parse_json_aur); - if (not scalar(@level)) { + if (not scalar(@level) and $a == 1) { + say STDERR "$argv0: no packages found"; + exit(1); + } + elsif (not scalar(@level)) { last; # no results } @depends = (); @@ -110,9 +62,7 @@ sub chain { push(@{$reqby{$dep}{$deptype}}, $node->{'Name'}); # avoid querying duplicate packages (#4) - if (defined $results{$dep}) { - next; - } + next if (defined $results{$dep}); push(@depends, $dep); # mark as incomplete (retrieved in next step or repo package) @@ -254,6 +204,7 @@ unless(caller) { 'a|all' => \$opt_show_all ) or exit(1); + # TODO: handle '-' as stdin argument my @types; push(@types, 'Depends') if $opt_depends; push(@types, 'MakeDepends') if $opt_makedepends; @@ -261,7 +212,7 @@ unless(caller) { push(@types, 'OptDepends') if $opt_optdepends; # Resolve dependency tree - my $results = chain_mod(chain(\@ARGV, \@types, 30, \&query), $opt_provides, $opt_show_all); + my $results = chain_mod(chain(\@ARGV, \@types, 30), $opt_provides, $opt_show_all); if ($opt_mode eq 'pairs') { pairs($results, ($opt_pkgname or $opt_show_all) ? 'Name' : 'PackageBase', $opt_reverse); @@ -273,8 +224,7 @@ unless(caller) { table_v10_compat($results, \@types); } elsif ($opt_mode eq 'json') { - $aur_json->canonical(); - say $aur_json->encode($results); + write_json($results); } else { say STDERR "$argv0: invalid mode selected"; diff --git a/lib/aur-format b/lib/aur-format index 74347ca8..8ed204dc 100755 --- a/lib/aur-format +++ b/lib/aur-format @@ -1,19 +1,13 @@ #!/usr/bin/env perl use strict; use warnings; + use open ":std", ":encoding(UTF-8)"; use POSIX qw(strftime); use v5.20; + +use AUR::Json qw(parse_json parse_json_aur); my $argv0 = 'format'; -my $aur_json; - -# Fallback to slower perl-based JSON parsing -if (eval { require JSON::XS; 1 }) { - $aur_json = JSON::XS->new; -} else { - require JSON::PP; - $aur_json = JSON::PP->new; -} # Dictionary for formatter string - subset of package-query(1) format options # Save type of attribute (AUR, pacman or both) for --dump-format @@ -42,7 +36,7 @@ my %aur_formats = ( 'o' => ['epoch', 'OutOfDate' ], 'S' => ['epoch', 'FirstSubmitted'], 'p' => ['numeric', 'Popularity' ], - 'w' => ['numeric', 'NumVotes' ], + 'w' => ['numeric', 'NumVotes' ] ); # Known AUR types for use with --format, --gron @@ -170,44 +164,6 @@ sub info_gron { } } -sub parse_json { - my $obj = $aur_json->incr_parse($_[0]) - or die $argv0 . ": expected JSON object or array at beginning of string"; - $aur_json->incr_reset(); - - return $obj; -} - -sub parse_json_aur { - my $row = $_[0]; - my $obj = parse_json($row); - - # Possible AUR responses: - # - JSON arrays: REST (suggests), metadata archives (pkgnames.git, pkgbases.git) - # - JSON hashes, `results` array: REST (info, search) - # - JSON hashes: metadata archives (pkgname.json, pkgbase.json) - if (ref($obj) eq 'HASH' and defined($obj->{'results'})) { - my $rref = $obj->{'results'}; - my $error = $obj->{'error'}; - - if (defined($error)) { - say STDERR $argv0 . ': response error (' . $error . ')'; - exit(4); - } - return @{$rref}; - } - elsif (ref($obj) eq 'HASH') { - return values %{$obj}; - } - elsif (ref($obj) eq 'ARRAY') { - return @{$obj}; - } - else { - say STDERR $argv0 . ": not an array or hash"; - exit(4); - } -} - # https://www.drdobbs.com/scripts-as-modules/184416165 unless (caller) { # option handling diff --git a/lib/aur-query b/lib/aur-query dissimilarity index 85% index 675cf987..db7fbc04 100755 --- a/lib/aur-query +++ b/lib/aur-query @@ -1,89 +1,42 @@ -#!/usr/bin/env perl -use strict; -use warnings; -use v5.20; - -my $argv0 = 'query'; -my @curl_args = ('-A', 'aurutils', '-fgLsSq'); - -# environment variables -my $aur_location = $ENV{AUR_LOCATION} // 'https://aur.archlinux.org'; -my $aur_rpc = $ENV{AUR_QUERY_RPC} // $aur_location . "/rpc"; -my $aur_rpc_ver = $ENV{AUR_QUERY_RPC_VERSION} // 5; -my $aur_splitno = $ENV{AUR_QUERY_RPC_SPLITNO} // 5000; - -# https://code.activestate.com/recipes/577450-perl-url-encode-and-decode/#c6 -sub urlencode { - my $s = shift; - $s =~ s/([^A-Za-z0-9])/sprintf("%%%2.2X", ord($1))/ge; - return $s; -} - -# option handling -use Getopt::Long; -my $opt_by; -my $opt_dry_run; -my $opt_type = ""; - -GetOptions('t|type=s' => \$opt_type, - 'b|by=s' => \$opt_by, - 'n|dry-run' => \$opt_dry_run) - or exit(1); - -# search requests take a single argument only -if ($opt_type eq "search" or $opt_type eq "suggest") { - $aur_splitno = 1; -} - -# process package names from stdin or the command-line -if (not scalar(@ARGV)) { - say STDERR "$argv0: at least one argument required"; - exit(1); -} -if ($ARGV[0] eq "-" or $ARGV[0] eq "/dev/stdin") { - while (my $arg = ) { - chomp($arg); - push(@ARGV, $arg); - } - shift(@ARGV); -} - -# generate POST data -my @forms; -my $NR = 0; - -# URI/URI::QueryParam is extremely slow for large inputs. Build the form data -# by hand and use sprintf to encode the package names. -for my $target (@ARGV) { - if ($NR % $aur_splitno == 0) { - # Create new form element - push @forms, ""; - - # Set fields and values - $forms[$#forms] .= '&by=' . $opt_by if defined($opt_by); - } - $forms[$#forms] .= '&arg[]=' . urlencode($target); - $NR++; -} - -# Output as JSON lines -for my $form (@forms) { - my @cmd = ('curl', @curl_args, "$aur_rpc/v$aur_rpc_ver/$opt_type", '--data-raw', $form); - - if ($opt_dry_run) { - say join(" ", map(qq/'$_'/, @cmd)); - } else { - my $child_pid = open(my $fh, "-|", @cmd) or die $!; - - if ($child_pid) { # parent process - say <$fh>; - die "$argv0: response error (multi-line output)" if defined(<$fh>); - - waitpid($child_pid, 0); - } - # Return a generic error code on `curl` failure, to avoid overlap with - # codes from other tools which use pipelines (`aur-repo`, `aur-vercmp`). - # 2 is the same code returned if `curl` is not found in `open` above. - exit(2) if $?; - } -} +#!/usr/bin/env perl +use strict; +use warnings; +use v5.20; + +use AUR::Query qw(query query_multi); +my $argv0 = 'query'; + +# option handling +use Getopt::Long; +my $opt_by; +my $opt_type = ""; + +GetOptions('t|type=s' => \$opt_type, + 'b|by=s' => \$opt_by, + 'r|raw' => sub { } # noop +) or exit(1); + +# process package names from the command-line +if (not scalar(@ARGV)) { + say STDERR "$argv0: at least one argument required"; + exit(1); +} +if (not length($opt_type)) { + say STDERR "$argv0: type must be specified"; + exit(1); +} +my $index = grep { $ARGV[$_] eq '-' or $ARGV[$_] eq '/dev/stdin' } (0 .. @ARGV-1); + +if ($index > 0) { + splice(@ARGV, $index, 1); # remove '-' + push(@ARGV, ); # add arguments from stdin + chomp(@ARGV); # remove newlines +} +my %args = (type => $opt_type, by => $opt_by, pkgs => \@ARGV, callback => sub { say @_ }); + +# search requests take a single argument only +if ($opt_type eq "search" or $opt_type eq "suggest") { + query(%args); +} else { + query_multi(%args); +} diff --git a/lib/aur-search b/lib/aur-search index 07fdb982..62bf0485 100755 --- a/lib/aur-search +++ b/lib/aur-search @@ -10,60 +10,31 @@ use Term::ANSIColor qw(:constants); use constant OSC8 => "\033]8"; use constant ST => "\033\\"; +use AUR::Json qw(parse_json_aur write_json); +use AUR::Query qw(query query_multi); my $argv0 = 'search'; -my $aur_json; my $aur_location = $ENV{AUR_LOCATION} // 'https://aur.archlinux.org'; # sprintf, strftime() setlocale(LC_NUMERIC, 'C'); setlocale(LC_TIME, 'C'); -# Fallback to slower perl-based JSON parsing -if (eval { require JSON::XS; 1 }) { - $aur_json = JSON::XS->new; -} else { - require JSON::PP; - $aur_json = JSON::PP->new; -} - -sub parse_json { - my $row = shift; - - my $obj = $aur_json->incr_parse($row) - or die $argv0 . ": expected JSON object or array at beginning of string"; - $aur_json->incr_reset(); - - return $obj; -} - -sub get_results { - my $obj = shift; - - if (ref($obj) eq 'ARRAY') { - return $obj; - } - elsif ($obj->{'type'} eq 'error') { - say STDERR "$argv0: $obj->{'error'}"; - exit(4); - } - return $obj->{'results'}; -} - sub format_long { my $pkg = shift; + # Custom fixed order for info output + my @keys = ( + 'Name' , 'PackageBase' , 'Version' , 'Description' , 'URL', + 'Keywords' , 'License' , 'Maintainer' , 'Submitter' , 'NumVotes', + 'Popularity' , 'OutOfDate' , 'FirstSubmitted' , 'LastModified', 'Depends', + 'MakeDepends', 'CheckDepends', 'OptDepends' + ); my $url = join("/", $aur_location, $pkg->{'Name'}); say BOLD, sprintf("%-15s", "AUR URL:"), RESET, ' ', $url; - # Custom fixed order for info output - my @keys = ( - 'Name' , 'PackageBase' , 'Version' , 'Description' , 'URL', - 'Keywords' , 'License' , 'Maintainer' , 'Submitter' , 'NumVotes', - 'Popularity' , 'OutOfDate' , 'FirstSubmitted' , 'LastModified', 'Depends', - 'MakeDepends', 'CheckDepends', 'OptDepends' - ); + # XXX: overlap with info_expand_field() from aur-format for my $k (@keys) { - # XXX: duplicates info_expand_field() from aur-format my $f; + if (ref $pkg->{$k} eq 'ARRAY') { $f = join(' ', @{$pkg->{$k} // ['-']}); } elsif ($k eq 'LastModified' or $k eq 'OutOfDate' or $k eq 'FirstSubmitted') { @@ -143,7 +114,6 @@ unless(caller) { my $opt_color = 'auto'; my $opt_reverse = 0; my $opt_format = ''; - my $opt_stdin = 0; # XXX: add option to disable set operations, --time-format GetOptions ( @@ -162,8 +132,7 @@ unless(caller) { 'J|json' => sub { $opt_format = 'json' }, 'color=s' => \$opt_color, 'r|reverse' => \$opt_reverse, - 'k|key=s' => \$opt_sort_key, - 'json-stdin' => \$opt_stdin # disambiguate `-`, `/dev/stdin` + 'k|key=s' => \$opt_sort_key ) or exit(1); # Colored messages on both stdout and stderr may be desired if stdout is not @@ -186,23 +155,18 @@ unless(caller) { } # Retrieve JSON responses - my @command = $opt_stdin ? ('cat') : ('aur', 'query', '-t', $opt_type, @ARGV); my @results; - my $child_pid = open(my $fh, "-|", @command) or die $!; - # Build list of results starting at the first response. - if ($child_pid) { - my $first = <$fh>; - chomp $first if defined $first; + # TODO: handle '-' as stdin argument + if ($opt_type eq 'search') { + # Apply union/intersection starting at the first argument + my %query_args = (type => 'search', by => $opt_search_by, callback => \&parse_json_aur); + my $first = shift; + @results = query(pkgs => [$first], %query_args); - if (length($first)) { - @results = @{get_results(parse_json($first))}; - } my %seen; - - while (my $row = <$fh>) { - chomp $row; - my @next = @{get_results(parse_json($row))}; + for my $arg (@ARGV) { + my @next = query(pkgs => [$arg], %query_args); if ($opt_multiple eq 'union') { results_union(\@next, \@results, \%seen, 'Name'); @@ -214,18 +178,17 @@ unless(caller) { push(@results, @next); } } - die if $!; - - waitpid($child_pid, 0); } - exit(2) if $?; + elsif ($opt_type eq 'info') { + # Union/intersection do not apply to info-style requests + @results = query_multi(pkgs => \@ARGV, type => 'info', callback => \&parse_json_aur); + } exit(1) if scalar @results == 0; # Apply sorting criteria if (length $opt_sort_key or $opt_reverse) { results_rsort(\@results, $opt_sort_key, $opt_reverse); } - # Format results to standard output if ($opt_format eq 'short') { map { format_short($_) } @results; @@ -235,12 +198,11 @@ unless(caller) { map { format_long($_); say '' if ++$i < scalar @results } @results; } elsif ($opt_format eq 'json') { - $aur_json->canonical(); - say $aur_json->encode(\@results); + write_json(\@results); } else { die 'invalid format'; } } -# vim: set et sw=4 sts=4 ft=awk: +# vim: set et sw=4 sts=4 ft=perl: diff --git a/makepkg/aurutils.changelog b/makepkg/aurutils.changelog index a30cc5c1..a3bc49f5 100644 --- a/makepkg/aurutils.changelog +++ b/makepkg/aurutils.changelog @@ -44,11 +44,10 @@ + perl rewrite + remove support for parallel (`AUR_QUERY_PARALLEL`) and `GET` requests + set operations (union, intersection) are moved to `aur-search` - - remove `--any` - + print curl command-lines with `--dry-run` - - remove `--dump-curl-config` - + `--raw` output is now the default - - remove `--exit-if-empty`, `--raw` + - remove `--any`, `--exit-if-empty` + - `--raw` is noop + + remove `--dump-curl-config` + - print command-lines with `AUR_DEBUG=1` * `aur-search` + perl rewrite diff --git a/man1/aur-depends.1 b/man1/aur-depends.1 index 39e667b8..ec7f6558 100644 --- a/man1/aur-depends.1 +++ b/man1/aur-depends.1 @@ -1,4 +1,4 @@ -.TH AUR-DEPENDS 1 2022-07-03 AURUTILS +.TH AUR-DEPENDS 1 2023-01-13 AURUTILS .SH NAME aur\-depends \- retrieve dependencies using aurweb . @@ -12,38 +12,28 @@ aur\-depends \- retrieve dependencies using aurweb .B aur\-depends solves dependencies for packages provided on the command line using .BR aur\-query (1). -The transitive closure of dependencies within AUR is computed. +The transitive closure of dependencies within AUR is computed. Dependency +information is printed to standard output as edges +.BR \%pkgbase\etdepends , +where +.I depends +is resolved to +.BR pkgbase +by default. . .SH OPTIONS .TP -.BR \-b ", " \-\-pkgbase -Print dependency information (AUR-only) to stdout as -.BR pkgbase , -in total order. -. -.TP .BR \-n ", " \-\-pkgname -Print dependency information (AUR-only) to stdout as -.BR pkgname , -in total order. -. -.TP -.BR \-a ", " \-\-pkgname\-all Print dependency information to stdout as -.BR pkgname , -in total order. Direct -.BR pacman (8) -dependencies of one or more AUR dependencies -are included. +.BR pkgname +instead of +.BR pkgbase . . .TP -.BR \-G ", " \-\-graph -Print dependency information to stdout as edges -.BR \%pkgbase\etdepends , -where -.I depends -is resolved to -.BR pkgbase . +.BR \-a ", " \-\-all +Include direct +.BR pacman (8) +dependencies of dependencies in the output. . .TP .BR \-t ", " \-\-table @@ -62,15 +52,11 @@ and .BR OptDepends . . .TP -.BR \-J ", " \-\-json -Print dependency information as JSON. The union of all results is taken by -.BR pkgname . +.BR \-r ", " \-\-reverse . .TP -.BR \-\-raw -Print dependency information as JSON Lines (JSONL), where each line contains an -.BR aur\-query (1) -response. +.BR \-J ", " \-\-json +Print dependency information as JSON. . .SS Dependency options When resolving dependencies, @@ -93,6 +79,9 @@ and options. In particular, these options may be used to bypass cycles between dependencies of differing types. . +.TP +.BR \-\-no\-provides +. .SH NOTES Version information is ignored for dependencies. See .B FS#54906 diff --git a/man1/aur-query.1 b/man1/aur-query.1 index 3b736f36..14f13bfe 100644 --- a/man1/aur-query.1 +++ b/man1/aur-query.1 @@ -55,12 +55,6 @@ Type of request. Can be one of or .BR suggest . . -.TP -.BR \-n ", " \-\-dry\-run -Show -.BR curl (1) -command-lines instead of executing them. -. .SH EXIT STATUS .B aur\-query returns 0 if no errors occurred, 1 if an invalid option was specified, @@ -94,6 +88,12 @@ request. The version for the RPC endpoint. Defaults to .IR 5 . . +.TP +.B AUR_DEBUG +Display +.BR curl (1) +command-lines prior to running them. +. .SH NOTES The default set of options for .BR curl (1) diff --git a/perl/AUR.pm b/perl/AUR.pm new file mode 100644 index 00000000..6fd678bc --- /dev/null +++ b/perl/AUR.pm @@ -0,0 +1,4 @@ +package AUR; +use strict; +use warnings; +use v5.20; diff --git a/perl/AUR/Json.pm b/perl/AUR/Json.pm new file mode 100644 index 00000000..5fc5650a --- /dev/null +++ b/perl/AUR/Json.pm @@ -0,0 +1,97 @@ +package AUR::Json; +use strict; +use warnings; +use v5.20; + +use Exporter qw(import); +our @EXPORT = qw(parse_json parse_json_aur write_json); +our $VERSION = 'unstable'; + +=head1 NAME + +AUR::Json - Perl interface to AurJson + +=head1 SYNOPSIS + + use AUR::Json qw(parse_json_aur write_json); + + my $json; + my @results = parse_json_aur($json); + my $object = parse_json($json); + write_json($object); + +=head1 DESCRIPTION + +This module provides Perl aur(1) scripts a coherent way to deal with +AurJson responses. In particular, parse_json_aur() returns an array of +package results for variable AUR inputs (both from AurJson and +metadata archives. + +If JSON::XS is available, this module will use it for JSON +parsing. JSON::PP shipped with Perl is used as a fallback. + +TODO: The interface is in its early stages and is prone to change in +later versions. Possible additions include AUR types for common use +with aur-format(1) and aur-search(1). + +=head1 AUTHORS + +Alad Wenter + +=cut + +my $aur_json; + +# Fallback to slower perl-based JSON parsing +if (eval { require JSON::XS; 1 }) { + $aur_json = JSON::XS->new; +} +else { + require JSON::PP; + $aur_json = JSON::PP->new; +} + +sub parse_json { + my $str = shift; + my $obj = $aur_json->incr_parse($str) + or die __PACKAGE__ . ": expected JSON object or array at beginning of string"; + $aur_json->incr_reset(); + + return $obj; +} + +sub parse_json_aur { + my $str = shift; + my $obj = parse_json($str); + + # Possible AUR responses: + # - JSON arrays: REST (suggests), metadata archives (pkgnames.git, pkgbases.git) + # - JSON hashes, `results` array: REST (info, search) + # - JSON hashes: metadata archives (pkgname.json, pkgbase.json) + if (ref($obj) eq 'HASH' and defined($obj->{'results'})) { + my $error = $obj->{'error'}; + + if (defined($error)) { + say STDERR __PACKAGE__ . ': response error (' . $error . ')'; + exit(4); + } + return @{$obj->{'results'}}; + } + elsif (ref($obj) eq 'HASH') { + return values %{$obj}; + } + elsif (ref($obj) eq 'ARRAY') { + return @{$obj}; + } + else { + say STDERR __PACKAGE__ . ": not an array or hash"; + exit(4); + } +} + +sub write_json { + my $obj = shift; + say $aur_json->canonical()->encode($obj); +} + +# vim: set et sw=4 sts=4 ft=perl: diff --git a/perl/AUR/Query.pm b/perl/AUR/Query.pm new file mode 100644 index 00000000..84212d4f --- /dev/null +++ b/perl/AUR/Query.pm @@ -0,0 +1,111 @@ +package AUR::Query; +use strict; +use warnings; +use v5.20; +use Carp; + +use Exporter qw(import); +our @EXPORT = qw(urlencode query query_multi); +our $VERSION = 'unstable'; + +=head1 NAME + +AUR::Query - Retrieve data from AurJSON + +=head1 SYNOPSIS + + use AUR::Query; + + # type=search, performs one query for each argument + my @search = query(pkgs => ['foo', 'bar'], type => 'search', by => 'name-desc'); + + # type=info, performs one query for multiple arguments + my @info = query_multi(pkgs => ['bar', 'baz'], type => 'info'); + +=head1 DESCRIPTION + +This module offers perl aur(1) scripts a direct way to retrieve data from AurJson +using POST requests. Arguments are url-encoded beforehand. + +=head1 AUTHORS + +Alad Wenter + +=cut + +# environment variables +our $aur_location = $ENV{AUR_LOCATION} // 'https://aur.archlinux.org'; +our $aur_rpc = $ENV{AUR_QUERY_RPC} // $aur_location . "/rpc"; +our $aur_rpc_ver = $ENV{AUR_QUERY_RPC_VERSION} // 5; +our $aur_splitno = $ENV{AUR_QUERY_RPC_SPLITNO} // 5000; + +# https://code.activestate.com/recipes/577450-perl-url-encode-and-decode/#c6 +sub urlencode { + my $s = shift; + $s =~ s/([^A-Za-z0-9])/sprintf("%%%2.2X", ord($1))/ge; + return $s; +} + +sub data_post { + my ($args, $splitno, $by) = @_; + my @forms; + my $NR = 0; + + for my $target (@{$args}) { + if ($NR % $splitno == 0) { + # Create new form element + push @forms, ""; + + # Set by field (search) + $forms[$#forms] .= '&by=' . $by if defined($by); + } + $forms[$#forms] .= '&arg[]=' . urlencode($target); + $NR++; + } + return @forms; +} + +sub query_post { + my ($data, $path) = @_; + my @cmd = ('curl', '-A', 'aurutils', '-fgLsSq', $path, '--data-raw', $data); + + if (defined $ENV{'AUR_DEBUG'}) { + say STDERR join(" ", map(qq/'$_'/, @cmd)); + } + my $str; + my $child_pid = open(my $fh, "-|", @cmd) or die $!; + + if ($child_pid) { # parent process + $str = <$fh>; + croak 'response error (multi-line output)' if defined(<$fh>); + + waitpid($child_pid, 0); + } + # Return a generic error code on `curl` failure, to avoid overlap with + # codes from other tools which use pipelines (`aur-repo`, `aur-vercmp`). + # 2 is the same code returned if `curl` is not found in `open` above. + exit (2) if $?; + return $str; +} + +# Use named parameters for default value of splitno/aur_splitno +sub query_multi { + my %args = (type => undef, by => undef, pkgs => [], splitno => $aur_splitno, callback => undef, @_); + my $path = "$aur_rpc/v$aur_rpc_ver/$args{type}"; + my @results; + + # TODO/Idea: let callback handle both @results and $response (aur-search union/intersection) + for my $data (data_post($args{pkgs}, $args{splitno}, $args{by})) { + my $response = query_post($data, $path); + + defined $args{callback} ? push(@results, $args{callback}->($response)) + : push(@results, $response); + } + return @results; +} + +sub query { + return query_multi(splitno => 1, @_); +} + +# vim: set et sw=4 sts=4 ft=perl: diff --git a/perl/Makefile b/perl/Makefile new file mode 100644 index 00000000..e161acaf --- /dev/null +++ b/perl/Makefile @@ -0,0 +1,8 @@ +PREFIX ?= /usr +SHRDIR ?= $(PREFIX)/share +PRLDIR ?= $(SHRDIR)/perl5/vendor_perl +.PHONY = install-perl + +install-perl: + @install -Dm644 AUR/*.pm -t '$(DESTDIR)$(PRLDIR)/AUR' + @install -Dm644 AUR.pm -t '$(DESTDIR)$(PRLDIR)' diff --git a/tests/parseopt-consistency b/tests/parseopt-consistency index f893bff7..e44f7c84 100755 --- a/tests/parseopt-consistency +++ b/tests/parseopt-consistency @@ -17,7 +17,10 @@ parse_loop() { } ret=0 -for aurcmd in "${BASH_SOURCE%/*}"/../lib/!(aur-graph|aur-sync--ninja|aur-format|aur-repo-parse|aur-query|aur-fetch--mirror|aur-build--sync|aur-search--helper); do +have_optdump=(aur-build aur-chroot aur-fetch aur-pkglist aur-repo aur-repo-filter aur-srcver aur-sync aur-vercmp aur-view) +for cmd in "${have_optdump[@]}"; do + aurcmd=${BASH_SOURCE%/*}/../lib/$cmd + diff --color -U0 --label "$aurcmd Options" --label "$aurcmd Loop" \ <(bash --pretty-print -O extglob "$aurcmd" | parse_loop | sort) \ <(AUR_DEBUG=1 command "$aurcmd" --dump-options 2>/dev/null | sort) -- 2.11.4.GIT