#!/usr/bin/perl

use strict;
use Getopt::Long;
use JSON;

my %opt;

GetOptions( \%opt, 'h|help', 'v|version', 'json', 'dev|development',
    'prod|production', );

# Usage and version
if ( $opt{h} ) {
    print <<EOF;
Usage: pkgjs-ls

Same as `npm ls` but read also global files

Options:
 -h, --help: print this
 --dev, --development: includes dev dependencies
 --prod, --production: don't include dev dependencies
EOF
    exit;
}
elsif ( $opt{v} ) {
    print "0.0.1\n";
    exit;
}

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

# Prepare Semver server
my $semver = undef;

use IO::Pipe;
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
else {
    $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 {
        print STDERR "No semver, did you install node-semver ?\n";
    }
}

# MAIN: launch `npm ls` and decode
my $cmd = join( ' ',
    'npm', 'ls', '--json',
    ( $opt{dev}  ? '--dev'  : '' ),
    ( $opt{prod} ? '--prod' : '' ) );
our $deps = `$cmd 2>/dev/null`;

eval { $deps = decode_json($deps) };
if ($@) {
    die "Unable to parse `npm ls` result: $@\n";
}

# Transform tree
$deps->{dependencies} //= {};

#foreach my $k ( keys %{ $deps->{dependencies} } ) {
transform($deps);

#}

# And display
if ( $opt{json} ) {
    print JSON->new->pretty->encode($deps);
}
else {
    eval {
        no warnings;
        open my $f, 'package.json' or die;
        local $/ = undef;
        my $pkg = decode_json(<$f>);
        close $f;
        print "$pkg->{name}\@$pkg->{version}\n";
    };
    display( $deps, '' );
}
exit(0);

sub transform {
    my ($deps) = @_;

    #if ( $deps->{problems} ) {
    #    foreach ( @{ $deps->{problems} } ) {
    #        if ( /^missing: (.+?)\@(\d[\d\.\w]*)\S*(.*)$/
    #            and $deps->{dependencies}->{$1} )
    #        {
    #            $deps->{dependencies}->{$1}->{missing}  = 1;
    #            $deps->{dependencies}->{$1}->{required} = $2;
    #            $deps->{dependencies}->{$1}->{why}      = $3;
    #        }
    #    }
    #}
    delete $deps->{problems};
    foreach my $k ( keys %{ $deps->{dependencies} } ) {
        my $v = $deps->{dependencies}->{$k};
        $k =~ s/\@(?:\d.*|)$//;
        my $path;
        foreach (@npaths) {
            $path = "$_/$k" if -d "$_/$k" or -f "$_/$k.js";
        }
        if ($path) {
            $v->{global} = $path;
            my $version = '';
            if ( -e "$path/package.json" ) {
                my $f;
                if ( open $f, "$path/package.json" ) {
                    eval {
                        local $/ = undef;
                        my $content = <$f>;
                        $content = decode_json($content);
                        $version = $content->{version}
                          if $content->{version};
                    };
                }
                $v->{version} ||= $version;
            }
            unless ( delete $v->{missing} ) {
                $v->{double} = $version;
            }
        }
        if ( $v->{dependencies} and not $v->{global} ) {
            transform( $deps->{dependencies}->{$k} );
        }
    }
}

sub display {
    my ( $deps, $offset ) = @_;
    my @keys = sort keys %{ $deps->{dependencies} };
    for ( my $i = 0 ; $i < @keys ; $i++ ) {
        my $k = $keys[$i];

        #foreach my $k ( keys %{ $deps->{dependencies} } ) {
        my $v = $deps->{dependencies}->{$k};
        print ''
          . $offset
          . (
              ( $v->{dependencies} and !$v->{global} and !$v->{missing} )
            ? ( $i == $#keys ? '└─┬ ' : '├─┬ ' )
            : $i == $#keys ? '└── '
            :                '├── '
          )
          . (
              $v->{missing} ? "\033[1mUNMET DEPENDENCY\033[0m "
            : $v->{double}  ? "\033[1mDUPLICATE "
            : $v->{global}  ? ''
            :                 "\033[31;2;3mlocal "
          )
          . $k . '@'
          . ( $v->{double} || $v->{version} || $v->{required} )
          . "\033[0m"
          . (
            (
                     !$v->{missing}
                  and $semver
                  and $v->{version} ne ''
                  and ( $v->{required} || $v->{double} )
            )
            ? (
                $semver->(
                    (
                        $v->{double}
                        ? ( $v->{double}, $v->{version} )
                        : ( $v->{version}, $v->{required} )
                    )
                  )
                ? ''
                : " \033[1mRequires: "
                  . ( $v->{required} || $v->{version} )
                  . "\033[0m"
              )
            : ( $v->{missing} && $v->{why} ) ? " \033[1m$v->{why}\033[0m"
            :                                  ''
          ) . "\n";
        if ( $v->{dependencies} and !$v->{missing} and !$v->{global} ) {
            my $o = $offset;
            $o .= ( $i == $#keys ? '  ' : '│ ' );
            display( $v, $o );
        }
    }
}
