#!/usr/bin/perl

use strict;
use Dpkg::IPC;
use Debian::PkgJs::Banned;
use Debian::PkgJs::Utils;
use Debian::PkgJs::Version;
use Getopt::Long;
use IO::Pipe;
use JSON;
use Progress::Any '$progress';
use Progress::Any::Output;

use constant CACHEDELAY => 86400;
Progress::Any::Output->set( 'TermProgressBarColor',
    template =>
'<color ffff00>%p%</color> <color 808000>[</color>%B<color 808000>]</color>'
);

my %opt;

# I - Initialization: get options/args

GetOptions(
    \%opt, qw(
      h|help
      v|version
      dev|development
      debug
      c|checkversions
      clearcache
      nocache
    )
);

my $currentPackage   = '';
my $availableModules = {};
$opt{cachedelay} //= CACHEDELAY;
my $cache = new PkgJs::Cache(%opt);

# Find name
if ( !@ARGV and -e 'package.json' ) {
    local $/ = undef;
    open my $f, 'package.json';
    eval {
        my $res = JSON::from_json(<$f>);
        if ( $res->{name} ) {
            push @ARGV,
              $res->{name} . ( $res->{version} ? "\@$res->{version}" : '' );
            $opt{local} = $res;
        }
        else {
            print STDERR "Unable to find name from ./package.json\n";
        }
    };
}

# Usage and version
if ( $opt{h} or !@ARGV ) {
    print <<EOF;
Usage: pkgjs-depends

Search recursively dependencies of the given module name (else use
`package.json#name`) and displays:
 * related Debian packages (using apt-file)
 * missing modules

Options:
 -h, --help: print this
 --dev, --development: includes dev dependencies
                       (for main package only, not dependencies)
 --debug
 -c, --checkversions: verify that version matches
 --nocache: don't use local cache
 --clearcache: clear local cache
EOF
    exit;
}
elsif ( $opt{v} ) {
    print "$VERSION\n";
    exit;
}

# nodejs paths
my @npaths =
  ( '/usr/share/nodejs', '/usr/lib/nodejs', glob("/usr/lib/*/nodejs") );

# II - Prepare semver server if --checkversion

my $semver = undef;

use IO::Pipe;
if ( $opt{c} ) {
    debug("Preparing semver server\n");
    my $qchannel = IO::Pipe->new;
    my $rchannel = IO::Pipe->new;

    my $pid = fork;

    unless ($pid) {
        $qchannel->reader();
        $rchannel->writer();
        open STDIN,  '<&', $qchannel->fileno or die $!;
        open STDOUT, '>&', $rchannel->fileno or die $!;
        exec qq@node -e 'var readline=require("readline");
var semver=require("semver");
var rl=readline.createInterface({input:process.stdin,output:process.stdout,terminal:false});
rl.on("line",function(line){
  var v=line.replace(/ .*\$/,"");
  var r=line.replace(/^.* /,"");
  console.log(semver.satisfies(v,r)?1:0)
});
'@;
        exit;
    }

    # Initialize and verify semver channel
    $qchannel->writer();
    $rchannel->reader();
    $qchannel->autoflush(1);
    $qchannel->print("1.1.1 ^1.0.0\n");
    my $v = $rchannel->getline;
    chomp $v;
    if ( $v eq '1' ) {
        $semver = sub {
            my ( $v, $ref ) = @_;
            my $res;
            eval {
                $qchannel->print("$v $ref\n");
                $res = $rchannel->getline;
                chomp $res;
            };
            return $res;
        }
    }
    else {
        die "Unable to check versions, did you install node-semver ?\n";
    }
}

# III - Main

sub debug {
    print STDERR $_[0] if $opt{debug};
}

# hashref getDeps( string: $mod, string: $offset )
# Get dependencies of $mod module using the result of `npm view` and
# launches checkMods() with it
#
# $mod: module name
# $offset: prefix for debugging message ("  " added at each call)
# result: dependencies tree
sub getDeps {
    my ( $mod, $offset ) = @_;
    my $pb = !defined $offset;
    debug "#$offset checking $mod:\n";
    my $res;

    # $opt{local} is set to package.json#name if no arg is given
    $progress->update( message => "checking $mod " ) if $pb;
    unless ( $opt{local} ) {
        my ( $out, $stderr );
        unless ( $res = $cache->get($mod) ) {

            # Launch `npm view`
            spawn(
                exec => [
                    'npm',
                    'view',
                    '--json',
                    $mod,
                    'version',
                    'name',
                    'dependencies',
                    'peerDependencies',
                    ( $opt{dev} ? ('devDependencies') : () )
                ],
                nocheck         => 1,
                wait_child      => 1,
                to_string       => \$out,
                error_to_string => \$stderr,
            );
            $opt{dev} = 0;
            if ( $@ or !$out ) {
                print STDERR "$mod not found\n" . ( $stderr ? $stderr : '' );
                return {};
            }
            eval { $res = JSON::from_json($out); };
            if ($@) {
                print STDERR "`npm view` returned bad JSON for $mod\n$@";
                return {};
            }
            $res = pop @{$res} if ref $res eq 'ARRAY';
        }
        if ( ref $res ) {
            $cache->set( $mod, $res, CACHEDELAY );
        }
        else { return () }
    }
    else {
        $res = $opt{local};
        delete $opt{local};
        delete $res->{devDependencies} unless $opt{dev};
    }
    if ($pb) {
        my $count = 1;
        foreach my $type (qw(dependencies peerDependencies devDependencies)) {
            if ( $res->{$type} and %{ $res->{$type} } ) {
                my @a = keys %{ $res->{$type} };
                $count += @a;
            }
            else {
            }
        }
        $progress->target($count);
    }
    checkMods( $res, $offset );
    delete $res->{name};
    return $res;
}

