perl/AUR/Query.pm

   1 package AUR::Query;
   2 use strict;
   3 use warnings;
   4 use v5.20;
   5 use Carp;
   6
   7 use Exporter qw(import);
   8 our @EXPORT_OK = qw(urlencode query query_multi);
   9 our $VERSION = 'unstable';
  10
  11 =head1 NAME
  12
  13 AUR::Query - Retrieve data from AurJSON
  14
  15 =head1 SYNOPSIS
  16
  17   use AUR::Query;
  18
  19   # type=search, one GET request per argument
  20   my $search = query(term => 'foo', type => 'search', by => 'name-desc');
  21
  22   # type=info, one POST request for multiple arguments
  23   my @info = query_multi(terms => ['bar', 'baz'], type => 'info');
  24
  25 =head1 DESCRIPTION
  26
  27 This module offers perl aur(1) scripts a direct way to retrieve data from AurJson
  28 using GET or POST requests. Arguments are url-encoded beforehand.
  29
  30 =head1 AUTHORS
  31
  32 Alad Wenter <https://github.com/AladW>
  33
  34 =cut
  35
  36 # environment variables
  37 our $aur_location = $ENV{AUR_LOCATION}  // 'https://aur.archlinux.org';
  38 our $aur_rpc      = $ENV{AUR_QUERY_RPC} // $aur_location . "/rpc";
  39 our $aur_rpc_ver  = $ENV{AUR_QUERY_RPC_VERSION} // 5;
  40 our $aur_splitno  = $ENV{AUR_QUERY_RPC_SPLITNO} // 5000;
  41
  42 =item urlencode()
  43
  44 =cut
  45
  46 # https://code.activestate.com/recipes/577450-perl-url-encode-and-decode/#c6
  47 sub urlencode {
  48     my $s = shift;
  49     $s =~ s/([^A-Za-z0-9])/sprintf("%%%2.2X", ord($1))/ge;
  50     return $s;
  51 }
  52
  53 sub query_curl {
  54     my @cmd = ('curl', '-A', 'aurutils', '-fgLsSq', @_);
  55
  56     if (defined $ENV{'AUR_DEBUG'}) {
  57         say STDERR join(" ", map(qq/'$_'/, @cmd));
  58     }
  59     my $str;
  60     my $child_pid = open(my $fh, "-|", @cmd) or die $!;
  61
  62     if ($child_pid) { # parent process
  63         $str = <$fh>;
  64         croak 'response error (multi-line output)' if defined(<$fh>);
  65
  66         waitpid($child_pid, 0);
  67     }
  68     # Return a generic error code on `curl` failure, to avoid overlap with
  69     # codes from other tools which use pipelines (`aur-repo`, `aur-vercmp`).
  70     # 2 is the same code returned if `curl` is not found in `open` above.
  71     exit (2) if $?;
  72     return $str;
  73 }
  74
  75 =item query()
  76
  77 =cut
  78
  79 # XXX: accept arbitrary suffix/parameter instead of $by
  80 sub query {
  81     my %args = (type => undef, term => undef, by => undef, callback => undef, @_);
  82     if (not defined $args{term}) {
  83         die 'query: no search term supplied';
  84     }
  85     my $term = urlencode($args{term});
  86     my $path = "$aur_rpc/v$aur_rpc_ver/$args{type}/$term";
  87
  88     if (defined $args{by}) {
  89         $path = join('?by=', $path, $args{by});
  90     }
  91     my $response = query_curl($path);
  92
  93     defined $args{callback} ? return $args{callback}->($response)
  94                             : return $response;
  95 }
  96
  97 =item query_multi()
  98
  99 =cut
 100
 101 # XXX: this can also be used to split GET requests
 102 sub query_multi {
 103     my %args = (type => undef, terms => [], splitno => $aur_splitno, callback => undef, @_);
 104     croak if defined $args{by}; # searches should be done with query()
 105
 106     if (scalar @{$args{terms}} == 0) {
 107         die 'query_multi: no search terms supplied';
 108     }
 109     my @results;
 110
 111     # n-ary queue processing (aurweb term limit)
 112     while (my @next = splice(@{$args{terms}}, 0, $args{splitno})) {
 113         my $data;
 114         map { $data .= '&arg[]=' . urlencode($_) } @next;
 115
 116         # XXX: let callback handle both @results and $response (aur-search union/intersection)
 117         my $response = query_curl("$aur_rpc/v$aur_rpc_ver/$args{type}", '--data-raw', $data);
 118
 119         defined $args{callback} ? push(@results, $args{callback}->($response))
 120                                 : push(@results, $response);
 121     }
 122     return @results;
 123 }
 124
 125 # vim: set et sw=4 sts=4 ft=perl: