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 my $argv0 = 'repo-parse';
  12
  13 # Attributes which (where applicable) match AurJson, such that `aur-repo-parse --json`
  14 # can be piped to `aur-format`.
  15 my %repo_add_attributes = (
  16     'ARCH'      => 'Arch',       'BASE'         => 'PackageBase',   'BUILDDATE'   => 'BuildDate',
  17     'CONFLICTS' => 'Conflicts',  'CHECKDEPENDS' => 'CheckDepends',  'CSIZE'       => 'CSize',
  18     'DEPENDS'   => 'Depends',    'DESC'         => 'Description',   'FILENAME'    => 'FileName',
  19     'ISIZE'     => 'ISize',      'LICENSE'      => 'License',       'MAKEDEPENDS' => 'MakeDepends',
  20     'MD5SUM'    => 'Md5Sum',     'NAME'         => 'Name',          'OPTDEPENDS'  => 'OptDepends',
  21     'PACKAGER'  => 'Packager',   'PROVIDES'     => 'Provides',      'REPLACES'    => 'Replaces',
  22     'SHA256SUM' => 'Sha256Sum',  'URL'          => 'URL',           'VERSION'     => 'Version',
  23     'PGPSIG'    => 'PgpSig',     'GROUPS'       => 'Groups',        'FILES'       => 'Files'
  24 );
  25
  26 my %repo_add_array = (
  27     'GROUPS'  => 1, 'LICENSE'    => 1, 'REPLACES'    => 1, 'CONFLICTS'    => 1, 'PROVIDES' => 1,
  28     'DEPENDS' => 1, 'OPTDEPENDS' => 1, 'MAKEDEPENDS' => 1, 'CHECKDEPENDS' => 1, 'FILES'    => 1
  29 );
  30
  31 # md5sum and sha256sum are numeric values, but too large to be represented in int32/64.
  32 my %repo_add_numeric = (
  33     'BUILDDATE' => 1, 'CSIZE' => 1, 'ISIZE' => 1
  34 );
  35
  36
  37 sub entry_search {
  38     my ($expr, $entry_data) = @_;
  39
  40     if (length($expr) and defined($entry_data)) {
  41         # Search entry-by-entry on arrays
  42         if (ref($entry_data) eq 'ARRAY') {
  43             return grep(/$expr/, @{$entry_data});
  44         } else {
  45             return $entry_data =~ /$expr/;
  46         }
  47     } else {
  48         return defined($entry_data);
  49     }
  50 }
  51
  52 sub parse_db {
  53     my ($fh, $db_path, $db_name, $header, $handler, $search_expr, $search_label, @varargs) = @_;
  54     my $count = 0;
  55     my ($entry, $filename, $attr, $attr_label);
  56
  57     while (my $row = <$fh>) {
  58         chomp($row);
  59
  60         if ($row =~ /^%\Q$header\E%$/) {
  61             $filename = readline($fh);
  62             chomp($filename);
  63
  64             # Evaluate condition on previous entry and run handler
  65             if ($count > 0) {
  66                 if (entry_search($search_expr, $entry->{$search_label})) {
  67                     $handler->($entry, $count, 0, @varargs);
  68                 }
  69                 ++$count;
  70             } else {
  71                 ++$count;
  72             }
  73             # New entry in the database (hashref)
  74             %{$entry} = ();
  75             $entry->{'DBPath'} = $db_path;
  76             $entry->{'Repository'} = $db_name;
  77             $entry->{$repo_add_attributes{$header}} = $filename;
  78         }
  79         elsif ($row =~ /^%.+%$/) {
  80             if (not length($filename)) {
  81                 die "$argv0: attribute '$header' not set";
  82             }
  83             $attr = substr($row, 1, -1);
  84             $attr_label = $repo_add_attributes{$attr};
  85
  86             if (not defined $attr_label) {
  87                 warn "$argv0: unknown attribute '$attr'";
  88                 $attr_label = ucfirst(lc($attr));
  89             }
  90         }
  91         elsif ($row eq "") {
  92             next;
  93         }
  94         else {
  95             die unless length($attr) and length($attr_label);
  96
  97             if (defined($repo_add_numeric{$attr})) {
  98                 $entry->{$attr_label} = $row + 0; # integer type
  99             } elsif (defined($repo_add_array{$attr})) {
 100                 push(@{$entry->{$attr_label}}, $row); # array type
 101             } else {
 102                 $entry->{$attr_label} = $row; # string type
 103             }
 104         }
 105     }
 106     # Process last entry
 107     if ($count > 0) {
 108         if (entry_search($search_expr, $entry->{$search_label})) {
 109             $handler->($entry, $count, 1, @varargs);
 110         } else {
 111             # Run handler with empty input to ensure correct termination for --json (#1120)
 112             $handler->(undef, $count, 1, @varargs);
 113         }
 114     }
 115     return $count;
 116 }
 117
 118 sub repo_json {
 119     my ($pkg, $count, $last) = @_;
 120
 121     if (defined $pkg) {
 122         print '[' if $count == 1;
 123         print ',' if $count  > 1;
 124
 125         my $json_text = write_json($pkg);
 126         print $json_text;
 127     }
 128     print "]\n" if $last  == 1;
 129 }
 130
 131 sub repo_jsonl {
 132     my ($pkg, undef, undef) = @_;
 133     return if not defined $pkg;
 134
 135     my $json_text = write_json($pkg);
 136     print $json_text . "\n";
 137 }
 138
 139 sub repo_list {
 140     my ($pkg, undef, undef, $delim, $quiet) = @_;
 141     return if not defined $pkg;
 142
 143     my $name = $pkg->{'Name'};
 144     my $pver = $pkg->{'Version'};
 145
 146     if ($quiet) {
 147         say $name;
 148     } else {
 149         say join($delim, $name, $pver);
 150     }
 151 }
 152
 153 sub repo_table {
 154     my ($pkg, undef, undef, $delim) = @_;
 155     return if not defined $pkg;
 156
 157     my $name = $pkg->{'Name'};
 158     my $base = $pkg->{'PackageBase'};
 159     my $pver = $pkg->{'Version'};
 160
 161     say join($delim, $name, $name, $base, $pver, 'Self');
 162
 163     for my $key ('Depends', 'MakeDepends', 'CheckDepends') {
 164         if (ref($pkg->{$key}) eq 'ARRAY') {
 165             map { say join($delim, $name, $_, $base, $pver, $key) } @{$pkg->{$key}};
 166         }
 167     }
 168 }
 169
 170 sub repo_attr {
 171     my ($pkg, undef, undef, $attr) = @_;
 172     return if not defined $pkg;
 173
 174     my $value = $pkg->{$repo_add_attributes{$attr}};
 175
 176     if (defined($value) and ref($value) eq 'ARRAY') {
 177         say join("\n", @{$value});
 178     } elsif (defined($value)) {
 179         say $value;
 180     }
 181 }
 182
 183 unless (caller) {
 184     use Getopt::Long;
 185     my $opt_json = 0;
 186     my $opt_jsonl = 0;
 187     my $opt_list = 0;
 188     my $opt_list_attr = 0;
 189     my $opt_table = 0;
 190     my $opt_quiet = 0;
 191     my $opt_delim;
 192     my $opt_attr = "";
 193     my @opt_db_path;
 194     my $opt_stdin = 0;
 195     my $opt_search = "";
 196     my $opt_search_by = 'Name';
 197
 198     # optional arguments
 199     GetOptions('J|json'      => \$opt_json,
 200                'jsonl'       => \$opt_jsonl,
 201                'F|attr=s'    => \$opt_attr,
 202                'l|list'      => \$opt_list,
 203                'q|quiet'     => \$opt_quiet,
 204                't|table'     => \$opt_table,
 205                'd|delim'     => \$opt_delim,
 206                'list-attr'   => \$opt_list_attr,
 207                'p|path=s'    => \@opt_db_path,
 208                's|search=s'  => \$opt_search,
 209                'search-by=s' => \$opt_search_by)
 210         or exit(1);
 211
 212     if (scalar(@ARGV) > 0 and ($ARGV[0] eq "-" or $ARGV[0] eq "/dev/stdin")) {
 213         $opt_stdin = 1;
 214     }
 215     elsif ($opt_list_attr) {
 216         say(join("\n", sort(keys(%repo_add_attributes))));
 217         exit(0);
 218     }
 219     elsif (scalar(@opt_db_path) < 1 and not $opt_stdin) {
 220         say STDERR $argv0 . ': repository path must be specified';
 221         exit(1);
 222     }
 223
 224     # Callback function run on each entry in the database
 225     my ($handler, @varargs);
 226
 227     if ($opt_json) {
 228         $handler = \&repo_json;
 229     }
 230     elsif ($opt_jsonl) {
 231         $handler = \&repo_jsonl;
 232     }
 233     elsif (length($opt_attr) and defined($repo_add_attributes{$opt_attr})) {
 234         $handler = \&repo_attr;
 235         @varargs = $opt_attr;
 236     }
 237     elsif (length($opt_attr)) {
 238         say STDERR "$argv0: unknown attribute '$opt_attr'";
 239         exit(2);
 240     }
 241     elsif ($opt_list) {
 242         $handler = \&repo_list;
 243         @varargs = (length($opt_delim) ? $opt_delim : "\t", $opt_quiet);
 244     }
 245     elsif ($opt_table) {
 246         $handler = \&repo_table;
 247         @varargs = length($opt_delim) ? $opt_delim : "\t";
 248     }
 249     else {
 250         say STDERR $argv0 . ': no mode specified';
 251         exit(1);
 252     }
 253
 254     # Verify search field
 255     my $opt_search_attr = $repo_add_attributes{uc($opt_search_by)};
 256
 257     if (not defined $opt_search_attr) {
 258         say STDERR "$argv0: unknown attribute '$opt_search_by'";
 259         exit(2);
 260     }
 261     my @parse_db_args = ($handler, $opt_search, $opt_search_attr, @varargs);
 262
 263     # Take input from stdin instead of a pacman database
 264     if ($opt_stdin) {
 265         parse_db(*STDIN, "/dev/stdin", 'local', 'FILENAME', @parse_db_args);
 266         exit(0);
 267     }
 268
 269     # bsdtar(1) does not support extracting multiple files in a single invocation,
 270     # so fork a new process for each specified path.
 271     for my $db_path (@opt_db_path) {
 272         my $db_abs_path = abs_path($db_path);
 273         my $db_name = basename($db_path);
 274
 275         if (not length($db_abs_path)) {
 276             say STDERR $argv0 . ": file path '$db_path' not found";
 277             exit(2);
 278         }
 279
 280         # repo-add(8) only accepts *.db or *.db.tar* extensions
 281         if ($db_name =~ /\.(db|files)(\.tar(\.\w+)?)?$/g) {
 282             $db_name = substr $db_name, 0, $-[0];
 283         } else {
 284             say STDERR "$argv0: $db_name does not have a valid database archive extension";
 285             exit(1);
 286         }
 287
 288         # When parsing the database, do not require a full extraction to either memory or disk
 289         # by reading `tar` output line-by-line. It is not strictly necessary to depend on
 290         # attribute order (i.e. %FILENAME% occuring in first place) while doing so; however,
 291         # the `--verbose` flag printing file names has different behavior for different `tar`
 292         # versions. Specifically, `bsdtar -xv` does not add a newline after the file path,
 293         # while `tar -xv` does.
 294         my @extract = ('bsdtar', '-Oxf', $db_abs_path);
 295         my $child_pid = open(my $fh, "-|", @extract) or die $!;
 296
 297         if ($child_pid) { # parent process
 298             my $count = parse_db($fh, $db_abs_path, $db_name, 'FILENAME', @parse_db_args);
 299
 300             waitpid($child_pid, 0);
 301         }
 302         exit(2) if $?;
 303     }
 304 }
 305
 306 # vim: set et sw=4 sts=4 ft=perl: