nomdep

#!/usr/bin/env perl
#
# Copyright (C) 2017  Christian Garbs <mitch@cgarbs.de>
# Licensed under GNU GPL v3 or later.
#
# This file is part of nomd.
#
# nomd is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# nomd is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with nomd.  If not, see <http://www.gnu.org/licenses/>.
#

use strict;
use warnings;
use v5.10;

use File::Basename;
use Getopt::Long;

#################################

sub find_perl_files()
{
    return glob("nomdoc nomdep check/wrapper/*.pl");
}

sub find_shell_files()
{
    return glob("nomd check/*.check notify/*.notify tool/*.tool");
}

sub extract_perl_dependencies($)
{
    my ($file) = @_;
    
    my @deps = ();

    open PERL, '<', $file or die "can't open $file: $!";
    
    while (my $line = <PERL>) {
	if ($line =~ /^use ([a-zA-z0-9.:]+)(?:\s+.*)?;/) {
	    chomp $line;
	    push @deps, {
		FILE => $file,
		DEP => $1,
		LINE => $line,
		TYPE => 'perl',
	    };
	}
    }
    
    close PERL or die "can't close $file: $!";

    return @deps;
}

sub extract_shell_dependencies($)
{
    my ($file) = @_;
    
    my @deps = ();

    open SHELL, '<', $file or die "can't open $file: $!";
    
    while (my $line = <SHELL>) {
	if ($line =~ /^##SHELLDEP\s+(.+?)\s*$/) {
	    chomp $line;
	    push @deps, {
		FILE => $file,
		DEP => $1,
		LINE => $line,
		TYPE => 'shell',
	    };
	}
    }
    
    close SHELL or die "can't close $file: $!";

    return @deps;
}

sub group_by_line(@)
{
    my (@deps) = @_;

    my %uses = ();

    foreach my $dep (@deps) {
	$uses{$dep->{LINE}}->{DEP} = $dep->{DEP};
	$uses{$dep->{LINE}}->{LINE} = $dep->{LINE};
	$uses{$dep->{LINE}}->{TYPE} = $dep->{TYPE};
	push @{$uses{$dep->{LINE}}->{FILES}}, $dep->{FILE};
    }

    return values %uses;
}

sub sort_by_type_then_name()
{
    return $a->{TYPE} cmp $b->{TYPE} || $a->{DEP} cmp $b->{DEP};
}

sub is_binary_in_path($)
{
    my ($cmd) = @_;

    `which $cmd`;
    return ! $?;
}

sub keep_missing($)
{
    my ($dep) = @_;

    if ($dep->{TYPE} eq 'perl') {
	eval($dep->{LINE});
	my $module_load_ok = $@ eq '';
	return ! $module_load_ok;
    }
    elsif ($dep->{TYPE} eq 'shell') {
	# support OR conditions with multiple binaries in one line
	my $binary_in_path = grep { is_binary_in_path $_ } split /\s+/, $dep->{DEP};
	return ! $binary_in_path;
    }
    
    return 1;
}

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

    foreach my $dep (@deps) {
	my $name = $dep->{DEP};
	
	if ($dep->{TYPE} eq 'shell') {
	    # expand OR conditions
	    $name =~ s/\s+/ or /g;
	}
	
	printf
	    "missing %s dependency: %s (used in %s)\n",
	    $dep->{TYPE},
	    $name,
	    join(', ', map { basename $_} @{$dep->{FILES}});
    }
}

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

    my @modules = map { $_->{DEP} } @deps;
    
    # TODO: remove --skip-satisfied? will break with versioned dependencies
    printf "cpanm --skip-satisfied %s\n", join(' ', @modules);
}

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

    my %APT_MAP = ('notify-send' => 'libnotify-bin');
    
    my @packages = map {
	if (exists $APT_MAP{$_}) {
	    $APT_MAP{$_}
	}
	else {
	    $_
	}
    } map {
	if ($_->{TYPE} eq 'perl') {
	    sprintf "lib%s-perl", join('-', split(/::/, lc($_->{DEP})));
	}
	elsif ($_->{TYPE} eq 'shell') {
	    # only take first option if there are more
	    (split /\s/, $_->{DEP}, 2)[0];
	}
	else {
	    $_->{DEP}
	}
    } @deps;
    
    printf "apt install %s\n", join(' ', @packages);
}

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

    my @packages = map {
	if ($_->{TYPE} eq 'perl') {
	    sprintf "p5-%s", join('-', split(/::/, $_->{DEP}));
	}
	elsif ($_->{TYPE} eq 'shell') {
	    # only take first option if there are more
	    (split /\s/, $_->{DEP}, 2)[0];
	}
	else {
	    $_->{DEP}
	}
    } @deps;

    printf "pkg install %s\n", join(' ', @packages);
}

sub get_perl_deps()
{
    return map { extract_perl_dependencies($_) } find_perl_files();
}

sub get_shell_deps()
{
    return map { extract_shell_dependencies($_) } find_shell_files();
}

#################################

my $help;
my $apt;
my $cpanm;
my $pkg;

GetOptions('help' => \$help, 'apt' => \$apt, 'cpanm' => \$cpanm, 'pkg' => \$pkg);

if ($help) {
    print <<'EOF'
usage:  nomdep [--help | --apt | --cpanm | --pkg]

Call without parameters to list all missing dependencies.
Use --cpanm to generate a cpanm command to install missing Perl libraries.
Use --apt to try to guess package names to install missing dependencies via apt.
Use --pkg to try to guess package names to install missing dependencies via pkg.
EOF
	;
    exit 0;
}

my @deps;
my $printer;

if ($apt) {
    @deps = (get_perl_deps(), get_shell_deps());
    $printer = \&print_apt;
}
elsif ($cpanm)
{
    @deps = get_perl_deps();
    $printer = \&print_cpanm;
}
elsif ($pkg)
{
    @deps = (get_perl_deps(), get_shell_deps());
    $printer = \&print_pkg;
}
else {
    @deps = (get_perl_deps(), get_shell_deps());
    $printer = \&print_missing;
}

my @missing = sort { sort_by_type_then_name() } grep { keep_missing($_) } group_by_line (@deps);
$printer->(@missing) if @missing;