#!/usr/bin/perl -w

# TODO: 
# * get more info from the package (maybe using CPAN methods)

package MyPod;
use Pod::Parser;
use YAML;

@MyPod::ISA = qw(Pod::Parser);

my @pragmas = qw(attributes attrs autouse base bigint bignum
				 bigrat blib bytes charnames constant
				 diagnostics encoding fields filetest if 
				 integer less lib locale open ops overload
				 re sigtrap sort strict subs threads utf8
				 vars vmsish warnings warnings::register);

my @stdmodules = qw(AnyDBM_File Attribute::Handlers::demo::Demo
Attribute::Handlers::demo::Descriptions
Attribute::Handlers::demo::MyClass Attribute::Handlers attributes
AutoLoader AutoSplit autouse base Benchmark bigint bignum bigrat blib
bytes Carp::Heavy Carp CGI::Apache CGI::Carp CGI::Cookie CGI::Fast
CGI::Pretty CGI::Push CGI::Switch CGI::Util CGI charnames Class::ISA
Class::Struct constant CPAN::FirstTime CPAN::Nox CPAN Cwd DB
Devel::SelfStubber diagnostics Digest DirHandle Dumpvalue English Env
Exporter::Heavy Exporter ExtUtils::Command::MM ExtUtils::Command
ExtUtils::Constant ExtUtils::Embed ExtUtils::Installed ExtUtils::Install
ExtUtils::Liblist::Kid ExtUtils::Liblist ExtUtils::MakeMaker::bytes
ExtUtils::MakeMaker::vmsish ExtUtils::MakeMaker ExtUtils::Manifest
ExtUtils::Mkbootstrap ExtUtils::Mksymlists ExtUtils::MM_Any
ExtUtils::MM_BeOS ExtUtils::MM_Cygwin ExtUtils::MM_DOS
ExtUtils::MM_MacOS ExtUtils::MM_NW5 ExtUtils::MM_OS2 ExtUtils::MM
ExtUtils::MM_Unix ExtUtils::MM_UWIN ExtUtils::MM_VMS ExtUtils::MM_Win32
ExtUtils::MM_Win95 ExtUtils::MY ExtUtils::Packlist ExtUtils::testlib
Fatal fields File::Basename File::CheckTree File::Compare File::Copy
File::DosGlob File::Find File::Path File::Spec::Cygwin File::Spec::Epoc
File::Spec::Functions File::Spec::Mac File::Spec::OS2 File::Spec::Unix
File::Spec::VMS File::Spec::Win32 File::Spec File::stat File::Temp
FileCache FileHandle filetest Filter::Simple FindBin Getopt::Long
Getopt::Std Hash::Util I18N::Collate I18N::LangTags::List I18N::LangTags
if integer IPC::Open2 IPC::Open3 less Locale::Constants Locale::Country
Locale::Currency Locale::Language Locale::Maketext::GutsLoader
Locale::Maketext::Guts Locale::Maketext Locale::Script locale
Math::BigFloat Math::BigFloat::Trace Math::BigInt::Calc
Math::BigInt::Scalar Math::BigInt::Trace Math::BigInt Math::BigRat
Math::Complex Math::Trig Memoize::AnyDBM_File Memoize::ExpireFile
Memoize::Expire Memoize::ExpireTest Memoize::NDBM_File
Memoize::SDBM_File Memoize::Storable Memoize Net::Cmd Net::Config
Net::Domain Net::FTP::A Net::FTP::dataconn Net::FTP::E Net::FTP::I
Net::FTP::L Net::FTP Net::hostent Net::netent Net::Netrc Net::NNTP
Net::Ping Net::POP3 Net::protoent Net::servent Net::SMTP Net::Time NEXT
open overload PerlIO PerlIO::via::QuotedPrint Pod::Checker Pod::Find
Pod::Functions Pod::Html Pod::InputObjects Pod::LaTeX Pod::Man
Pod::ParseLink Pod::Parser Pod::ParseUtils Pod::Perldoc::BaseTo
Pod::Perldoc::GetOptsOO Pod::Perldoc::ToChecker Pod::Perldoc::ToMan
Pod::Perldoc::ToNroff Pod::Perldoc::ToPod Pod::Perldoc::ToRtf
Pod::Perldoc::ToText Pod::Perldoc::ToTk Pod::Perldoc::ToXml Pod::Perldoc
Pod::Plainer Pod::PlainText Pod::Select Pod::Text::Color
Pod::Text::Overstrike Pod::Text::Termcap Pod::Text Pod::Usage
Search::Dict SelectSaver SelfLoader Shell sigtrap sort strict subs
Switch Symbol Term::ANSIColor Term::Cap Term::Complete Term::ReadLine
Test::Builder Test::Harness::Assert Test::Harness::Iterator
Test::Harness::Straps Test::Harness Test::More Test::Simple Test
Text::Abbrev Text::Balanced Text::ParseWords Text::Soundex Text::Tabs
Text::Wrap Thread Thread::Queue Thread::Semaphore Tie::Array Tie::File
Tie::Handle Tie::Hash Tie::Memoize Tie::RefHash Tie::Scalar
Tie::SubstrHash Time::gmtime Time::Local Time::localtime Time::tm
Unicode::Collate Unicode::UCD UNIVERSAL User::grent User::pwent utf8
vars vmsish warnings warnings::register);

sub set_names {
	my ($parser, @names) = @_;
	foreach my $n (@names) {
		$parser->{_deb_}->{$n} = undef;
	}
}

sub get {
	my ($parser, $name) = @_;
	$parser->{_deb_}->{$name};
}

sub cleanup {
	my $parser = shift;
	delete $parser->{_current_};
	foreach my $k ( keys %{$parser->{_deb_}}) {
		$parser->{_deb_}->{$k} = undef;
	}
}

sub command {
	my ($parser, $command, $paragraph, $line_num) = @_;
	$paragraph =~ s/\s+$//s;
	if ($command =~ /head/ && exists($parser->{_deb_}->{$paragraph})) {
		$parser->{_current_} = $paragraph;
		$parser->{_lineno_} = $line_num;
	} else {
		delete $parser->{_current_};
	}
	#print "GOT: $command -> $paragraph\n";
}

sub add_text {
	my ($parser, $paragraph, $line_num) = @_;
	return unless exists $parser->{_current_};
	return if ($line_num - $parser->{_lineno_} > 15);
	$paragraph =~ s/^\s+//s;
	$paragraph =~ s/\s+$//s;
	$paragraph = $parser->interpolate($paragraph, $line_num);
	$parser->{_deb_}->{$parser->{_current_}} .= "\n\n".$paragraph;
	#print "GOTT: $paragraph'\n";
}

sub verbatim { shift->add_text(@_)}

sub textblock { shift->add_text(@_)}

sub interior_sequence {
	my ($parser, $seq_command, $seq_argument) = @_;
	if ($seq_command eq 'E') {
		my %map = ('gt' => '>', 'lt' => '<', 'sol' => '/', 'verbar' => '|');
		return $map{$seq_argument} if exists $map{$seq_argument};
		return chr($seq_argument) if ($seq_argument =~ /^\d+$/);
		# html names...
	}
	return $seq_argument;
}

package main;

use File::Basename;
use File::Find;
use File::Copy qw(copy move);
use User::pwent;
use Getopt::Long;
use Cwd;
use Module::Depends::Intrusive;
use strict;

my $perl_pkg = get_perl_pkg_details();

my $debstdversion = '3.7.2';
my $priority = 'optional';
my $section = 'perl';
my $depends = '${perl:Depends}';
my $bdependsi = "perl (>= $perl_pkg->{Version})";
my $bdepends = 'debhelper (>= 5.0.0)';
my $maintainer = get_maintainer();
my $arch = 'all';
my $date = `822-date`;
my $debiandir;
my $startdir = getcwd();
my $dh_compat = 5;

our %overrides;
my $datadir = '/usr/share/dh-make-perl';
my $homedir = "$ENV{HOME}/.dh-make-perl";
my ($perlname, $maindir, $modulepm, $meta);
my ($pkgname, $srcname, 
    # $version is the version from the perl module itself
    $version, 
    # $pkgversion is the resulting version of the package: User's
    # --version=s or "$version-1"
    $pkgversion, 
    $desc, $longdesc, $copyright, $author);
my ($extrasfields, $extrapfields);
my (@docs, $changelog, @args);
my ($cpanmodule, $cpanplusmodule, $cpanmirror, $build, $install, $dbflags, 
    $excludeRE, $notest, $nometa, $requiredeps, $user_depends, $user_bdepends,
    $user_bdependsi);

my $mod_cpan_version;

$dbflags = $>==0?"":"-rfakeroot";
chomp($date);

GetOptions(
	"cpan=s" => \$cpanmodule,
#	"cpanplus=s" => \$cpanplusmodule,
	"cpan-mirror=s" => \$cpanmirror,
	"desc=s" => \$desc,
	"arch=s" => \$arch,
	"version=s" => \$pkgversion,
	"help" => sub {die "\n"},
	# disabled: see build_package()
	"dbflags=s" => \$dbflags,
	"exclude|i:s{,}" => \$excludeRE,
	"build!" => \$build,
	"install!" => \$install,
	"notest" => \$notest,
	"nometa" => \$nometa,
	"requiredeps" => \$requiredeps,
	"depends=s" => \$user_depends,
	"bdepends=s" => \$user_bdepends,
	"bdependsi=s" => \$user_bdependsi
	) || die <<"USAGE";
Usage:
$0 [ --build ] [ --install ] [ SOURCE_DIR | --cpan MODULE ]
Other options: [ --desc DESCRIPTION ] [ --arch all|any ] [ --version VERSION ]
               [ --depends DEPENDS ] [ --bdepends BUILD-DEPENDS ]
               [ --bdependsi BUILD-DEPENDS-INDEP ] [ --cpan-mirror MIRROR ]
               [ --exclude|-i [REGEX] ] [ --notest ] [ --nometa ] 
               [ --requiredeps ]
USAGE

$excludeRE = '(?:\/|^)(?:CVS|.svn)\/' if (defined $excludeRE && 
					  $excludeRE eq '');

load_overrides();
my $tarball = setup_dir();
$meta = process_meta("$maindir/META.yml") if (-f "$maindir/META.yml");
findbin_fix();
($pkgname, $version) = extract_basic();
if (! defined $pkgversion) {
	$pkgversion = $version . "-1";
}
move ($tarball, dirname($tarball) . "/${pkgname}_${version}.orig.tar.gz") if ($tarball && $tarball =~ /(?:\.tar\.gz|\.tgz)$/);
my $module_build = (-f "$maindir/Build.PL") ? "Module-Build" : "MakeMaker";
extract_changelog($maindir);
extract_docs($maindir);

