r28053 - /trunk/dh-make-perl/dh-make-perl

dmn at users.alioth.debian.org dmn at users.alioth.debian.org
Thu Dec 11 08:10:02 UTC 2008


Author: dmn
Date: Thu Dec 11 08:09:59 2008
New Revision: 28053

URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=28053
Log:
wrap main execution flow into a main() sub

Modified:
    trunk/dh-make-perl/dh-make-perl

Modified: trunk/dh-make-perl/dh-make-perl
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/dh-make-perl/dh-make-perl?rev=28053&op=diff
==============================================================================
--- trunk/dh-make-perl/dh-make-perl (original)
+++ trunk/dh-make-perl/dh-make-perl Thu Dec 11 08:09:59 2008
@@ -1,4 +1,5 @@
 #!/usr/bin/perl -w
+
 use DhMakePerl::PodParser;
 use YAML;
 use IO::File;
@@ -88,50 +89,131 @@
 
 my $mod_cpan_version;
 
-$opt_dbflags = $> == 0 ? "" : "-rfakeroot";
-chomp($date);
-
-GetOptions(
-    'arch=s'          => \$opt_arch,
-    'basepkgs=s'      => \$opt_basepkgs,
-    'bdepends=s'      => \$opt_bdepends,
-    'bdependsi=s'     => \$opt_bdependsi,
-    'build!'          => \$opt_build,
-    'core-ok'         => \$opt_core_ok,
-    'cpan=s'          => \$opt_cpan,
-    'cpanplus=s'      => \$opt_cpanplus,
-    'closes=i'        => \$opt_closes,
-    'cpan-mirror=s'   => \$opt_cpan_mirror,
-    'dbflags=s'       => \$opt_dbflags,
-    'depends=s'       => \$opt_depends,
-    'desc=s'          => \$opt_desc,
-    'exclude|i:s{,}'  => \$opt_exclude,
-    'help'            => \$opt_help,
-    'install!'        => \$opt_install,
-    'nometa'          => \$opt_nometa,
-    'notest'          => \$opt_notest,
-    'pkg-perl!'       => \$opt_pkg_perl,
-    'requiredeps'     => \$opt_requiredeps,
-    'version=s'       => \$opt_version,
-    'e|email=s'       => \$opt_email,
-    'p|packagename=s' => \$opt_packagename,
-    'refresh|R'       => \$opt_refresh,
-    'dh=i'            => \$opt_dh,
-    'sources-list=s'  => \$opt_sources_list,
-    'dist=s'          => \$opt_dist,
-    'verbose!'        => \$opt_verbose,
-    'data-dir=s'      => \$opt_datadir,
-    'home-dir=s'      => \$opt_homedir,
-    'refresh-cache'   => \$opt_refresh_cache,
-) or die usage_instructions();
-
- at bdepends = ( Debian::Dependency->new( 'debhelper', $opt_dh ) );
-
-# Help requested? Nice, we can just die! Isn't it helpful?
-die usage_instructions() if $opt_help;
-die "CPANPLUS support disabled, sorry" if $opt_cpanplus;
-
-if ($opt_refresh_cache) {
+sub run() {
+    $opt_dbflags = $> == 0 ? "" : "-rfakeroot";
+    chomp($date);
+
+    GetOptions(
+        'arch=s'          => \$opt_arch,
+        'basepkgs=s'      => \$opt_basepkgs,
+        'bdepends=s'      => \$opt_bdepends,
+        'bdependsi=s'     => \$opt_bdependsi,
+        'build!'          => \$opt_build,
+        'core-ok'         => \$opt_core_ok,
+        'cpan=s'          => \$opt_cpan,
+        'cpanplus=s'      => \$opt_cpanplus,
+        'closes=i'        => \$opt_closes,
+        'cpan-mirror=s'   => \$opt_cpan_mirror,
+        'dbflags=s'       => \$opt_dbflags,
+        'depends=s'       => \$opt_depends,
+        'desc=s'          => \$opt_desc,
+        'exclude|i:s{,}'  => \$opt_exclude,
+        'help'            => \$opt_help,
+        'install!'        => \$opt_install,
+        'nometa'          => \$opt_nometa,
+        'notest'          => \$opt_notest,
+        'pkg-perl!'       => \$opt_pkg_perl,
+        'requiredeps'     => \$opt_requiredeps,
+        'version=s'       => \$opt_version,
+        'e|email=s'       => \$opt_email,
+        'p|packagename=s' => \$opt_packagename,
+        'refresh|R'       => \$opt_refresh,
+        'dh=i'            => \$opt_dh,
+        'sources-list=s'  => \$opt_sources_list,
+        'dist=s'          => \$opt_dist,
+        'verbose!'        => \$opt_verbose,
+        'data-dir=s'      => \$opt_datadir,
+        'home-dir=s'      => \$opt_homedir,
+        'refresh-cache'   => \$opt_refresh_cache,
+    ) or die usage_instructions();
+
+    @bdepends = ( Debian::Dependency->new( 'debhelper', $opt_dh ) );
+
+    # Help requested? Nice, we can just die! Isn't it helpful?
+    die usage_instructions() if $opt_help;
+    die "CPANPLUS support disabled, sorry" if $opt_cpanplus;
+
+    if ($opt_refresh_cache) {
+        my $apt_contents = Debian::AptContents->new({
+            homedir      => $opt_homedir,
+            dist         => $opt_dist,
+            sources_file => $opt_sources_list,
+            verbose      => $opt_verbose,
+        });
+
+        return 0;
+    }
+
+    $arch = $opt_arch if defined $opt_arch;
+
+    $maintainer = get_maintainer($opt_email);
+
+    if ( defined $opt_desc ) {
+        $desc = $opt_desc;
+    }
+    else {
+        $desc = '';
+    }
+
+    if ($opt_refresh) {
+        print "Engaging refresh mode\n" if $opt_verbose;
+        $maindir = '.';
+
+        die "debian/rules.bak already exists. Aborting!\n"
+            if -e "debian/rules.bak";
+
+        die "debian/copyright.bak already exists. Aborting!\n"
+            if -e "debian/copyright.bak";
+
+        $meta = process_meta("$maindir/META.yml") if ( -f "$maindir/META.yml" );
+        ( $pkgname, $version ) = extract_basic();  # also detects arch-dep package
+        $module_build = ( -f "$maindir/Build.PL" ) ? "Module-Build" : "MakeMaker";
+        $debiandir = './debian';
+        extract_changelog($maindir);
+        extract_docs($maindir);
+        extract_examples($maindir);
+        print "Found changelog: $changelog\n"
+            if defined $changelog and $opt_verbose;
+        print "Found docs: @docs\n" if $opt_verbose;
+        print "Found examples: @examples\n" if @examples and $opt_verbose;
+        copy( "$debiandir/rules", "$debiandir/rules.bak" );
+        create_rules("$debiandir/rules");
+        if (! -f "$debiandir/compat" or $opt_dh == 7) {
+            create_compat("$debiandir/compat");
+        }
+        fix_rules( "$debiandir/rules", ( defined $changelog ? $changelog : '' ),
+            \@docs, \@examples, );
+        copy( "$debiandir/copyright", "$debiandir/copyright.bak" );
+        create_copyright("$debiandir/copyright");
+        print "--- Done\n" if $opt_verbose;
+        return 0;
+    }
+
+    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 $opt_packagename ) {
+        $pkgname = $opt_packagename;
+    }
+    unless ( defined $opt_version ) {
+        $pkgversion = $version . "-1";
+    }
+    else {
+        $pkgversion = $opt_version;
+    }
+
+    move( $tarball, dirname($tarball) . "/${pkgname}_${version}.orig.tar.gz" )
+        if ( $tarball && $tarball =~ /(?:\.tar\.gz|\.tgz)$/ );
+
+    # fail before further inspection of the source
+    # $debiandir is set by extract_basic() above
+    -d $debiandir
+        && die
+        "The directory $debiandir is already present and I won't overwrite it: remove it yourself.\n";
+
     my $apt_contents = Debian::AptContents->new({
         homedir      => $opt_homedir,
         dist         => $opt_dist,
@@ -139,157 +221,80 @@
         verbose      => $opt_verbose,
     });
 
-    exit 0;
-}
-
-$arch = $opt_arch if defined $opt_arch;
-
-$maintainer = get_maintainer($opt_email);
-
-if ( defined $opt_desc ) {
-    $desc = $opt_desc;
-}
-else {
-    $desc = '';
-}
-
-if ($opt_refresh) {
-    print "Engaging refresh mode\n" if $opt_verbose;
-    $maindir = '.';
-
-    die "debian/rules.bak already exists. Aborting!\n"
-        if -e "debian/rules.bak";
-
-    die "debian/copyright.bak already exists. Aborting!\n"
-        if -e "debian/copyright.bak";
-
-    $meta = process_meta("$maindir/META.yml") if ( -f "$maindir/META.yml" );
-    ( $pkgname, $version ) = extract_basic();  # also detects arch-dep package
+    undef($apt_contents) unless $apt_contents->cache;
+
+    push @depends, Debian::Dependency->new('${shlibs:Depends}') if $arch eq 'any';
+    push @depends, Debian::Dependency->new('${misc:Depends}');
+    my $extradeps = extract_depends( $maindir, $apt_contents, 0 );
+    push @depends, @$extradeps;
+    push @depends, Debian::Dependency->parse_list($opt_depends) if $opt_depends;
+
     $module_build = ( -f "$maindir/Build.PL" ) ? "Module-Build" : "MakeMaker";
-    $debiandir = './debian';
     extract_changelog($maindir);
     extract_docs($maindir);
     extract_examples($maindir);
-    print "Found changelog: $changelog\n"
-        if defined $changelog and $opt_verbose;
+
+    push @bdepends, Debian::Dependency->new('libmodule-build-perl')
+        if ( $module_build eq "Module-Build" );
+
+    my ( @extrabdepends, @extrabdependsi );
+    if ( $arch eq 'any' ) {
+        @extrabdepends = (
+            @{ extract_depends( $maindir, $apt_contents, 1 ) },
+            @$extradeps,
+        );
+    }
+    else {
+        @extrabdependsi = (
+            @{ extract_depends( $maindir, $apt_contents, 1 ) },
+            @$extradeps,
+        );
+    }
+
+    push @bdepends, Debian::Dependency->parse_list($opt_bdepends) if $opt_bdepends;
+    push @bdepends, @extrabdepends;
+
+    push @bdependsi, Debian::Dependency->parse_list($opt_bdependsi) if $opt_bdependsi;
+    push @bdependsi, @extrabdependsi;
+
+    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*$/ ) and $opt_verbose;
+    print "Using maintainer: $maintainer\n" if $opt_verbose;
+    print "Found changelog: $changelog\n" if defined $changelog and $opt_verbose;
     print "Found docs: @docs\n" if $opt_verbose;
     print "Found examples: @examples\n" if @examples and $opt_verbose;
