[Date Prev][Date Next] [Thread Prev][Thread Next] [Date Index] [Thread Index]

[mathew.robertson@netratings.com.au: dh-make-perl]



----- Forwarded message from Mathew Robertson <mathew.robertson@netratings.com.au> -----

From: Mathew Robertson <mathew.robertson@netratings.com.au>
To: gwolf@gwolf.org
Date: Wed, 05 Mar 2008 16:47:06 +1100
Subject: dh-make-perl
X-Spam-Level: 
X-Spam-Status: No, score=-2.6 required=5.0 tests=BAYES_00,HTML_MESSAGE 
	autolearn=ham version=3.1.7-deb

Hi Gunner,

I have recently have the privilege (displeasure?) of needing to install many CPAN modules into a 'stable/etch' Debian system; and so began the tale of using dh-make-perl

I found that dh-make-perl wouldn't simply resolve all of my dependencies, without requiring lots of manual intervention of checking if the various Debian packages or CPAN modules 
existed, was already installed and/or had a sufficient version... So I made it do it for me... and so is attached for your perusal.

regards,
Mathew Robertson

#!/usr/bin/perl
use strict;
use warnings;
use Pod::Parser;
use YAML;
use IO::File;
use File::Basename;
use File::Find;
use File::Copy qw(copy move);
use Cwd qw(getcwd abs_path chdir);
use Scalar::Util qw(dualvar);
use User::pwent;
use Getopt::Long;
use CPAN;
use Module::Depends;
use Module::Depends::Intrusive;
$| = 1;

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

######################################################################
# This Pod::Parser must be declared before the main program flow. If you
# are trying to figure out what happens inside dh-make-perl, skip down
# until 'package main'.
package MyPod;

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

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;
}

######################################################################
# Main dh-make-perl starts here, don't look any further!
package main;
my (@stdmodules, $perl_pkg, $debstdversion, $priority, $section, $depends,
    $bdepends, $bdependsi, $maintainer, $arch, $closes, $date, $debiandir,
    $startdir, $dh_compat, $datadir, $homedir, $builddir, $email,
    $requiredeps, $recursive, $build, $install, $cleanup, $coreok);
our %overrides;

my %recursed;

$perl_pkg = get_perl_pkg_details();

$debstdversion = '3.7.3';
$priority = 'optional';
$section = 'perl';
$depends = '${perl:Depends}';
$bdependsi = "perl (>= $perl_pkg->{Version})";
$bdepends = 'debhelper (>= 5.0.0)';
$arch = 'all';
$date = `date -R`;
$startdir = getcwd();
$dh_compat = 5;
$datadir = '/usr/share/dh-make-perl';
$homedir = "$ENV{HOME}/.dh-make-perl";
$builddir = "$homedir/build";

`mkdir -p $builddir`;

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, $upsurl);
my ($extrasfields, $extrapfields);
my (@docs, $changelog, @args);

my %opts;

my $mod_cpan_version;

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

GetOptions(\%opts,
    'arch=s', 'basepkgs=s', 'bdepends=s', 'bdependsi=s',
    'build!', 'core-ok!', 'cpan=s', 'cpanplus=s', 'closes=i',
    'cpan-mirror=s', 'dbflags=s', 'depends=s', 'desc=s',
    'exclude|i:s{,}', 'help', 'install!', 'nometa', 'notest',
    'pkg-perl!', 'requiredeps!', 'version=s', 'e=s', 'email=s',
    'p=s', 'packagename=s', 'recursive!', 'build-dir=s',
    'cleanup!', 'yes'
) or die usage_instructions();

@stdmodules = get_stdmodules();

# Help requested? Nice, we can just die! Isn't it helpful?
die usage_instructions() if $opts{help};
die "CPANPLUS support disabled, sorry" if $opts{cpanplus};

$requiredeps = $opts{requiredeps};
$requiredeps = 2 if $opts{recursive};
$recursive = $opts{recursive};
$install = $opts{install};
$build = $opts{build};
$coreok = $opts{"core-ok"};
$opts{yes} ||= "";
die "No such build directory: ".$opts{"build-dir"} if ($opts{"build-dir"} && ! -d $opts{"build-dir"});
$builddir = $opts{"build-dir"} if ($opts{"build-dir"});
$cleanup = $opts{cleanup};
$cleanup = y_or_n("Should I cleanup after myself when done (eg: remove the Debian-specific files, CPAN modules, etc)?") unless (defined $cleanup);

$opts{exclude} = '(?:\/|^)(?:CVS|.svn)\/' if (defined $opts{exclude} && $opts{exclude} eq '');

load_overrides();
my $tarball = setup_dir();
$meta = process_meta("$maindir/META.yml") if (-f "$maindir/META.yml");
findbin_fix();

if (defined $opts{e}) {
    $email = $opts{e};
} elsif (defined $opts{email}) {
    $email = $opts{email};
} else {
    $email = '';
}
$maintainer = get_maintainer($email);

if (defined $opts{desc}) {
    $desc = $opts{desc};
}
($pkgname, $version) = extract_basic();
if (defined $opts{p}) {
    $pkgname = $opts{p};
} elsif (defined $opts{packagename}) {
    $pkgname = $opts{packagename};
}
unless (defined $opts{version}) {
    $pkgversion = $version . "-1";
} else {
    $pkgversion = $opts{version};
}
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 $opts{bdepends}) {
    $bdepends = $opts{bdepends};
} else {
    $bdepends .= ', libmodule-build-perl' if ($module_build eq "Module-Build");
}
$bdependsi = $opts{bdependsi} if defined $opts{bdependsi};

