#!/usr/bin/perl -w

=encoding utf8

=head1 NAME

dh_fortran_mod - Install Fortran 90 .mod files and add dependency information.

=cut

use strict;
use File::Find;
use Debian::Debhelper::Dh_Lib;
use IO::Uncompress::Gunzip qw( $GunzipError );
use File::LibMagic;

=head1 SYNOPSIS

B<dh_fortran_mod> [$<I<debhelper options>>] [$<I<file> ...>]

=head1 DESCRIPTION

B<dh_fortran_mod> is a debhelper program that finds Fortran module files and 
adds dependencies to B<gfortran-mod-$version> as required to the package using
via the variable B<${misc:Depends}>.

B<dh_fortran_mod> is expected to be automatically added using the debhelper "addon" B<fortran_mod>
ie. using the debian/rules line:

    dh $@ --with fortran_mod


=head1 OPTIONS

=over 4

=item B<--sourcedir=>I<dir>

Look in the specified directory for files to be installed.

Typically Fortran module files are included in library development packages.

=back

=head1 TODO

=over 4

B<dh_fortran_mod> will be expanded to find mod files automatically from the I<debian/tmp> directory.
It will enable the installation of mod files in parallel for multiple compilers.
It will check that mod files are installed in the correct location when multi-arch is enabled.
It will install .smod files for Fortran 2018.

=cut
    

# Default for now: gfortran only
my $multicompiler = 0; 
my $multiarch = 0;

our %modversions = ();

init(options => {
    "multicompiler" => \$multicompiler,
    "multiarch" => \$multiarch,
    "autodest" => \$dh{AUTODEST},
    "sourcedir=s" => \$dh{SOURCEDIR},
});

my $srcdir = '.';
$srcdir = $dh{SOURCEDIR} if defined $dh{SOURCEDIR};

sub ScanDirectory{
    my ($workdir) = shift;
    chdir($workdir) or die "Unable to enter dir $workdir:$!\n";
    opendir(DIR, ".") or die "Unable to open $workdir:$!\n";
    my @names = readdir(DIR) or die "Unable to read $workdir:$!\n";
    closedir(DIR);

    foreach my $name (@names){
        next if ($name eq "."); 
        next if ($name eq "..");

        if (-d $name){                  # is this a directory?
            #Whatever you want to do goes here.
        }
    }
}



sub determine_mod_version {
    my $modfile = shift;
    my $magic = File::LibMagic->new();
    
    if ( ! (-r $modfile) ) {  
	warning("Can't open $modfile");
	return ('none', -1);	
    }
    my ($mime) = split(/;/, $magic->checktype_filename($modfile));

    if ($mime eq "text/plain") {
        if ( ! (open(MODFILE, "<", $modfile))) {
	    warning($!);
	    return ('none', -1);
	}	     
        $_ = <MODFILE>;
        close(MODFILE);
    } elsif ($mime eq "application/gzip") {
        my $z = new IO::Uncompress::Gunzip $modfile or error("gunzip failed: $GunzipError\n");
        $_ = <$z>;
        $z->close();
    } else {
        print("wrong MIME type $mime for $modfile; ignoring");
	return ('none', -1);
    }

    if (/^GFORTRAN module version '([0-9]+)'/) {
        return ('gfortran', $1);
    } else {
        # error("$modfile is not a gfortran mod file.");
	return ('none', -1);
    }
}

sub process {
    my $modfile = shift;
    my $package = shift;

    my ($compiler, $modversion) = determine_mod_version($modfile);
    my $realversion = '';
    next if $compiler eq 'none';
    
    if (!exists($modversions{$modversion})) {
        $modversions{$modversion} = 1;
	if ($modversion eq 14) { 
		$realversion = 'gfortran-7 | ';
	}
	if ($modversion eq 15) { 
		$realversion = 'gfortran-8 | ';
	}
	addsubstvar($package, "misc:Depends", "$realversion $compiler-mod-$modversion");
    }
    verbose_print ("Fortran modfile $modfile created by $compiler modversion $modversion");
}

# Should we install the .mod file in a Multi-arch aware directory for this package ?
# TODO: Write this
sub do_multiarch {
    my $package = shift;
    if ($multiarch) {
	return dpkg_architecture_value("DEB_HOST_MULTIARCH");
    } else { 
	return "";
    } 
}

sub compute_dest {
	my ($source_dir, $dest) = @_;
	
	#my $archd = do_multiarch($package);
	#my $modfile;
	#my $modd = '';

	$dest =~ s/^(.*\/)?\Q$srcdir\E\///;
	$dest =~ s/^(.*\/)?\Q$source_dir\E\///;
	$dest = dirname("/".$dest);

	#if ($multicompiler) {
	#    $modd = "$tmpd/usr/include/$archd/$compiler/$modversion/";
	#} else {
	#    $modd = "$tmpd/usr/include/$archd";
	#}
	
	return $dest;
}

# Support for -X flag.
my $exclude = '';
if ($dh{EXCLUDE_FIND}) {
	$exclude = '! \( '.$dh{EXCLUDE_FIND}.' \)';
}