-    copy( "$debiandir/rules", "$debiandir/rules.bak" );
+
+    # start writing out the data
+    mkdir( $debiandir, 0755 ) || die "Cannot create $debiandir dir: $!\n";
+    create_control("$debiandir/control");
+    if ( defined $opt_closes ) {
+        $closes = $opt_closes;
+    }
+    else {
+        $closes = get_itp($pkgname);
+    }
+    create_changelog( "$debiandir/changelog", $closes );
     create_rules("$debiandir/rules");
-    if (! -f "$debiandir/compat" or $opt_dh == 7) {
-        create_compat("$debiandir/compat");
-    }
+    create_compat("$debiandir/compat");
+    create_watch("$debiandir/watch") if $upsurl;
+
+    #create_readme("$debiandir/README.Debian");
+    create_copyright("$debiandir/copyright");
     fix_rules( "$debiandir/rules", ( defined $changelog ? $changelog : '' ),
-        \@docs, \@examples, );
-    copy( "$debiandir/copyright", "$debiandir/copyright.bak" );
-    create_copyright("$debiandir/copyright");
+        \@docs, \@examples );
+    apply_final_overrides();
+    build_package($maindir) if $opt_build or $opt_install;
+    install_package($debiandir) if $opt_install;
     print "--- Done\n" if $opt_verbose;
-    exit 0;
-}
-
-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 $opt_packagename ) {
-    $pkgname = $opt_packagename;
-}
-unless ( defined $opt_version ) {
-    $pkgversion = $version . "-1";
-}
-else {
-    $pkgversion = $opt_version;
-}
-
-move( $tarball, dirname($tarball) . "/${pkgname}_${version}.orig.tar.gz" )
-    if ( $tarball && $tarball =~ /(?:\.tar\.gz|\.tgz)$/ );
-
-# fail before further inspection of the source
-# $debiandir is set by extract_basic() above
--d $debiandir
-    && die
-    "The directory $debiandir is already present and I won't overwrite it: remove it yourself.\n";
-
-my $apt_contents = Debian::AptContents->new({
-    homedir      => $opt_homedir,
-    dist         => $opt_dist,
-    sources_file => $opt_sources_list,
-    verbose      => $opt_verbose,
-});
-
-undef($apt_contents) unless $apt_contents->cache;
-
-push @depends, Debian::Dependency->new('${shlibs:Depends}') if $arch eq 'any';
-push @depends, Debian::Dependency->new('${misc:Depends}');
-my $extradeps = extract_depends( $maindir, $apt_contents, 0 );
-push @depends, @$extradeps;
-push @depends, Debian::Dependency->parse_list($opt_depends) if $opt_depends;
-
-$module_build = ( -f "$maindir/Build.PL" ) ? "Module-Build" : "MakeMaker";
-extract_changelog($maindir);
-extract_docs($maindir);
-extract_examples($maindir);
-
-push @bdepends, Debian::Dependency->new('libmodule-build-perl')
-    if ( $module_build eq "Module-Build" );
-
-my ( @extrabdepends, @extrabdependsi );
-if ( $arch eq 'any' ) {
-    @extrabdepends = (
-        @{ extract_depends( $maindir, $apt_contents, 1 ) },
-        @$extradeps,
-    );
-}
-else {
-    @extrabdependsi = (
-        @{ extract_depends( $maindir, $apt_contents, 1 ) },
-        @$extradeps,
-    );
-}
-
-push @bdepends, Debian::Dependency->parse_list($opt_bdepends) if $opt_bdepends;
-push @bdepends, @extrabdepends;
-
-push @bdependsi, Debian::Dependency->parse_list($opt_bdependsi) if $opt_bdependsi;
-push @bdependsi, @extrabdependsi;
-
-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*$/ ) and $opt_verbose;
-print "Using maintainer: $maintainer\n" if $opt_verbose;
-print "Found changelog: $changelog\n" if defined $changelog and $opt_verbose;
-print "Found docs: @docs\n" if $opt_verbose;
-print "Found examples: @examples\n" if @examples and $opt_verbose;
-
-# start writing out the data
-mkdir( $debiandir, 0755 ) || die "Cannot create $debiandir dir: $!\n";
-create_control("$debiandir/control");
-if ( defined $opt_closes ) {
-    $closes = $opt_closes;
-}
-else {
-    $closes = get_itp($pkgname);
-}
-create_changelog( "$debiandir/changelog", $closes );
-create_rules("$debiandir/rules");
-create_compat("$debiandir/compat");
-create_watch("$debiandir/watch") if $upsurl;
-
-#create_readme("$debiandir/README.Debian");
-create_copyright("$debiandir/copyright");
-fix_rules( "$debiandir/rules", ( defined $changelog ? $changelog : '' ),
-    \@docs, \@examples );
-apply_final_overrides();
-build_package($maindir) if $opt_build or $opt_install;
-install_package($debiandir) if $opt_install;
-print "--- Done\n" if $opt_verbose;
-exit(0);
+    return(0);
+}
+
+exit( run() );
 
 sub usage_instructions {
     return <<"USAGE"




More information about the Pkg-perl-cvs-commits mailing list