#!/usr/bin/perl

# This script is becoming obsolete with dh-raku. With dh-raku,
# pre-compiled files are build at package build time and shipped in
# binary package.

# On the other hand, this script must be shipped with rakudo until
# debian 12 is out to make sure that rakudo modules can be upgraded
# from debian 11 to debian 12.

# this script is used by the perl6 infrastructure to manage precompiled files of
# perl6 module packages. after the installation of a package, this is run
# from the module package postinst script and installs the perl6 sources from the 
# module package into the perl6 code repository, creating precomp files in the
# process. All files created are tracked so that they can be cleaned up on
# package removal. A rakudo upgrade may need to redo the precompilation when the
# rakudo package is no longer compatible with the existing precomp files, this
# script also takes care of that.

use strict;
use warnings;
use 5.20.1;

use Getopt::Long;
use Path::Tiny;
use Graph;
# set automatic die for system() calls
use autodie qw(:all);

# this is determined and injected at package build times, and represents 
# the compiler id of this rakudo version. precomp files are only 
# compatible between rakudos that have the same compiler id.
my $compiler_id_file = path('/usr/share/perl6/rakudo-compiler-id');
my ($compiler_id) = $compiler_id_file->lines({ chomp => 1, count => 1 });

my $varlib = path('/var/lib/perl6/modules');
my $vendor = path('/usr/lib/perl6/vendor');
my $p6src  = path('/usr/share/perl6/debian-sources');

sub debug_say($) {
    if (defined $ENV{'RAKUDO_HELPER_DEBUG'}) {
        say @_;
    }
}

sub install($) {
    my ($module) = @_;
    my $pkg_list_path = $vendor->child("$module.dh-raku.list");

    if ($pkg_list_path->exists) {
        debug_say("Pre-compiled files of module $module are shipped with package. Skipping rebuild");
        return;
    }

    debug_say("installing perl6 module $module...");
    my $tmpdir = Path::Tiny->tempdir;
    my $build_dir = $tmpdir->child('build');
    $build_dir->mkpath;
    my $src_dir = $p6src->child($module);
    $ENV{'RAKUDO_RERESOLVE_DEPENDENCIES'} = 0;
    my @cmd = qq!perl6 /usr/share/perl6/tools/install-dist.p6 --from=$src_dir --to=$build_dir --for=vendor!;
    system(@cmd);

    @cmd = qq!find $build_dir -type d -empty -delete!;
    system(@cmd);
    my @resulting_files;
    $build_dir->visit(sub {
        my ($path, $state) = @_;
        return if $path->is_dir;
        push(@resulting_files, $path =~ s/.*\/build\///r);
    }, { recurse => 1 });
    my $fh;
    $varlib->child("$module.list")->spew(map {"$_\n"} @resulting_files);
    @cmd = qq!cp -r $build_dir/* $vendor!;
    system(@cmd);
}

sub remove($) {
    my ($module) = @_;
    my $module_list_path = $varlib->child("$module.list");
    my $pkg_list_path = $vendor->child("$module.dh-raku.list");

    my %pkg_files;
    if ($pkg_list_path->exists) {
        debug_say("reading $pkg_list_path...");
        %pkg_files = map { ($_ => 1) } $pkg_list_path->lines({chomp => 1});
    }
    else {
        debug_say("file $pkg_list_path not found...");
    }

    if ($module_list_path->exists) {
        debug_say("removing perl6 module $module...");
        foreach my $file ($module_list_path->lines({chomp => 1})) {
            # do not delete files shipped by package. (i.e. packages
            # that ship pre-compiled files)
            if ($pkg_files{$file}) {
                debug_say("file $file is shipped by package, skipping removal...");
            }
            else {
                debug_say("removing file $file...");
                $vendor->child($file)->remove;
            }
        }
        $module_list_path->remove;
        my @dirs = map { $vendor->child($_) } qw!short precomp dist sources resources!;
        foreach my $dir (@dirs) {
            if ($dir->is_dir) {
                system(qq!find $dir -type d -empty -delete!);
            }
        }
    }
}

sub reinstall_all() {
    # remove all existing precompiled files
    debug_say("reinstalling all perl6 modules on system...");
    foreach my $list ($varlib->children(qr/\.list$/)) {
        my $module = $list->basename =~ s/\.list$//r;
        debug_say("deleting old precompiled files of module $module");
        remove($module);
    }
    # now build a graph of module dependencies
    my $g = Graph->new;
    foreach my $cdir ($p6src->children) {
        next unless $cdir->is_dir;
        my $module = $cdir->basename;
        debug_say("  vertex: $module");
        $g->add_vertex($module);
        my $p6deps = path("$p6src/$module/$module.p6deps");
        next unless $p6deps->exists;
        foreach my $dep ($p6deps->lines({ chomp => 1 })) {
            debug_say("    edge: $module -> $dep");
            $g->add_edge($dep => $module);
        }
    }
    my @modules_topo = $g->topological_sort;
    my @imodules_topo = map [ $_, $modules_topo[$_] ], 0 .. $#modules_topo;
    foreach my $ref (@imodules_topo) {
        my( $i, $module ) = @$ref;
        if ($module) {
            if ($p6src->child($module)->is_dir) {
                say("    (@{[ $i+1 ]}/@{[ $#modules_topo+1 ]}) reinstall: $module");
                install($module);
            }
            else {
                debug_say("warning: $module shows up in package dependency graph but is not installed");
            }
        }
    }
}

sub usage {
    print <<'EOF';
Rakudo/Perl 6 Helper script
Usage: rakudo-helper.pl [arguments]
Where [arguments] can be one of:
  --install -i <package> install perl modules from specified package
                         into rakudo distribution
  --remove -r <package>  remove files created by --install
  --reinstall-all        reinstall all perl6 module packages on the system
  --compiler-id -c       print the rakudo compiler id
  --help -h              show this text
EOF
}

my $arg_install = undef;
my $arg_remove = undef;
my $arg_reinstall_all;
my $arg_compiler_id;
my $arg_help;

GetOptions(
    "--install=s" => \$arg_install,
    "--remove=s" => \$arg_remove,
    "--reinstall-all|R" => \$arg_reinstall_all,
    "--compiler-id" => \$arg_compiler_id,
    "--help" => \$arg_help,
)
    or do {
        print STDERR "Could not parse cmdline arguments";
        usage();
        exit 1;
    };

if ($arg_help) {
    usage();
    exit 0;
}
elsif ($arg_compiler_id) {
    say $compiler_id;
}
elsif (defined $arg_install) {
    install($arg_install);
}
elsif (defined $arg_remove) {
    remove($arg_remove);
}
elsif (defined $arg_reinstall_all) {
    reinstall_all();
}
else {
    print STDERR "No argument specified";
    usage();
    exit 1;
}