foreach my $package (getpackages()) {
    next if is_udeb($package);

    my (@installed, %dest2sources);    
    my $default_source_dir = default_sourcedir($package);
    my @search_dirs = ($srcdir);
    push(@search_dirs, $default_source_dir);

    my $tmp = tmpdir($package);
    my $config = pkgfile($package, "fortran-mod");
    my @install;
        
    # try parsing a list of files
    if ($config) { 
	@install = filedoublearray($config);
    }

    # With autodest, we can just pretend every pattern was on its own line
    @install = map { [$_] } map { @$_ } @install if $dh{AUTODEST};

    if ($dh{AUTODEST}) {
	# Same as above, with autodest, we can just isolate each entry
	# - the split is for bug-backwards compatibility (#867866).
	push(@install, map { [$_] } map { split } @ARGV);
    } else {
	# Copy dh_install behaviour.
	#
	# Bug backwards compatibility (#867866).  The new "glob_expand"
	# interface is smart enough to not split on spaces, but dh_install
	# used to do that... *except* for the "DEST" since it was never
	# passed to the glob function.
	my @a = @ARGV;
	my $dest = pop(@a) if @a > 1;
	my @srcs = map { split } @a;
	push(@srcs, $dest) if defined($dest);
	push(@install, \@srcs);
    }

    my $glob_error_handler = sub {
	# Do not require a match for packages that not acted on
	# (directly).  After all, the files might not have been
	# generated/compiled.
	goto \&glob_expand_error_handler_warn_and_discard;
    };

    foreach my $set (@install) {

	my ($dest, @filelist, @patterns);
		
	if (@$set > 1) {
	    $dest=pop @$set;
	}
	
	my @tmp = @$set;

	# Skip excluded patterns.  We will need two exclude checks per pattern;
	# 1) exclude the entire pattern as people expect this to work (#814856)
	# 2) exclude files matched by the pattern as people could have just
	#    excluded a single file of a "dir/*"-pattern.
	# This line below filters entire patterns
	@patterns = grep { not excludefile($_) } @{$set};
	next if not @patterns;
	foreach my $glob (@patterns) {
	    my @found = glob_expand(\@search_dirs, $glob_error_handler, $glob);
	    push(@filelist, map { tr{/}{/}s; $_ } @found);
	}
	
	if (! @filelist ) {
	    warning("$package missing files: @$set");
	    next;
	}
	
	# Do a quick bulk handling of excluded files and update @installed.
	# - this is for filtering files matched by the pattern
	@filelist = grep { not excludefile($_) } @filelist if $exclude;
	push(@installed, @filelist);

	if (not $exclude) {
	    my @unoptimized;
	    for my $src (@filelist) {
		my $d = $dest // compute_dest($default_source_dir, $src);
		my $basename = basename($src);
		if (exists($dest2sources{$d}{$basename})) {
		    # If there is a clash, silently undo the optimizations.
		    # See #866405 and #868169.
		    my $replaced = delete($dest2sources{$d}{$basename});
		    # Associate the $replaced the destination
		    # directory.  We cannot be sure that compute_dest will
		    # get it right nor can we blindly set $dest.
		    #
		    # It is technically unnecessary for $src, but we
		    # might as well do it to possibly save a
		    # compute_dest call.
		    push(@unoptimized, [$replaced, $d], [$src, $d]);
		    next;
		}
		$dest2sources{$d}{$basename} = $src;
	    }
	    next if not @unoptimized;
	    @filelist = @unoptimized;
	}
	
	foreach my $src (@filelist) {
	    
	    my $target_dest;
	    
	    if (ref($src)) {
		# On a failed optimization, we will have the
		# destination directory.
		($src, $target_dest) = @{$src};
	    } else {
		$target_dest = $dest;
		if (! defined $target_dest) {
		    # Guess at destination directory.
		    $target_dest = compute_dest($default_source_dir, $src);
		}
	    }
	    
	    # Make sure the destination directory exists.
	    install_dir("$tmp/$target_dest");

	    if (-d $src && $exclude) {
		my $basename = basename($src);
		my $dir = ($basename eq '.') ? $src : "$src/..";
		my $pwd=`pwd`;
		chomp $pwd;
		complex_doit("cd '$dir' && " .
			     "find '$basename' $exclude \\( -type f -or -type l \\) -print0 | LC_ALL=C sort -z | " .
			     "xargs -0 -I {} cp --reflink=auto --parents -dp {} $pwd/$tmp/$target_dest/");
		# cp is annoying so I need a separate pass
		# just for empty directories
		complex_doit("cd '$dir' && " .
			     "find '$basename' $exclude \\( -type d -and -empty \\) -print0 | LC_ALL=C sort -z | " .
			     "xargs -0 -I {} cp --reflink=auto --parents -a {} $pwd/$tmp/$target_dest/");
	    }
	    else {
		doit("cp", '--reflink=auto', "-a", $src, "$tmp/$target_dest/");
	    }
	}
    }

    for my $dest (sort(keys(%dest2sources))) {
	my @srcs = sort(values(%{$dest2sources{$dest}}));
	# Make sure the destination directory exists.
	install_dir("$tmp/$dest");

	for my $src (@srcs) {
	    process($src,$package);
	}
	xargs(\@srcs, "cp", '--reflink=auto', "-a", XARGS_INSERT_PARAMS_HERE, "$tmp/$dest/");
    }
    log_installed_files($package, @installed);
    	
}


if (%modversions > 1) { 
    warning("Multiple compilers / compiler versions in file");
}

=back

=head1 SEE ALSO

L<debhelper(7)>

=head1 AUTHORS

Sébastien Villemot <sebastien@debian.org>
Alastair McKinstry <mckinstry@debian.org>

Lots of code stolen shamelessly from dh_install (Joey Hess <joeyh@debian.org>).
=cut
