#!/usr/bin/perl -w
#
# Find dependencies on perl stuff
# Remove .packlist files

use strict;
use Debian::Debhelper::Dh_Lib;
init();

my $perlext = '';
my $lib_dir = 'usr/lib/perl5';

# Figure out the version of perl. If $ENV{PERL} is set, query the perl binary
# it points to, otherwise query perl directly.
#
# This is pretty gawd-aweful ugly, because we need "5.00[45]"
# and "5.[6789]" to be returned depending on perl version.
my $version;
if (defined $ENV{PERL}) {
	$version=`$ENV{PERL} -e '\$] < 5.006 ? printf "%.3f", \$] : printf "%vd", substr \$^V, 0, -1'`;
}
else {
	$version=$] < 5.006 ? sprintf "%.3f", $] : sprintf "%vd", substr $^V, 0, -1;
}

# Cleaning the paths given on the command line
foreach (@ARGV) {
	s#/$##;
	s#^/##;
}

# If -d is given, then we'll try to depend on one of the perl-5.00X-base 
# package instead of perl-5.00X
$perlext='-base' if ($dh{'D_FLAG'});

foreach my $package (@{$dh{DOPACKAGES}}) {
	my $tmp=tmpdir($package);
	my $ext=pkgext($package);

	my ($file, $v, $arch);
	my $dep_arch = '';
	my $dep = '';
	my $found = 0;

	# Check also for alternate locations given on the command line
	my $dirs = '';
	foreach ($lib_dir, @ARGV) {
		$dirs .= "$tmp/$_ " if (-d "$tmp/$_");
	}
	my $re = '(?:' . join('|', ($lib_dir, @ARGV)) . ')';

	# Look for perl modules and check where they are installed
	if ($dirs) {
	    foreach $file (split(/\n/,`find $dirs -type f \\( -name "*.pm" -or -name "*.so" \\)`)) {
	        $found++;
		if ($file =~ m<^$tmp/$re/(\d\.\d+)/([^/]+)/>) {
			$v = $1;
			$arch = $2;
			check_module_version ($v, $version);
			$v .= '-thread' if ($arch =~ /-thread/); 
			$dep_arch = add_deps ($dep_arch, "perl-$v");
		} elsif ($file =~ m<^$tmp/$re/(\d.\d+)/>) {
			$v = $1;
			check_module_version ($v, $version);
			$dep_arch = add_deps ($dep_arch, "perl-$v");
		}
	    }
	}

	if ($found and not $dep_arch) {
		$dep = "perl5$perlext";
	} elsif ($dep_arch) {
		$dep = $dep_arch;
	}

	# Look for perl scripts
	my ($ff, $newdep);
	foreach $file (split(/\n/,`find $tmp -type f \\( -name "*.pl" -or -perm +111 \\)`)) {
		$ff=`file -b $file`;
		if ($ff =~ /perl/) {
			$newdep = dep_from_script ($file);
			$dep = add_deps ($dep, $newdep) if $newdep;
		}
	}

	# Remove .packlist files and eventually some empty directories
	if (not $dh{'K_FLAG'}) {
		foreach $file (split(/\n/,`find $tmp -type f -name .packlist`))
		{
			unlink($file);
			# Get the directory name
			while ($file =~ s#/[^/]+$##){
				last if (not -d $file);
				last if (not rmdir $file);
			}
		}
	}

	next unless $dep;

	if (-e "debian/${ext}substvars") {
		open (IN, "<debian/${ext}substvars");
		my @lines=grep { ! /^perl:Depends=/ } <IN>;
		close IN;
		open (OUT, ">debian/${ext}substvars");
		print OUT @lines;
	} else {
		open (OUT, ">debian/${ext}substvars");
	}
	print OUT "perl:Depends=$dep\n";
	close OUT;
}

sub add_deps {
	my ($dep, $new) = @_;
	
        # If the $new-base package can exist then add $perlext to $new
	$new = "$new$perlext" if ($new =~ m/^(?:perl5|perl-\d\.\d+)$/);
	
	# If $new = perl5 or perl5-thread check if perl-X.XXX(-thread)?
	# is not already in the dependencies
	if ($new eq "perl5") {
		return $dep if ($dep =~ m/(^|\s)perl-5\.\d+(\s|,|$)/);
	} elsif ($new eq "perl5-thread") {
		return $dep if ($dep =~ m/(^|\s)perl-5\.\d+-thread(\s|,|$)/);
	}
	
	if (not $dep) {
		$dep = $new;
	} else {
		$dep .= ", $new" unless ($dep =~ m/(^|\s)$new(\s|,|$)/);
	}

	return $dep;
}

sub check_module_version {
	my ($v1, $v2) = @_;
	unless ($v1 eq $v2) {
		warning("A module has been found in perl-$v1 arch directory. But perl-$v2 is the perl currently used ...\n");
	}
}

sub dep_from_script {
	my $file = shift;
	my ($line, $perl, $dep);
	open (SCRIPT, "<$file") || die "Can't open $file: $!\n";
	$line = <SCRIPT>;
	close (SCRIPT);
	if ($line =~ m<^#!\s*/usr/bin/(perl\S*)(?:\s+|$)>) {
		$perl = $1;
		if ($perl eq "perl") {
			$dep = "perl5";
		} elsif ($perl eq "perl-thread") {
			$dep = "perl5-thread";
		} elsif ($perl =~ m/^perl-\d\.\d+(?:-thread)?$/) {
			$dep = $perl;
		} elsif ($perl =~ m/^perl(\d\.\d+)(\d\d)$/) {
			# Should never happen but ...
			$dep = "perl-$1 (=$1.$2)";
		}
	}
	return $dep;
}