rev 10034 - scripts
Modestas Vainius
modax-guest at alioth.debian.org
Sun Apr 6 17:31:04 UTC 2008
Author: modax-guest
Date: 2008-04-06 17:31:03 +0000 (Sun, 06 Apr 2008)
New Revision: 10034
Modified:
scripts/dh_installgen
Log:
* Support *.manpages (autoremoval only)
* Support sorting
* Support custom command line arguments
* Support validation/test mode for *.installgen development
Modified: scripts/dh_installgen
===================================================================
--- scripts/dh_installgen 2008-04-06 17:03:49 UTC (rev 10033)
+++ scripts/dh_installgen 2008-04-06 17:31:03 UTC (rev 10034)
@@ -8,8 +8,10 @@
use strict;
use File::Find;
+use File::Temp ':mktemp';
use Debian::Debhelper::Dh_Lib;
+use Getopt::Long;
=head1 SYNOPSIS
@@ -97,7 +99,7 @@
=cut
-package DH::AI::File;
+package DH::InstGen::File;
our %builddir_cache = (
builddir => "",
@@ -121,7 +123,7 @@
return;
}
$cache{$key} = [] unless exists $cache{$key};
- push @{$cache{$key}}, new DH::AI::File($_);
+ push @{$cache{$key}}, new DH::InstGen::File($_);
}, no_chdir => 1 }, $builddir);
$builddir_cache{'builddir'} = $builddir;
$builddir_cache{'cache'} = \%cache;
@@ -252,7 +254,7 @@
if (!($self->{src} = $self->locate_in_cache($cache))) {
my $path = $self->get_path();
if (-f $path) {
- my $new_file = new DH::AI::File($path);
+ my $new_file = new DH::InstGen::File($path);
$self->{src} = $new_file->locate_in_cache($cache);
}
}
@@ -289,7 +291,7 @@
}
###############################################################################
-package DH::AI::Installed;
+package DH::InstGen::Installed;
sub new {
my $cls = shift;
@@ -337,7 +339,7 @@
###############################################################################
-package DH::AI::Pattern::Common;
+package DH::InstGen::Pattern::Common;
sub new {
my ($cls, $negated, $val) = @_;
@@ -362,11 +364,11 @@
return defined shift()->{value};
}
-package DH::AI::Pattern::Src;
-our @ISA = qw( DH::AI::Pattern::Common );
+package DH::InstGen::Pattern::Src;
+our @ISA = qw( DH::InstGen::Pattern::Common );
sub new {
- my $self = DH::AI::Pattern::Common::new(@_);
+ my $self = DH::InstGen::Pattern::Common::new(@_);
if ($self->{value} && !($self->{value} =~ m/^\s*$/)) {
$self->{regex} = qr{$self->{value}};
} else {
@@ -394,8 +396,8 @@
return $self->_match_filename($file->{src});
}
-package DH::AI::Pattern::Dst;
-our @ISA = qw( DH::AI::Pattern::Src );
+package DH::InstGen::Pattern::Dst;
+our @ISA = qw( DH::InstGen::Pattern::Src );
sub type {
"dst";
@@ -406,8 +408,8 @@
return $self->_match_filename($file->{dst});
}
-package DH::AI::Pattern::Link;
-our @ISA = qw( DH::AI::Pattern::Src );
+package DH::InstGen::Pattern::Link;
+our @ISA = qw( DH::InstGen::Pattern::Src );
sub type {
"link";
@@ -419,11 +421,11 @@
$self->_match_filename($file->get_path()));
}
-package DH::AI::Pattern::Magic;
-our @ISA = qw( DH::AI::Pattern::Common );
+package DH::InstGen::Pattern::Magic;
+our @ISA = qw( DH::InstGen::Pattern::Common );
sub new {
- my $self = DH::AI::Pattern::Common::new(@_);
+ my $self = DH::InstGen::Pattern::Common::new(@_);
$self->{regex} = qr{^$self->{value}$};
return $self;
}
@@ -463,7 +465,7 @@
}
###############################################################################
-package DH::AI::Pattern;
+package DH::InstGen::Pattern;
sub new {
my ($cls, $pattern) = @_;
@@ -492,16 +494,16 @@
$p = shift @$pattern;
}
if ($p =~ m/^dst:(.*)$/) {
- $self->add_pattern(new DH::AI::Pattern::Dst($negated,$1));
+ $self->add_pattern(new DH::InstGen::Pattern::Dst($negated,$1));
} elsif ($p =~ m/^src:(.*)$/){
- $self->add_pattern(new DH::AI::Pattern::Src($negated, $1));
+ $self->add_pattern(new DH::InstGen::Pattern::Src($negated, $1));
} elsif ($p =~ m/^link:(.*)$/) {
- $self->add_pattern(new DH::AI::Pattern::Link($negated, $1));
+ $self->add_pattern(new DH::InstGen::Pattern::Link($negated, $1));
} elsif ($p =~ m/^mime:(.*)$/) {
- $self->add_pattern(new DH::AI::Pattern::Magic($negated, $1));
+ $self->add_pattern(new DH::InstGen::Pattern::Magic($negated, $1));
} else {
# Default is src
- $self->add_pattern(new DH::AI::Pattern::Src($negated, $p));
+ $self->add_pattern(new DH::InstGen::Pattern::Src($negated, $p));
}
}
return $self;
@@ -544,27 +546,44 @@
my %autoremove;
my %autoadd;
+my %instgen_opts;
+# Parse installgen specific command line options first
+my $prevconfig = Getopt::Long::Configure("pass_through", "no_auto_abbrev");
+$instgen_opts{SORT} = 1;
+$instgen_opts{MANPAGES} = 1;
+exit 1 unless (GetOptions(
+ "builddir|b=s" => \$instgen_opts{BUILDDIR},
+ "validate|test|t" => \$instgen_opts{VALIDATE},
+ "sort!" => \$instgen_opts{SORT},
+ "manpages!" => \$instgen_opts{MANPAGES},
+));
+
+# Get global debhelper options
+Getopt::Long::Configure($prevconfig);
init();
-my $installed = new DH::AI::Installed;
+my $installed = new DH::InstGen::Installed;
my $srcdir = '.';
$srcdir = $dh{SOURCEDIR}."/" if defined $dh{SOURCEDIR};
my $builddir = '.';
-$builddir = $dh{DESTDIR} . "/" if defined $dh{DESTDIR};
+$builddir = $dh{BUILDDIR} . "/" if defined $dh{BUILDDIR};
-
sub rewrite_install_file($\@\@) {
my ($file, $remove, $add) = @_;
+ my $tmpfile = "$file.tmp";
+ my $delfile = 0;
if (@$remove || @$add) {
my $p = shift @$remove;
my @lines;
my $again = 0;
+ my $prevline = "";
+
# Read. Remove non-matching patterns
- if (-r $file) {
+ if (-r $file && !$instgen_opts{VALIDATE}) {
open (DH_INSTALL, "<$file") || error("cannot read $file: $!");
while ($again || ($_ = <DH_INSTALL>)) {
if (defined $p && !m/^#/ && m/(?:^|\s+)\Q$p\E(?:\s+|$)/) {
@@ -587,21 +606,52 @@
push @lines, $_;
}
$again = 0;
+ $prevline = $_;
}
close(DH_INSTALL);
}
+ # Sort *.install if needed
+ if ($instgen_opts{VALIDATE} && $instgen_opts{SORT}) {
+ my $needs_sort = 0;
+ my @install_data;
+ my $prevline = "";
+
+ open(DH_INSTALL, "<$file");
+ while (<DH_INSTALL>) {
+ $needs_sort = 1 if (!$needs_sort && $prevline gt $_);
+ push @install_data, $_;
+ $prevline = $_;
+ }
+ close(DH_INSTALL);
+
+ if ($needs_sort) {
+ @install_data = sort(@install_data);
+
+ my ($fh, $sorted_file) = mkstemp("/tmp/" . basename($file) . ".XXXXXX");
+ for (@install_data) {
+ print $fh $_;
+ }
+ close($fh);
+
+ $file = $sorted_file;
+ $delfile = 1;
+ }
+ }
+
push @lines, map { "$_\n" } @$add if (@$add);
+ @lines = sort(@lines) if ($instgen_opts{SORT});
- open (DH_INSTALL, ">$file.tmp") || error("cannot write to ${file}.tmp: $!");
+ open (DH_INSTALL, ">$tmpfile") || error("cannot write to $tmpfile: $!");
for (@lines) {
print DH_INSTALL $_;
}
close(DH_INSTALL);
- if ($dh{NO_ACT}) {
- system("diff", "-uN", "$file", "$file.tmp");
+ if ($dh{NO_ACT} || $instgen_opts{VALIDATE}) {
+ system("diff", "-uN", "$file", "$tmpfile");
+ system("rm", "-rf", "$file") if ($delfile);
} else {
- doit("mv", "$file.tmp", "$file");
+ doit("mv", "$tmpfile", "$file");
}
}
}
@@ -635,7 +685,7 @@
if (@$missing && @installgen) {
for my $set (@installgen) {
- my $pattern = new DH::AI::Pattern($set);
+ my $pattern = new DH::InstGen::Pattern($set);
# Search for the missing files in the source/build tree
foreach my $miss (@$missing) {
@@ -660,53 +710,75 @@
$pdone->{$package} = 1; # Complete
}
+sub check_for_autoremove {
+ my ($package, $type, $fileset, $sdir) = @_;
+ $sdir = "." if (! defined $sdir);
-foreach my $package (@{$dh{DOPACKAGES}}) {
- my $tmp=tmpdir($package);
- my $file=pkgfile($package,"install");
- $autoremove{$package} = [];
+ foreach (@$fileset) {
+ my $pat = "$sdir/$_";
+ my @files = glob $pat;
+ if (@files == 1) {
+ # The pattern might have not been expanded.
+ # Check manually
+ if (! -e $pat && ! -l $pat) {
+ push @{$autoremove{$package}{$type}}, $_;
+ }
+ } elsif ( ! @files ) {
+ push @{$autoremove{$package}{$type}}, $_;
+ }
+ }
- my @install;
- if ($file) {
- @install=filedoublearray($file); # no globbing yet
+ foreach my $src (map { glob "$sdir/$_" } @$fileset) {
+ next if excludefile($src);
+
+ $installed->add($src);
}
-
- if (($package eq $dh{FIRSTPACKAGE} || $dh{PARAMS_ALL}) && @ARGV) {
- push @install, [@ARGV];
- }
+}
- # Support for -X flag.
- my $exclude = '';
- if ($dh{EXCLUDE_FIND}) {
- $exclude = '! \( '.$dh{EXCLUDE_FIND}.' \)';
- }
-
- foreach my $set (@install) {
- my $dest;
- my $tmpdest=0;
+# Initialize some data
+foreach my $package (@{$dh{DOPACKAGES}}) {
+ $autoremove{$package} = {};
+ $autoremove{$package}{install} = [];
+ $autoremove{$package}{manpages} = [];
+}
+
+# Read and process *.install unless dh_installgen was started in the
+# validate mode. In that case, assume none of the files are installed.
+if (!$instgen_opts{VALIDATE}) {
+ foreach my $package (@{$dh{DOPACKAGES}}) {
+ $autoremove{$package} = {};
+
+ # Handle *.install files
+ my $tmp=tmpdir($package);
+ my $file=pkgfile($package,"install");
+
+ my @install;
+ if ($file) {
+ @install=filedoublearray($file); # no globbing yet
+ }
- if (! defined $dh{AUTODEST} && @$set > 1) {
- $dest=pop @$set;
+ if (($package eq $dh{FIRSTPACKAGE} || $dh{PARAMS_ALL}) && @ARGV) {
+ push @install, [@ARGV];
}
- foreach (@$set) {
- my $pat = "$srcdir/$_";
- my @files = glob $pat;
- if (@files == 1) {
- # The pattern might have not been expanded.
- # Check manually
- if (! -e $pat && ! -l $pat) {
- push @{$autoremove{$package}}, $_;
- }
- } elsif ( ! @files ) {
- push @{$autoremove{$package}}, $_;
+ foreach my $set (@install) {
+ my $dest;
+ my $tmpdest=0;
+
+ if (! defined $dh{AUTODEST} && @$set > 1) {
+ $dest=pop @$set;
}
+
+ check_for_autoremove($package, "install", $set, $srcdir);
}
- foreach my $src (map { glob "$srcdir/$_" } @$set) {
- next if excludefile($src);
-
- $installed->add($src);
+ if ($instgen_opts{MANPAGES}) {
+ # Handle .manpages files
+ $file = pkgfile($package, "manpages");
+ if ($file) {
+ @install=filearray($file);
+ }
+ check_for_autoremove($package, "manpages", \@install);
}
}
}
@@ -721,7 +793,7 @@
find( { wanted => sub {
-f || -l || return;
if (! excludefile($_) && ! $installed->check($_) ) {
- push @missing, new DH::AI::File($_);
+ push @missing, new DH::InstGen::File($_);
}
}, no_chdir => 1 }, $srcdir);
@@ -784,9 +856,17 @@
}
foreach my $package (@{$dh{DOPACKAGES}}) {
+ # Handle *.install files
my $file=pkgfile($package, "install");
$file = "debian/$package.install" if (! -r $file);
- rewrite_install_file($file, @{$autoremove{$package}}, @{$autoadd{$package}});
+ rewrite_install_file($file, @{$autoremove{$package}{install}}, @{$autoadd{$package}});
+
+ # Handle *.manpages file (TODO; improve)
+ $file=pkgfile($package, "manpages");
+ if ($file && exists $autoremove{$package}) {
+ my @dummy;
+ rewrite_install_file($file, @{$autoremove{$package}{manpages}}, @dummy);
+ }
}
More information about the pkg-kde-commits
mailing list