lib/aur-repo-parse

   1 #!/usr/bin/env perl
   2 use strict;
   3 use warnings;
   4 use v5.20;
   5
   6 use open ":std", ":encoding(UTF-8)";
   7 use Cwd 'abs_path';
   8 use File::Basename;
   9
  10 use AUR::Json qw(write_json);
  11 use AUR::Repo qw(check_attr list_attr parse_db);
  12 my $argv0 = 'repo-parse';
  13
  14 # Handlers for filtering data
  15 sub entry_search {
  16     my ($expr, $entry_data) = @_;
  17
  18     if (length($expr) and defined($entry_data)) {
  19         # Search entry-by-entry on arrays
  20         if (ref($entry_data) eq 'ARRAY') {
  21             return grep(/$expr/, @{$entry_data});
  22         } else {
  23             return $entry_data =~ /$expr/;
  24         }
  25     } else {
  26         return defined($entry_data);
  27     }
  28 }
  29
  30 # XXX: ignore for array types
  31 sub repo_filter {
  32     my ($callback, $search, $search_by, $ignore, $ignore_by,
  33         $pkg, $count, $last, @varargs) = @_;
  34
  35     my $pkg_ignore = defined $ignore->{$pkg->{$ignore_by}};
  36
  37     if (entry_search($search, $pkg->{$search_by}) and not $pkg_ignore) {
  38         $callback->($pkg, $count, $last, @varargs);
  39         return 1;  # increase count (parse_db)
  40     } else {
  41         $callback->(undef, $count, $last, @varargs);
  42         return 0;
  43     }
  44 }
  45
  46 # Handlers for varying output formats
  47 sub repo_json {
  48     my ($pkg, $count, $last, $db_path, $db_name) = @_;
  49
  50     if (defined $pkg) {
  51         # Additional fields for `aur-format`
  52         $pkg->{'DBPath'}     = $db_path;
  53         $pkg->{'Repository'} = $db_name;
  54
  55         print '[' if $count == 1;
  56         print ',' if $count  > 1;
  57
  58         my $json_text = write_json($pkg);
  59         print $json_text;
  60     }
  61     print "]\n" if $last == 1;
  62 }
  63
  64 sub repo_jsonl {
  65     my ($pkg, undef, undef, $db_path, $db_name) = @_;
  66     return if not defined $pkg;
  67
  68     # Additional fields for `aur-format`
  69     $pkg->{'DBPath'}     = $db_path;
  70     $pkg->{'Repository'} = $db_name;
  71
  72     my $json_text = write_json($pkg);
  73     print $json_text . "\n";
  74 }
  75
  76 sub repo_list {
  77     my ($pkg, undef, undef, $delim, $quiet) = @_;
  78     return if not defined $pkg;
  79
  80     my $name = $pkg->{'Name'};
  81     my $pver = $pkg->{'Version'};
  82
  83     if ($quiet) {
  84         say $name;
  85     } else {
  86         say join($delim, $name, $pver);
  87     }
  88 }
  89
  90 sub repo_table {
  91     my ($pkg, undef, undef, $delim) = @_;
  92     return if not defined $pkg;
  93
  94     my $name = $pkg->{'Name'};
  95     my $base = $pkg->{'PackageBase'};
  96     my $pver = $pkg->{'Version'};
  97
  98     say join($delim, $name, $name, $base, $pver, 'Self');
  99
 100     for my $key ('Depends', 'MakeDepends', 'CheckDepends') {
 101         if (ref($pkg->{$key}) eq 'ARRAY') {
 102             map { say join($delim, $name, $_, $base, $pver, $key) } @{$pkg->{$key}};
 103         }
 104     }
 105 }
 106
 107 sub repo_attr {
 108     my ($pkg, undef, undef, $label) = @_;
 109     return if not defined $pkg;
 110
 111     my $value = $pkg->{$label};
 112
 113     if (defined($value) and ref($value) eq 'ARRAY') {
 114         say join("\n", @{$value});
 115     } elsif (defined($value)) {
 116         say $value;
 117     }
 118 }
 119
 120 sub check_option {
 121     my ($opt, $opt_label, $attr_def) = @_;
 122
 123     if (length $opt) {
 124         my $attr = check_attr(uc($opt));
 125
 126         if (not defined $attr) {
 127             say STDERR "$argv0: $opt_label: unknown attribute '$opt'";
 128             exit(2);
 129         }
 130         return $attr;
 131     } else {
 132         return $attr_def;
 133     }
 134 }
 135
 136 unless (caller) {
 137     use Getopt::Long;
 138     my $opt_json = 0;
 139     my $opt_jsonl = 0;
 140     my $opt_list = 0;
 141     my $opt_list_attr = 0;
 142     my $opt_table = 0;
 143     my $opt_quiet = 0;
 144     my $opt_delim;
 145     my $opt_attr = "";
 146     my @opt_db_path;
 147     my $opt_stdin = 0;
 148     my $opt_search = "" ;
 149     my $opt_search_by;
 150     my @opt_ignore;
 151     my $opt_ignore_by;
 152
 153     GetOptions('J|json'         => \$opt_json,
 154                'jsonl'          => \$opt_jsonl,
 155                'F|field|attr=s' => \$opt_attr,
 156                'l|list'         => \$opt_list,
 157                'q|quiet'        => \$opt_quiet,
 158                't|table'        => \$opt_table,
 159                'd|delim'        => \$opt_delim,
 160                'list-attr'      => \$opt_list_attr,
 161                'p|path=s'       => \@opt_db_path,
 162                's|search=s'     => \$opt_search,
 163                'search-by=s'    => \$opt_search_by,
 164                'i|ignore=s'     => \@opt_ignore,
 165                'ignore-by=s'    => \$opt_ignore_by
 166         )
 167         or exit(1);
 168
 169     if (scalar(@ARGV) > 0 and ($ARGV[0] eq "-" or $ARGV[0] eq "/dev/stdin")) {
 170         $opt_stdin = 1;
 171     }
 172     elsif ($opt_list_attr) {
 173         say join("\n", list_attr());
 174         exit(0);
 175     }
 176     elsif (scalar(@opt_db_path) < 1 and not $opt_stdin) {
 177         say STDERR $argv0 . ': repository path must be specified';
 178         exit(1);
 179     }
 180
 181     # Callback function run on each entry in the database
 182     my ($callback, @varargs);
 183
 184     if ($opt_json) {
 185         $callback = \&repo_json;
 186         # @varargs defined in input loop
 187     }
 188     elsif ($opt_jsonl) {
 189         $callback = \&repo_jsonl;
 190         # @varargs defined in input loop
 191     }
 192     elsif (length($opt_attr)) {
 193         my $attr_label = check_attr($opt_attr);
 194
 195         if (not defined $attr_label) {
 196             say STDERR "$argv0: unknown attribute '$opt_attr'";
 197             exit(2);
 198         }
 199         $callback = \&repo_attr;
 200         @varargs  = ($attr_label);
 201     }
 202     elsif ($opt_list) {
 203         $callback = \&repo_list;
 204         @varargs  = (length($opt_delim) ? $opt_delim : "\t", $opt_quiet);
 205     }
 206     elsif ($opt_table) {
 207         $callback = \&repo_table;
 208         @varargs  = (length($opt_delim) ? $opt_delim : "\t");
 209     }
 210     else {
 211         say STDERR $argv0 . ': no mode specified';
 212         exit(1);
 213     }
 214
 215     # Verify search field
 216     my $search = length($opt_search) ? $opt_search : "";
 217     my $search_by = check_option($opt_search_by, '--search-by', 'Name');
 218
 219     # Verify ignores field
 220     my %ignore;
 221     $ignore{$_}++ for (map { split(',', $_) } @opt_ignore);
 222     my $ignore_by = check_option($opt_ignore_by, '--ignore-by', 'Name');
 223
 224     # Take input from stdin instead of a pacman database
 225     if ($opt_stdin) {
 226         @varargs = ("/dev/stdin", "local") if ($opt_json or $opt_jsonl);
 227
 228         my $count = parse_db(*STDIN, 'FILENAME', sub {
 229             repo_filter($callback, $search, $search_by, \%ignore, $ignore_by, @_);
 230         }, @varargs);
 231
 232         exit(0);
 233     }
 234
 235     # bsdtar(1) does not support extracting multiple files in a single invocation,
 236     # so fork a new process for each specified path.
 237     for my $db_path (@opt_db_path) {
 238         my $db_abs_path = abs_path($db_path);
 239         my $db_name = basename($db_path);
 240
 241         if (not length($db_abs_path)) {
 242             say STDERR $argv0 . ": file path '$db_path' not found";
 243             exit(2);
 244         }
 245
 246         # repo-add(8) only accepts *.db or *.db.tar* extensions
 247         if ($db_name =~ /\.(db|files)(\.tar(\.\w+)?)?$/g) {
 248             $db_name = substr $db_name, 0, $-[0];
 249         } else {
 250             say STDERR "$argv0: $db_name does not have a valid database archive extension";
 251             exit(1);
 252         }
 253
 254         # When parsing the database, do not require a full extraction to either memory or disk
 255         # by reading `tar` output line-by-line. It is not strictly necessary to depend on
 256         # attribute order (i.e. %FILENAME% occuring in first place) while doing so; however,
 257         # the `--verbose` flag printing file names has different behavior for different `tar`
 258         # versions. Specifically, `bsdtar -xv` does not add a newline after the file path,
 259         # while `tar -xv` does.
 260         my $child_pid = open(my $fh, "-|", 'bsdtar', '-Oxf', $db_abs_path) or die $!;
 261
 262         if ($child_pid) { # parent process
 263             @varargs = ($db_abs_path, $db_name) if ($opt_json or $opt_jsonl);
 264
 265             my $count = parse_db($fh, 'FILENAME', sub {
 266                 repo_filter($callback, $search, $search_by, \%ignore, $ignore_by, @_);
 267             }, @varargs);
 268         }
 269         exit(2) if $?;
 270     }
 271 }
 272
 273 # vim: set et sw=4 sts=4 ft=perl: