vcs.maemo.org Git - pkg-perl/blob - deb-src/dh-make-perl/dh-make-perl-0.47/debian/dh-make-perl/usr/bin/dh-make-perl

   1 #!/usr/bin/perl -w
   2 use Pod::Parser;
   3 use YAML;
   4 use IO::File;
   5 use File::Basename;
   6 use File::Find;
   7 use File::Copy qw(copy move);
   8 use User::pwent;
   9 use Getopt::Long;
  10 use Cwd;
  11 use CPAN;
  12 use Module::Depends::Intrusive;
  13 use Email::Date::Format qw(email_date);
  14 use strict;
  15
  16 # TODO:
  17 # * get more info from the package (maybe using CPAN methods)
  18
  19 ######################################################################
  20 # This Pod::Parser must be declared before the main program flow. If you
  21 # are trying to figure out what happens inside dh-make-perl, skip down
  22 # until 'package main'.
  23 package MyPod;
  24
  25 @MyPod::ISA = qw(Pod::Parser);
  26
  27 sub set_names {
  28         my ($parser, @names) = @_;
  29         foreach my $n (@names) {
  30                 $parser->{_deb_}->{$n} = undef;
  31         }
  32 }
  33
  34 sub get {
  35         my ($parser, $name) = @_;
  36         $parser->{_deb_}->{$name};
  37 }
  38
  39 sub cleanup {
  40         my $parser = shift;
  41         delete $parser->{_current_};
  42         foreach my $k ( keys %{$parser->{_deb_}}) {
  43                 $parser->{_deb_}->{$k} = undef;
  44         }
  45 }
  46
  47 sub command {
  48         my ($parser, $command, $paragraph, $line_num) = @_;
  49         $paragraph =~ s/\s+$//s;
  50         if ($command =~ /head/ && exists($parser->{_deb_}->{$paragraph})) {
  51                 $parser->{_current_} = $paragraph;
  52                 $parser->{_lineno_} = $line_num;
  53         } else {
  54                 delete $parser->{_current_};
  55         }
  56         #print "GOT: $command -> $paragraph\n";
  57 }
  58
  59 sub add_text {
  60         my ($parser, $paragraph, $line_num) = @_;
  61         return unless exists $parser->{_current_};
  62         return if ($line_num - $parser->{_lineno_} > 15);
  63         $paragraph =~ s/^\s+//s;
  64         $paragraph =~ s/\s+$//s;
  65         $paragraph = $parser->interpolate($paragraph, $line_num);
  66         $parser->{_deb_}->{$parser->{_current_}} .= "\n\n".$paragraph;
  67         #print "GOTT: $paragraph'\n";
  68 }
  69
  70 sub verbatim { shift->add_text(@_)}
  71
  72 sub textblock { shift->add_text(@_)}
  73
  74 sub interior_sequence {
  75         my ($parser, $seq_command, $seq_argument) = @_;
  76         if ($seq_command eq 'E') {
  77                 my %map = ('gt' => '>', 'lt' => '<', 'sol' => '/', 'verbar' => '|');
  78                 return $map{$seq_argument} if exists $map{$seq_argument};
  79                 return chr($seq_argument) if ($seq_argument =~ /^\d+$/);
  80                 # html names...
  81         }
  82         return $seq_argument;
  83 }
  84
  85 ######################################################################
  86 # Main dh-make-perl starts here, don't look any further!
  87 package main;
  88 my (@stdmodules, $min_perl_version, $debstdversion, $priority, $section,
  89     $depends, $bdepends, $bdependsi, $maintainer, $arch, $closes, $date,
  90     $debiandir, $startdir, $datadir, $homedir, $email);
  91 our %overrides;
  92
  93 $debstdversion = '3.8.0';
  94 $priority = 'optional';
  95 $section = 'perl';
  96 $depends = '${perl:Depends}';
  97 # 5.6.0-12 is where arch-indep modules are moved in /usr/share/perl5
  98 # (according to dh_perl)
  99 # if the module has stricter requirements, this build-dependency
 100 # is replaced below by calling substitute_perl_dependency
 101 $min_perl_version = '5.6.10-12';
 102 $bdependsi = "perl (>= $min_perl_version)";
 103 $arch = 'all';
 104 $date = email_date(time);
 105 $startdir = getcwd();
 106 $datadir = '/usr/share/dh-make-perl';
 107 $homedir = "$ENV{HOME}/.dh-make-perl";
 108
 109 my ($perlname, $maindir, $modulepm, $meta);
 110 my ($pkgname, $srcname,
 111     # $version is the version from the perl module itself
 112     $version,
 113     # $pkgversion is the resulting version of the package: User's
 114     # --version=s or "$version-1"
 115     $pkgversion,
 116     $desc, $longdesc, $copyright, $author, $upsurl);
 117 my ($extrasfields, $extrapfields);
 118 my ($module_build);
 119 my (@docs, @examples, $changelog, @args);
 120
 121 my %opts = (
 122     'dh'   => 5,
 123 );
 124
 125 my $mod_cpan_version;
 126
 127 $opts{dbflags} = $>==0?"":"-rfakeroot";
 128 chomp($date);
 129
 130 GetOptions(\%opts,
 131            'arch=s', 'basepkgs=s', 'bdepends=s', 'bdependsi=s',
 132            'build!', 'core-ok', 'cpan=s', 'cpanplus=s', 'closes=i',
 133            'cpan-mirror=s', 'dbflags=s', 'depends=s', 'desc=s',
 134            'exclude|i:s{,}', 'help', 'install!', 'nometa', 'notest',
 135            'pkg-perl!', 'requiredeps', 'version=s', 'e=s', 'email=s',
 136            'p=s', 'packagename=s', 'refresh|R', 'dh=i'
 137 ) or die usage_instructions();
 138
 139 $bdepends = "debhelper (>= $opts{dh})";
 140 @stdmodules = get_stdmodules();
 141
 142 # Help requested? Nice, we can just die! Isn't it helpful?
 143 die usage_instructions() if $opts{help};
 144 die "CPANPLUS support disabled, sorry" if $opts{cpanplus};
 145
 146 $opts{exclude} = '(?:\/|^)(?:CVS|\.svn)\/' if (!defined $opts{exclude} or
 147                                           $opts{exclude} eq '');
 148
 149 $arch = $opts{arch} if defined $opts{arch};
 150
 151 if ( $opts{refresh} )
 152 {
 153     print "Engaging refresh mode\n";
 154     $maindir='.';
 155     $meta = process_meta("$maindir/META.yml") if (-f "$maindir/META.yml"); # package name
 156     ($pkgname, $version) = extract_basic();  # also detects arch-dep package
 157     $module_build = (-f "$maindir/Build.PL") ? "Module-Build" : "MakeMaker";
 158     $debiandir='./debian';
 159     extract_changelog($maindir);
 160     extract_docs($maindir);
 161     extract_examples($maindir);
 162     print "Found changelog: $changelog\n" if defined $changelog;
 163     print "Found docs: @docs\n";
 164     print "Found examples: @examples\n" if @examples;
 165     create_rules("$debiandir/rules");
 166     fix_rules(
 167         "$debiandir/rules",
 168         (defined $changelog ? $changelog : ''),
 169         \@docs, \@examples,
 170     );
 171     print "Done\n";
 172     exit 0;
 173 }
 174
 175 load_overrides();
 176 my $tarball = setup_dir();
 177 $meta = process_meta("$maindir/META.yml") if (-f "$maindir/META.yml");
 178 findbin_fix();
 179
 180 if (defined $opts{e}) {
 181   $email = $opts{e};
 182 } elsif (defined $opts{email}) {
 183   $email = $opts{email};
 184 } else {
 185   $email = '';
 186 }
 187 $maintainer = get_maintainer($email);
 188
 189 if (defined $opts{desc}) {
 190   $desc = $opts{desc};
 191 } else {
 192   $desc = '';
 193 }
 194 ($pkgname, $version) = extract_basic();
 195 if (defined $opts{p}) {
 196   $pkgname = $opts{p};
 197 } elsif (defined $opts{packagename}) {
 198   $pkgname = $opts{packagename};
 199 }
 200 unless (defined $opts{version}) {
 201         $pkgversion = $version . "-1";
 202 } else {
 203         $pkgversion = $opts{version};
 204 }
 205
 206 move ($tarball, dirname($tarball) . "/${pkgname}_${version}.orig.tar.gz") if ($tarball && $tarball =~ /(?:\.tar\.gz|\.tgz)$/);
 207 $module_build = (-f "$maindir/Build.PL") ? "Module-Build" : "MakeMaker";
 208 extract_changelog($maindir);
 209 extract_docs($maindir);
 210 extract_examples($maindir);
 211
 212 if (defined $opts{bdepends}) {
 213     $bdepends = $opts{bdepends};
 214 } else {
 215     $bdepends .= ', libmodule-build-perl' if ($module_build eq "Module-Build");
 216 }
 217 $bdependsi = $opts{bdependsi} if defined $opts{bdependsi};
 218
 219 if (defined $opts{depends}) {
 220     $depends = $opts{depends};
 221 } else {
 222     $depends .= ', ${shlibs:Depends}' if $arch eq 'any';
 223     $depends .= ', ${misc:Depends}';
 224     my $extradeps = extract_depends($maindir, $meta);
 225     $depends .= ( $extradeps ? ", $extradeps" : '' );
 226 }
 227
 228 apply_overrides();
 229
 230 die "Cannot find a description for the package: use the --desc switch\n"
 231     unless $desc;
 232 print "Package does not provide a long description - " ,
 233     " Please fill it in manually.\n"
 234     if (!defined $longdesc or $longdesc =~ /^\s*\.?\s*$/);
 235 print "Using maintainer: $maintainer\n";
 236 print "Found changelog: $changelog\n" if defined $changelog;
 237 print "Found docs: @docs\n";
 238 print "Found examples: @examples\n" if @examples;
 239 -d $debiandir && die "The directory $debiandir is already present and I won't overwrite it: remove it yourself.\n";
 240 # start writing out the data
 241 mkdir ($debiandir, 0755) || die "Cannot create $debiandir dir: $!\n";
 242 create_control("$debiandir/control");
 243 if (defined $opts{closes}) {
 244     $closes = $opts{closes};
 245 } else {
 246     $closes = get_itp($pkgname);
 247 }
 248 create_changelog("$debiandir/changelog", $closes);
 249 create_rules("$debiandir/rules");
 250 create_compat("$debiandir/compat");
 251 create_watch("$debiandir/watch") if $upsurl;
 252 #create_readme("$debiandir/README.Debian");
 253 create_copyright("$debiandir/copyright");
 254 fix_rules("$debiandir/rules", (defined $changelog ? $changelog : ''), \@docs, \@examples);
 255 apply_final_overrides();
 256 build_package($maindir) if $opts{build} or $opts{install};
 257 install_package($debiandir) if $opts{install};
 258 print "Done\n";
 259 exit(0);
 260
 261 sub usage_instructions {
 262 return <<"USAGE"
 263 Usage:
 264 $0 [ --build ] [ --install ] [ SOURCE_DIR | --cpan MODULE ]
 265 $0 --refresh|-R
 266 Other options: [ --desc DESCRIPTION ] [ --arch all|any ] [ --version VERSION ]
 267                [ --depends DEPENDS ] [ --bdepends BUILD-DEPENDS ]
 268                [ --bdependsi BUILD-DEPENDS-INDEP ] [ --cpan-mirror MIRROR ]
 269                [ --exclude|-i [REGEX] ] [ --notest ] [ --nometa ]
 270                [ --requiredeps ] [ --core-ok ] [ --basepkgs PKGSLIST ]
 271                [ --closes ITPBUG ] [ --packagename|-p PACKAGENAME ]
 272                [ --email|-e EMAIL ] [ --pkg-perl ] [ --dh <ver> ]
 273 USAGE
 274 }
 275
 276 sub get_stdmodules {
 277     my ($base_packages, @modules, $paths);
 278     $base_packages = $opts{basepkgs} || 'perl,perl-base,perl-modules';
 279
 280     # We will check on all the base Perl packages for the modules they provide.
 281     # To know which files we care for, we look at @INC - In a format easy to
 282     # integrate into a regex
 283     $paths = join('|', @INC);
 284
 285     for my $pkg (split(/,/,$base_packages)) {
 286         for my $file (map {chomp;$_} `dpkg -L $pkg`) {
 287             next unless $file =~ s!^(?:$paths)[\d\.]*/(.*).pm$!$1!x;
 288
 289             $file =~ s!/!::!g;
 290             push @modules, $file;
 291         }
 292     }
 293
 294     return sort @modules;
 295 }
 296
 297 sub setup_dir {
 298         my ($dist, $mod, $cpanversion, $tarball);
 299         $mod_cpan_version = '';
 300         if ($opts{cpan}) {
 301                 my ($new_maindir);
 302                 # Is the module a core module?
 303                 if (grep(/$opts{cpan}/, @stdmodules)) {
 304                         die "$opts{cpan} is a standard module.\n"
 305                             unless $opts{'core-ok'};
 306                 }
 307
 308                 # Make CPAN happy, make the user happy: Be more tolerant!
 309                 # Accept names to be specified with double-colon, dash or slash
 310                 $opts{cpan} =~ s![/-]!::!g;
 311
 312 ###             require CPAN;
 313                 CPAN::Config->load;
 314
 315                 unshift(@{$CPAN::Config->{'urllist'}}, $opts{'cpan-mirror'})
 316                     if $opts{'cpan-mirror'};
 317
 318                 $CPAN::Config->{'build_dir'} = $ENV{'HOME'} . "/.cpan/build";
 319                 $CPAN::Config->{'cpan_home'} = $ENV{'HOME'} . "/.cpan/";
 320                 $CPAN::Config->{'histfile'}  = $ENV{'HOME'} . "/.cpan/history";
 321                 $CPAN::Config->{'keep_source_where'} = $ENV{'HOME'} . "/.cpan/source";
 322
 323                 # This modification allows to retrieve all the modules that
 324                 # match the user-provided string.
 325                 #
 326                 # expand() returns a list of matching items when called in list
 327                 # context, so after retrieving it, I try to match exactly what
 328                 # the user asked for. Specially important when there are
 329                 # different modules which only differ in case.
 330                 #
 331                 # This Closes: #451838
 332                 my @mod = CPAN::Shell->expand('Module', '/^'.$opts{cpan}.'$/')
 333                         or die "Can't find '$opts{cpan}' module on CPAN\n";
 334                 foreach(@mod) {
 335                         my $file = $_->cpan_file();
 336                         $file =~ s#.*/##; # remove directory
 337                         $file =~ s/(.*)-.*/$1/; # remove version and extension
 338                         $file =~ s/-/::/g; # convert dashes to colons
 339                         if($file eq $opts{cpan}) {
 340                                 $mod = $_;
 341                                 last;
 342                         }
 343                 }
 344                 $mod = shift @mod unless($mod);
 345                 $mod_cpan_version = $mod->cpan_version;
 346                 $cpanversion = $CPAN::VERSION;
 347                 $cpanversion =~ s/_.*//;
 348
 349                 $tarball = $CPAN::Config->{'keep_source_where'} . "/authors/id/";
 350
 351                 if ($cpanversion < 1.59) { # wild guess on the version number
 352                         $dist = $CPAN::META->instance('CPAN::Distribution', $mod->{CPAN_FILE});
 353                         $dist->get || die "Cannot get $mod->{CPAN_FILE}\n";
 354                         $tarball .= $mod->{CPAN_FILE};
 355                         $maindir = $dist->{'build_dir'};
 356                 } else {
 357                         # CPAN internals changed
 358                         $dist = $CPAN::META->instance('CPAN::Distribution', $mod->cpan_file);
 359                         $dist->get || die "Cannot get ", $mod->cpan_file, "\n";
 360                         $tarball .= $mod->cpan_file;
 361                         $maindir = $dist->dir;
 362                 }
 363
 364                 copy ($tarball, $ENV{'PWD'});
 365                 $tarball = $ENV{'PWD'} . "/" . basename($tarball);
 366                 # build_dir contains a random part since 1.88_59
 367                 # use the new CPAN::Distribution::base_id (introduced in 1.91_53)
 368                 $new_maindir = $ENV{PWD} . "/" . (
 369                         $cpanversion < 1.9153 ? basename($maindir) : $dist->base_id
 370                 );
 371                 # rename existing directory
 372                 if (-d $new_maindir && system("mv", "$new_maindir", "$new_maindir.$$") == 0) {
 373                         print '='x70,"\n";
 374                         print "Unpacked tarball already existed, directory renamed to $new_maindir.$$\n";
 375                         print '='x70,"\n";
 376                 }
 377                 system("mv", "$maindir", "$new_maindir") == 0
 378                         or die "Failed to move $maindir to $new_maindir: $!";
 379                 $maindir = $new_maindir;
 380
 381         } elsif ($opts{cpanplus}) {
 382                 die "CPANPLUS support is b0rken at the moment.";
 383 #               my ($cb, $href, $file);
 384
 385 #               eval "use CPANPLUS 0.045;";
 386 #               $cb = CPANPLUS::Backend->new(conf => {debug => 1, verbose => 1});
 387 #               $href = $cb->fetch( modules => [ $opts{cpanplus} ], fetchdir => $ENV{'PWD'});
 388 #               die "Cannot get $opts{cpanplus}\n" if keys(%$href) != 1;
 389 #               $file = (values %$href)[0];
 390 #               print $file, "\n\n";
 391 #               $maindir = $cb->extract( files => [ $file ], extractdir => $ENV{'PWD'} )->{$file};
 392         } else {
 393                 $maindir = shift(@ARGV) || '.';
 394                 $maindir =~ s/\/$//;
 395         }
 396         return $tarball;
 397 }
 398
 399 sub build_package {
 400         my $maindir = shift;
 401         # uhmf! dpkg-genchanges doesn't cope with the deb being in another dir..
 402         #system("dpkg-buildpackage -b -us -uc $opts{dbflags}") == 0
 403         system("fakeroot make -C $maindir -f debian/rules clean");
 404         system("fakeroot make -C $maindir -f debian/rules binary") == 0
 405                 || die "Cannot create deb package\n";
 406 }
 407
 408 sub install_package {
 409         my ($archspec, $debname);
 410
 411         if ($arch eq 'any') {
 412                 $archspec = `dpkg --print-architecture`;
 413                 chomp($archspec);
 414             } else {
 415                 $archspec = $arch;
 416             }
 417
 418         $debname = "${pkgname}_$version-1_$archspec.deb";
 419
 420         system("dpkg -i $startdir/$debname") == 0
 421                 || die "Cannot install package $startdir/$debname\n";
 422 }
 423
 424 sub process_meta {
 425     my ($file, $yaml);
 426     $file = shift;
 427     # Command line option nometa causes this function not to be run
 428     return {} if $opts{nometa};
 429
 430     # YAML::LoadFile has the bad habit of dying when it cannot properly parse
 431     # a file - Catch it in an eval, and if it dies, return -again- just an
 432     # empty hashref. Oh, were it not enough: It dies, but $! is not set, so we
 433     # check against $@. Crap, crap, crap :-/
 434     eval {
 435         $yaml = YAML::LoadFile($file);
 436     };
 437     if ($@) {
 438         print "Error parsing $file - Ignoring it.\n";
 439         print "Please notify module upstream maintainer.\n";
 440         $yaml = {};
 441     }
 442
 443     # Returns a simple hashref with all the keys/values defined in META.yml
 444     return $yaml;
 445 }
 446
 447 sub extract_basic_copyright {
 448         for my $f (qw(LICENSE LICENCE COPYING)) {
 449                 if (-f $f) {
 450                         return `cat $f`;
 451                 }
 452         }
 453         return undef;
 454 }
 455
 456 sub extract_basic {
 457     ($perlname, $version) = extract_name_ver();
 458     find(\&check_for_xs, $maindir);
 459     $pkgname = lc $perlname;
 460     $pkgname = 'lib'.$pkgname unless $pkgname =~ /^lib/;
 461     $pkgname .= '-perl' unless ($pkgname =~ /-perl$/ and $opts{cpan} !~ /::perl$/i);
 462
 463     # ensure policy compliant names and versions (from Joeyh)...
 464     $pkgname =~ s/[^-.+a-zA-Z0-9]+/-/g;
 465
 466     $srcname = $pkgname;
 467     $version =~ s/[^-.+a-zA-Z0-9]+/-/g;
 468     $version = "0$version" unless $version =~ /^\d/;
 469
 470     print "Found: $perlname $version ($pkgname arch=$arch)\n";
 471     $debiandir = "$maindir/debian";
 472
 473     $upsurl = "http://search.cpan.org/dist/$perlname/";
 474
 475     $copyright = extract_basic_copyright();
 476     if ($modulepm) {
 477         extract_desc($modulepm);
 478     }
 479
 480     $opts{exclude} = '^$' unless $opts{exclude};
 481     find(sub {
 482         $File::Find::name !~ /$opts{exclude}/ &&
 483             /\.(pm|pod)$/ &&
 484             extract_desc($_);
 485     }, $maindir);
 486
 487     return ($pkgname, $version);
 488 }
 489
 490 sub makefile_pl {
 491     return "$maindir/Makefile.PL";
 492 }
 493
 494 sub findbin_fix {
 495     # FindBin requires to know the name of the invoker - and requires it to be
 496     # Makefile.PL to function properly :-/
 497     $0 = makefile_pl();
 498     if (exists $FindBin::{Bin}) {
 499         FindBin::again();
 500     }
 501 }
 502
 503 sub extract_name_ver {
 504         my ($name, $ver, $makefile);
 505         $makefile = makefile_pl();
 506
 507         if (defined $meta->{name} and defined $meta->{version}) {
 508             $name = $meta->{name};
 509             $ver = $meta->{version};
 510
 511         } else {
 512             ($name, $ver) = extract_name_ver_from_makefile($makefile);
 513         }
 514
 515         $name =~ s/::/-/g;
 516         return ($name, $ver);
 517 }
 518
 519 sub extract_name_ver_from_makefile {
 520         my ($file, $name, $ver, $vfrom, $dir, $makefile);
 521         $makefile = shift;
 522
 523         {
 524             local $/ = undef;
 525             my $fh = _file_r($makefile);
 526             $file = $fh->getline;
 527         }
 528
 529         # Replace q[quotes] by "quotes"
 530         $file =~ s/q\[(.+)]/'$1'/g;
 531
 532         # Get the name
 533         if ($file =~ /([\'\"]?)
 534             DISTNAME\1\s*
 535             (=>|,)
 536             \s*
 537             ([\'\"]?)
 538             (\S+)\3/xs) {
 539             # Regular MakeMaker
 540             $name = $4;
 541         } elsif ($file =~ /([\'\"]?)
 542                  NAME\1\s*
 543                  (=>|,)
 544                  \s*
 545                  ([\'\"]?)
 546                  (\S+)\3/xs) {
 547             # Regular MakeMaker
 548             $name = $4;
 549         } elsif ($file =~ /name
 550                  \s*
 551                  \(
 552                      ([\'\"]?)
 553                          (\S+)
 554                      \1
 555                  \);/xs) {
 556             # Module::Install syntax
 557             $name = $2;
 558         }
 559         $name =~ s/,.*$//;
 560         # band aid: need to find a solution also for build in directories
 561         # warn "name is $name (cpan name: $opts{cpan})\n";
 562         $name = $opts{cpan} if ($name eq '__PACKAGE__' && $opts{cpan});
 563         $name = $opts{cpanplus} if ($name eq '__PACKAGE__' && $opts{cpanplus});
 564
 565         # Get the version
 566         if (defined $opts{version}) {
 567             # Explicitly specified
 568             $ver = $opts{version};
 569
 570         } elsif ($file =~ /([\'\"]?)VERSION\1\s*(=>|,)\s*([\'\"]?)(\S+)\3/s) {
 571             # Regular MakeMaker
 572             $ver = $4;
 573             # Where is the version taken from?
 574             $vfrom = $4 if
 575                 $file =~ /([\'\"]?)VERSION_FROM\1\s*(=>|,)\s*([\'\"]?)(\S+)\3/s;
 576
 577         } elsif ($file =~ /([\'\"]?)VERSION_FROM\1\s*(=>|,)\s*([\'\"]?)(\S+)\3/s) {
 578             # Regular MakeMaker pointing to where the version is taken from
 579             $vfrom = $4;
 580
 581         } elsif ($file =~ /version\((\S+)\)/s) {
 582             # Module::Install
 583             $ver = $1;
 584         }
 585
 586         $dir = dirname($makefile) || './';
 587
 588         $modulepm = "$dir/$vfrom" if defined $vfrom;
 589
 590         for (($name, $ver)) {
 591                 next unless defined;
 592                 next unless /^\$/;
 593                 # decode simple vars
 594                 s/(\$\w+).*/$1/;
 595                 if ($file =~ /\Q$_\E\s*=\s*([\'\"]?)(\S+)\1\s*;/) {
 596                         $_ = $2;
 597                 }
 598         }
 599
 600         unless (defined $ver) {
 601             local $/ = "\n";
 602             # apply the method used by makemaker
 603             if (defined $dir and defined $vfrom and -f "$dir/$vfrom"
 604                 and -r "$dir/$vfrom") {
 605                 my $fh = _file_r("$dir/$vfrom");
 606                 while (my $lin = $fh->getline) {
 607                     if ($lin =~ /([\$*])(([\w\:\']*)\bVERSION)\b.*\=/) {
 608                         no strict;
 609                         #warn "ver: $lin";
 610                         $ver = (eval $lin)[0];
 611                         last;
 612                     }
 613                 }
 614                 $fh->close;
 615             } else {
 616                 if ( $mod_cpan_version ) {
 617                     $ver = $mod_cpan_version;
 618                     warn "Cannot use internal module data to gather the ".
 619                         "version; using cpan_version\n";
 620                 } else {
 621                     die "Cannot use internal module data to gather the ".
 622                         "version; use --cpan or --version\n";
 623                 }
 624             }
 625         }
 626
 627         return ($name, $ver);
 628 }
 629
 630 sub extract_desc {
 631         my ($file, $parser);
 632         $file = shift;
 633         $parser = new MyPod;
 634         return unless -f $file;
 635         $parser->set_names(qw(NAME DESCRIPTION DETAILS COPYRIGHT AUTHOR AUTHORS));
 636         $parser->parse_from_file($file);
 637         if ($desc) {
 638             # No-op - We already have it, probably from the command line
 639
 640         } elsif ($meta->{abstract}) {
 641             # Get it from META.yml
 642             $desc = $meta->{abstract};
 643
 644         } elsif (my $my_desc = $parser->get('NAME')) {
 645             # Parse it, fix it, send it!
 646             $my_desc =~ s/^\s*\S+\s+-\s+//s;
 647             $my_desc =~ s/^\s+//s;
 648             $my_desc =~ s/\s+$//s;
 649             $my_desc =~ s/^([^\s])/ $1/mg;
 650             $my_desc =~ s/\n.*$//s;
 651             $desc = $my_desc;
 652         }
 653         # Replace linefeeds (not followed by a space) in $desc with spaces
 654         $desc =~ s/\n(?=\S)/ /gs;
 655
 656         unless ($longdesc) {
 657                 $longdesc = $parser->get('DESCRIPTION')
 658                         || $parser->get('DETAILS')
 659                         || $desc;
 660         }
 661         if (defined $longdesc && $longdesc !~ /^$/) {
 662                 $longdesc =~ s/^\s+//s;
 663                 $longdesc =~ s/\s+$//s;
 664                 $longdesc =~ s/^\t/ /mg;
 665                 $longdesc =~ s/^\s*$/ ./mg;
 666                 $longdesc =~ s/^\s*/ /mg;
 667                 $longdesc =~ s/^([^\s])/ $1/mg;
 668                 $longdesc =~ s/\r//g;
 669         }
 670
 671         $copyright = $copyright || $parser->get('COPYRIGHT');
 672         if (!$author) {
 673             if (ref $meta->{author}) {
 674                 # Does the author information appear in META.yml?
 675                 $author = join(', ', @{$meta->{author}});
 676             } else {
 677                 # Get it from the POD
 678                 $author = $parser->get('AUTHOR') || $parser->get('AUTHORS');
 679             }
 680         }
 681
 682         $parser->cleanup;
 683 }
 684
 685 sub extract_changelog {
 686         my ($dir) = shift;
 687         $dir .= '/' unless $dir =~ m(/$);
 688         find(sub {
 689                 $changelog = substr($File::Find::name, length($dir))
 690                         if (!defined($changelog) && /^change(s|log)$/i and (! $opts{exclude} or $File::Find::name !~ /$opts{exclude}/));
 691         }, $dir);
 692 }
 693
 694 sub extract_docs {
 695         my ($dir) = shift;
 696         $dir .= '/' unless $dir =~ m(/$);
 697         find(sub {
 698                 push (@docs, substr($File::Find::name, length($dir)))
 699                         if (/^(README|TODO|BUGS|NEWS|ANNOUNCE)/i and (! $opts{exclude} or $File::Find::name !~ /$opts{exclude}/)) ;
 700         }, $dir);
 701 }
 702
 703 sub extract_examples {
 704         my ($dir) = shift;
 705         $dir .= '/' unless $dir =~ m(/$);
 706         find(sub {
 707                 push (@examples, substr($File::Find::name, length($dir)) . '/*')
 708                         if (/^(examples|eg|samples?)$/i and (! $opts{exclude} or $File::Find::name !~ /$opts{exclude}/)) ;
 709         }, $dir);
 710 }
 711
 712 sub run_depends {
 713     my ($depends_module, $dir) = @_;
 714
 715     no warnings;
 716     local *STDERR;
 717     open(STDERR, ">/dev/null");
 718     my $mod_dep = $depends_module->new();
 719
 720     $mod_dep->dist_dir( $dir );
 721     $mod_dep->find_modules();
 722
 723     my %dep_hash = %{$mod_dep->requires};
 724
 725     my $error = $mod_dep->error();
 726     die "Error: $error\n" if $error;
 727     return %dep_hash;
 728 }
 729
 730 sub extract_depends {
 731     my $dir = shift;
 732     my $meta = shift;
 733     my (%dep_hash, @uses, @deps, @not_debs, $has_apt_file);
 734     local @INC = ($dir, @INC);
 735
 736     $dir .= '/' unless $dir =~ m/\/$/;
 737
 738     # try Module::Depends::Intrusive, but if that fails then
 739     # fall back to Module::Depends.
 740
 741     eval {
 742         %dep_hash = run_depends('Module::Depends::Intrusive',$dir);
 743     };
 744     if ($@) {
 745         warn '='x70,"\n";
 746         warn "First attempt (Module::Depends::Intrusive) at a dependency\n" .
 747         "check failed. Possible use of Module::Install ?\n" .
 748         "Trying again with Module::Depends ... \n";
 749         warn '='x70,"\n";
 750
 751         eval {
 752             %dep_hash = run_depends('Module::Depends',$dir);
 753         };
 754
 755         if ($@) {
 756             warn '='x70,"\n";
 757             warn "Could not find the dependencies for the requested module.\n";
 758             warn "Generated error: $@";
 759
 760             warn "Please check if your module depends on Module::Install\n" .
 761             "for its build process - Automatically finding its\n" .
 762             "dependencies is unsupported, please specify them manually\n" .
 763             "using the 'depends' option. \n";
 764             warn "Alternatively, including a META.yml file with dependencies\n" .
 765             "should allow discovery even for Module::Install modules. \n";
 766             warn '='x70,"\n";
 767
 768             exit 1;
 769         }
 770     }
 771
 772         foreach my $module (keys( %dep_hash )) {
 773                 next if (grep ( /^$module$/, @stdmodules));
 774
 775                 push @uses, $module;
 776         }
 777
 778         if (`which apt-file`) {
 779             $has_apt_file = 1;
 780             foreach my $module (@uses) {
 781                 my (@rawsearch, @search, $ls, $ver, $re, $mod);
 782
 783                 if ($module eq 'perl') {
 784                     substitute_perl_dependency($dep_hash{perl});
 785                     next;
 786                 }
 787
 788                 $mod = $module;
 789                 print "Searching for package containing $module using apt-file.\n";
 790                 $module =~ s|::|/|g;
 791
 792                 # Regex's to search the return of apt-file to find the right pkg
 793                 $ls  = '(?:lib|share)';
 794                 $ver = '\d+(\.\d+)+';
 795                 $re  = "usr/(?:$ls/perl/$ver|$ls/perl5)/$module\\.pm";
 796
 797                 @rawsearch = `apt-file search -x '$re'`;
 798
 799                 # rank non -perl packages lower
 800                 @search = sort {
 801                         if ($a !~ /-perl: /)    { return 1; }
 802                         elsif ($b !~ /-perl: /) { return -1; }
 803                         else                    { return $a cmp $b; } # or 0?
 804                 } @rawsearch;
 805
 806                 for (@search) {
 807                     # apt-file output
 808                     # package-name: path/to/perl/module.pm
 809                     chomp;
 810                     my ($p, $f) = split / /, $_;
 811                     chop($p); #Get rid of the ":"
 812                     if ($f =~ /$re/ && !
 813                         grep { $_ eq $p } @deps, split(/,/,@stdmodules)) {
 814                         if (exists $dep_hash{$mod}) {
 815                             my $v = $dep_hash{$mod};
 816                             $v =~ s/^v//;   # strip leading 'v' from version
 817                             push @deps, {name=>$p,
 818                                          version=>$v};
 819                         } else {
 820                             push @deps, {name => $p};
 821                         }
 822                         last;
 823                     }
 824                 }
 825
 826                 unless (@search) {
 827                     $module =~ s|/|::|g;
 828                     push @not_debs, $module;
 829                 }
 830             }
 831         } elsif ( $opts{requiredeps} ) {
 832             die "--requiredeps was specified, but apt-file was not found\n";
 833         }
 834
 835         print "\n";
 836         print "Needs the following debian packages: " .
 837             join (", ", map {$_->{name}} @deps) . "\n" if (@deps);
 838         if (@not_debs) {
 839             my ($missing_debs_str);
 840             if ($has_apt_file) {
 841                 $missing_debs_str = join("\n", "Needs the following modules for which there are no debian packages available",
 842                                          map({" - $_"} @not_debs), '');
 843             } else {
 844                 $missing_debs_str = join("\n", "The following Perl modules are required and not installed in your system:",
 845                                          map({" - $_"} @not_debs),
 846                                          "You do not have 'apt-file' currently installed - If you install it, I will",
 847                                          "be able to tell you which Debian packages are those modules in (if they are",
 848                                          "packaged).");
 849             }
 850
 851             if ( $opts{requiredeps} ) {
 852                 die $missing_debs_str;
 853             } else {
 854                 print $missing_debs_str;
 855             }
 856
 857         }
 858
 859         return join (", ", map { $_->{version} ?
 860                                      $_->{name} ." (>= ". $_->{version} .")" :
 861                                      $_->{name} } @deps);
 862 }
 863
 864 sub get_itp {
 865     use WWW::Mechanize;
 866
 867     my ($package) = shift @_;
 868
 869     my $wnpp = "http://bugs.debian.org/cgi-bin/pkgreport.cgi?pkg=wnpp;includesubj=ITP: $package";
 870     my $mech = WWW::Mechanize->new();
 871
 872     $mech->get($wnpp);
 873
 874     my @links = $mech->links();
 875
 876     foreach my $link (@links) {
 877         my $desc = $link->text();
 878
 879         return $1 if $desc =~ /^#(\d+): ITP: $package /;
 880     }
 881     return 0;
 882 }
 883
 884 sub substitute_perl_dependency {
 885     # If we get 'perl' specified in here, the module requires a
 886     # specific version of Perl in order to be run. This is only
 887     # reliable if we have ${perl:Depends} in $depends and either
 888     # of $bdepends and $bdependsi - Warn otherwise.
 889     my ($version, $dep_str, $old_dep_str, $old_bdep_str);
 890     $version = shift;
 891
 892     # Over-escaping? I'm putting this in variables to get a bit more clarity.
 893     # Remember they will be fed into the regex engine.
 894     $dep_str = "perl (>= $version)";
 895     $old_dep_str = '\\$\\{perl:Depends\\}';
 896     $old_bdep_str = "perl \\(>= $min_perl_version\\)";
 897
 898     unless ($depends =~ s/$old_dep_str/$dep_str/ and
 899             ($bdepends =~ s/$old_bdep_str/$dep_str/ or
 900              $bdependsi =~ s/$old_bdep_str/$dep_str/)) {
 901         warn "The module requires Perl version $version, but you have ",
 902         "apparently overriden the default dependency handling.\n",
 903         "Please note that you might need to manually edit your debian/control ",
 904         "- It might not make sense at all!\n";
 905     }
 906 }
 907
 908 sub check_for_xs {
 909         (! $opts{exclude} or $File::Find::name !~ /$opts{exclude}/) && /\.(xs|c|cpp|cxx)$/i && do {
 910                 $arch = 'any';
 911         };
 912 }
 913
 914 sub fix_rules  {
 915         my ($rules_file, $changelog_file, $docs, $examples, $test_line, $fh, @content);
 916         ($rules_file, $changelog_file, $docs, $examples) = @_;
 917
 918         if( $opts{dh} < 7 )
 919         {
 920             $test_line = ($module_build eq 'Module-Build') ?
 921                 '$(PERL) Build test' : '$(MAKE) test';
 922             $test_line = "#$test_line" if $opts{notest};
 923
 924             $fh = _file_rw($rules_file);
 925             @content = $fh->getlines;
 926
 927             $fh->seek(0, 0) || die "Can't rewind $rules_file: $!";
 928             $fh->truncate(0)|| die "Can't truncate $rules_file: $!";
 929             for (@content) {
 930                 s/#CHANGES#/$changelog_file/g;
 931                 s/#EXAMPLES#/join " ", @examples/eg;
 932                 s/\s+dh_installexamples\s+$//g; # no need for empty dh_installexamples
 933                     s/#DOCS#/join " ", @docs/eg;
 934                 s/#TEST#/$test_line/g;
 935                 $fh->print($_);
 936             }
 937             $fh->close;
 938         }
 939         else
 940         {
 941             if( @examples )
 942             {
 943                 open F, '>>', "$maindir/debian/$pkgname.examples" or die $!;
 944                 print F "$_\n" foreach @examples;
 945                 close F;
 946             }
 947             if( @docs )
 948             {
 949                 open F, '>>', "$maindir/debian/$pkgname.docs" or die $!;
 950                 print F "$_\n" foreach @docs;
 951                 close F;
 952             }
 953         }
 954 }
 955
 956 sub create_control {
 957         my $fh = _file_w(shift);
 958
 959         if ($arch ne 'all' and
 960             !defined($opts{bdepends}) and !defined($opts{bdependsi})) {
 961             $bdepends .= ", $bdependsi";
 962             $bdependsi = '';
 963         }
 964
 965         $fh->print("Source: $srcname\n");
 966         $fh->print("Section: $section\n");
 967         $fh->print("Priority: $priority\n");
 968         $fh->print("Build-Depends: $bdepends\n") if $bdepends;
 969         $fh->print("Build-Depends-Indep: $bdependsi\n") if $bdependsi;
 970         $fh->print($extrasfields) if defined $extrasfields;
 971         if( $opts{'pkg-perl'} )
 972         {
 973             $fh->print("Maintainer: Debian Perl Group <pkg-perl-maintainers\@lists.alioth.debian.org>\n");
 974             $fh->print("Uploaders: $maintainer\n");
 975         }
 976         else
 977         {
 978             $fh->print("Maintainer: $maintainer\n");
 979         }
 980         $fh->print("Standards-Version: $debstdversion\n");
 981         $fh->print("Homepage: $upsurl\n") if $upsurl;
 982         do {
 983             $fh->print("Vcs-Svn: svn://svn.debian.org/pkg-perl/trunk/$srcname/\n");
 984             $fh->print("Vcs-Browser: http://svn.debian.org/wsvn/pkg-perl/trunk/$srcname/\n");
 985         } if $opts{'pkg-perl'};
 986         $fh->print("\n");
 987         $fh->print("Package: $pkgname\n");
 988         $fh->print("Architecture: $arch\n");
 989         $fh->print("Depends: $depends\n") if $depends;
 990         $fh->print($extrapfields) if defined $extrapfields;
 991         $fh->print("Description: $desc\n$longdesc\n .\n This description was automagically extracted from the module by dh-make-perl.\n");
 992         $fh->close;
 993 }
 994
 995 sub create_changelog {
 996         my $fh = _file_w(shift);
 997         my $bug = shift;
 998
 999         my $closes = $bug ? " (Closes: #$bug)" : '';
1000
1001         $fh->print("$srcname ($pkgversion) unstable; urgency=low\n");
1002         $fh->print("\n  * Initial Release.$closes\n\n");
1003         $fh->print(" -- $maintainer  $date\n");
1004         #$fh->print("Local variables:\nmode: debian-changelog\nEnd:\n");
1005         $fh->close
1006 }
1007
1008 sub create_rules {
1009         my ($file, $rulesname, $error);
1010         ($file) = shift;
1011         $rulesname = (
1012             ($opts{dh} eq 7)
1013             ? $arch eq 'all'?'rules.dh7.noxs'          :'rules.dh7.xs'
1014             : $arch eq 'all'?"rules.$module_build.noxs":"rules.$module_build.xs"
1015         );
1016
1017         for my $source (("$homedir/$rulesname", "$datadir/$rulesname")) {
1018                 copy($source, $file) && do {
1019                         print "Using rules: $source\n";
1020                         last;
1021                 };
1022                 $error = $!;
1023         }
1024         die "Cannot copy rules file ($rulesname): $error\n" unless -e $file;
1025         chmod(0755, $file);
1026 }
1027
1028 sub create_compat {
1029         my $fh = _file_w(shift);
1030         $fh->print("$opts{dh}\n");
1031         $fh->close;
1032 }
1033
1034 sub create_copyright {
1035         my $fh = _file_w(shift);
1036         my $incomplete = '';
1037
1038         $fh->print(
1039 "This is the debian package for the $perlname module.
1040 It was created by $maintainer using dh-make-perl.
1041
1042 ");
1043         if (defined $upsurl) {
1044                 $fh->print("It was downloaded from $upsurl\n\n");
1045         } else {
1046                 $incomplete .= "No upstream URL\n";
1047         }
1048         $fh->print(
1049 "This copyright info was automatically extracted from the perl module.
1050 It may not be accurate, so you better check the module sources
1051 if you don\'t want to get into legal troubles.
1052
1053 ");
1054         if (defined $author) {
1055                 $fh->print("The upstream author is: $author.\n");
1056         } else {
1057                 $incomplete .= "No upstream author\n";
1058         }
1059
1060         if (defined($copyright)) {
1061                 $fh->print($copyright);
1062                 # Fun with regexes
1063                 if ( $copyright =~ /terms as Perl itself/i ) {
1064                     $fh->print("
1065
1066 Perl is distributed under your choice of the GNU General Public License or
1067 the Artistic License.  On Debian GNU/Linux systems, the complete text of the
1068 GNU General Public License can be found in \`/usr/share/common-licenses/GPL\'
1069 and the Artistic Licence in \`/usr/share/common-licenses/Artistic\'.
1070 ");
1071                 } elsif ( $copyright =~ /GPL/ ) {
1072                     $fh->print("
1073
1074 The full text of the GPL is available on Debian systems in
1075 /usr/share/common-licenses/GPL
1076 ");
1077                 }
1078         } else {
1079                 $incomplete .= "No licensing information\n";
1080         }
1081
1082         my $year = (localtime)[5]+1900;
1083         $fh->print("
1084
1085 The Debian packaging is (C) $year, $maintainer and
1086 is licensed under the same terms as the software itself (see above).
1087 ");
1088
1089         $fh->close;
1090
1091         if ($incomplete) {
1092             _warn_incomplete_copyright($incomplete)
1093         }
1094 }
1095
1096 sub create_readme {
1097         my $fh = _file_w(shift);
1098         $fh->print(
1099 "This is the debian package for the $perlname module.
1100 It was created by $maintainer using dh-make-perl.
1101 ");
1102         $fh->close;
1103 }
1104
1105 sub create_watch {
1106         my $fh = _file_w(shift);
1107
1108         my $version_re = 'v?(\d[\d_.-]+)\.(?:tar(?:\.gz|\.bz2)?|tgz|zip)';
1109
1110         $fh->print(
1111 "\# format version number, currently 3; this line is compulsory!
1112 version=3
1113 \# URL to the package page followed by a regex to search
1114 $upsurl   .*/$perlname-$version_re\$
1115 ");
1116         $fh->close;
1117 }
1118
1119 sub get_maintainer {
1120     my ($user, $pwnam, $email, $name, $mailh);
1121         $user = $ENV{LOGNAME} || $ENV{USER};
1122         $pwnam = getpwuid($<);
1123         die "Cannot determine current user\n" unless $pwnam;
1124         if (defined $ENV{DEBFULLNAME}) {
1125                 $name = $ENV{DEBFULLNAME};
1126         } else {
1127                 $name = $pwnam->gecos;
1128                 $name =~ s/,.*//;
1129         }
1130         $user ||= $pwnam->name;
1131         $name ||= $user;
1132         $email = shift @_ || ($ENV{DEBEMAIL} || $ENV{EMAIL});
1133         unless ($email) {
1134                 chomp($mailh = `cat /etc/mailname`);
1135                 $email = $user.'@'.$mailh;
1136         }
1137
1138         $email =~ s/^(.*)\s+<(.*)>$/$2/;
1139
1140         return "$name <$email>";
1141 }
1142
1143 sub load_overrides {
1144     eval {
1145         do "$datadir/overrides" if -f "$datadir/overrides";
1146         do "$homedir/overrides" if -f "$homedir/overrides";
1147     };
1148     if ($@) {
1149         die "Error when processing the overrides files: $@";
1150     }
1151 }
1152
1153 sub apply_overrides {
1154         my ($data, $val, $subkey);
1155
1156         ($data, $subkey) = get_override_data();
1157         return unless defined $data;
1158         $pkgname = $val if (defined($val=get_override_val($data, $subkey, 'pkgname')));
1159         $srcname = $val if (defined($val=get_override_val($data, $subkey, 'srcname')));
1160         $section = $val if (defined($val=get_override_val($data, $subkey, 'section')));
1161         $priority = $val if (defined($val=get_override_val($data, $subkey, 'priority')));
1162         $depends = $val if (defined($val=get_override_val($data, $subkey, 'depends')));
1163         $bdepends = $val if (defined($val=get_override_val($data, $subkey, 'bdepends')));
1164         $bdependsi = $val if (defined($val=get_override_val($data, $subkey, 'bdependsi')));
1165         $desc = $val if (defined($val=get_override_val($data, $subkey, 'desc')));
1166         $longdesc = $val if (defined($val=get_override_val($data, $subkey, 'longdesc')));
1167         $pkgversion = $val if (defined($val=get_override_val($data, $subkey, 'version')));
1168         $arch = $val if (defined($val=get_override_val($data, $subkey, 'arch')));
1169         $changelog = $val if (defined($val=get_override_val($data, $subkey, 'changelog')));
1170         @docs = split(/\s+/, $val) if (defined($val=get_override_val($data, $subkey, 'docs')));
1171
1172         $extrasfields = $val if (defined($val=get_override_val($data, $subkey, 'sfields')));
1173         $extrapfields = $val if (defined($val=get_override_val($data, $subkey, 'pfields')));
1174         $maintainer = $val if (defined($val=get_override_val($data, $subkey, 'maintainer')));
1175         # fix longdesc if needed
1176         $longdesc =~ s/^\s*/ /mg;
1177 }
1178
1179 sub apply_final_overrides {
1180         my ($data, $val, $subkey);
1181
1182         ($data, $subkey) = get_override_data();
1183         return unless defined $data;
1184         get_override_val($data, $subkey, 'finish');
1185 }
1186
1187 sub get_override_data {
1188         my ($data, $checkver, $subkey);
1189         $data = $overrides{$perlname};
1190
1191         return unless defined $data;
1192         die "Value of '$perlname' in overrides not a hashref\n" unless ref($data) eq 'HASH';
1193         if (defined($checkver = $data->{checkver})) {
1194                 die "checkver not a function\n" unless (ref($checkver) eq 'CODE');
1195                 $subkey = &$checkver($maindir);
1196         } else {
1197                 $subkey = $pkgversion;
1198         }
1199         return ($data, $subkey);
1200 }
1201
1202 sub get_override_val {
1203         my ($data, $subkey, $key, $val);
1204         ($data, $subkey, $key) = @_;
1205         $val = defined($data->{$subkey.$key})?$data->{$subkey.$key}:$data->{$key};
1206         return &$val() if (defined($val) && ref($val) eq 'CODE');
1207         return $val;
1208 }
1209
1210 sub _warn_incomplete_copyright {
1211     print '*'x10, '
1212 Copyright information incomplete!
1213
1214 Upstream copyright information could not be automatically determined.
1215
1216 If you are building this package for your personal use, you might disregard
1217 this information; however, if you intend to upload this package to Debian
1218 (or in general, if you plan on distributing it), you must look into the
1219 complete copyright information.
1220
1221 The causes for this warning are:
1222 ', @_;
1223 }
1224
1225 sub _file_r {
1226     my ($file, $fh);
1227     $file = shift;
1228     $fh = IO::File->new($file, 'r') or die "Cannot open $file: $!\n";
1229     return $fh;
1230 }
1231
1232 sub _file_w {
1233     my ($file, $fh);
1234     $file = shift;
1235     $fh = IO::File->new($file, 'w') or die "Cannot open $file: $!\n";
1236     return $fh;
1237 }
1238
1239 sub _file_rw {
1240     my ($file, $fh);
1241     $file = shift;
1242     $fh = IO::File->new($file, 'r+') or die "Cannot open $file: $!\n";
1243     return $fh;
1244 }
1245
1246 =head1 NAME
1247
1248 B<dh-make-perl> - Create debian source packages from perl modules
1249
1250 =head1 SYNOPSIS
1251
1252 B<dh-make-perl> [B<SOURCE_DIR> | B<--cpan> I<MODULE>]
1253
1254 B<dh-make-perl> B<--refresh>
1255
1256 You can modify B<dh-make-perl>'s behaviour with some switches:
1257
1258 =over
1259
1260 =item B<--desc> I<SHORT DESCRIPTION>
1261
1262 Uses the argument to --desc as short description for the package.
1263
1264 =item B<--arch> I<any> | I<all>
1265
1266 This switches between arch-dependent and arch-independet packages. If B<--arch>
1267 isn't used, B<dh-make-perl> uses a relatively good-working algorithms to
1268 decide this alone.
1269
1270 =item B<--version> I<VERSION>
1271
1272 Specifies the version of the resulting package.
1273
1274 =item B<--email> | B<-e> I<EMAIL>
1275
1276 Manually specify the Maintainer email address to use in debian/control and
1277 in debian/changelog.
1278
1279 =item B<--packagename> | B<-p> I<PACKAGENAME>
1280
1281 Manually specify the Package Name, useful when the module has dashes in its
1282 name.
1283
1284 =item B<--closes> I<ITPBUG>
1285
1286 Manually specify the ITP bug number that this package closes. If not
1287 given, dh-make-perl will try to connect to bugs.debian.org to fetch the
1288 appropriate bug number, using WWW::Mechanize.
1289
1290 =item B<--depends> I<DEPENDS>
1291
1292 Manually specify the string to be used for the module's dependencies. This
1293 should be used when building modules where dh-make-perl cannot guess the Perl
1294 dependencies (such as modules built using L<Module::Install>), or when the
1295 Perl code depends on non-Perl binaries or libraries. Usually, dh-make-perl
1296 will figure out the dependencies by itself. If you need to pass dh-make-perl
1297 dependency information, you must do it using the debian package format. i.e.
1298
1299 dh-make-perl --depends libtest-more-perl
1300
1301 =item B<--bdepends> I<BUILD-DEPENDS>
1302
1303 Manually specify the string to be used for the module's build-dependencies
1304 (that is, the packages and their versions that have to be installed in order to
1305 successfully build the package). Keep in mind that packages generated by
1306 dh-make-perl require debhelper to be specified as a build dependency. Same note
1307 as for --depends applies here - Use only when needed.
1308
1309 =item B<--bdependsi> I<BUILD-DEPENDS-INDEP>
1310
1311 Manually specify the string to be used for the module's build-dependencies
1312 for architecture-independent builds. Same notes as those for the --depends
1313 and --bdepends options apply here.
1314
1315 Note that for --depends, --bdepends and --bdependsi you can also specify that
1316 the field should not appear in debian/rules (if you really mean it, of course
1317 ;-) ) by giving it an empty string as an argument.
1318
1319 =item B<--pkg-perl>
1320
1321 Useful when preparing a package for the Debian Perl Group
1322 L<http://pkg-perl.alioth.debian.org>.
1323
1324 Sets C<Maintainer>, C<Uploaders>, C<Vcs-Svn> and C<Vcs-Browser> fields in
1325 debian/control accordingly.
1326
1327 =item B<--cpan-mirror> I<MIRROR>
1328
1329 Specifies a CPAN site to use as mirror.
1330
1331 =item B<--exclude> | B<-i> [I<REGEX>]
1332
1333 This allows you to specify a PCRE to exclude some files from the search for
1334 docs and stuff like that. If no argument is given (but the switch is specified
1335 - not specifying the switch will include everything), it defaults to exclude
1336 CVS and .svn directories.
1337
1338 =item B<--build>
1339
1340 Builds the package after setting it up.
1341
1342 NB: This builds only a binary package (by calling "fakeroot debian/rules
1343 binary") and does not sign the package. It is meant for a quick local
1344 install of a package, not for creating a package ready for submission to the
1345 Debian archive.
1346
1347 =item B<--install>
1348
1349 Installs the freshly built package. Specifying --install implies --build - The
1350 package will not be installed unless it was built (obviously ;-) )
1351
1352 =item B<--notest>
1353
1354 Does not run the automatic testing of the module as part of the build script.
1355 This is mostly useful when packaging buggy or incomplete software.
1356
1357 =item B<--basepkgs>
1358
1359 Explicitly gives a comma-separated list of packages to consider "base"
1360 packages (i.e. packages that should always be available in Debian
1361 systems). This option defaults to C<perl,perl-base,perl-modules> - It
1362 is used to check for module dependencies. If a needed module is in the
1363 C<basepkgs>, it won't be mentioned in the C<depends:> field of
1364 C<debian/control>.
1365
1366 If this option is specified, the above mentioned default packages will
1367 not be included (but will be mentioned as explicit dependencies in the
1368 resulting package). You can, of course, mention your own modules
1369 and explicitly specify the default values.
1370
1371 Note that this option should be used sparsingly and with care, as it
1372 might lead to packages not being rebuildable because of unfulfilled
1373 dependencies.
1374
1375 =item B<--requiredeps>
1376
1377 Fail if a dependency perl package was not found (dependency tracking
1378 requires the apt-file package installed and updated)
1379
1380 =item B<--core-ok>
1381
1382 Allows building core Perl modules. By default, dh-make-perl will not allow
1383 building a module that is shipped as part of the standard Perl library; by
1384 specifying this option, dh-make-perl will build them anyway.
1385
1386 Note that, although it is not probable, this might break unrelated items in
1387 your system - If a newer version of a core module breaks the API, all kinds
1388 of daemons might get upset ;-)
1389
1390 =item B<--refresh>
1391
1392 Refresh mode.
1393
1394 Instead of creating new debian/ directory, B<--refresh> makes B<dh-make-perl>
1395 to re-create only B<debian/rules> according to the current templates.
1396
1397 This is useful when B<debian/rules> was created using older templates and
1398 doesn't contain much customisations. As always, you're strongly encouraged to
1399 verify if B<debian/rules> looks sane.
1400
1401 =back
1402
1403 =item B<--dh ver>
1404
1405 Set desired debhelper version. If C<ver> is 7, generated debian/rules is
1406 minimalistic, using the auto-mode of debhelper. Also, any additional
1407 documentation and examples are listed in additional files under debian/, instead
1408 of being listed in debian/rules
1409
1410 =back
1411
1412 =head1 DESCRIPTION
1413
1414 B<dh-make-perl> will create the files required to build
1415 a debian source package out of a perl package.
1416 This works for most simple packages and is also useful
1417 for getting started with packaging perl modules.
1418
1419 You can specify a module name with the B<--cpan> switch
1420 and B<dh-make-perl> will download the module for you from
1421 a CPAN mirror, or you can specify the directory with the
1422 already unpacked sources. If neither --cpan nor a directory
1423 is given as argument, dh-make-perl tries to create a
1424 perl package from the data in F<.>
1425
1426 There is an override mechanism in place to handle most of
1427 the little changes that may be needed for some modules
1428 (this hasn't been tested much, though, and the override
1429 database needs to be filled in).
1430
1431 You can build and install the debian package using the --build
1432 and --install command line switches.
1433
1434 Using this program is no excuse for not reading the
1435 debian developer documentation, including the Debian policy,
1436 the perl policy, the packaging manual and so on.
1437
1438 =head1 FILES
1439
1440 The following directories will be searched to find additional files
1441 required by dh-make-perl:
1442
1443         /usr/share/dh-make-perl/
1444         $HOME/.dh-make-perl/
1445
1446 =over 4
1447
1448 =item * overrides
1449
1450 File that overrides information retreived (or guessed) about the package.
1451 All the files in the library directories are loaded: entries in the home
1452 take precedence. See the distributed overrides file for usage information.
1453
1454 =item * rules.MakeMaker.noxs
1455
1456 A debian/rules makefile for modules that use ExtUtils::MakeMaker, but don't
1457 have C/XS code.
1458
1459 =item * rules.MakeMaker.xs
1460
1461 A debian/rules makefile for modules that use ExtUtils::MakerMaker and
1462 C/XS code.
1463
1464 =item * rules.Module-Build.noxs
1465
1466 A debian/rules makefile for modules that use Module::Build, but don't have
1467 C/XS code.
1468
1469 =item * rules.Module-Build.xs
1470
1471 A debian/rules makefile for modules that use Module::Build and C/XS code.
1472
1473 =back
1474
1475 =head1 ENVIRONMENT
1476
1477 HOME - get user's home directory
1478
1479 DEBFULLNAME - get the real name of the maintainer
1480
1481 LOGNAME or USER - get the username
1482
1483 DEBEMAIL or EMAIL - get the email address of the user
1484
1485 =head1 BUGS
1486
1487 Several, let me know when you find them.
1488
1489 =head1 AUTHOR
1490
1491 Paolo Molaro E<lt>lupus@debian.orgE<gt> (MIA)
1492
1493 Maintained for a time by Ivan Kohler E<lt>ivan-debian@420.amE<gt>.
1494
1495 Maintained for a time by Marc Brockschmdit E<lt>marc@dch-faq.deE<gt>.
1496
1497 Now maintained by Gunnar Wolf E<lt>gwolf@gwolf.orgE<gt>, and team-maintained
1498 by the Debian pkg-perl team, http://alioth.debian.org/projects/pkg-perl
1499
1500 Patches from:
1501
1502 =over
1503
1504 =item Adam Sjoegren E<lt>asjo@koldfront.dkE<gt>
1505
1506 =item Adrian Phillips E<lt>adrianp@powertech.noE<gt>
1507
1508 =item Amos Shapira E<lt>amos.shapira@gmail.comE<gt>
1509
1510 =item Christian Kurz E<lt>shorty@debian.orgE<gt>
1511
1512 =item Damyan Ivanov E<lt>divanov@creditreform.bgE<gt>
1513
1514 =item David Paleino E<lt>d.paleino@gmail.comE<gt>
1515
1516 =item David Pashley E<lt>david@davidpashley.comE<gt>
1517
1518 =item Edward Betts E<lt>edward@debian.orgE<gt>
1519
1520 =item Fermin Galan E<lt>galan@dit.upm.esE<gt>
1521
1522 =item Geoff Richards E<lt>qef@ungwe.orgE<gt>
1523
1524 =item Gergely Nagy E<lt>algernon@bonehunter.rulez.orgE<gt>
1525
1526 =item gregor herrmann E<lt>gregoa@debian.orgE<gt>
1527
1528 =item Hilko Bengen E<lt>bengen@debian.orgE<gt>
1529
1530 =item Kees Cook E<lt>keex@outflux.netE<gt>
1531
1532 =item Jesper Krogh E<lt>jesper@krogh.ccE<gt>
1533
1534 =item Johnny Morano E<lt>jmorano@moretrix.comE<gt>
1535
1536 =item Juerd E<lt>juerd@ouranos.juerd.netE<gt>
1537
1538 =item Marc Chantreux (mail withheld)
1539
1540 =item Matt Hope E<lt>dopey@debian.orgE<gt>
1541
1542 =item Noel Maddy E<lt>noel@zhtwn.comE<gt>
1543
1544 =item Oliver Gorwits E<lt>oliver.gorwits@oucs.ox.ac.ukE<gt>
1545
1546 =item Peter Moerch E<lt>mn3k66i02@sneakemail.comE<gt>
1547
1548 =item Stephen Oberholtzer E<lt>oliverklozoff@gmail.comE<gt>
1549
1550 =item Ton Nijkes E<lt>tonn@wau.mis.ah.nlE<gt>
1551
1552 =back
1553
1554 ... And others who, sadly, we have forgot to add :-/
1555
1556 =cut
1557