lib/aur-depends

   1 #!/usr/bin/env perl
   2 use strict;
   3 use warnings;
   4 use v5.20;
   5
   6 use List::Util qw(first);
   7 use AUR::Json qw(parse_json_aur write_json);
   8 use AUR::Query qw(query_multi);
   9 use AUR::Options qw(add_from_stdin);
  10 my $argv0 = 'depends';
  11
  12 sub chain {
  13     my ($targets, $types, $max_req) = @_;
  14     my @depends = @{$targets};
  15     my (%results, %reqby, %shlibs);
  16
  17     # Make every explicit target provide itself
  18     map { $shlibs{$_} = [$_, 0] } @{$targets};
  19
  20     for my $a (1..$max_req) {
  21         say STDERR join(" ", "query: [$a]", @depends) if defined $ENV{'AUR_DEBUG'};
  22
  23         if ($a == $max_req) {
  24             say STDERR "$argv0: total requests: $a (out of range)";
  25             exit(34);
  26         }
  27         my @level = query_multi(terms => \@depends, type => 'info', callback => \&parse_json_aur);
  28
  29         if (not scalar(@level) and $a == 1) {
  30             say STDERR "$argv0: no packages found";
  31             exit(1);
  32         }
  33         @depends = ();
  34
  35         for my $node (@level) {
  36             my $name = $node->{'Name'};
  37             $results{$name} = $node;
  38
  39             # Include `Self` dependency for every target (aur-sync, #1065)
  40             push(@{$reqby{$name}{'Self'}}, $name);
  41
  42             # XXX: no check if provides has valid package version (vercmp)
  43             for my $spec (@{$node->{'Provides'} // []}) {
  44                 my ($prov, $op, $ver) = split(/(<=|>=|<|=|>)/, $spec);
  45
  46                 # XXX: only keeps the first provider
  47                 if (not defined $shlibs{$prov}) {
  48                     # Use weights to make explicit provides take precedence
  49                     $shlibs{$prov} = [$node->{'Name'}, $a]
  50                 }
  51             }
  52
  53             # Filter out dependency types early (#882)
  54             for my $deptype (@{$types}) {
  55                 if (not defined($node->{$deptype})) {
  56                     next;  # no dependency of this type
  57                 }
  58
  59                 for my $spec (@{$node->{$deptype}}) {
  60                     # valid operators (important: <= before <)
  61                     my ($dep, $op, $ver) = split(/(<=|>=|<|=|>)/, $spec);
  62
  63                     # populate reverse depends
  64                     push(@{$reqby{$dep}{$deptype}}, $node->{'Name'});
  65
  66                     # avoid querying duplicate packages (#4)
  67                     next if (defined $results{$dep});
  68                     push(@depends, $dep);
  69
  70                     # mark as incomplete (retrieved in next step or repo package)
  71                     $results{$dep} = 'None';
  72                 }
  73             }
  74         }
  75         if (not scalar(@depends)) {
  76             last;  # no further results
  77         }
  78     }
  79     return \%results, \%reqby, \%shlibs;
  80 }
  81
  82 sub chain_mod {
  83     my ($results, $reqby, $shlibs, $provides, $showall) = @_;
  84     %{$shlibs} = () if not $provides;
  85     my %mod;
  86
  87     # Add reverse dependencies for AUR targets
  88     say STDERR "query: filtering results" if defined $ENV{'AUR_DEBUG'};
  89     map {
  90         # Take provides on the command-line into account (#837)
  91         if (defined $shlibs->{$_} and $shlibs->{$_}->[1] == 1) {
  92             my $name = $shlibs->{$_}->[0];
  93
  94             # Preserve `Self` deptype of command-line target
  95             $mod{$name} = $results->{$name};
  96             $mod{$name}->{'RequiredBy'} = {%{$reqby->{$_}}, %{$reqby->{$name}}};
  97         }
  98         # Avoid overriding provides with later target (random ordering of hash!)
  99         elsif (not defined $mod{$_}) {
 100             $mod{$_} = $results->{$_};
 101             $mod{$_}->{'RequiredBy'} = $reqby->{$_};
 102         }
 103     } grep {
 104         $results->{$_} ne 'None'
 105     } keys %{$results};
 106
 107     # Merge reverse dependencies for purely virtual targets, with
 108     # corresponding packages specified on the command-line
 109     map {
 110         my $name = $shlibs->{$_}[0];
 111
 112         for my $deptype (keys %{$reqby->{$_}}) {
 113             push(@{$mod{$name}->{'RequiredBy'}{$deptype}}, @{$reqby->{$_}{$deptype}});
 114         }
 115     } grep {
 116         $results->{$_} eq 'None' and defined $shlibs->{$_}
 117     } keys %{$results};
 118
 119     # Add reverse dependencies for any remaining targets
 120     if ($showall) {
 121         map {
 122             $mod{$_}->{'Name'} = $_;
 123             $mod{$_}->{'RequiredBy'} = $reqby->{$_};
 124         } grep {
 125             $results->{$_} eq 'None'
 126         } keys %{$results};
 127     }
 128     else {
 129         # Remove `None` reverse dependencies (#1062)
 130         map {
 131             delete $mod{$_};
 132         } grep {
 133             $results->{$_} eq 'None'
 134         } keys %mod;
 135     }
 136
 137     return \%mod, $reqby, $shlibs;
 138 }
 139
 140 # Recursively remove nodes from dependency graph (#592)
 141 # Operates on modified graph: provides are solved first
 142 sub prune {
 143     my ($mod, $installed) = @_;
 144
 145     # XXX: use Schwartzian transform
 146     map {
 147         # Every reverse dependency needs to be checked against every pkgname
 148         # that is assumed to be installed (quadratic complexity)
 149         my $reqby = $mod->{$_}->{'RequiredBy'};  # reference to RequiredBy{ Depends [] }
 150
 151         for my $deptype (keys %{$reqby}) {  # list returned by keys is a copy
 152             my @pruned = ();
 153
 154             for my $dep (@{$reqby->{$deptype}}) {
 155                 my $found = first { $dep eq $_ } @{$installed};
 156
 157                 if (not defined ($found)) {
 158                     push(@pruned, $dep);
 159                 }
 160             }
 161             if (scalar @pruned) {
 162                 @{$reqby->{$deptype}} = @pruned;
 163             }
 164             else {
 165                 delete $reqby->{$deptype};
 166             }
 167         }
 168     } keys %{$mod};
 169
 170     map {
 171         my $name = $_;
 172         if (not scalar keys %{$mod->{$name}->{'RequiredBy'}}) {
 173             delete $mod->{$name};  # remove targets that are no longer required
 174         }
 175         my $found = first { $name eq $_ } @{$installed};
 176         if (defined $found) {
 177             delete $mod->{$name};  # remove targets that are installed
 178         }
 179     } keys %{$mod}; # list returned by keys is a copy
 180
 181     return $mod;
 182 }
 183
 184 # tsv output for usage with aur-sync (aurutils <=10)
 185 sub table_v10_compat {
 186     my ($results, $types) = @_;
 187
 188     map {
 189         my ($name, $base, $version) = ($_->{'Name'}, $_->{'PackageBase'}, $_->{'Version'});
 190         say join("\t", $name, $name, $base, $version, 'Self');
 191
 192         for my $deptype (@{$types}) {
 193             my $depends = $_->{$deptype};
 194             next if (ref($depends) ne 'ARRAY');
 195
 196             for my $dep (@{$depends}) {
 197                 say join("\t", $name, $dep, $base, $version, $deptype);
 198             }
 199         }
 200     } grep { defined $_->{'PackageBase'} } values %{$results};
 201 }
 202
 203 # tsv output for usage with aur-sync (aurutils >=11)
 204 sub table {
 205     my $results = shift;
 206
 207     for my $pkg (values %{$results}) {
 208         my ($name, $base, $version) = ($pkg->{'Name'}, $pkg->{'PackageBase'}, $pkg->{'Version'});
 209
 210         for my $deptype (keys %{$pkg->{'RequiredBy'}}) {
 211             map {
 212                 say join("\t", $name, $_, $base // '-', $version // '-', $deptype);
 213             } @{$pkg->{'RequiredBy'}{$deptype}};
 214         }
 215     }
 216 }
 217
 218 # package/dependency pairs for use with tsort(1) or aur-graph
 219 # XXX: include optional column for versioned dependencies
 220 sub pairs {
 221     my ($results, $key, $reverse) = @_;
 222
 223     for my $pkg (values %{$results}) {
 224         my $target = $pkg->{$key};
 225
 226         for my $reqby (values %{$pkg->{'RequiredBy'}}) {
 227             map {
 228                 my $rdep = $key eq 'Name' ? $_ : $results->{$_}->{$key} // '-';
 229                 my @pair = $reverse ? ($target, $rdep) : ($rdep, $target);
 230
 231                 say join("\t", @pair);
 232             } @{$reqby};
 233         }
 234     }
 235 }
 236
 237 unless(caller) {
 238     use Getopt::Long;
 239     my $opt_depends      = 1;
 240     my $opt_makedepends  = 1;
 241     my $opt_checkdepends = 1;
 242     my $opt_optdepends   = 0;
 243     my $opt_mode         = "pairs";
 244     my $opt_pkgname      = 0;
 245     my $opt_show_all     = 0;  # implies $opt_pkgname = 1
 246     my $opt_reverse      = 0;
 247     my $opt_provides     = 1;
 248     my $opt_installed    = [];
 249
 250     GetOptions(
 251         'assume-installed=s' => $opt_installed,
 252         'no-depends'         => sub { $opt_depends = 0 },
 253         'no-makedepends'     => sub { $opt_makedepends = 0 },
 254         'no-checkdepends'    => sub { $opt_checkdepends = 0 },
 255         'optdepends'         => \$opt_optdepends,
 256         'no-provides'        => sub { $opt_provides = 0 },
 257         'n|pkgname'          => \$opt_pkgname,
 258         'b|pkgbase'          => sub { $opt_pkgname = 0 },
 259         'G|graph'            => sub { },  # noop
 260         't|table'            => sub { $opt_mode = "table" },
 261         'J|json'             => sub { $opt_mode = "json" },
 262         'jsonl'              => sub { $opt_mode = "jsonl" },
 263         'r|reverse'          => \$opt_reverse,
 264         'a|all|show-all'     => \$opt_show_all
 265         ) or exit(1);
 266
 267     if (not scalar(@ARGV)) {
 268         say STDERR "$argv0: at least one argument required";
 269         exit(1);
 270     }
 271
 272     # Handle '-' to take packages from stdin
 273     add_from_stdin(\@ARGV, ['-', '/dev/stdin']);
 274
 275     # Exit gracefully on empty stdin, e.g. when piping from `aur repo -u`
 276     exit(0) if not scalar(@ARGV);
 277
 278     # Variable dependency types (#826)
 279     my @types;
 280     push(@types, 'Depends')      if $opt_depends;
 281     push(@types, 'MakeDepends')  if $opt_makedepends;
 282     push(@types, 'CheckDepends') if $opt_checkdepends;
 283     push(@types, 'OptDepends')   if $opt_optdepends;
 284
 285     # Array notation for `--assume-installed`
 286     @{$opt_installed} = map { split(',', $_) } @{$opt_installed};
 287
 288     # Resolve dependency tree
 289     my ($results, $reqby, $shlibs) = chain_mod(chain(\@ARGV, \@types, 30), $opt_provides, $opt_show_all);
 290
 291     # Remove virtual dependencies with `--show-all` (#1063)
 292     if ($opt_show_all and $opt_provides) {
 293         # XXX: also include `None` dependencies with `Self` RequiredBy
 294         my @virtual = grep {
 295             $_ ne $shlibs->{$_}->[0] and $shlibs->{$_}->[1] > 0
 296         } keys %{$shlibs};
 297
 298         $results = prune($results, \@virtual);
 299     }
 300
 301     # Remove transitive dependencies for installed targets (#592)
 302     if (scalar @{$opt_installed}) {
 303         $results = prune($results, $opt_installed);
 304     }
 305
 306     # Main operations
 307     if ($opt_mode eq 'pairs') {
 308         pairs($results, ($opt_pkgname or $opt_show_all) ? 'Name' : 'PackageBase', $opt_reverse);
 309     }
 310     elsif ($opt_mode eq 'table' and $opt_reverse) {
 311         table($results);
 312     }
 313     elsif ($opt_mode eq 'table') {
 314         table_v10_compat($results, \@types);
 315     }
 316     elsif ($opt_mode eq 'json') {
 317         say write_json($results);
 318     }
 319     elsif ($opt_mode eq 'jsonl') {
 320         map { say write_json $results->{$_} } keys %{$results};
 321     }
 322     else {
 323         say STDERR "$argv0: invalid mode selected";
 324         exit(1);
 325     }
 326 }
 327
 328 # vim: set et sw=4 sts=4 ft=perl: