6 use open ":std", ":encoding(UTF-8)";
10 use AUR
::Json
qw(write_json);
11 use AUR
::Repo
qw(check_attr check_type list_attr parse_db);
12 my $argv0 = 'repo-parse';
14 # Handlers for filtering data
16 my ($expr, $entry_data) = @_;
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});
23 return $entry_data =~ /$expr/;
26 return defined($entry_data);
30 # XXX: ignore for array types
32 my ($callback, $search, $search_by, $ignore, $ignore_by,
33 $pkg, $count, $last, @varargs) = @_;
35 my $pkg_ignore = defined $ignore->{$pkg->{$ignore_by}};
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)
41 $callback->(undef, $count, $last, @varargs);
46 # Handlers for varying output formats
48 my ($pkg, $count, $last, $db_path, $db_name) = @_;
51 # Additional fields for `aur-format`
52 $pkg->{'DBPath'} = $db_path;
53 $pkg->{'Repository'} = $db_name;
55 print '[' if $count == 1;
56 print ',' if $count > 1;
58 my $json_text = write_json
($pkg);
61 print "]\n" if $last == 1;
65 my ($pkg, undef, undef, $db_path, $db_name) = @_;
66 return if not defined $pkg;
68 # Additional fields for `aur-format`
69 $pkg->{'DBPath'} = $db_path;
70 $pkg->{'Repository'} = $db_name;
72 my $json_text = write_json
($pkg);
73 print $json_text . "\n";
77 my ($pkg, undef, undef, $delim, $quiet) = @_;
78 return if not defined $pkg;
80 my $name = $pkg->{'Name'};
81 my $pver = $pkg->{'Version'};
86 say join($delim, $name, $pver);
91 my ($pkg, undef, undef, $delim) = @_;
92 return if not defined $pkg;
94 my $name = $pkg->{'Name'};
95 my $base = $pkg->{'PackageBase'};
96 my $pver = $pkg->{'Version'};
98 say join($delim, $name, $name, $base, $pver, 'Self');
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}};
108 my ($pkg, undef, undef, $label) = @_;
109 return if not defined $pkg;
111 my $value = $pkg->{$label};
113 if (defined($value) and ref($value) eq 'ARRAY') {
114 say join("\n", @
{$value});
115 } elsif (defined($value)) {
121 my ($opt, $opt_label, $attr_def) = @_;
124 my $attr = check_attr
(uc($opt));
126 if (not defined $attr) {
127 say STDERR
"$argv0: $opt_label: unknown attribute '$opt'";
141 my $opt_list_attr = 0;
148 my $opt_search = "" ;
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
169 if (scalar(@ARGV) > 0 and ($ARGV[0] eq "-" or $ARGV[0] eq "/dev/stdin")) {
172 elsif ($opt_list_attr) {
173 say join("\n", list_attr
());
176 elsif (scalar(@opt_db_path) < 1 and not $opt_stdin) {
177 say STDERR
$argv0 . ': repository path must be specified';
181 # Callback function run on each entry in the database
182 my ($callback, @varargs);
185 $callback = \
&repo_json
;
186 # @varargs defined in input loop
189 $callback = \
&repo_jsonl
;
190 # @varargs defined in input loop
192 elsif (length($opt_attr)) {
193 my $attr_label = check_attr
($opt_attr);
195 if (not defined $attr_label) {
196 say STDERR
"$argv0: unknown attribute '$opt_attr'";
199 $callback = \
&repo_attr
;
200 @varargs = ($attr_label);
203 $callback = \
&repo_list
;
204 @varargs = (length($opt_delim) ?
$opt_delim : "\t", $opt_quiet);
207 $callback = \
&repo_table
;
208 @varargs = (length($opt_delim) ?
$opt_delim : "\t");
211 say STDERR
$argv0 . ': no mode specified';
215 # Verify search field
216 my $search = length($opt_search) ?
$opt_search : "";
217 my $search_by = check_option
($opt_search_by, '--search-by', 'Name');
219 # Verify ignores field
221 $ignore{$_}++ for (map { split(',', $_) } @opt_ignore);
222 my $ignore_by = check_option
($opt_ignore_by, '--ignore-by', 'Name');
224 # Take input from stdin instead of a pacman database
226 @varargs = ("/dev/stdin", "local") if ($opt_json or $opt_jsonl);
228 my $count = parse_db
(*STDIN
, 'FILENAME', sub {
229 repo_filter
($callback, $search, $search_by, \
%ignore, $ignore_by, @_);
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);
241 if (not length($db_abs_path)) {
242 say STDERR
$argv0 . ": file path '$db_path' not found";
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];
250 say STDERR
"$argv0: $db_name does not have a valid database archive extension";
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 $!;
262 if ($child_pid) { # parent process
263 @varargs = ($db_abs_path, $db_name) if ($opt_json or $opt_jsonl);
265 my $count = parse_db
($fh, 'FILENAME', sub {
266 repo_filter
($callback, $search, $search_by, \
%ignore, $ignore_by, @_);
273 # vim: set et sw=4 sts=4 ft=perl: