#!/usr/bin/perl -w

=encoding utf8

=head1 NAME

dh_fortran_lib - Fortran library installation support

=cut

use strict;
use File::Find;
use Debian::Debhelper::Dh_Lib;
use File::LibMagic;
use File::Basename qw(fileparse);
use Cwd qw(getcwd);

our $VERSION = '@VERSION@';


=head1 SYNOPSIS

B<dh_fortran_lib>
[S<I<debhelper options>>]
B<--flavor=>I<flavor>
[B<--sourcedir=>I<dir>]
[B<--no-orig-library>]
[B<--no-create-in-sourcedir>] 
[S<I<libname> I<destination> ...>]

=head1 DESCRIPTION

B<dh_fortran_lib> is a debhelper program that enables multiple compiler flavous of a Fortran library
to be installed in parallel by mangling the library filename and SONAME. 

Fortran libraries compiled by different compilers are not expected to be ABI-compatible, and hence
for multiple compilers to be supported simultaneously the libraries must be named differently,
and shared libraries need to include the  compiler flavor in the SONAME.

B<dh_fortran_lib> makes this possible without changes being necessary to the upstream library code.

It does this by renaming a library, for example:

	$(LIBDIR)/libfiat.so.1.2 => $(LIBDIR)/libfiat-gfortran.so.1.2
=back

Symlinks also get renamed:

	$(LIBDIR)/libfiat.so.1 => $(LIBDIR)/libfiat-gfortran.so.1

A per-flavor compilation link is added:
 	$(LIBDIR)/fortran/gfortran/libfiat.so -> $(LIBDIR)/libfiat-gfortran.so.1.2

and the SONAME in the ELF file is changed:

	$ readelf -a $(LIBDIR)/libfiat.so.1.2 | grep SONAME
 		0x000000000000000e (SONAME)             Library soname: [libfiat.so.1]
	$ readelf -a $(LIBDIR)/libfiat-gfortran.so.1.2 | grep SONAME
 		0x000000000000000e (SONAME)             Library soname: [libfiat-gfortran.so.1]

For static files, we  just rename and add symlinks:

	$(LIBDIR)/libfiat.a => $(LIBDIR)/libfiat-gfortran.a

	$(LIBDIR)/fortran/gfortran/libfiat.a => $(LIBDIR)/libfiat-gfortran.a

The consequence of this is that any library that builds against I<libfiat> with appropriate search paths
set will use I<libfiat-gfortran> instead. This enables parallel builds with multiple compiler flavors to
be installed simultaneously.

=head1 USAGE

The expected usage is that this will be called in debian/rules as:
	
	dh_fortran_lib --flavor=$(FLAVOR) $(BUILDDIR)/XXX/libfiat-gfortran.so.1

The files are installed in the sourcedir (usually debian/tmp) by default.


=head1 OPTIONS

=over 4

=item B<--flavor=>S<dir>
=item B<--sourcedir=>I<dir>
=item B<-n>, B<--no-orig-library>

Look in the specified directory for files to be installed.

B<--no-orig-library> adds the library name (with default path) to the list of files not to be installed
by debhelper. 

=back

=head1 TODO

(1) Do we really want to support --no-orig-library, blocking install of unmangled library ?
(2) 2 install variants;
   dh_fortran_lib --flavor=F LIBBDIR/libfiat.so.4.1
   # installs in debian/tmp ; simplest
   dh_fortran_lib -p libfiat-dev LIBBDIR/libfiat.so.4.1
(3) what about reading .fortran-lib files? ugly build-paths messy to include in these


=cut

# Default

my $create_in_sourcedir = 1;
my $no_orig_library = 0;
my $flavor = undef;

init(options => {
    "sourcedir=s" => \$dh{SOURCEDIR},
     'create-in-sourcedir!' => \$create_in_sourcedir,
     'no-orig-library!' => \$no_orig_library ,
    "flavor=s" => \$dh{FLAVOR} ,
});

my $srcdir = 'debian/tmp';
$srcdir = $dh{SOURCEDIR} if defined $dh{SOURCEDIR};

if (defined $dh{FLAVOR}) {
    $flavor = $dh{FLAVOR}  
} else {
   error("--flavor must be defined");
}

my $multiarch = dpkg_architecture_value("DEB_HOST_MULTIARCH");
my $flibdir = "/usr/lib/${multiarch}/fortran/${flavor}";