if (defined $user_bdepends) {
    $bdepends = $user_bdepends;
} else {
    $bdepends .= ', libmodule-build-perl' if ($module_build eq "Module-Build");
}
$bdependsi = $user_bdependsi if defined $user_bdependsi;

if (defined $user_depends) {
    $depends = $user_depends;
} else {
    $depends .= ', ${shlibs:Depends}' if $arch eq 'any';
    $depends .= ', ${misc:Depends}';
    $depends .= ", " . extract_depends($maindir, $meta);
}

apply_overrides();

die "Cannot find a description for the package: use the --desc switch\n" 
    unless $desc;
print "Package does not provide a long description - " , 
    " Please fill it in manually.\n"
    if (!defined $longdesc or $longdesc =~ /^\s*\.?\s*/);
print "Using maintainer: $maintainer\n";
print "Found changelog: $changelog\n" if defined $changelog;
print "Found docs: @docs\n";
-d $debiandir && die "The directory $debiandir is already present and I won't overwrite it: remove it yourself.\n";
# start writing out the data
mkdir ($debiandir, 0755) || die "Cannot create $debiandir dir: $!\n";
create_control("$debiandir/control");
create_changelog("$debiandir/changelog");
create_rules("$debiandir/rules");
create_compat("$debiandir/compat");
create_watch("$debiandir/watch", $cpanmodule) if ($cpanmodule);
#create_readme("$debiandir/README.Debian");
create_copyright("$debiandir/copyright");
fix_rules("$debiandir/rules", (defined $changelog ? $changelog : ''), @docs);
apply_final_overrides();
build_package($maindir) if $build or $install;
install_package($debiandir) if $install;
print "Done\n";
exit(0);

sub get_perl_pkg_details {
    my (@dpkg_info);
    chomp( @dpkg_info =  grep /^\S/, `dpkg -p perl`);
       return( { map { m/^(\S+?):\s+(.*)/; $1 => $2} @dpkg_info })  ;
}

sub setup_dir {
	my ($dist, $mod, $cpanversion, $tarball);
	$mod_cpan_version = '';
	if ($cpanmodule) {
        # Is the module a core module
        if ((grep(/$cpanmodule/, @pragmas)) ||
            (grep(/$cpanmodule/, @stdmodules))) {
            die "$cpanmodule is a standard module.\n";
        }	
	
		require CPAN;
		CPAN::Config->load;

		unshift @{$CPAN::Config->{'urllist'}}, $cpanmirror if $cpanmirror;

		$CPAN::Config->{'build_dir'} = $ENV{'HOME'} . "/.cpan/build";
		$CPAN::Config->{'cpan_home'} = $ENV{'HOME'} . "/.cpan/";
		$CPAN::Config->{'histfile'}  = $ENV{'HOME'} . "/.cpan/history";
		$CPAN::Config->{'keep_source_where'} = $ENV{'HOME'} . "/.cpan/source";
                
		$mod = CPAN::Shell->expand('Module', '/^'.$cpanmodule.'$/') 
			|| die "Can't find '$cpanmodule' module on CPAN\n";
		$mod_cpan_version = $mod->cpan_version;
		$cpanversion = $CPAN::VERSION;
		$cpanversion =~ s/_.*//;

		$tarball = $CPAN::Config->{'keep_source_where'} . "/authors/id/";
                
		if ($cpanversion < 1.59) { # wild guess on the version number
			$dist = $CPAN::META->instance('CPAN::Distribution', $mod->{CPAN_FILE});
			$dist->get || die "Cannot get $mod->{CPAN_FILE}\n";
                        $tarball .= $mod->{CPAN_FILE};
			$maindir = $dist->{'build_dir'};
		} else {
			# CPAN internals changed
			$dist = $CPAN::META->instance('CPAN::Distribution', $mod->cpan_file);
			$dist->get || die "Cannot get ", $mod->cpan_file, "\n";
                        $tarball .= $mod->cpan_file;
                        $maindir = $dist->dir;
		}

		copy ($tarball, $ENV{'PWD'});
		$tarball = $ENV{'PWD'} . "/" . basename($tarball);
		my $new_maindir = $ENV{PWD}."/".basename($maindir);
		`mv "$maindir" "$new_maindir"`;
		$maindir = $new_maindir;

	} elsif ($cpanplusmodule) {
	        die "CPANPLUS support is b0rken at the moment.";
 	        my ($cb, $href, $file);

		eval "use CPANPLUS 0.045;";
		$cb = CPANPLUS::Backend->new(conf => {debug => 1, verbose => 1});
		$href = $cb->fetch( modules => [ $cpanplusmodule ], fetchdir => $ENV{'PWD'});
		die "Cannot get $cpanplusmodule\n" if keys(%$href) != 1;
		$file = (values %$href)[0];
		print $file, "\n\n";
		$maindir = $cb->extract( files => [ $file ], extractdir => $ENV{'PWD'} )->{$file};
	} else {
		$maindir = shift(@ARGV) || '.';
		$maindir =~ s/\/$//;
	}
	return $tarball;
}

sub build_package {
	my $maindir = shift;
	# uhmf! dpkg-genchanges doesn't cope with the deb being in another dir..
	#system("dpkg-buildpackage -b -us -uc $dbflags") == 0
	system("fakeroot make -C $maindir -f debian/rules clean");
	system("fakeroot make -C $maindir -f debian/rules binary") == 0
		|| die "Cannot create deb package\n";
}

sub install_package {
	my $archspec = $arch;
	my $debname;
	if ($arch eq 'any') {
		$archspec = `dpkg --print-architecture`;
		chomp($archspec);
	}
	$debname = "${pkgname}_$version-1_$archspec.deb";
	system("dpkg -i $startdir/$debname") == 0
		|| die "Cannot install package $startdir/$debname\n";
}

sub process_meta {
    my ($file, $yaml);
    $file = shift;
    # Command line option nometa causes this function not to be run
    return {} if $nometa;

    # YAML::LoadFile has the bad habit of dying when it cannot properly parse
    # a file - Catch it in an eval, and if it dies, return -again- just an
    # empty hashref. Oh, were it not enough: It dies, but $! is not set, so we
    # check against $@. Crap, crap, crap :-/
    eval {
	$yaml = YAML::LoadFile($file);
    };
    if ($@) {
	print "Error parsing $file - Ignoring it.\n";
	print "Please notify module upstream maintainer.\n";
	$yaml = {};
    }

    # Returns a simple hashref with all the keys/values defined in META.yml
    return $yaml;
}

sub extract_basic_copyright {
	for my $f (qw(LICENSE LICENCE COPYING)) {
		if (-f $f) {
			return `cat $f`;
		}
	}
	return undef;
}

sub extract_basic {
    ($perlname, $version) = extract_name_ver();
    find(\&check_for_xs, $maindir);
    $pkgname = lc $perlname;
    $pkgname =~ s/::/-/;
    $pkgname = 'lib'.$pkgname unless $pkgname =~ /^lib/;
    $pkgname .= '-perl' unless ($pkgname =~ /-perl$/ and $cpanmodule !~ /::perl$/i);

    # ensure policy compliant names and versions (from Joeyh)...
    $pkgname =~ s/[^-.+a-zA-Z0-9]+/-/g;
        
    $srcname = $pkgname;
    $version =~ s/[^-.+a-zA-Z0-9]+/-/g;
    $version = "0$version" unless $version =~ /^\d/;

    print "Found: $perlname $version ($pkgname arch=$arch)\n";
    $debiandir = "$maindir/debian";

    $copyright = extract_basic_copyright();
    if ($modulepm) {
	extract_desc($modulepm);
    }

    $excludeRE = '^$' unless $excludeRE;
    find(sub {
	$File::Find::name !~ /$excludeRE/ &&
	    /\.(pm|pod)$/ &&
	    extract_desc($_);
    }, $maindir);

    return ($pkgname, $version);
}

sub makefile_pl {
    return "$maindir/Makefile.PL";
}

sub findbin_fix {
    # FindBin requires to know the name of the invoker - and requires it to be
    # Makefile.PL to function properly :-/
    $0 = makefile_pl();
    if (exists $FindBin::{Bin}) {
	FindBin::again();
    }
}

sub extract_name_ver {
	my ($name, $ver, $makefile);
	$makefile = makefile_pl();

	if (defined $meta->{name} and defined $meta->{version}) {
	    $name = $meta->{name};
	    $ver = $meta->{version};

	} else {
	    ($name, $ver) = extract_name_ver_from_makefile($makefile);
	}

	return ($name, $ver);
}

sub extract_name_ver_from_makefile {
	my ($file, $name, $ver, $vfrom, $dir, $makefile);
	$makefile = shift;
	local $/ = undef;
	open (MF, "<$makefile") || die "Cannot open $makefile: $!\n";
	$file = <MF>;
	close(MF);

	# Get the name
	if ($file =~ /([\'\"]?)DISTNAME\1\s*(=>|,)\s*([\'\"]?)(\S+)\3/s) {
	    # Regular MakeMaker
	    $name = $4;
	} elsif ($file =~ /([\'\"]?)NAME\1\s*(=>|,)\s*([\'\"]?)(\S+)\3/s) {
	    # Regular MakeMaker
	    $name = $4;
	} elsif ($file =~ /name\(([\'\"]?)(\S+)\1\);/s) {
	    # Module::Install syntax
	    $name = $2;
	}
	$name =~ s/,.*$//;
	# band aid: need to find a solution also for build in directories
	# warn "name is $name (cpan name: $cpanmodule)\n";
	$name = $cpanmodule if ($name eq '__PACKAGE__' && $cpanmodule);
	$name = $cpanplusmodule if ($name eq '__PACKAGE__' && $cpanplusmodule);

	# Get the version
	if (defined $pkgversion) {
	    # Explicitly specified
	    $ver = $pkgversion;

	} elsif ($file =~ /([\'\"]?)VERSION\1\s*(=>|,)\s*([\'\"]?)(\S+)\3/s) {
	    # Regular MakeMaker
	    $ver = $4;
	    # Where is the version taken from?
	    $vfrom = $4 if 
		$file =~ /([\'\"]?)VERSION_FROM\1\s*(=>|,)\s*([\'\"]?)(\S+)\3/s;

	} elsif ($file =~ /([\'\"]?)VERSION_FROM\1\s*(=>|,)\s*([\'\"]?)(\S+)\3/s) {
	    # Regular MakeMaker pointing to where the version is taken from
	    $vfrom = $4;

	} elsif ($file =~ /version\((\S+)\)/s) {
	    # Module::Install
	    $ver = $1;
	}

	$modulepm = "$dir/$vfrom" if defined $vfrom;

	$dir = dirname($makefile) || './';

	for (($name, $ver)) {
		next unless defined;
		next unless /^\$/;
		# decode simple vars
		s/(\$\w+).*/$1/;
		if ($file =~ /\Q$_\E\s*=\s*([\'\"]?)(\S+)\1\s*;/) {
			$_ = $2;
		}
	}

	unless (defined $ver) {
	    local $/ = "\n";
	    # apply the method used by makemaker
	    if (defined $dir and defined $vfrom and -f "$dir/$vfrom"
		and open(MF, "<$dir/$vfrom") ) {
		while (<MF>) {
		    if (/([\$*])(([\w\:\']*)\bVERSION)\b.*\=/) {
			no strict;
			#warn "ver: $_";
			$ver = (eval $_)[0];
			last;
		    }
		}
		close(MF);
	    } else {
		if ( $mod_cpan_version ) {
		    $ver = $mod_cpan_version;
		    warn "Cannot use internal module data to gather the ".
			"version; using cpan_version\n";
		} else {
		    die "Cannot use internal module data to gather the ".
			"version; use --cpan or --version\n";
		}
	    }
	}

	return ($name, $ver);
}

sub extract_desc {
        my ($file, $parser);
	$file = shift;
	$parser = new MyPod;
	return unless -f $file;
	$parser->set_names(qw(NAME DESCRIPTION DETAILS COPYRIGHT AUTHOR AUTHORS));
	$parser->parse_from_file($file);
	if ($desc) {
	    # No-op - We already have it, probably from the command line

	} elsif ($meta->{abstract}) {
	    # Get it from META.yml
	    $desc = $meta->{abstract};

	} elsif (my $my_desc = $parser->get('NAME')) {
	    # Parse it, fix it, send it!
	    $my_desc =~ s/^\s*\S+\s+-\s+//s;
	    $my_desc =~ s/^\s+//s;
	    $my_desc =~ s/\s+$//s;
	    $my_desc =~ s/^([^\s])/ $1/mg;
	    $my_desc =~ s/\n.*$//s;
	    $desc = $my_desc;
	}
	# Replace linefeeds (not followed by a space) in $desc with spaces
	$desc =~ s/\n(?=\S)/ /gs;

	unless ($longdesc) {
		$longdesc = $parser->get('DESCRIPTION')
			|| $parser->get('DETAILS')
			|| $desc
			|| ''; # Just to avoid warnings...
		$longdesc =~ s/^\s+//s;
		$longdesc =~ s/\s+$//s;
		$longdesc =~ s/^\t/ /mg;
		$longdesc =~ s/^\s*$/ ./mg;
		$longdesc =~ s/^\s*/ /mg;
		$longdesc =~ s/^([^\s])/ $1/mg;
		$longdesc =~ s/\r//g;
	}

	$copyright = $copyright || $parser->get('COPYRIGHT');
	if (!$author) {
	    if (ref $meta->{author}) {
		# Does the author information appear in META.yml?
		$author = join(', ', @{$meta->{author}});
	    } else {
		# Get it from the POD
		$author = $parser->get('AUTHOR') || $parser->get('AUTHORS');
	    }
	}

	$parser->cleanup;
}

sub extract_changelog {
	my ($dir) = shift;
	$dir .= '/' unless $dir =~ m(/$);
	find(sub {
		$changelog = substr($File::Find::name, length($dir))
			if (!defined($changelog) && /^change(s|log)$/i && (! $excludeRE || ! $File::Find::name =~ /$excludeRE/));
	}, $dir);
}

sub extract_docs {
	my ($dir) = shift;
	$dir .= '/' unless $dir =~ m(/$);
	find(sub {
		push (@docs, substr($File::Find::name, length($dir)))
			if (/^(README|TODO|BUGS|NEWS|ANNOUNCE)/i && (! $excludeRE || ! $File::Find::name =~ /$excludeRE/)) ;
	}, $dir);
}

sub extract_depends {
	my ($dir, $meta, %dep_hash, $error, @uses, @deps, @not_debs);
	$dir = shift;
	$meta = shift;
	local @INC = ($dir, @INC);

	$dir .= '/' unless $dir =~ m/\/$/;

	### Mental note to self: It'd be worth it to fall back to 
	### Module:::Depends and _only_ then fail
	eval {
	    no warnings;
	    local *STDERR;
	    open(STDERR, ">/dev/null");
	    my $mod_dep = Module::Depends::Intrusive->new();
	
	    $mod_dep->dist_dir( $dir );
	    $mod_dep->find_modules();

	    %dep_hash = %{$mod_dep->requires};

	    $error = $mod_dep->error();
	    die "Error: $error\n" if $error;
	};
	if ($@ or $error) {
	    warn '='x70,"\n";
	    warn "Could not find the dependencies for the requested module\n";

	    warn "Module::Depends::Intrusive reports: $error\n" if $error;
	    warn "Generated error: $@" if $@;

	    warn "Please check if your module depends on Module::Install\n" .
		"for its build process - Automatically finding its\n" .
		"dependencies is unsupported, please specify them manually\n" .
		"using the 'depends' option. \n";
	    warn '='x70,"\n";

	    exit 1;
	}
	
	foreach my $module (keys( %dep_hash )) {
		next if (grep ( /^$module$/, @pragmas, @stdmodules));
		
		push @uses, $module;
	}

	if (`which apt-file`) {
		foreach my $module (@uses) {
		        my (@search, $ls, $ver, $re, $mod);
			$mod = $module;
			print "Searching for $module package using apt-file.\n";
			$module =~ s|::|/|g;

			@search = `apt-file search $module.pm`;

			# Regex's to search the return of apt-file to find the right pkg
			$ls  = '(?:lib|share)';
			$ver = '\d+(\.\d+)+';
			$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 } @deps, "perl", "perl-base", "perl-modules") {
				    if (exists $dep_hash{$mod}) {
					push @deps, {name=>$p, 
						     version=>$dep_hash{$mod}};
				    } else {
					push @deps, {name => $p};
				    }
				    last;
				}
			}
			
			unless (@search) {
			    $module =~ s|/|::|g;
				push @not_debs, $module;
		    }
		}
	} elsif ( $requiredeps ) {
		die "--requiredeps was specified, but apt-file was not found\n";
	}
	
	print "\n";
	print "Needs the following debian packages: " .
	    join (", ", map {$_->{name}} @deps) . "\n" if (@deps);
	if (@not_debs) {
		my $missing_debs_str = "Needs the following modules for which there are no debian packages available: "
			. join (", ", @not_debs) . "\n";
		if ( $requiredeps ) {
			die $missing_debs_str;
		} else {
			print $missing_debs_str;
		}
	}

	return join (", ", map { $_->{version} ?
				     $_->{name} ." (>= ". $_->{version} .")" :
				     $_->{name} } @deps);
}

sub check_for_xs {
	(! $excludeRE || ! $File::Find::name =~ /$excludeRE/) && /\.(xs|c|cpp|cxx)$/i && do {
		$arch = 'any';
	};
}

sub fix_rules  {
        my ($rules_file, $changelog_file, @docs, $test_line, @content);
        ($rules_file, $changelog_file, @docs) = @_;

	$test_line = ($module_build eq 'Module-Build') ? 
	    '$(PERL) Build test' : '$(MAKE) test';
	$test_line = "#$test_line" if $notest;

	open (FH, "+<$rules_file") || die "Can't open $rules_file: $!";
	@content = <FH>;
	seek(FH, 0, 0) || die "Can't rewind $rules_file: $!";
	truncate(FH, 0)|| die "Can't truncate $rules_file: $!";
	for (@content) {
		s/#CHANGES#/$changelog_file/g;
		s/#DOCS#/join " ", @docs/eg;
		s/#TEST#/$test_line/g;
		print FH $_;
	}
	close FH;
}

sub create_control {
	my ($file) = shift;

	if ($arch ne 'all' and 
	    !defined($user_bdepends) and !defined($user_bdependsi)) {
	    $bdepends .= ", $bdependsi";
	    $bdependsi = '';
	}

	open(C, ">$file") || die "Cannot open $file: $!\n";
	print C "Source: $srcname\n";
	print C "Section: $section\n";
	print C "Priority: $priority\n";
	print C "Build-Depends: $bdepends\n" if $bdepends;
	print C "Build-Depends-Indep: $bdependsi\n" if $bdependsi;
	print C $extrasfields if defined $extrasfields;
	print C "Maintainer: $maintainer\n";
	print C "Standards-Version: $debstdversion\n";
	print C "\n";
	print C "Package: $pkgname\n";
	print C "Architecture: $arch\n";
	print C "Depends: $depends\n" if $depends;
	print C $extrapfields if defined $extrapfields;
	print C "Description: $desc\n$longdesc\n .\n This description was automagically extracted from the module by dh-make-perl.\n";
	close(C);
}

sub create_changelog {
	my ($file) = shift;
	open(C, ">$file") || die "Cannot open $file: $!\n";
	print C "$srcname ($pkgversion) unstable; urgency=low\n";
	print C "\n  * Initial Release.\n\n";
	print C " -- $maintainer  $date\n\n";
	#print C "Local variables:\nmode: debian-changelog\nEnd:\n";
	close(C);
}

sub create_rules {
        my ($file, $rulesname);
	($file) = shift;
	$rulesname = $arch eq 'all'?"rules.$module_build.noxs":"rules.$module_build.xs";
	my $error;
	
	for my $source (("$homedir/$rulesname", "$datadir/$rulesname")) {
		copy($source, $file) && do {
			print "Using rules: $source\n";
			last;
		};
		$error = $!;
	}
	die "Cannot copy rules file ($rulesname): $error\n" unless -e $file;
	chmod(0755, $file);
}

sub create_compat {
	my $file = shift;
	open(COMPAT, ">$file") or die "Can't open $file: $!\n";
	print COMPAT "$dh_compat\n";
	close COMPAT;
}

sub create_copyright {
	my ($file) = shift;
	open(C, ">$file") || die "Cannot open $file: $!\n";
	print C <<"EOF";
This is the debian package for the $perlname module.
It was created by $maintainer using dh-make-perl.

This copyright info was automatically extracted from the perl module.
It may not be accurate, so you better check the module sources
if don\'t want to get into legal troubles.

EOF
	if (defined $author) {
		print C "The upstream author is: $author.\n";
	}
	if (defined($copyright)) {
		print C $copyright;
		# Fun with regexes
		if ( $copyright =~ /terms as Perl itself/i ) {
		    print C "\n\n", <<END;
Perl is distributed under your choice of the GNU General Public License or
the Artistic License.  On Debian GNU/Linux systems, the complete text of the
GNU General Public License can be found in \`/usr/share/common-licenses/GPL\'
and the Artistic Licence in \`/usr/share/common-licenses/Artistic\'.
END
		} elsif ( $copyright =~ /GPL/ ) {
		    print C "\n\n", <<END;
The full text of the GPL is available on Debian systems in
/usr/share/common-licenses/GPL
END
		}
	}
	close(C);
}

sub create_readme {
	my ($file) = shift;
	open(C, ">$file") || die "Cannot open $file: $!\n";
	print C "This is the debian package for the $perlname module.\n";
	print C "It was created by $maintainer using dh-make-perl.\n";
	close(C);
}

sub create_watch {
	my ($file, $perl_path_name) = @_;
	open(C, ">$file") || die "Cannot open $file: $!\n";
	
	$perl_path_name =~ s|::|-|g;
	$perl_path_name =~ s|(\w+)(-.*)|$1/$1$2|;
	$perl_path_name .= "-(.*)\.(tar\.gz|tar|tgz)";

	print C "\# format version number, currently 2; this line is compulsory!\n";
	print C "version=2\n";
	print C "http://www.cpan.org/modules/by-module/$perl_path_name\n";
	close(C);
}

sub get_maintainer {
        my ($user, $pwnam, $email, $name, $mailh);
	$user = $ENV{LOGNAME} || $ENV{USER};
	$pwnam = getpwuid($<);
	die "Cannot determine current user\n" unless $pwnam;
	if (defined $ENV{DEBFULLNAME}) {
		$name = $ENV{DEBFULLNAME};
	} else {
		$name = $pwnam->gecos;
		$name =~ s/,.*//;
	}
	$user ||= $pwnam->name;
	$name ||= $user;
	$email = $ENV{DEBEMAIL} || $ENV{EMAIL};
	unless ($email) {
		chomp($mailh = `cat /etc/mailname`);
		$email = $user.'@'.$mailh;
	}

	$email =~ s/^(.*)\s+<(.*)>$/$2/;
	
	return "$name <$email>";
}

sub load_overrides {
    eval {
	do "$datadir/overrides" if -f "$datadir/overrides";
	do "$homedir/overrides" if -f "$homedir/overrides";
    };
    if ($@) {
	die "Error when processing the overrides files: $@";
    }
}

sub apply_overrides {
	my ($data, $val, $subkey);

	($data, $subkey) = get_override_data();
	return unless defined $data;
	$pkgname = $val if (defined($val=get_override_val($data, $subkey, 'pkgname')));
	$srcname = $val if (defined($val=get_override_val($data, $subkey, 'srcname')));
	$section = $val if (defined($val=get_override_val($data, $subkey, 'section')));
	$priority = $val if (defined($val=get_override_val($data, $subkey, 'priority')));
	$depends = $val if (defined($val=get_override_val($data, $subkey, 'depends')));
	$bdepends = $val if (defined($val=get_override_val($data, $subkey, 'bdepends')));
	$bdependsi = $val if (defined($val=get_override_val($data, $subkey, 'bdependsi')));	
	$desc = $val if (defined($val=get_override_val($data, $subkey, 'desc')));
	$longdesc = $val if (defined($val=get_override_val($data, $subkey, 'longdesc')));
	$pkgversion = $val if (defined($val=get_override_val($data, $subkey, 'version')));
	$arch = $val if (defined($val=get_override_val($data, $subkey, 'arch')));
	$changelog = $val if (defined($val=get_override_val($data, $subkey, 'changelog')));
	@docs = split(/\s+/, $val) if (defined($val=get_override_val($data, $subkey, 'docs')));

	$extrasfields = $val if (defined($val=get_override_val($data, $subkey, 'sfields')));
	$extrapfields = $val if (defined($val=get_override_val($data, $subkey, 'pfields')));
	$maintainer = $val if (defined($val=get_override_val($data, $subkey, 'maintainer')));
	# fix longdesc if needed
	$longdesc =~ s/^\s*/ /mg;
}

sub apply_final_overrides {
	my ($data, $val, $subkey);

	($data, $subkey) = get_override_data();
	return unless defined $data;
	get_override_val($data, $subkey, 'finish');
}

sub get_override_data {
	my ($data, $checkver, $subkey);
	$data = $overrides{$perlname};

	return unless defined $data;
	die "Value of '$perlname' in overrides not a hashref\n" unless ref($data) eq 'HASH';
	if (defined($checkver = $data->{checkver})) {
		die "checkver not a function\n" unless (ref($checkver) eq 'CODE');
		$subkey = &$checkver($maindir);
	} else {
		$subkey = $pkgversion;
	}
	return ($data, $subkey);
}

sub get_override_val {
        my ($data, $subkey, $key, $val);
	($data, $subkey, $key) = @_;
	$val = defined($data->{$subkey.$key})?$data->{$subkey.$key}:$data->{$key};
	return &$val() if (defined($val) && ref($val) eq 'CODE');
	return $val;
}

=head1 NAME

B<dh-make-perl> - Create debian source packages from perl modules

=head1 SYNOPSIS

B<dh-make-perl> [B<SOURCE_DIR> | B<--cpan> I<MODULE>]

You can modify B<dh-make-perl>'s behaviour with some switches:

=over

=item B<--desc> I<SHORT DESCRIPTION>

Uses the argument to --desc as short description for the package.

=item B<--arch> I<any> | I<all>

This switches between arch-dependent and arch-independet packages. If B<--arch>
isn't used, B<dh-make-perl> uses a relatively good-working algorithms to
decide this alone.

=item B<--version> I<VERSION>

Specifies the version of the resulting package.

=item B<--depends> I<DEPENDS>

Manually specify the string to be used for the module's dependencies. This 
should be used when building modules where dh-make-perl cannot guess the Perl
dependencies (such as modules built using L<Module::Install>), or when the
Perl code depends on non-Perl binaries or libraries. Usually, dh-make-perl
will figure out the dependencies by itself.

=item B<--bdepends> I<BUILD-DEPENDS>

Manually specify the string to be used for the module's build-dependencies
(that is, the packages and their versions that have to be installed in order
to successfully build the package). Keep in mind that packages generated by
dh-make-perl require debhelper (>= 5.0.0) to be specified as a build 
dependency. Same note as for --depends applies here - Use only when needed.

=item B<--bdependsi> I<BUILD-DEPENDS-INDEP>

Manually specify the string to be used for the module's build-dependencies
for architecture-independent builds. Same notes as those for the --depends 
and --bdepends options apply here.

Note that for --depends, --bdepends and --bdependsi you can also specify that
the field should not appear in debian/rules (if you really mean it, of course
;-) ) by giving it an empty string as an argument.

=item B<--cpan-mirror> I<MIRROR>

Specifies a CPAN site to use as mirror.

=item B<--exclude> | B<-i> [I<REGEX>]

This allows you to specify a PCRE to exclude some files from the search for
docs and stuff like that. If no argument is given (but the switch is specified
- not specifying the switch will include everything), it defaults to exclude
CVS and .svn directories.

=item B<--build>

Builds the package after setting it up

=item B<--install>

Installs the freshly built package. Specifying --install implies --build - The
package will not be installed unless it was built (obviously ;-) )

=item B<--notest>

Does not run the automatic testing of the module as part of the build script.
This is mostly useful when packaging buggy or incomplete software.

=item B<--requiredeps>

Fail if a dependency perl package was not found (dependency tracking
requires the apt-file package installed and updated)

=back

=head1 DESCRIPTION

B<dh-make-perl> will create the files required to build
a debian source package out of a perl package.
This works for most simple packages and is also useful
for getting started with packaging perl modules.

You can specify a module name with the B<--cpan> switch
and B<dh-make-perl> will download the module for you from
a CPAN mirror, or you can specify the directory with the
already unpacked sources. If neither --cpan nor a directory
is given as argument, dh-make-perl tries to create a
perl package from the data in F<.>

There is an override mechanism in place to handle most of
the little changes that may be needed for some modules
(this hasn't been tested much, though, and the override
database needs to be filled in).

You can build and install the debian package using the --build
and --install command line switches.

Using this program is no excuse for not reading the
debian developer documentation, including the Debian policy,
the perl policy, the packaging manual and so on.

=head1 FILES

The following directories will be searched to find additional files
required by dh-make-perl:

	/usr/share/dh-make-perl/
	$HOME/.dh-make-perl/

=over 4

=item * overrides

File that overrides information retreived (or guessed) about the package.
All the files in the library directories are loaded: entries in the home
take precedence. See the distributed overrides file for usage information.

=item * rules.MakeMaker.noxs

A debian/rules makefile for modules that use ExtUtils::MakeMaker, but don't
have C/XS code.

=item * rules.MakeMaker.xs

A debian/rules makefile for modules that use ExtUtils::MakerMaker and
C/XS code.

=item * rules.Module-Build.noxs

A debian/rules makefile for modules that use Module::Build, but don't have 
C/XS code.

=item * rules.Module-Build.xs

A debian/rules makefile for modules that use Module::Build and C/XS code.

=back

=head1 ENVIRONMENT

HOME - get user's home directory

DEBFULLNAME - get the real name of the maintainer

LOGNAME or USER - get the username

DEBEMAIL or EMAIL - get the email address of the user

=head1 BUGS

Several, let me know when you find them.

=head1 AUTHOR

Paolo Molaro E<lt>lupus@debian.orgE<gt> (MIA)

Maintained for a time by Ivan Kohler E<lt>ivan-debian@420.amE<gt>.

Maintained for a time by Marc Brockschmdit E<lt>marc@dch-faq.deE<gt>.

Now maintained by Gunnar Wolf E<lt>gwolf@gwolf.orgE<gt>.

Patches from:

  Adam Sjoegren E<lt>asjo@koldfront.dkE<gt>
  Adrian Phillips E<lt>adrianp@powertech.noE<gt>
  Amos Shapira E<lt>amos.shapira@gmail.comE<gt>
  Christian Kurz E<lt>shorty@debian.orgE<gt>
  Damyan Ivanov E<lt>divanov@creditreform.bgE<gt>
  David Pashley E<lt>david@davidpashley.comE<gt>
  Edward Betts E<lt>edward@debian.orgE<gt>
  Fermin Galan E<lt>galan@dit.upm.esE<gt>
  Geoff Richards E<lt>qef@ungwe.orgE<gt>
  Gergely Nagy E<lt>algernon@bonehunter.rulez.orgE<gt>
  Hilko Bengen E<lt>bengen@debian.orgE<gt>
  Jesper Krogh E<lt>jesper@krogh.ccE<gt>
  Johnny Morano E<lt>jmorano@moretrix.comE<gt>
  Juerd E<lt>juerd@ouranos.juerd.netE<gt>
  Matt Hope E<lt>dopey@debian.orgE<gt>
  Noel Maddy E<lt>noel@zhtwn.comE<gt>
  Peter Moerch E<lt>mn3k66i02@sneakemail.comE<gt>
  Stephen Oberholtzer E<lt>oliverklozoff@gmail.comE<gt>
  Ton Nijkes E<lt>tonn@wau.mis.ah.nlE<gt>

  ...And others who, sadly, we have forgot to add :-/

=cut

