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