if (defined $opts{depends}) {
    $depends = $opts{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);
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");
if (defined $opts{closes}) {
    $closes = $opts{closes};
} else {
    $closes = get_itp($pkgname);
}
create_changelog("$debiandir/changelog", $closes);
create_rules("$debiandir/rules");
create_compat("$debiandir/compat");
create_watch("$debiandir/watch", $opts{cpan}) if ($opts{cpan});
#create_readme("$debiandir/README.Debian");
create_copyright("$debiandir/copyright");
fix_rules("$debiandir/rules", (defined $changelog ? $changelog : ''), @docs);
apply_final_overrides();

if (not defined $install) {
    $install = y_or_n("Should I install this module?");
} elsif ($install == 2) {
    $install = y_or_n("You have elected to install the dependencies - should I also install this module?");
}
$build = 1 if $install;
$build = y_or_n("Should I build this module?") unless (defined $build);
my $debname = build_package($maindir) if ($install or $build);
install_package($debname) if $install;
if ($cleanup) {
    if ($opts{cpan}) {
        remove_module();
    } else {
        clean_package();
    }
    print "Leaving packaged xxx.deb files in the build directory ($builddir).$/";
}

print "Done\n";
exit(0);

sub usage_instructions {
    my $name = basename($0);
    return <<"USAGE"
Usage:
$name [ --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 ] [ --core-ok ] [ --basepkgs PKGSLIST ]
               [ --closes ITPBUG ] [ --packagename|-p PACKAGENAME ]
               [ --email|-e EMAIL ] [ --pkg-perl ] [ --recursive ]
               [ --build-dir DIR ] [ --cleanup ] [ --yes ]
USAGE
}

sub get_stdmodules {
    my ($base_packages, @modules, $paths);
    $base_packages = $opts{basepkgs} || 'perl,perl-base,perl-modules';

    # We will check on all the base Perl packages for the modules they provide.
    # To know which files we care for, we look at @INC - In a format easy to
    # integrate into a regex
    $paths = join('|', @INC);

    for my $pkg (split(/,/,$base_packages)) {
        for my $file (map {chomp;$_} `dpkg -L $pkg`) {
            next unless $file =~ s!^(?:$paths)[\d\.]*/(.*).pm$!$1!x;
            $file =~ s!/!::!g;
            push @modules, $file;
        }
    }

    return sort @modules;
}

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 ($opts{cpan}) {
        my ($new_maindir);

        # Is the module a core module?
        if (grep(/$opts{cpan}/, @stdmodules)) {
            $coreok = y_or_n("$opts{cpan} is a standard module, do you want me to continue processing it?",2,0) unless (defined $coreok);
            die "$opts{cpan} is a standard module.$/" unless $coreok;
        }

        # Make CPAN happy, make the user happy: Be more tolerant!
        # Accept names to be specified with double-colon, dash or slash
        $opts{cpan} =~ s![/-]!::!g;

###        require CPAN;
        CPAN::Config->load;

        unshift(@{$CPAN::Config->{'urllist'}}, $opts{'cpan-mirror'})
            if $opts{'cpan-mirror'};

        $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";

        # This modification allows to retrieve all the modules that
        # match the user-provided string.
        #
        # expand() returns a list of matching items when called in list
        # context, so after retrieving it, I try to match exactly what
        # the user asked for. Specially important when there are
        # different modules which only differ in case.
        #
        # This Closes: #451838
        #
        # FIXME: we need to work in the requirement for specifying a min
        #        module version.
        #
        my @mod = CPAN::Shell->expand('Module', '/^'.$opts{cpan}.'$/')
            or die "Can't find '$opts{cpan}' module on CPAN\n";
        foreach(@mod) {
            my $file = $_->cpan_file();
            $file =~ s#.*/##; # remove directory
            $file =~ s/(.*)-.*/$1/; # remove version and extension
            $file =~ s/-/::/g; # convert dashes to colons
            if($file eq $opts{cpan}) {
                $mod = $_;
                last;
            }
        }
        $mod = shift @mod unless($mod);
        $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, $builddir);
        $tarball = $builddir . "/" . basename($tarball);
        $new_maindir = $builddir."/".basename($maindir);
        `rm -rf "$new_maindir"` if (-d "$new_maindir"); # This is needed just in case you run it twice for the same package.
        `mv "$maindir" "$new_maindir"`;
        $maindir = $new_maindir;

    } elsif ($opts{cpanplus}) {
        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 => [ $opts{cpanplus} ], fetchdir => $builddir);
#        die "Cannot get $opts{cpanplus}\n" if keys(%$href) != 1;
#        $file = (values %$href)[0];
#        print $file, "\n\n";
#        $maindir = $cb->extract( files => [ $file ], extractdir => $builddir )->{$file};
    } else {
        $maindir = shift(@ARGV) || '.';
        $maindir =~ s/\/$//;
    }
    return $tarball;
}

sub make_debname {
    my $archspec;
    if ($arch eq 'any') {
        $archspec = `dpkg --print-architecture`;
        chomp($archspec);
    } else {
        $archspec = $arch;
    }
    return "${pkgname}_$version-1_$archspec.deb";
}

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 $opts{dbflags}") == 0
    system("fakeroot make -C $maindir -f debian/rules clean") == 0
        || die "Could not prepare the deb package.$/";
    system("fakeroot make -C $maindir -f debian/rules binary") == 0
        || die "Cannot create deb package.$/";

    my $debname = make_debname();
    move("$maindir/../$debname","$builddir/$debname");
    return $debname;
}

sub install_package {
    my $debname = shift;
    system("dpkg -i $builddir/$debname") == 0
        || die "Cannot install package $builddir/$debname\n";
}

sub clean_package {
    my $cwd = getcwd();
    chdir($maindir);
    `rm -rf debian build-stamp install-stamp`;
    `make distclean`;
    chdir($cwd);
}