my $global         = {};
my $missing        = {};
my $known          = {};
my $debianVersions = {};
my $mismatch       = {};

# void checkMods( hashref: $res, string: $offset )
# Parse `npm view` result and search for dependencies existing in Debian
# using local tree and apt/dpkg-query
# If dependency isn't found in Debian, checkMods() calls getDeps() for it.
#
# $res: dependencies tree
# $offset: prefix for debugging message ("  " added at each call)
sub checkMods {
    my ( $res, $offset ) = @_;
    my $pb = !defined($offset);
    foreach my $f ( 'dependencies', 'peerDependencies', 'devDependencies' ) {
        next unless $res->{$f};
        foreach my $mod ( sort keys %{ $res->{$f} } ) {
            my $want = $res->{$f}->{$mod};
            $progress->update( message => "checking $mod " ) if $pb;
            if ( $known->{$mod} ) {
                $global->{ $known->{$mod} }->{$mod}++;
                $res->{$f}->{$mod} = { global => $known->{$mod} };
                debug "#$offset  => package (seen): $known->{$mod}\n";
                next;
            }
            my $path;
            my $debianVersion;
            foreach (@npaths) {
                if ( -d "$_/$mod" ) {
                    $path = "$_/$mod";
                    unless ( $debianVersion = $cache->get("dv-$mod") ) {
                        $debianVersion = `pkgjs-pjson $path version` if $opt{c};
                        chomp $debianVersion;
                        $cache->set( "dv-$mod", $debianVersion, CACHEDELAY );
                    }
                }
                elsif ( -f "$_/$mod.js" ) {
                    $path = "$_/$mod.js";
                }
            }
            if ($path) {
                if ( my $debianPackage = availableModules()->{$mod} ) {
                    $res->{$f}->{$mod} = { global => $debianPackage };

                    # Check versions if wanted
                    if ( $opt{c} ) {
                        unless ( $semver->( $debianVersion, $want ) ) {
                            $debianVersions->{$debianPackage} = $debianVersion;
                            push @{ $mismatch->{$mod} }, $want;
                        }
                        debug "Semver result: "
                          . $semver->( $debianVersion, $want ) . "\n";
                    }
                    $global->{$debianPackage}->{$mod}++;
                    $known->{$mod} = $debianPackage;
                    debug "#$offset  => package: $known->{$mod}\n";
                    if ( $known->{$mod} eq $currentPackage ) {
                        debug(
                            "# $mod is member of current package, continue\n");
                        getDeps( $mod . '@' . $want, "  $offset" );
                    }
                }
                else {
                    print STDERR "Fail to find package for $path\n";
                    $res->{$f}->{$mod} = { global => $path };
                }
            }
            else {
                my $out;
                if ( my $package = availableModules()->{$mod} ) {
                    $res->{$f}->{$mod} = { global => $package };
                    $global->{$package}->{$mod}++;
                    $known->{$mod} = $package;
                    debug
"#$offset  => package: $known->{$mod} ($currentPackage)\n";
                    if ( $known->{$mod} eq $currentPackage ) {
                        debug(
                            "# $mod is member of current package, continue\n");
                        getDeps( $mod . '@' . $want, "  $offset" );
                    }

                    # Check versions if wanted
                    if ( $opt{c} ) {
                        unless ( $debianVersion =
                            $cache->get("dv-$known->{$mod}") )
                        {
                            spawn(
                                exec => [ 'dpkg-query', '-p', $known->{$mod} ],
                                wait_child => 1,
                                to_string  => \$out,
                            );
                            die "Unable to get $known->{$mod} version"
                              unless $out =~ /\nVersion: ([^\s-]+)/s;
                            $debianVersion = $1;
                            my $normalizedName =
                              normalize_name( $known->{$mod} );

                            # Check "Provides" field
                            if ( $out =~
/\nProvides:[^\n]*node-$normalizedName\s*\(\s*=\s*(\d[\.\da-zA-Z]*)/s
                              )
                            {
                                $debianVersion = $1;
                            }
                            else {
                                $debianVersion =~ s/\+~.*$//;
                            }
                            $cache->set( "dv-$known->{$mod}", $debianVersion,
                                CACHEDELAY );
                        }
                        unless ( $semver->( $debianVersion, $want ) ) {
                            $debianVersions->{ $known->{$mod} } =
                              $debianVersion;
                            push @{ $mismatch->{$mod} }, $want;
                        }
                    }
                }
                else {
                    if ( $missing->{$mod} ) {
                        $res->{$f}->{$mod} =
                          ref $missing->{$mod} ? $missing->{$mod} : {};
                        $missing->{$mod}->{$want}++;
                    }
                    elsif ( $mod eq $ARGV[0] ) {
                        $res->{$f}->{$mod} = { $want => 1 };
                    }
                    else {
                        debug "#$offset  => missing: $mod\n";
                        $missing->{$mod} = $res->{$f}->{$mod} =
                          getDeps( $mod . '@' . $want, "  $offset" );
                        $missing->{$mod}->{$want}++;
                    }
                }
            }
        }
    }
}

sub displayMissing {
    my ( $res, $offset ) = @_;
    $offset //= '';
    foreach my $f ( 'dependencies', 'devDependencies' ) {
        next unless $res->{$f};
        foreach my $mod ( sort keys %{ $res->{$f} } ) {
            next if $res->{$f}->{$mod}->{global};
            my $reason = banned($mod);
            my $suffix = ( $reason ? " # BANNED ($reason)" : '' );
            if ( ref $missing->{$mod} ) {
                $missing->{$mod} = '';
                print "$offset └── $mod "
                  . "($res->{$f}->{$mod}->{version})$suffix\n";
                displayMissing( $res->{$f}->{$mod}, "    $offset" )
                  if $res->{$f}->{$mod}->{dependencies};
            }
            else {
                print
"$offset └── (^) $mod ($res->{$f}->{$mod}->{version})$suffix\n";
            }
        }
    }
}

my $reason = '';
$missing->{ $ARGV[0] } = "\@$ARGV[0]";
if ( $ARGV[0] =~ /\@(.*)$/ ) {
    print "# $ARGV[0]";
}
else {
    my $mainVersion;
    spawn(
        exec       => [ 'npm', 'view', '--json', $ARGV[0], 'version', ],
        nocheck    => 1,
        wait_child => 1,
        to_string  => \$mainVersion,
    );
    chomp $mainVersion;
    $mainVersion =~ s/"//g;
    print "# $ARGV[0]\@$mainVersion";
}
{
    my $out;
    my $module = $ARGV[0];
    $module =~ s/(.)\@.*$/$1/;
    $reason = banned($module);
    print " /!\\ BANNED: $reason" if $reason;
    if ( $currentPackage = availableModules()->{$module} ) {
        print " ($currentPackage)\n";
    }
    else {
        print "\n";
    }
}

my $res = getDeps( $ARGV[0] );
$progress->finish();

#print STDERR Dumper($res);use Data::Dumper;

if (%$global) {
    print "DEPENDENCIES:\n";
    foreach my $mod ( sort keys %$global ) {
        print "  $mod (" . join( ', ', sort keys %{ $global->{$mod} } ) . ")\n";
    }
    print "\n";
}
delete $missing->{ $ARGV[0] };
if (%$missing) {
    print "MISSING:\n$ARGV[0]"
      . ( $reason ? " /!\\ BANNED: $reason" : '' ) . "\n";
    displayMissing($res);
}
if (%$mismatch) {
    print "\nWARNING: some version mismatch\n";
    foreach ( sort keys %$mismatch ) {
        print "  $_ "
          . $debianVersions->{ $known->{$_} }
          . ", wanted: "
          . join( ', ', @{ $mismatch->{$_} } ) . "\n";
    }
}

sub availableModules {
    return $availableModules if %$availableModules;
    return $availableModules
      if ( $availableModules = $cache->get('available') );
    debug "Initialize cache\n";
    open my $out, '-|', 'apt-file search /nodejs/' or die $!;
    while (<$out>) {
        $availableModules->{$2} = $1
          if
          m#^(.*?): /usr/.*?/nodejs/([^/]+|\@[^/]+/[^/]+)/package\.(json|yaml)#;
    }
    close $out;
    $cache->set( 'available', $availableModules, CACHEDELAY );
    return $availableModules;
}

package PkgJs::Cache;

sub new {
    my ( $class, %opts ) = @_;
    my $self = bless {}, $class;
    if ( $opts{clearcache} or !$opts{nocache} ) {
        require Cache::FileCache;
        $self->{_c} = new Cache::FileCache(
            {
                namespace          => 'PkgJsDepends',
                default_expires_in => $opts{cachedelay},
            }
        );
    }
    if ( $opts{clearcache} ) {
        $self->{_c}->Clear();
        exit 0;
    }
    elsif ( $self->{_c} ) {
        $self->{_c}->purge;
    }
    return $self;
}

sub get {
    my $self = shift;
    return $self->_cmd( 'get', @_ );
}

sub set {
    my $self = shift;
    return $self->_cmd( 'set', @_ );
}

sub _cmd {
    my $self = shift;
    my $cmd  = shift;
    return $self->{_c} ? $self->{_c}->$cmd(@_) : undef;
}
