r5379 - in /tools/dh-make-perl/trunk: debian/changelog dh-make-perl
gwolf at users.alioth.debian.org
gwolf at users.alioth.debian.org
Thu May 10 00:28:38 UTC 2007
Author: gwolf
Date: Thu May 10 00:28:34 2007
New Revision: 5379
URL: http://svn.debian.org/wsvn/?sc=1&rev=5379
Log:
Started reorganizing the flying spaghetti monster this code has become ;-)
Modified:
tools/dh-make-perl/trunk/debian/changelog
tools/dh-make-perl/trunk/dh-make-perl
Modified: tools/dh-make-perl/trunk/debian/changelog
URL: http://svn.debian.org/wsvn/tools/dh-make-perl/trunk/debian/changelog?rev=5379&op=diff
==============================================================================
--- tools/dh-make-perl/trunk/debian/changelog (original)
+++ tools/dh-make-perl/trunk/debian/changelog Thu May 10 00:28:34 2007
@@ -9,8 +9,15 @@
* Patched regex for finding the module name when unde Module::Install,
allowing for whitespace between the "name" string and the module
name. Thanks to Marc Chantreux for the patch (and the patience ;-) )
-
- -- Gunnar Wolf <gwolf at debian.org> Fri, 23 Feb 2007 18:29:34 -0600
+ * Replaced the (now deprecated) call to the external program 822-date
+ for date -R
+ * Started reorganizing the code - All bare open() calls are now
+ handled through IO::File; shuffled some functions around so the code
+ is more followable
+ * Added --core-ok option to allow building core modules (Closes:
+ #409017)
+
+ -- Gunnar Wolf <gwolf at debian.org> Wed, 09 May 2007 19:24:16 -0500
dh-make-perl (0.25) unstable; urgency=low
Modified: tools/dh-make-perl/trunk/dh-make-perl
URL: http://svn.debian.org/wsvn/tools/dh-make-perl/trunk/dh-make-perl?rev=5379&op=diff
==============================================================================
--- tools/dh-make-perl/trunk/dh-make-perl (original)
+++ tools/dh-make-perl/trunk/dh-make-perl Thu May 10 00:28:34 2007
@@ -1,22 +1,98 @@
#!/usr/bin/perl -w
+use Pod::Parser;
+use YAML;
+use IO::File;
+use File::Basename;
+use File::Find;
+use File::Copy qw(copy move);
+use User::pwent;
+use Getopt::Long;
+use Cwd;
+use Module::Depends::Intrusive;
+use strict;
# 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;
-use Pod::Parser;
-use YAML;
@MyPod::ISA = qw(Pod::Parser);
-my @pragmas = qw(attributes attrs autouse base bigint bignum
- bigrat blib bytes charnames constant
- diagnostics encoding fields filetest if
- integer less lib locale open ops overload
- re sigtrap sort strict subs threads utf8
- vars vmsish warnings warnings::register);
-
-my @stdmodules = qw(AnyDBM_File Attribute::Handlers::demo::Demo
+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 (@pragmas, @stdmodules);
+
+ at pragmas = qw(attributes attrs autouse base bigint bignum
+ bigrat blib bytes charnames constant
+ diagnostics encoding fields filetest if
+ integer less lib locale open ops overload
+ re sigtrap sort strict subs threads utf8
+ vars vmsish warnings warnings::register);
+
+ at stdmodules = qw(AnyDBM_File Attribute::Handlers::demo::Demo
Attribute::Handlers::demo::Descriptions
Attribute::Handlers::demo::MyClass Attribute::Handlers attributes
AutoLoader AutoSplit autouse base Benchmark bigint bignum bigrat blib
@@ -69,75 +145,6 @@
Unicode::Collate Unicode::UCD UNIVERSAL User::grent User::pwent utf8
vars vmsish warnings warnings::register);
-sub set_names {
- my ($parser, @names) = @_;
- foreach my $n (@names) {
- $parser->{_deb_}->{$n} = undef;
- }
-}
-
-sub get {
- my ($parser, $name) = @_;
- $parser->{_deb_}->{$name};
-}
-
-sub cleanup {
- my $parser = shift;
- delete $parser->{_current_};
- foreach my $k ( keys %{$parser->{_deb_}}) {
- $parser->{_deb_}->{$k} = undef;
- }
-}
-
-sub command {
- my ($parser, $command, $paragraph, $line_num) = @_;
- $paragraph =~ s/\s+$//s;
- if ($command =~ /head/ && exists($parser->{_deb_}->{$paragraph})) {
- $parser->{_current_} = $paragraph;
- $parser->{_lineno_} = $line_num;
- } else {
- delete $parser->{_current_};
- }
- #print "GOT: $command -> $paragraph\n";
-}
-
-sub add_text {
- my ($parser, $paragraph, $line_num) = @_;
- return unless exists $parser->{_current_};
- return if ($line_num - $parser->{_lineno_} > 15);
- $paragraph =~ s/^\s+//s;
- $paragraph =~ s/\s+$//s;
- $paragraph = $parser->interpolate($paragraph, $line_num);
- $parser->{_deb_}->{$parser->{_current_}} .= "\n\n".$paragraph;
- #print "GOTT: $paragraph'\n";
-}
-
-sub verbatim { shift->add_text(@_)}
-
-sub textblock { shift->add_text(@_)}
-
-sub interior_sequence {
- my ($parser, $seq_command, $seq_argument) = @_;
- if ($seq_command eq 'E') {
- my %map = ('gt' => '>', 'lt' => '<', 'sol' => '/', 'verbar' => '|');
- return $map{$seq_argument} if exists $map{$seq_argument};
- return chr($seq_argument) if ($seq_argument =~ /^\d+$/);
- # html names...
- }
- return $seq_argument;
-}
-
-package main;
-
-use File::Basename;
-use File::Find;
-use File::Copy qw(copy move);
-use User::pwent;
-use Getopt::Long;
-use Cwd;
-use Module::Depends::Intrusive;
-use strict;
-
my $perl_pkg = get_perl_pkg_details();
my $debstdversion = '3.7.2';
@@ -148,7 +155,7 @@
my $bdepends = 'debhelper (>= 5.0.0)';
my $maintainer = get_maintainer();
my $arch = 'all';
-my $date = `822-date`;
+my $date = `date -R`;
my $debiandir;
my $startdir = getcwd();
my $dh_compat = 5;
@@ -166,9 +173,9 @@
$desc, $longdesc, $copyright, $author);
my ($extrasfields, $extrapfields);
my (@docs, $changelog, @args);
-my ($cpanmodule, $cpanplusmodule, $cpanmirror, $build, $install, $dbflags,
- $excludeRE, $notest, $nometa, $requiredeps, $user_depends, $user_bdepends,
- $user_bdependsi);
+my ($core_ok, $cpanmodule, $cpanplusmodule, $cpanmirror, $build, $install,
+ $dbflags, $excludeRE, $notest, $nometa, $requiredeps, $user_depends,
+ $user_bdepends, $user_bdependsi);
my $mod_cpan_version;
@@ -176,6 +183,7 @@
chomp($date);
GetOptions(
+ "core-ok" => \$core_ok,
"cpan=s" => \$cpanmodule,
# "cpanplus=s" => \$cpanplusmodule,
"cpan-mirror=s" => \$cpanmirror,
@@ -201,7 +209,7 @@
[ --depends DEPENDS ] [ --bdepends BUILD-DEPENDS ]
[ --bdependsi BUILD-DEPENDS-INDEP ] [ --cpan-mirror MIRROR ]
[ --exclude|-i [REGEX] ] [ --notest ] [ --nometa ]
- [ --requiredeps ]
+ [ --requiredeps ] [ --core-ok ]
USAGE
$excludeRE = '(?:\/|^)(?:CVS|.svn)\/' if (defined $excludeRE &&
@@ -272,11 +280,12 @@
my ($dist, $mod, $cpanversion, $tarball);
$mod_cpan_version = '';
if ($cpanmodule) {
- # Is the module a core module
- if ((grep(/$cpanmodule/, @pragmas)) ||
- (grep(/$cpanmodule/, @stdmodules))) {
- die "$cpanmodule is a standard module.\n";
- }
+ my ($new_maindir);
+ # Is the module a core module
+ if ((grep(/$cpanmodule/, @pragmas)) ||
+ (grep(/$cpanmodule/, @stdmodules))) {
+ die "$cpanmodule is a standard module.\n" unless $core_ok;
+ }
require CPAN;
CPAN::Config->load;
@@ -311,7 +320,7 @@
copy ($tarball, $ENV{'PWD'});
$tarball = $ENV{'PWD'} . "/" . basename($tarball);
- my $new_maindir = $ENV{PWD}."/".basename($maindir);
+ $new_maindir = $ENV{PWD}."/".basename($maindir);
`mv "$maindir" "$new_maindir"`;
$maindir = $new_maindir;
@@ -343,13 +352,17 @@
}
sub install_package {
- my $archspec = $arch;
- my $debname;
+ my ($archspec, $debname);
+
if ($arch eq 'any') {
$archspec = `dpkg --print-architecture`;
chomp($archspec);
- }
+ } else {
+ $archspec = $arch;
+ }
+
$debname = "${pkgname}_$version-1_$archspec.deb";
+
system("dpkg -i $startdir/$debname") == 0
|| die "Cannot install package $startdir/$debname\n";
}
@@ -450,10 +463,12 @@
sub extract_name_ver_from_makefile {
my ($file, $name, $ver, $vfrom, $dir, $makefile);
$makefile = shift;
- local $/ = undef;
- open (MF, "<$makefile") || die "Cannot open $makefile: $!\n";
- $file = <MF>;
- close(MF);
+
+ {
+ local $/ = undef;
+ my $fh = _file_r($makefile);
+ $file = $fh->getline;
+ }
# Get the name
if ($file =~ /([\'\"]?)
@@ -527,16 +542,17 @@
local $/ = "\n";
# apply the method used by makemaker
if (defined $dir and defined $vfrom and -f "$dir/$vfrom"
- and open(MF, "<$dir/$vfrom") ) {
- while (<MF>) {
- if (/([\$*])(([\w\:\']*)\bVERSION)\b.*\=/) {
+ and -r "$dir/$vfrom") {
+ my $fh = _file_r("$dir/$vfrom");
+ while (my $lin = $fh->getline) {
+ if ($lin =~ /([\$*])(([\w\:\']*)\bVERSION)\b.*\=/) {
no strict;
- #warn "ver: $_";
- $ver = (eval $_)[0];
+ #warn "ver: $lin";
+ $ver = (eval $lin)[0];
last;
}
}
- close(MF);
+ $fh->close;
} else {
if ( $mod_cpan_version ) {
$ver = $mod_cpan_version;
@@ -635,10 +651,11 @@
### Mental note to self: It'd be worth it to fall back to
### Module:::Depends and _only_ then fail
eval {
+ my $mod_dep;
no warnings;
local *STDERR;
open(STDERR, ">/dev/null");
- my $mod_dep = Module::Depends::Intrusive->new();
+ $mod_dep = Module::Depends::Intrusive->new();
$mod_dep->dist_dir( $dir );
$mod_dep->find_modules();
@@ -735,28 +752,29 @@
}
sub fix_rules {
- my ($rules_file, $changelog_file, @docs, $test_line, @content);
+ 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 $notest;
- open (FH, "+<$rules_file") || die "Can't open $rules_file: $!";
- @content = <FH>;
- seek(FH, 0, 0) || die "Can't rewind $rules_file: $!";
- truncate(FH, 0)|| die "Can't truncate $rules_file: $!";
+ $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;
- print FH $_;
- }
- close FH;
+ $fh->print($_);
+ }
+ $fh->close;
}
sub create_control {
- my ($file) = shift;
+ my $fh = _file_w(shift);
if ($arch ne 'all' and
!defined($user_bdepends) and !defined($user_bdependsi)) {
@@ -764,39 +782,36 @@
$bdependsi = '';
}
- open(C, ">$file") || die "Cannot open $file: $!\n";
- print C "Source: $srcname\n";
- print C "Section: $section\n";
- print C "Priority: $priority\n";
- print C "Build-Depends: $bdepends\n" if $bdepends;
- print C "Build-Depends-Indep: $bdependsi\n" if $bdependsi;
- print C $extrasfields if defined $extrasfields;
- print C "Maintainer: $maintainer\n";
- print C "Standards-Version: $debstdversion\n";
- print C "\n";
- print C "Package: $pkgname\n";
- print C "Architecture: $arch\n";
- print C "Depends: $depends\n" if $depends;
- print C $extrapfields if defined $extrapfields;
- print C "Description: $desc\n$longdesc\n .\n This description was automagically extracted from the module by dh-make-perl.\n";
- close(C);
+ $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;
+ $fh->print("Maintainer: $maintainer\n");
+ $fh->print("Standards-Version: $debstdversion\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 description was automagically extracted from the module by dh-make-perl.\n");
+ $fh->close;
}
sub create_changelog {
- my ($file) = shift;
- open(C, ">$file") || die "Cannot open $file: $!\n";
- print C "$srcname ($pkgversion) unstable; urgency=low\n";
- print C "\n * Initial Release.\n\n";
- print C " -- $maintainer $date\n";
- #print C "Local variables:\nmode: debian-changelog\nEnd:\n";
- close(C);
+ my $fh = _file_w(shift);
+ $fh->print("$srcname ($pkgversion) unstable; urgency=low\n");
+ $fh->print("\n * Initial Release.\n\n");
+ $fh->print(" -- $maintainer $date\n");
+ #$fh->print("Local variables:\nmode: debian-changelog\nEnd:\n");
+ $fh->close
}
sub create_rules {
- my ($file, $rulesname);
+ my ($file, $rulesname, $error);
($file) = shift;
$rulesname = $arch eq 'all'?"rules.$module_build.noxs":"rules.$module_build.xs";
- my $error;
for my $source (("$homedir/$rulesname", "$datadir/$rulesname")) {
copy($source, $file) && do {
@@ -810,67 +825,71 @@
}
sub create_compat {
- my $file = shift;
- open(COMPAT, ">$file") or die "Can't open $file: $!\n";
- print COMPAT "$dh_compat\n";
- close COMPAT;
+ my $fh = _file_w(shift);
+ $fh->print("$dh_compat\n");
+ $fh->close;
}
sub create_copyright {
- my ($file) = shift;
- open(C, ">$file") || die "Cannot open $file: $!\n";
- print C <<"EOF";
-This is the debian package for the $perlname module.
+ 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.
This copyright info was automatically extracted from the perl module.
It may not be accurate, so you better check the module sources
if don\'t want to get into legal troubles.
-EOF
+");
if (defined $author) {
- print C "The upstream author is: $author.\n";
+ $fh->print("The upstream author is: $author.\n");
}
if (defined($copyright)) {
- print C $copyright;
+ $fh->print($copyright);
# Fun with regexes
if ( $copyright =~ /terms as Perl itself/i ) {
- print C "\n\n", <<END;
+ $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\'.
-END
+");
} elsif ( $copyright =~ /GPL/ ) {
- print C "\n\n", <<END;
+ $fh->print("
+
The full text of the GPL is available on Debian systems in
/usr/share/common-licenses/GPL
-END
+");
}
}
- close(C);
+ $fh->close;
}
sub create_readme {
- my ($file) = shift;
- open(C, ">$file") || die "Cannot open $file: $!\n";
- print C "This is the debian package for the $perlname module.\n";
- print C "It was created by $maintainer using dh-make-perl.\n";
- close(C);
+ 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 ($file, $perl_path_name) = @_;
- open(C, ">$file") || die "Cannot open $file: $!\n";
+ my ($fh, $perl_path_name);
+ $fh = _file_w(shift);
+ $perl_path_name = shift;
$perl_path_name =~ s|::|-|g;
$perl_path_name =~ s|(\w+)(-.*)|$1/$1$2|;
$perl_path_name .= "-(.*)\.(tar\.gz|tar|tgz)";
- print C "\# format version number, currently 2; this line is compulsory!\n";
- print C "version=2\n";
- print C "http://www.cpan.org/modules/by-module/$perl_path_name\n";
- close(C);
+ $fh->print(
+"\# format version number, currently 2; this line is compulsory!
+version=2
+http://www.cpan.org/modules/by-module/$perl_path_name
+");
+ $fh->close;
}
sub get_maintainer {
@@ -964,6 +983,27 @@
return $val;
}
+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
@@ -1045,6 +1085,16 @@
Fail if a dependency perl package was not found (dependency tracking
requires the apt-file package installed and updated)
+
+=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 ;-)
=back
@@ -1133,7 +1183,8 @@
Maintained for a time by Marc Brockschmdit E<lt>marc at dch-faq.deE<gt>.
-Now maintained by Gunnar Wolf E<lt>gwolf at gwolf.orgE<gt>.
+Now maintained by Gunnar Wolf E<lt>gwolf at gwolf.orgE<gt>, and team-maintained
+by the Debian pkg-perl team, http://alioth.debian.org/projects/pkg-perl
Patches from:
@@ -1148,9 +1199,11 @@
Geoff Richards E<lt>qef at ungwe.orgE<gt>
Gergely Nagy E<lt>algernon at bonehunter.rulez.orgE<gt>
Hilko Bengen E<lt>bengen at debian.orgE<gt>
+ Kees Cook E<lt>keex at outflux.netE<gt>
Jesper Krogh E<lt>jesper at krogh.ccE<gt>
Johnny Morano E<lt>jmorano at moretrix.comE<gt>
Juerd E<lt>juerd at ouranos.juerd.netE<gt>
+ Marc Chantreux (mail withheld)
Matt Hope E<lt>dopey at debian.orgE<gt>
Noel Maddy E<lt>noel at zhtwn.comE<gt>
Peter Moerch E<lt>mn3k66i02 at sneakemail.comE<gt>
More information about the Pkg-perl-cvs-commits
mailing list