sub remove_module {
    my $cwd = getcwd();
    chdir($builddir);
    my $dir = $perlname;
    $dir =~ s/::/-/g;
    $dir .= "-".$version;
print "FIXME: removing $builddir/$dir  $/";
    `rm "$dir"` if (-d "$dir");
    chdir($cwd);
}

sub remove_debs {
}

sub process_meta {
    my ($file, $yaml);
    $file = shift;
    # Command line option nometa causes this function not to be run
    return {} if $opts{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 ($@) {
        warn "Error parsing $file - Ignoring it.$/".
             "Please notify module upstream maintainer.$/";
        $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 $opts{cpan} !~ /::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";

    $upsurl = "http://search.cpan.org/dist/$perlname/";;

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

    $opts{exclude} = '^$' unless $opts{exclude};
    find(sub {
        $File::Find::name !~ /$opts{exclude}/ &&
            /\.(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;

    eval {
        local $/ = undef;
        my $fh = _file_r($makefile);
        $file = $fh->getline;
    }; if ($@) {
       die unless (ref($@) eq '' && $@ =~ /No such file or directory/);
       my $dir = $makefile;
       $makefile =~ s/.*\///;
       $dir =~ s/$makefile$//;
       $maindir = abs_path($maindir);
       $dir = "the current directory" if ($maindir eq $startdir);
       die "It appears that $dir does not contain a $makefile - try using the help." if (-f $dir);
       die "Unknown directory $dir";
    }

    # Replace q[quotes] by "quotes"
    $file =~ s/q\[(.+)]/'$1'/g;

    # Get the name
    if ($file =~ /([\'\"]?)
                  DISTNAME\1\s*
                  (=>|,)
                  \s*
                  ([\'\"]?)
                  (\S+)\3/xs) {
        # Regular MakeMaker
        $name = $4;
    } elsif ($file =~ /([\'\"]?)
                       NAME\1\s*
                       (=>|,)
                       \s*
                       ([\'\"]?)
                       (\S+)\3/xs) {
        # Regular MakeMaker
        $name = $4;
    } elsif ($file =~ /name
                       \s*
                       \(
                         ([\'\"]?)
                         (\S+)
                         \1
                       \);/xs) {
        # 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: $opts{cpan})\n";
    $name = $opts{cpan} if ($name eq '__PACKAGE__' && $opts{cpan});
    $name = $opts{cpanplus} if ($name eq '__PACKAGE__' && $opts{cpanplus});

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

    } 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;
    }

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

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

    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 -r "$dir/$vfrom") {
            my $fh = _file_r("$dir/$vfrom");
            while (my $lin = $fh->getline) {
                if ($lin =~ /([\$*])(([\w\:\']*)\bVERSION)\b.*\=/) {
                    no strict;
                    #warn "ver: $lin";
                    $ver = (eval $lin)[0];
                    last;
                }
            }
            $fh->close;
        } 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;
    }
    $desc = '' unless (defined $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 && (! $opts{exclude} || ! $File::Find::name =~ /$opts{exclude}/));
    }, $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 && (! $opts{exclude} || ! $File::Find::name =~ /$opts{exclude}/)) ;
    }, $dir);
}

sub run_depends {
    my ($depends_module, $dir) = @_;

    no warnings;
    local *STDERR;
    open(STDERR, ">/dev/null");
    my $mod_dep = $depends_module->new();

    $mod_dep->dist_dir( $dir );
    $mod_dep->find_modules();

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

    my $error = $mod_dep->error();
    die "Error: $error\n" if $error;
    return %dep_hash;
}

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

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

    my $again = 0;
    AGAIN: if ($again >= 2) {
        print "hmm... tried twice to configure dependencies for this module, but could not.$/";
        y_or_n("Should I continue processing this module?") or exit(2);
        return join (", ", map { $_->{version} ?
                                     $_->{name} ." (>= ". $_->{version} .")" :
                                     $_->{name} } @deps);
    }
    @deps = ();
    @not_debs = ();
    @uses = ();

    # try Module::Depends::Intrusive, but if that fails then
    # fall back to Module::Depends.
    eval {
        %dep_hash = run_depends('Module::Depends::Intrusive',$dir);
    };
    $@ && eval {
        %dep_hash = run_depends('Module::Depends',$dir);
    };
    if ($@) {
        warn '='x70,"\n";
        warn "Could not find the dependencies for the requested module.\n";
        warn "Generated error: $@";
        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 "Alternatively, including a META.yml file with dependencies\n" .
             "should allow discovery even for Module::Install modules. \n";
        warn '='x70,"\n";
        exit(1);
    }

    # Due to Debian's brain-dead idea of "standard modules" being encapsulated into
    # one of only three packages, we need to handle them as a special case.
    foreach my $module (sort keys( %dep_hash )) {
        if (grep ( /^$module$/, @stdmodules)) {
            next if (defined $coreok && $coreok == 0);
            if (!defined $coreok || $coreok == 2) {
                $coreok = y_or_n("$perlname depends on $module (which is part of the Debian/Perl standard modules).$/Should I resolve dependencies on these modules?");
                next unless $coreok;
            }
            my $module_version;
            eval {
                no warnings;
                no strict;
                eval "require $module";
                $module_version = $module::VERSION;
                $module_version = 0 unless (defined $module_version);
            };
            die "The $perlname Perl module requires $module, but it isn't installed.  Since it is packaged$/".
                "as part of Debian's standard modules, you need to try upgrading your standard Perl install.$/"
                    unless (defined $module_version);

            # since the module loaded, we dont have to do anything else if it satisifes the min-version,
            # otherwise we treat like requiring any other module dependency.
            my $min_version = 0;
            $min_version = $dep_hash{$module} if (exists $dep_hash{$module});
            next if ($min_version && $min_version < $module_version);
        }
        push @uses, $module;
    }
    return "" if (@uses == 0);

    my $apt_file = `which apt-file`;
    if ($apt_file && (not defined($requiredeps) || $requiredeps)) {
        MODULE: foreach my $module (@uses) {
            if ($module eq 'perl') {
                substitute_perl_dependency($dep_hash{perl});
                next;
            }

            my $mod = $module;
            $mod =~ s|::|/|g;
            my $package = lc($module);
            $package =~ s/::/-/g;
            $package = "lib".$package."-perl";
            my $dep;
            my $min_version = 0;
            $min_version = $dep_hash{$module} if (exists $dep_hash{$module});

            #
            # The dependency checking implemented in this sub, will re-evaluate whether this modules'
            # dependencies are being satisfied, using a two-pass approach (ie: pass 1 -> check &
            # install, pass 2 -> re-check).  However, when run in non-build/install mode (eg: when
            # run by a Debian-package maintainer, it causes the re-evaluation of the dependencies
            # that were just built in the sandbox but not installed into the system -> thus causing
            # this script to try to build them again.
            #
            # The following block of code solves this problem for the deb maintainer. However, when
            # this script is run by a general sysadmin, the evaluation of dependencies doesn't work
            # right....**
            #
            # In the meantime since I figure that the package maintainers have enough brains to force
            # the package to build... thus I have disabled the check so that sysadmins get the better
            # final result of always trying to resolve the needed dependencies.
            #
            # ** This is a side effect of both Debian and CPAN using deficient dependency tracking
            # mechanisms (or at least I think they are deficient...), in that they both wont do
            # forward-versioned and reverse-versioned dependency checks and that they both wont
            # install multiple versions of the same package/module side-by-side.  Of course if they
            # _did_ support this, this program would be inherently broken for the the same reasons...!
            #
            # if (exists $recursed{$module}) {
            #     push @deps, {name => $package, version => $recursed{$module} };
            #     next;
            # }
            #

            print "Dependency on $module module (".($min_version ? "of at least: $min_version" : "any version").")... ";

            # 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/(?:$ls/perl/$ver|$ls/perl5)/$mod\\.pm";

            my @search = `apt-file search $mod.pm`;
            for (@search) {
                # apt-file output
                # package-name: path/to/perl/module.pm
                chomp;
                my ($p, $f) = split(/:\s*/);

                #
                # If apt-file knows about the module, then someone has already packaged it.
                # If not, then we must get it from CPAN (unless we already have it installed
                # from a local package).
                #
                if ($f =~ /$re/) {
                    #
                    # Since we got here, we know that there is a deb package of the module.
                    #
                    $dep = { cpan => 0, installed => 0, name => $p, version => 0 };

                    #
                    # If the wanted perl module isn't a "Debian Standard module", then it
                    # is relatively straight forward -> we just check if the deb'ified package
                    # version is at least the min-required version.
                    #
                    if (! grep { $_ eq $p } split(/,/,@stdmodules)) {

                        #
                        # Have we already found a corresponding package? -> check version.
                        # If version is insufficient, then we just drop the dependency as it
                        # will be picked up in later tests.
                        #
                        $. = 0;
                        foreach (@deps) {
                            $. ++;
                            next unless ($_->{name} eq $p);
                            if ($min_version) {
                                if ($_->{version} < $min_version) {
                                    splice(@deps,$.,1);
                                    last;
                                }
                            }
                            print "using previously found package: $_->{name} ".($_->{version} ? $_->{version} : "(any version)").$/;
                            next MODULE;
                        }

                        if ($min_version) {
                            #
                            # check if/how deb matches the min required package
                            #
                            my $installed_version = get_installed_deb_version($p);
                            if ($installed_version) {
                                if ($installed_version < $min_version) {
                                    # is the latest version good enough?
                                    my $latest_version = get_latest_deb_version($p);
                                    if ($latest_version < $min_version) {
                                        $dep = undef;
                                    } else {
                                        $dep->{version} = $latest_version;
                                    }
                                } else {
                                    # min version already installed -> nothing to do
                                    $dep->{installed} = 1;
                                    $dep->{version} = $installed_version;
                                }
                            } else {  # not installed
                                my $current_version = get_uninstalled_deb_version($p);
                                if ($current_version < $min_version) {
                                    my $latest_version = get_latest_deb_version($p);
                                    if ($latest_version < $min_version) {
                                        # need the CPAN version as the latest isn't good enough
                                        $dep = undef;
                                    } else {
                                        # latest version is good enough, so use it
                                        $dep->{version} = $latest_version;
                                    }
                                } else {
                                    # current version is ok
                                    $dep->{version} = $current_version;
                                }
                            }
                        } else {
                            # we just install the default deb version, if it is not already installed
                            my $installed_version = get_installed_deb_version($p);
                            if ($installed_version) {
                                $dep->{version} = $installed_version;
                                $dep->{installed} = 1;
                            }
                        }
                    } else {
                        # Debian makes this painful by not using the modules' version number
                        # as the deb-version number. Instead we try to load the specific
                        # module and grab the version number; however, this wont always work
                        # correctly as large modules use file versioning which is different
                        # to the whole-module version.  Argh...
                        my $module_version;
                        eval {
                            no warnings;
                            no strict;
                            require $mod;
                            $module_version = $module::VERSION;
                            $module_version = 0 unless (defined $module_version);
                        };
                        if (defined $module_version) {
                            if ($min_version) {
                                if ($module_version < $min_version) {
                                    # try newer deb
                                    my $latest_version = get_latest_deb_version($p);
                                    if ($latest_version < $min_version) {
                                        $dep = undef;
                                    } else {
                                        $dep->{version} = $latest_version;
                                    }
                                } else {
                                    # nothing to do -> already good enough
                                    $dep->{version} = $module_version;
                                    $dep->{installed} = 1;
                                }
                            } else {
                                # since the module loaded, we dont have to do anything else
                                # to satisfy the dependency.
                                $dep->{version} = $module_version;
                                $dep->{installed} = 1;
                            }
                        } else {
                            # Couldn't load the module perhaps? In which case, one or more of
                            # the standard-modules is not installed... so we just die here.
                            die "The $perlname Perl module requires $module, but it is packaged as part of Debian's$/".
                                "standard packages. You need to try upgrading your standard Perl install.$/";
                        }
                    }
                    last;
                }
            }
            
            # if we got here and $dep isn't a hash, we need check to make sure there isn't
            # a locally made deb (ie: one not detected by apt-file) or a deb sitting in
            # ~/.dh-make-perl/build that is-already/could-be installed -> if so, then we
            # do the version test again.
            unless (defined $dep) {
                my $local_version = get_installed_deb_version($package);
                if ($local_version) {
                    if ($local_version < $min_version) {
                         my $latest_version = get_latest_deb_version($package);
                         if ($latest_version < $min_version) {
                             # need a CPAN version
                         } else {
                             $dep = {name => $package, version => $latest_version, cpan => 0, installed => 0};
                         }
                    } else {
                        $dep = {name => $package, version => $local_version, cpan => 0, installed => 1};
                    }
#                } else {
#                    my $debpath = $builddir ."/". $package ."_*";
                }
            }

            # if we got here and $dep isn't a hash, then we need the CPAN module,
            unless (defined $dep) {
                $dep = {name => $module, version => $min_version, cpan => 1, installed => 0};
            }

            #
            # Should we use the deb? or use the CPAN package...
            # $dep will say whether there is a deb'ified package and what version to install
            #
            if ($dep->{installed}) {
                print "installed package is sufficient ($dep->{name} : $dep->{version})$/";
            } elsif ($dep->{cpan}) {
                print "using latest CPAN module".($dep->{version} ? " (min required: $dep->{version})" : "").$/;
                push @not_debs, $dep;
            } else {
                print "using package: $dep->{name}".($dep->{version} ? " : ".$dep->{version} : " (any version)").$/;
                push @deps,$dep;
            }
        }
    } elsif ($requiredeps) {
        die "<--requiredeps> or <--recursive> was specified, but apt-file was not found.$/";
    } else {
        foreach (@uses) {
            push @not_debs, {name => $_, version => $dep_hash{$_}};
        }
    }

    if (@deps > 0) {
        print "$/$perlname needs the following Debian packages: $/";
        foreach (@deps) {
            print "- $_->{name}".($_->{version} ? " : ".$_->{version} : "").$/;
        }
        print "Note: these modules (or other modules required by them) may be from the$/";
        print "      unstable tree; you probably want to abort here it this bothers you.$/";
        $install = y_or_n("Should I install them?",2,0) unless (defined $install);
        if ($install) {
            my @pkgs;
            foreach (@deps) {
                my $pkg = $_->{name};
                $pkg .= "=".$_->{version} if $_->{version};
                push @pkgs, $pkg;
            }
            system("apt-get $opts{yes} install ".join(" ",@pkgs)) == 0
                or die "Failed to install sub-packages -> cannot continue installing $perlname";
            print "Done installing Debian packages.$/";
        }
    }

    if (@not_debs > 0) {
        if (! $requiredeps) {
            print "$perlname needs the following Perl modules but I could not determine if they were installed:$/";
            foreach (@not_debs) {
                print "- $_->{name} : ".($_->{version} ? $_->{version} : "any version").$/;
            }
            print "You could try again using the <--requiredeps> or <--recursive> arguments.$/".
                  "Should I continue processing this module as is?$/";
            print "** Note that if you say 'yes' here and later on to the \"should I install?\" question,$/".
                  "   the CPAN dependency system will take over and install the dependencies, without being$/".
                  "   under Debian's control.$/";
            y_or_n("Should I continue?") or exit(3);
        } elsif (! $apt_file) {
            print "$perlname requires the following Perl modules:$/";
            foreach (@not_debs) {
                print "- .$_->{name} : ".($_->{version} ? $_->{version} : "any version").$/;
            }
            print "However, you do not have 'apt-file' currently installed -> if you install it, I will be able$/".
                  "to tell you which Debian packages those modules are in (if they are packaged) or whether you".
                  "need to install them from CPAN.$/";
        }

        if ($requiredeps) {
            my @recurse_these;
            foreach (@not_debs) {
                push @recurse_these, $_ unless (exists $recursed{$_->{name}});
            }
            if (@recurse_these > 0) {
                print "$/$perlname needs the following CPAN modules:$/";
                foreach (@not_debs) {
                    print "- $_->{name}$/";
                }
                if ($install) {
                    if ($recursive) {
                        print "Since you just installed the deb's, I will also install the CPAN modules.$/";
                    } else {
                        $recursive = y_or_n("Since you just installed the deb's, would you also like to install the CPAN modules?",2,0) unless (defined $recursive);
                    }
                } else {
                    if ($recursive) {
                        print "Fetching them (this wont install them)...$/";
                    } else {
                        $recursive = y_or_n("Fetch them (this wont install them)?",3,0) unless (defined $recursive);
                    }
                    $install = y_or_n("Should I install them too?") unless (defined $install);
                }
                die "$perlname needs the previously listed Perl modules for which there are no Debian$/".
                    "packages available.  If you simply need to package up this module, try not using$/".
                    "the <--requiredeps> or <--recursive> arguments."  unless $recursive;
                recurse($install,@recurse_these);
                print "Finished recursing dependencies, trying $perlname again.$/";
                $again ++, goto AGAIN;
            } else {
                print "Finished recursing dependencies.$/";
            }
        }
    }

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

sub parse_aptitude_output {
    my $result_ref = shift;
    my @sections;
    my $keys = {};
    my $key = "";
    my $value = "";
    my @rows = split($/,$$result_ref);
    foreach (@rows) {
        next unless length;
        if (/^\s+/ or length == 1) {
        s/\s+/ /;
            $keys->{$key} .= $_;
            $keys->{$key} .= $/ if ($key eq 'Description');
            next;
        }
        ($key,$value) = split(/:\s/);
        if (exists $keys->{$key}) {
            push @sections, $keys;
            $keys = {};
        }
        $keys->{$key} = $value;
        $keys->{$key} .= $/ if ($key eq 'Description');
    }
    push @sections, $keys;
    return \@sections;
}

sub aptitude {
    my $pkg = shift;
    return () unless $pkg;
    my $result = `aptitude -v show $pkg 2>/dev/null`;
    return () unless ($? == 0 && defined $result && length $result);
    my $config = parse_aptitude_output(\$result);
    return () unless (@$config > 0);
    return @$config;
};

sub get_version {
    my $package = shift;
    return unless (defined $package->{Version});
    my $ver = $package->{Version};
    (undef,$ver) = split(':',$ver,2) if ($ver =~ /:/);
    ($ver,undef) = split('-',$ver,2) if ($ver =~ /-/);
    $ver =~ s/\.\d+$// if ($ver =~ /^\d+\.\d+\.\d+$/);
    return dualvar($ver,$package->{Version});
}

sub get_installed_deb_version {
    my $pkg = shift;
    my @config = aptitude($pkg);
    foreach my $package (@config) {
        next unless (exists $package->{State} and $package->{State} eq 'installed');
        return get_version($package) or next;
    }
    return 0;
}

sub get_uninstalled_deb_version {
    my $pkg = shift;
    my @config = aptitude($pkg);
    foreach my $package (@config) {
        next unless (exists $package->{State} and $package->{State} eq 'uninstalled');
        return get_version($package) or next;
    }
    return 0;
}

sub get_latest_deb_version {
    my $pkg = shift;
    my @config = aptitude($pkg);
    foreach my $package (@config) {
        return get_version($package) or next;
    }
    return 0;
}

sub ask {
    my($prompt,$regex,$default) = @_;
    $regex = qr/$regex/ unless (ref($regex) eq 'Regexp');
    my $result;
    do {
        print $prompt;
        if (defined $default) {
            print  "[", $default, "]";
        }
        print ": ";
        local $| = 1;
        local $_ = <STDIN>;
        chomp;
        if(defined $_ and $_ ne "") {
            $result = $_;
        } elsif (defined $default) {
            $result = $default;
        } else {
            $result = '';
        }
    } while ($regex ne '' and !($result =~ /$regex/));
    return $result;
}

sub y_or_n {
    my $m = shift;
    my ($y,$n) = (1,0);
    $y = shift if (@_ > 0);
    $n = shift if (@_ > 0);
    if (defined $m && length $m) {
        $m =~ s/\?$//;
        $m .= " - y/n? ";
    } else {
        $m = "y/n? ";
    }
    my $r = ask($m,'[yYnN]','n');
    return $y if ($r =~ /[yY]/);
    return $n;
}

sub cont_or_quit {
    my $m = shift;
    if (defined $m && length $m) {
        $m =~ s/\?$//;
        $m .= " - c/q? ";
    } else {
        $m = "c/q? ";
    }
    my $r = ask($m,'[cCqQ]','q');
    return 1 if ($r =~ /[cC]/);
    return 0;
}

sub recurse {
    my $install = shift;
    print "Recursing into CPAN packages: $/";
    my $args = "--recursive";
    $args .= " --build" if $build;
    $args .= " --install" if $install;
    $args .= " --cleanup" if $cleanup;
    if (defined $coreok) {
        if ($coreok == 0) {
            $args .= " --no-core-ok";
        } elsif ($coreok == 1) {
            $args .= " --core-ok";
        }
    }
    $args .= " --yes" if $opts{yes};
    foreach (@_) {
            next if (exists $recursed{$_->{name}});
            print "$/Processing: $_->{name}  (with args: $args) $/$/";
            system(qq{cd "$builddir"; dh-make-perl --cpan "$_->{name}" $args}) == 0 or die $?;
            $recursed{$_->{name}} = $_->{version};
    }
    print "$/Finished recursing into CPAN modules.$/";
}

sub get_itp {
    my ($package) = shift @_;
    use WWW::Mechanize;
    my $mech = WWW::Mechanize->new();
    my $wnpp = "http://bugs.debian.org/cgi-bin/pkgreport.cgi?pkg=wnpp;includesubj=ITP: $package";
    $mech->get($wnpp);

    my @links = $mech->links();
    foreach my $link (@links) {
        my $desc = $link->text();
        return $1 if $desc =~ /^#(\d+): ITP: $package /;
    }
    return 0;
}

sub substitute_perl_dependency {
    # If we get 'perl' specified in here, the module requires a
    # specific version of Perl in order to be run. This is only
    # reliable if we have ${perl:Depends} in $depends and either
    # of $bdepends and $bdependsi - Warn otherwise.
    my ($version, $dep_str, $old_dep_str, $old_bdep_str);
    $version = shift;

    # Over-escaping? I'm putting this in variables to get a bit more clarity.
    # Remember they will be fed into the regex engine.
    $dep_str = "perl (>= $version)";
    $old_dep_str = '\\$\\{perl:Depends\\}';
    $old_bdep_str = "perl \\(>= $perl_pkg->{Version}\\)";

    unless ($depends =~ s/$old_dep_str/$dep_str/ and
            ($bdepends =~ s/$old_bdep_str/$dep_str/ or
             $bdependsi =~ s/$old_bdep_str/$dep_str/)) {
        warn "The module requires Perl version $version, but you have ",
             "apparently overriden the default dependency handling.\n",
             "Please note that you might need to manually edit your debian/control ",
             "- It might not make sense at all!\n";
    }
}

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

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

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

    $fh = _file_rw($rules_file);
    @content = $fh->getlines;

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

sub create_control {
    my $fh = _file_w(shift);

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

    $fh->print("Source: $srcname\n");
    $fh->print("Section: $section\n");
    $fh->print("Priority: $priority\n");
    $fh->print("Build-Depends: $bdepends\n") if $bdepends;
    $fh->print("Build-Depends-Indep: $bdependsi\n") if $bdependsi;
    $fh->print($extrasfields) if defined $extrasfields;
    if ($opts{'pkg-perl'}) {
        $fh->print("Maintainer: Debian Perl Group <pkg-perl-maintainers\@lists.alioth.debian.org>\n");
        $fh->print("Uploaders: $maintainer\n");
    } else {
        $fh->print("Maintainer: $maintainer\n");
    }
    $fh->print("Standards-Version: $debstdversion\n");
    $fh->print("Homepage: $upsurl\n") if $upsurl;
    if ($opts{'pkg-perl'}) {
        $fh->print("Vcs-Svn: svn://svn.debian.org/pkg-perl/trunk/$srcname/\n");
        $fh->print("Vcs-Browser: http://svn.debian.org/wsvn/pkg-perl/trunk/$srcname/\n";);
    }
    $fh->print("\n");
    $fh->print("Package: $pkgname\n");
    $fh->print("Architecture: $arch\n");
    $fh->print("Depends: $depends\n") if $depends;
    $fh->print($extrapfields) if defined $extrapfields;
    $fh->print("Description: $desc\n$longdesc\n .\n This package was automagically generated from the $perlname module by dh-make-perl.\n");
    $fh->close;
}

sub create_changelog {
    my $fh = _file_w(shift);
    my $bug = shift;

    my $closes = $bug ? " (Closes: #$bug)" : '';

    $fh->print("$srcname ($pkgversion) unstable; urgency=low\n");
    $fh->print("\n  * Initial Release.$closes\n\n");
    $fh->print(" -- $maintainer  $date\n");
    #$fh->print("Local variables:\nmode: debian-changelog\nEnd:\n");
    $fh->close
}

sub create_rules {
        my ($file, $rulesname, $error);
    ($file) = shift;
    $rulesname = $arch eq 'all'?"rules.$module_build.noxs":"rules.$module_build.xs";

    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 $fh = _file_w(shift);
    $fh->print("$dh_compat\n");
    $fh->close;
}

sub create_copyright {
    my $fh = _file_w(shift);
    my $incomplete = '';

    $fh->print(
"This is the debian package for the $perlname module.
It was created by $maintainer using dh-make-perl.

");
        if (defined $upsurl) {
                $fh->print("It was downloaded from $upsurl\n\n");
    } else {
            $incomplete .= "No upstream URL\n";
        }
    $fh->print(
"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.

");
    if (defined $author) {
        $fh->print("The upstream author is: $author.\n");
    } else {
            $incomplete .= "No upstream author\n";
    }

    if (defined($copyright)) {
        $fh->print($copyright);
        # Fun with regexes
        if ( $copyright =~ /terms as Perl itself/i ) {
            $fh->print("

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\'.
");
        } elsif ( $copyright =~ /GPL/ ) {
            $fh->print("

The full text of the GPL is available on Debian systems in
/usr/share/common-licenses/GPL
");
        }
    } else {
            $incomplete .= "No licensing information\n";
    }

    my $year = (localtime)[5]+1900;
    $fh->print("

The Debian packaging is (C) $year, $maintainer and
is licensed under the same terms as the software itself (see above).
");

    $fh->close;

    if ($incomplete) {
        _warn_incomplete_copyright($incomplete)
    }
}

sub create_readme {
     my $fh = _file_w(shift);
    $fh->print(
"This is the debian package for the $perlname module.
It was created by $maintainer using dh-make-perl.
");
    $fh->close;
}

sub create_watch {
    my $fh = _file_w(shift);

    my $version_re = 'v?(\d[\d_.-]+)\.(?:tar(?:\.gz|\.bz2)?|tgz|zip)';

    $fh->print(
"\# format version number, currently 3; this line is compulsory!
version=3
$upsurl .*/$perlname-$version_re\$
");
    $fh->close;
}

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 = shift @_ || ($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;
}

sub _warn_incomplete_copyright {
    print '*'x10, '
Copyright information incomplete!

Upstream copyright information could not be automatically determined.

If you are building this package for your personal use, you might disregard
this information; however, if you intend to upload this package to Debian
(or in general, if you plan on distributing it), you must look into the
complete copyright information.

The causes for this warning are:
', @_;
}

sub _file_r {
    my ($file, $fh);
    $file = shift;
    $fh = IO::File->new($file, 'r') or die "Cannot open $file: $!\n";
    return $fh;
}

sub _file_w {
    my ($file, $fh);
    $file = shift;
    $fh = IO::File->new($file, 'w') or die "Cannot open $file: $!\n";
    return $fh;
}

sub _file_rw {
    my ($file, $fh);
    $file = shift;
    $fh = IO::File->new($file, 'r+') or die "Cannot open $file: $!\n";
    return $fh;
}

=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<--email> | B<-e> I<EMAIL>

Manually specify the Maintainer email address to use in debian/control and
in debian/changelog.

=item B<--packagename> | B<-p> I<PACKAGENAME>

Manually specify the Package Name, useful when the module has dashes in its
name.

=item B<--closes> I<ITPBUG>

Manually specify the ITP bug number that this package closes. If not
given, dh-make-perl will try to connect to bugs.debian.org to fetch the
appropriate bug number, using WWW::Mechanize.

=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. If you need to pass dh-make-perl
dependency information, you must do it using the debian package format. i.e.

dh-make-perl --depends libtest-more-perl

=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<--pkg-perl>

Useful when preparing a package for the Debian Perl Group
L<http://pkg-perl.alioth.debian.org>.

Sets C<Maintainer>, C<Uploaders>, C<Vcs-Svn> and C<Vcs-Browser> fields in
debian/control accordingly.

=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.

This option can be negated using B<--no-build>.

=item B<--install>

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

This option can be negated using B<--no-install>.

=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<--basepkgs> I<PKGSLIST>

Explicitly gives a comma-separated list of packages to consider "base"
packages (i.e. packages that should always be available in Debian
systems). This option defaults to C<perl,perl-base,perl-modules> - It
is used to check for module dependencies. If a needed module is in the
C<basepkgs>, it won't be mentioned in the C<depends:> field of
C<debian/control>.

If this option is specified, the above mentioned default packages will
not be included (but will be mentioned as explicit dependencies in the
resulting package). You can, of course, mention your own modules
and explicitly specify the default values.

Note that this option should be used sparsingly and with care, as it
might lead to packages not being rebuildable because of unfulfilled
dependencies.

=item B<--core-ok>

Allows building core Perl modules. By default, dh-make-perl will not allow
building a module that is shipped as part of the standard Perl library; by
specifying this option, dh-make-perl will build them anyway.

Note that, although it is not probable, this might break unrelated items in
your system - If a newer version of a core module breaks the API, all kinds
of daemons might get upset ;-)

This option can be negated using B<--no-core-ok>.

=item B<--requiredeps>

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

This option can be negated using B<--no-requiredeps>.

=item B<--recursive>

Cause dh-make-perl to recursively try to fetch any dependencies needed
by the current Perl module.

If a Debian package already exists for the dependency and --install is
supplied, the dependency is installed using apt-get (if --yes is supplied,
it will be passed directly to apt-get).

If no Debian package exists and --build/--install is supplied, those options
are also passed to the dependent Perl module.

This option can be negated using B<--no-recursive>.

=item B<--build-dir> I<DIR>

Use a build directory other than C<~/.dh-make-perl/build>. eg: to use the
current directory would be C<--build-dir .>.

=item B<--cleanup>

Get dh-make-perl to cleanup after itself (particularly when using --cpan).
We dont automatically cleanup as the generated files are often of use for
deb maintainers.

Note this doesn't clean out the deb's and CPAN builds, from the build-dir.

This option can be negated using B<--no-cleanup>.

=item B<--yes>

Passed directly to apt-get, when installing the require deb packages.  To
automate dh-make-perl (ie: to avoid answering questions), use B<--install>
and B<--recursive>.

=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 (and minimum version) 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<.>

Note that the version specified is the minimum version, ie:
the latest version available from CPAN will be used.

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 EXAMPLES

To configure a module from an unzipped CPAN tarball available in the
current directory:

  dh-make-perl

To install said module:

  dh-make-perl --install

To configure a CPAN module and list its Debian and CPAN dependencies):

  dh-make-perl --requiredeps --cpan <module>

To install a CPAN module and install all of its dependencies:

  dh-make-perl --recursive --install --cpan <module>

dh-make-perl wont allow you to update what it considers to be "core Perl
modules".  To just make the whole shebang update to the latest version:

  dh-make-perl --recursive --core-ok --install --yes --cpan <module>

=head1 BUGS

Several, let us know when you find them...

=over

=item

We are too lazy to clean up after ourselves when run in non --cpan mode,
thus leaving lots of useless Debian-specific files lying around.

=item

Since we dont have the ability to check reverse dependencies on modules
about to be installed, it is possible to install a module with an
updated API, that changes some existing behaviour.

=item

Doing a "--cpan CPAN" (or "--cpan Bundle::CPAN" or some other Debian-Perl
standard/base module), may cause your beautiful Debian system to come
unglued at the edges... you have been warned!

=back

=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>, and team-maintained
by the Debian pkg-perl team, http://alioth.debian.org/projects/pkg-perl

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 Paleino E<lt>d.paleino@gmail.comE<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>
  gregor herrmann E<lt>gregor+debian@comodo.priv.atE<gt>
  Hilko Bengen E<lt>bengen@debian.orgE<gt>
  Kees Cook E<lt>keex@outflux.netE<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>
  Marc Chantreux (mail withheld)
  Matt Hope E<lt>dopey@debian.orgE<gt>
  Noel Maddy E<lt>noel@zhtwn.comE<gt>
  Oliver Gorwits E<lt>oliver.gorwits@oucs.ox.ac.ukE<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>
  Mathew Robertson E<lt>mathew@users.sf.netE<gt>

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

=cut



----- End forwarded message -----

-- 
Gunnar Wolf - gwolf@gwolf.org - (+52-55)5623-0154 / 1451-2244
PGP key 1024D/8BB527AF 2001-10-23
Fingerprint: 0C79 D2D1 2C4E 9CE4 5973  F800 D80E F35A 8BB5 27AF


Reply to: