#!/usr/bin/env perl
use strict;
use warnings;
use v5.20;

use List::Util qw(first);
use AUR::Json qw(parse_json_aur write_json);
use AUR::Query qw(query_multi);
use AUR::Options qw(add_from_stdin);
my $argv0 = 'depends';

sub chain {
    my ($targets, $types, $max_req) = @_;
    my @depends = @{$targets};
    my (%results, %reqby, %shlibs);

    # Make every explicit target provide itself
    map { $shlibs{$_} = [$_, 0] } @{$targets};

    for my $a (1..$max_req) {
        say STDERR join(" ", "query: [$a]", @depends) if defined $ENV{'AUR_DEBUG'};

        if ($a == $max_req) {
            say STDERR "$argv0: total requests: $a (out of range)";
            exit(34);
        }
        my @level = query_multi(terms => \@depends, type => 'info', callback => \&parse_json_aur);

        if (not scalar(@level) and $a == 1) {
            say STDERR "$argv0: no packages found";
            exit(1);
        }
        @depends = ();

        for my $node (@level) {
            my $name = $node->{'Name'};
            $results{$name} = $node;

            # Include `Self` dependency for every target (aur-sync, #1065)
            push(@{$reqby{$name}{'Self'}}, $name);

            # XXX: no check if provides has valid package version (vercmp)
            for my $spec (@{$node->{'Provides'} // []}) {
                my ($prov, $op, $ver) = split(/(<=|>=|<|=|>)/, $spec);

                # XXX: only keeps the first provider
                if (not defined $shlibs{$prov}) {
                    # Use weights to make explicit provides take precedence
                    $shlibs{$prov} = [$node->{'Name'}, $a]
                }
            }

            # Filter out dependency types early (#882)
            for my $deptype (@{$types}) {
                if (not defined($node->{$deptype})) {
                    next;  # no dependency of this type
                }

                for my $spec (@{$node->{$deptype}}) {
                    # valid operators (important: <= before <)
                    my ($dep, $op, $ver) = split(/(<=|>=|<|=|>)/, $spec);

                    # populate reverse depends
                    push(@{$reqby{$dep}{$deptype}}, $node->{'Name'});

                    # avoid querying duplicate packages (#4)
                    next if (defined $results{$dep});
                    push(@depends, $dep);

                    # mark as incomplete (retrieved in next step or repo package)
                    $results{$dep} = 'None';
                }
            }
        }
        if (not scalar(@depends)) {
            last;  # no further results
        }
    }
    return \%results, \%reqby, \%shlibs;
}

sub chain_mod {
    my ($results, $reqby, $shlibs, $provides, $showall) = @_;
    %{$shlibs} = () if not $provides;
    my %mod;

    # Add reverse dependencies for AUR targets
    say STDERR "query: filtering results" if defined $ENV{'AUR_DEBUG'};
    map {
        # Take provides on the command-line into account (#837)
        if (defined $shlibs->{$_} and $shlibs->{$_}->[1] == 1) {
            my $name = $shlibs->{$_}->[0];

            # Preserve `Self` deptype of command-line target
            $mod{$name} = $results->{$name};
            $mod{$name}->{'RequiredBy'} = {%{$reqby->{$_}}, %{$reqby->{$name}}};
        }
        # Avoid overriding provides with later target (random ordering of hash!)
        elsif (not defined $mod{$_}) {
            $mod{$_} = $results->{$_};
            $mod{$_}->{'RequiredBy'} = $reqby->{$_};
        }
    } grep {
        $results->{$_} ne 'None'
    } keys %{$results};

    # Merge reverse dependencies for purely virtual targets, with
    # corresponding packages specified on the command-line
    map {
        my $name = $shlibs->{$_}[0];

        for my $deptype (keys %{$reqby->{$_}}) {
            push(@{$mod{$name}->{'RequiredBy'}{$deptype}}, @{$reqby->{$_}{$deptype}});
        }
    } grep {
        $results->{$_} eq 'None' and defined $shlibs->{$_}
    } keys %{$results};

    # Add reverse dependencies for any remaining targets
    if ($showall) {
        map {
            $mod{$_}->{'Name'} = $_;
            $mod{$_}->{'RequiredBy'} = $reqby->{$_};
        } grep {
            $results->{$_} eq 'None'
        } keys %{$results};
    }
    else {
        # Remove `None` reverse dependencies (#1062)
        map {
            delete $mod{$_};
        } grep {
            $results->{$_} eq 'None'
        } keys %mod;
    }

    return \%mod, $reqby, $shlibs;
}

# Recursively remove nodes from dependency graph (#592)
# Operates on modified graph: provides are solved first
sub prune {
    my ($mod, $installed) = @_;

    # XXX: use Schwartzian transform
    map {
        # Every reverse dependency needs to be checked against every pkgname
        # that is assumed to be installed (quadratic complexity)
        my $reqby = $mod->{$_}->{'RequiredBy'};  # reference to RequiredBy{ Depends [] }

        for my $deptype (keys %{$reqby}) {  # list returned by keys is a copy
            my @pruned = ();

            for my $dep (@{$reqby->{$deptype}}) {
                my $found = first { $dep eq $_ } @{$installed};

                if (not defined ($found)) {
                    push(@pruned, $dep);
                }
            }
            if (scalar @pruned) {
                @{$reqby->{$deptype}} = @pruned;
            }
            else {
                delete $reqby->{$deptype};
            }
        }
    } keys %{$mod};

    map {
        my $name = $_;
        if (not scalar keys %{$mod->{$name}->{'RequiredBy'}}) {
            delete $mod->{$name};  # remove targets that are no longer required
        }
        my $found = first { $name eq $_ } @{$installed};
        if (defined $found) {
            delete $mod->{$name};  # remove targets that are installed
        }
    } keys %{$mod}; # list returned by keys is a copy

    return $mod;
}

# tsv output for usage with aur-sync (aurutils <=10)
sub table_v10_compat {
    my ($results, $types) = @_;

    map {
        my ($name, $base, $version) = ($_->{'Name'}, $_->{'PackageBase'}, $_->{'Version'});
        say join("\t", $name, $name, $base, $version, 'Self');

        for my $deptype (@{$types}) {
            my $depends = $_->{$deptype};
            next if (ref($depends) ne 'ARRAY');

            for my $dep (@{$depends}) {
                say join("\t", $name, $dep, $base, $version, $deptype);
            }
        }
    } grep { defined $_->{'PackageBase'} } values %{$results};
}

# tsv output for usage with aur-sync (aurutils >=11)
sub table {
    my $results = shift;

    for my $pkg (values %{$results}) {
        my ($name, $base, $version) = ($pkg->{'Name'}, $pkg->{'PackageBase'}, $pkg->{'Version'});

        for my $deptype (keys %{$pkg->{'RequiredBy'}}) {
            map { 
                say join("\t", $name, $_, $base // '-', $version // '-', $deptype);
            } @{$pkg->{'RequiredBy'}{$deptype}};
        }
    }
}

# package/dependency pairs for use with tsort(1) or aur-graph
# XXX: include optional column for versioned dependencies
sub pairs {
    my ($results, $key, $reverse) = @_;

    for my $pkg (values %{$results}) {
        my $target = $pkg->{$key};

        for my $reqby (values %{$pkg->{'RequiredBy'}}) {
            map {
                my $rdep = $key eq 'Name' ? $_ : $results->{$_}->{$key} // '-';
                my @pair = $reverse ? ($target, $rdep) : ($rdep, $target);

                say join("\t", @pair);
            } @{$reqby};
        }
    }
}

unless(caller) {
    use Getopt::Long;
    my $opt_depends      = 1;
    my $opt_makedepends  = 1;
    my $opt_checkdepends = 1;
    my $opt_optdepends   = 0;
    my $opt_mode         = "pairs";
    my $opt_pkgname      = 0;
    my $opt_show_all     = 0;  # implies $opt_pkgname = 1
    my $opt_reverse      = 0;
    my $opt_provides     = 1;
    my $opt_installed    = [];

    GetOptions(
        'assume-installed=s' => $opt_installed,
        'no-depends'         => sub { $opt_depends = 0 },
        'no-makedepends'     => sub { $opt_makedepends = 0 },
        'no-checkdepends'    => sub { $opt_checkdepends = 0 },
        'optdepends'         => \$opt_optdepends,
        'no-provides'        => sub { $opt_provides = 0 },
        'n|pkgname'          => \$opt_pkgname,
        'b|pkgbase'          => sub { $opt_pkgname = 0 },
        'G|graph'            => sub { },  # noop
        't|table'            => sub { $opt_mode = "table" },
        'J|json'             => sub { $opt_mode = "json" },
        'jsonl'              => sub { $opt_mode = "jsonl" },
        'r|reverse'          => \$opt_reverse,
        'a|all|show-all'     => \$opt_show_all
        ) or exit(1);

    if (not scalar(@ARGV)) {
        say STDERR "$argv0: at least one argument required";
        exit(1);
    }

    # Handle '-' to take packages from stdin
    add_from_stdin(\@ARGV, ['-', '/dev/stdin']);

    # Exit gracefully on empty stdin, e.g. when piping from `aur repo -u`
    exit(0) if not scalar(@ARGV);

    # Variable dependency types (#826)
    my @types;
    push(@types, 'Depends')      if $opt_depends;
    push(@types, 'MakeDepends')  if $opt_makedepends;
    push(@types, 'CheckDepends') if $opt_checkdepends;
    push(@types, 'OptDepends')   if $opt_optdepends;

    # Array notation for `--assume-installed`
    @{$opt_installed} = map { split(',', $_) } @{$opt_installed};

    # Resolve dependency tree
    my ($results, $reqby, $shlibs) = chain_mod(chain(\@ARGV, \@types, 30), $opt_provides, $opt_show_all);

    # Remove virtual dependencies with `--show-all` (#1063)
    if ($opt_show_all and $opt_provides) {
        # XXX: also include `None` dependencies with `Self` RequiredBy
        my @virtual = grep {
            $_ ne $shlibs->{$_}->[0] and $shlibs->{$_}->[1] > 0
        } keys %{$shlibs};

        $results = prune($results, \@virtual);
    }

    # Remove transitive dependencies for installed targets (#592)
    if (scalar @{$opt_installed}) {
        $results = prune($results, $opt_installed);
    }

    # Main operations
    if ($opt_mode eq 'pairs') {
        pairs($results, ($opt_pkgname or $opt_show_all) ? 'Name' : 'PackageBase', $opt_reverse);
    }
    elsif ($opt_mode eq 'table' and $opt_reverse) {
        table($results);
    }
    elsif ($opt_mode eq 'table') {
        table_v10_compat($results, \@types);
    }
    elsif ($opt_mode eq 'json') {
        say write_json($results);
    }
    elsif ($opt_mode eq 'jsonl') {
        map { say write_json $results->{$_} } keys %{$results};
    }
    else {
        say STDERR "$argv0: invalid mode selected";
        exit(1);
    }
}

# vim: set et sw=4 sts=4 ft=perl:
