[dh-make-perl-cvs-dev] CVS dh-make-perl

CVS User csacca-guest cvs@dh-make-perl.alioth.debian.org
Tue, 29 Mar 2005 16:58:42 +0000


Update of /cvsroot/dh-make-perl/dh-make-perl
In directory haydn:/tmp/cvs-serv29832

Modified Files:
	dh-make-perl 
Log Message:
  * dh-make-perl: Uses Module::Depends::Intrusive in extract_depends() to find
    dependencies now.  This simulates a build of the module ensuring that you
    get all the dependencies.  (Closes: #297537)
  * debian/control: Added dependency on libmodule-depends-perl for dependency
    detection fix.


--- /cvsroot/dh-make-perl/dh-make-perl/dh-make-perl	2005/03/27 18:04:26	1.29
+++ /cvsroot/dh-make-perl/dh-make-perl/dh-make-perl	2005/03/29 16:58:39	1.30
@@ -135,6 +135,7 @@
 use User::pwent;
 use Getopt::Long;
 use Cwd;
+use Module::Depends::Intrusive;
 use strict;
 
 my $debstdversion = '3.6.1';
@@ -472,60 +473,61 @@
 	my ($dir) = shift;
 	$dir .= '/' unless $dir =~ m/\/$/;
 
-	my (@Modules, @use, @depends);
+	my $mod_dep = Module::Depends::Intrusive->new();
 	
-	find( sub {push @Modules, $File::Find::name if /pm$/ && (! $excludeRE || ! $File::Find::name =~ /$excludeRE/) }, $dir); #Find all modules
-    
-	foreach my $module (@Modules) {
-		open (FH, $module) or print "Couldn't open $module\n", next;
-		while(<FH>) {
-			if ($_ && /^\s*use ([^; \t\"(]+)(?: \d(?:\.\d+)+)?.*;\s*$/) {
-				my $m = $1;
-				my $f = $m;
-				   $f =~ s!::!/!g;
-				if ($m && $m !~ /^v?5/){ #Is not a perl version
-					if (! grep ($m eq $_, @pragmas)     #Is not a pragma
-						&&
-						! grep ($m eq $_, @stdmodules)) #Is not a standard module
-					{
-						if (! grep {$_ eq $m} @use) { #Prevent dupes
-							if (! grep { $_ && $_ =~ /$f.pm$/ } @Modules) { #Modules in this package
-								push @use, $m;
-							}
-						}
-					}
-				}								
-			}
-		}
-		close FH;
+	$mod_dep->dist_dir( $dir );
+	$mod_dep->find_modules();
+
+	my %dep_hash = %{$mod_dep->requires};
+	
+	my @uses;
+
+	foreach my $module (keys( %dep_hash )) {
+		next if (grep ( /^$module$/, @pragmas, @stdmodules));
+		
+		push @uses, $module;
 	}
 
+	my @deps;
+	my @not_debs;
+
 	if (`which apt-file`) {
-		for my $u (@use) {
-			print "Searching package for module $u with apt-file.\n";
-			$u =~ s!::!/!g;
+		foreach my $module (@uses) {
+			print "Searching for $module package using apt-file.\n";
+			$module =~ s|::|/|g;
 
-			my @search = `apt-file search $u.pm`;
+			my @search = `apt-file search $module.pm`;
 
+			# Regex's to search the return of apt-file to find the right pkg
 			my $ls  = '(?:lib|share)';
 			my $ver = '\d+(\.\d+)+';
-			my $re  = "usr/(?:(?:local/)?$ls/perl/$ver|$ls/perl5)/$u\\.pm";
+			my $re  = "usr/(?:$ls/perl/$ver|$ls/perl5)/$module\\.pm";
 				
 			for (@search) {
+				# apt-file output
+				# package-name: path/to/perl/module.pm
 				chomp; 
 				my ($p, $f) = split / /, $_;
 				chop($p); #Get rid of the ":"
-				if ($f =~ /$re/ && ! grep ($_ eq $p, @depends, "perl", "perl-base", "perl-modules")) {
-					push @depends, $p;
+				if ($f =~ /$re/ && ! grep { $_ eq $p } @deps, "perl", "perl-base", "perl-modules") {
+					push @deps, $p;
 					last;
 				}
 			}
+			
+			unless (@search) {
+			    $module =~ s|/|::|g;
+				push @not_debs, $module;
+		    }
 		}
-	} else {
-		print "Needs the following modules: ", join (", ", @use), "\n"
 	}
-
-	return join ", ", @depends;	
+	
+	print "\n";
+	print "Needs the following debian packages: " . join (", ", @deps) . "\n" if (@deps);
+	print "Needs the following modules for which there are debian packages availible: "
+		. join (", ", @not_debs) . "\n" if (@not_debs);
+	
+	return join (", ", @deps);
 }
 
 sub check_for_xs {