#verbose_print("DEBUG: create-in-sourcedir $create_in_sourcedir no-orig-library $no_orig_library flavor $flavor\n");


sub get_soname {
    my ($lib_file ) = @_;

   my ($ret, $library, $major);

   $ret = qx_cmd('objdump', '-p', $lib_file);
   if ($ret=~m/\s+SONAME\s+(.*)\.so\.(.*)/) {
                       # proper soname format
                        $library=$1;
                        $major=$2;
                } elsif ($ret=~m/\s+SONAME\s+(.*)-(\d.*)\.so/) {
                        # idiotic crap soname format
                        $library=$1;
                        $major=$2;
                } elsif ($ret !~ m/\s+SONAME\s+(?:\S)/) {
                        warning("No Match: $lib_file");
                }
	return ($library, $major);
    }


# Called for each library
#    source_dir to install in
#    libname to process
#    target_dest for devel links

sub process_static_lib {
    my ($tmpdir, $orig_libname, $filename) = @_;

    doit("cp", '--reflink=auto', "-a", $orig_libname, "$tmpdir/$flibdir/$filename");
}

sub process_shared_lib {
    my ($tmpdir, $orig_libname, $dir, $file) = @_;
    
    my ($lib, $major) = get_soname($orig_libname);
    
    $file=~m/(\w*).so(.*)/;
    my $ext = $2;
    
    my $destdir = "/usr/lib/$multiarch";
    my $new_libname = "$lib-$dh{FLAVOR}.so";
    my $new_soname = "$lib-$dh{FLAVOR}.so.$major";
   
    install_dir("$tmpdir/$destdir");
    # doit('gcc','-shared','-fPIC',"-Wl,-soname,$new_soname",'-o',"$tmpdir/$destdir/$new_libname",$orig_libname);
    # patchelf --remove-rpath --set-soname libfckit-gfortran.so.0d --output ./debian/libx.so.0  ./debian/tmp/usr/lib/aarch64-linux-gnu/libfckit.so.0d
    doit('patchelf','--remove-rpath','--set-soname',$new_soname,'--output',"$tmpdir/$destdir/$new_libname$ext",$orig_libname);
	
    make_symlink("$flibdir/$lib.so", "$destdir/$new_libname$ext", $tmpdir);
    make_symlink("$destdir/$new_libname","$destdir/$new_libname$ext", $tmpdir);
}



sub process_libname {
	my ($source_dir, $libname) = @_;

	# verbose_print("DEBUG process_library source $source_dir libname $libname ");

	my $tmpdir = default_sourcedir($dh{FIRSTPACKAGE});
	if (!$create_in_sourcedir) {
	    $tmpdir = $flibdir;
	}

	my ($file,$dir,$ext) = fileparse($libname, qr/\.[^.]*/);	    
	
	if ($ext eq ".a") {
	    process_static_lib($tmpdir, $libname, "$file$ext" );
	    return;
	}
	if ($ext eq ".so") {
	   if (-l $libname) {
	       warning("file $libname is a shared object development symlink; ignoring");
	       return;
	    }
	}
	if (! is_so_or_exec_elf_file($libname)) {
	    warning("File $libname is not an ELF file; ignoring");
	    return;
	}
	process_shared_lib($tmpdir, $libname,$dir,"$file$ext");    
}

#	    } else {
#		return "$fmoddir/$target_dest";
#	    }
##	} else {
#	    return $fmoddir;
#	}
#	    return $fmoddir;
	
# foreach my $package (@{$dh{DOPACKAGES}}) {
# 	my $tmp=tmpdir($package);
# 	my $file=pkgfile($package,"fortran-lib");
# 	my $srcdir = $dh{SOURCEDIR} // default_sourcedir($package);


# 	my @libnames;

# 	if ($file) {
# 		@libnames=filearray($file)
# 	}

# 	if (($package eq $dh{FIRSTPACKAGE} || $dh{PARAMS_ALL}) && @ARGV) {
# 		push @libnames, @ARGV;
# 	}	

# 	if (@libnames) {
# 		# Stick the $tmp onto the front of all the dirs.
# 		# This is necessary, for 2 reasons, one to make them 
# 		# be in the right directory, but more importantly, it 
# 		# protects against the danger of absolute dirs being
# 		# specified.
# 		my @make_libnames;
# 		push(@make_libnames, map {
# 				my $dir = "$tmp/$_";
# 				$dir =~ tr:/:/:s; # just beautification.
# 				$dir;
# 			} @libnames);
# 		if ($create_in_sourcedir) {
# 			push(@make_libnames, map {
# 					my $dir = "${srcdir}/$_";
# 					$dir =~ tr:/:/:s; # just beautification.
# 					$dir;
# 				} @libnames);
# 		}

# 		# Create dirs.
# 		process_libnames(@make_libnames);
# 	}
# }
# }

sub compute_dest {
	my ($source_dir, $libname, $target_dest) = @_;

	 # verbose_print("DEBUG compute_dest src $source_dir libname $libname \n");
	
	if (defined $target_dest) {
	    if ($target_dest =~ /^\//) {
		return $target_dest;
	    } else {
		return "$flibdir/$target_dest";
	    }
	} else {
	    return $flibdir;
	}
}

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

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

    # Much of the logic here unused
    # verbose_print("DEBUG: checking package FIRSTPACKAGE $dh{FIRSTPACKAGE} only ");
    next if  (!($package eq $dh{FIRSTPACKAGE}));

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

    # Look at the install files for all packages to handle
    # list-missing/fail-missing, but skip really installing for
    # packages that are not being acted on.
    my $skip_install = process_pkg($package) ? 0 : 1;

    my $tmp = tmpdir($package);
    my $config = pkgfile($package, "fortran-lib");
    my @install;
    my $pkg_built_using = '';
    my %compiler_pkgs;

    # try parsing a list of files
    if ($config) {
	@install = filedoublearray($config);
    }

    # Copy dh_install behaviour.
    #

    # 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.
	return if $skip_install;
	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  && !$skip_install ) {
	    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);

	# ... because then we can short-curcit here.
        next if $skip_install;

	if (not $exclude) {
	    my @unoptimized;
	    for my $src (@filelist) {
		my $d = compute_dest($default_source_dir, $src, $dest);
                my $base = basename($src);

		if (exists($dest2sources{$d}{$base})) {
		    # If there is a clash, silently undo the optimizations.
		    # See #866405 and #868169.
		    my $replaced = delete($dest2sources{$d}{$base});
		    # 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}{$base} = $src;
	    }
	    next if not @unoptimized;
	    @filelist = @unoptimized;
	}

	foreach my $libname (@filelist) {

	    my $target_dest;

	    #my $compiler_pkg = which_compiler($src);
	    #$compiler_pkgs{$compiler_pkg} = 1 ;

	    if (ref($libname)) {
		# On a failed optimization, we will have the
		# destination directory.
		($libname, $target_dest) = @{$libname};
	    } else {
		$target_dest = $dest;
		if (! defined $target_dest) {
		    # Guess at destination directory.
		    $target_dest = compute_dest($default_source_dir, $libname, undef);
		}
	    }

	    # Make sure the destination directory exists.
	    # verbose_print("DEBUG install_dir 1");
	    install_dir("$tmp/$target_dest");

	    if (-d $libname && $exclude) {
                my $base = basename($libname);

		my $dir = ($base eq '.') ? $libname : "$libname/..";
		my $pwd=`pwd`;
		chomp $pwd;
		complex_doit("cd '$dir' && " .
			     "find '$base' $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 '$base' $exclude \\( -type d -and -empty \\) -print0 | LC_ALL=C sort -z | " .
			     "xargs -0 -I {} cp --reflink=auto --parents -a {} $pwd/$tmp/$target_dest/");
	    }
	    else {
		warning("DEBUG NOTCALLED call $libname tmp $tmp target $target_dest");
		doit("echo","DEBUG","cp", '--reflink=auto', "-a", $libname, "$tmp/$target_dest/");
	    }
	}
    }

    for my $dest (sort(keys(%dest2sources))) {
	my @srcs = sort(values(%{$dest2sources{$dest}}));
	# Make sure the destination directory exists.
	# verbose_print("DEBUG creating install dir $tmp dest $dest");
	# TODO this isn't doing the right tmp; overwrite for now
 	$tmp = "debian/tmp";
	install_dir("$tmp/$dest");

	for my $src (@srcs) {
	    process_libname($tmp, $src, $dest);
	}
	if (!$create_in_sourcedir) {
	    log_installed_files($package, @installed);
	}
    }

}


=head1 SEE ALSO

L<debhelper(7)>

=head1 AUTHORS

Alastair McKinstry <mckinstry@debian.org>

Lots of code stolen shamelessly from dh_install (Joey Hess <joeyh@debian.org> and Sébastien Villemot <sebastien@debian.org>).
=cut