rev 9870 - scripts
Modestas Vainius
modax-guest at alioth.debian.org
Wed Mar 26 17:12:54 UTC 2008
Author: modax-guest
Date: 2008-03-26 17:12:52 +0000 (Wed, 26 Mar 2008)
New Revision: 9870
Added:
scripts/dh_installgen
Log:
It's my first version of debhelper *.install generator/editor.
It does not install files itself, however it tries to update *.install
files to match contents of installation tree. It currently features:
* Removal of no longer valid *.install entries (i.e. files which were dropped upstream).
* Automatic update of *.install files based on the contents of the *.installgen files:
*.installgen files are more flexible than plain *.install files, because:
+ perl regular expersions are used instead of shell patterns
+ it's possible to match destination of the file (e.g. its location in debian/tmp)
and source location of the file (in the build-tree)
+ it's possible to match file mimetype (via libmagic)
+ negation (!), AND (patterns on the line), OR (each line) are supported
+ it's possible to "describe" file(s) which is not installed on purpose. --list-missing and --fail-missing won't complain/fail on them.
+ --no-act shows a diff instead of updating *.install
Documentation is missing, but arguments are similar to dh_install ones.
E.g.
Run with `dh_installgen --sourcedir=debian/tmp --list-missing' on stuff has
been installed to debian/tmp.
Example package.installgen:
mime:text/.* src:doc
can be read as "install files with the mime type matching "text/.*" and originating from the (source) path in the build tree having 'doc' in its name.
Added: scripts/dh_installgen
===================================================================
--- scripts/dh_installgen (rev 0)
+++ scripts/dh_installgen 2008-03-26 17:12:52 UTC (rev 9870)
@@ -0,0 +1,662 @@
+#!/usr/bin/perl -w
+
+=head1 NAME
+
+dh_install - install files into package build directories
+
+=cut
+
+use strict;
+use File::Find;
+
+use Debian::Debhelper::Dh_Lib;
+
+=head1 SYNOPSIS
+
+B<dh_install> [B<-X>I<item>] [B<--autodest>] [B<--sourcedir=>I<dir>] [B<--destdir=>I<dir>] [S<I<debhelper options>>] [S<I<file [...] dest>>]
+
+=head1 DESCRIPTION
+
+dh_install is a debhelper program that handles installing files into package
+build directories. There are many dh_install* commands that handle installing
+specific types of files such as documentation, examples, man pages, and so on,
+and they should be used when possible as they often have extra intelligence for
+those particular tasks. dh_install, then, is useful for installing everything
+else, for which no particular intelligence is needed. It is a replacement for
+the old dh_movefiles command.
+
+Files named debian/package.install list the files to install into each
+package and the directory they should be installed to. The format is a set
+of lines, where each line lists a file or files to install, and at the end
+of the line tells the directory it should be installed in. The name of the
+files (or directories) to install should be given relative to the current
+directory, while the installation directory is given relative to the
+package build directory. You may use wildcards in the names of the files to
+install (in v3 mode and above).
+
+This program may be used in one of two ways. If you just have a file or two
+that the upstream Makefile does not install for you, you can run dh_install
+on them to move them into place. On the other hand, maybe you have a large
+package that builds multiple binary packages. You can use the upstream
+Makefile to install it all into debian/tmp, and then use dh_install to copy
+directories and files from there into the proper package build directories.
+
+=head1 OPTIONS
+
+=over 4
+
+=item B<-Xitem>, B<--exclude=item>
+
+Exclude files that contain "item" anywhere in their filename from
+being installed.
+
+=item B<--autodest>
+
+Guess as the destination directory to install things to. If this is
+specified, you should not list destination directories in
+debian/package.install files or on the command line. Instead, dh_install
+will guess as follows:
+
+Strip off debian/tmp (or the sourcedir if one is given) from the front of
+the filename, if it is present, and install into the dirname of the
+filename. So if the filename is debian/tmp/usr/bin, then that directory
+will be copied to debian/package/usr/. If the filename is
+debian/tmp/etc/passwd, it will be copied to debian/package/etc/.
+
+Note that if you list exactly one filename or wildcard-pattern on a line by
+itself in a
+debian/package.install file, with no explicit destination, then dh_install
+will automatically guess the destination even if this flag is not set.
+
+=item B<--fail-missing>
+
+This option is like --list-missing, except if a file was missed, it will
+not only list the missing files, but also fail with a nonzero exit code.
+
+=item B<--sourcedir=dir>
+
+Makes all source files be found under dir. If this is specified, it is
+akin to all the source filenames having "dir/" prepended to them.
+
+To make dh_install behave like the old dh_movefiles, move your
+package.files file to package.install and call dh_install with
+"--sourcedir=debian/tmp" appended to the command. This will
+approximate dh_movefiles behaviour, except it will copy files instead
+of moving them.
+
+=item B<--builddir=dir>
+
+foo bar
+
+=item I<file [...] dest>
+
+Lists files (or directories) to install and where to install them to.
+The files will be installed into the first package dh_install acts on.
+
+=back
+
+=cut
+
+package DH::AI::File;
+
+our %builddir_cache = (
+ builddir => "",
+ cache => undef,
+);
+
+sub build_cache($) {
+ my $builddir = shift;
+ if ($builddir_cache{'builddir'} ne $builddir) {
+ my %cache;
+ File::Find::find(sub {
+ my $key;
+ if ($_ eq "debian" && -d) {
+ $File::Find::prune = 1;
+ return;
+ } elsif (-f) {
+ # Size
+ $key = ((stat($_))[7] / (1024*256));
+ } elsif (-l) {
+ $key = 'links';
+ } else {
+ return;
+ }
+ $cache{$key} = [] unless exists $cache{$key};
+ push @{$cache{$key}}, new DH::AI::File($File::Find::name);
+ }, $builddir);
+ $builddir_cache{'builddir'} = $builddir;
+ $builddir_cache{'cache'} = \%cache;
+ }
+ return $builddir_cache{'cache'};
+}
+
+sub new($$) {
+ my ($cls, $dst) = @_;
+ my $self = {
+ src => undef,
+ dst => $dst,
+ chksum => undef,
+ is_link => (-l $dst),
+ };
+ return bless($self, $cls);
+}
+
+sub get_path($) {
+ my $self = shift;
+
+ sub gp_internal($) {
+ my $path = shift;
+ if ($path && (-f $path)) {
+ return $path;
+ } elsif ($path && (-l $path)) {
+ while (-l $path) {
+ $path = readlink($path);
+ }
+ return (-f $path) ? $path : undef;
+ }
+ return undef;
+ }
+
+ my $path;
+ $path = gp_internal($self->{dst});
+ return $path if $path;
+ $path = gp_internal($self->{src});
+ return $path if $path;
+}
+
+sub stripped_path($$) {
+ my ($self, $prefix) = @_;
+ my $path = $self->get_path();
+ $path =~ s/^\Q$prefix\E\/?//;
+ return $path;
+}
+
+sub calc_checksum {
+ my $self = shift;
+ my $path = shift;
+
+ return if ($self->{is_link});
+
+ $path = $self->get_path() if (! defined $path);
+
+ if ($path) {
+ open (CMD, "md5sum '$path'|") || error("md5sum '$path' failed: $!");
+ my $sum;
+ $_ = <CMD>;
+ $sum = (split)[0];
+ close CMD;
+ return $sum;
+ } else {
+ error("Unable to find/open file '$path'");
+ }
+}
+
+sub get_cache_key($) {
+ my $self = shift;
+ if (my $path = $self->get_path()) {
+ return ((stat($path))[7] / (1024*256));
+ }
+}
+
+sub locate_in_cache {
+ my ($self, $cache) = @_;
+ my $key = $self->get_cache_key();
+
+ if (exists $cache->{$key}) {
+ my $srcs = $cache->{$key};
+ foreach my $src (@$srcs) {
+ if ($self->is_the_same($src)) {
+ return $src;
+ }
+ }
+ }
+ return undef;
+}
+
+sub locate($$) {
+ my ($self, $builddir) = @_;
+
+ my $cache = build_cache($builddir);
+
+ if ($self->{is_link}) {
+ # Search among links first
+ if (!($self->{src} = $self->locate_in_cache($cache, 'links'))) {
+ my $path = $self->get_path();
+ my $new_file = new DH::AI::File($path);
+ $self->{src} = $new_file->locate_in_cache($cache);
+ }
+
+ main::warning("Unable to locate a source file for the link: " . $self->{dst})
+ unless($self->{src});
+ } else {
+ main::warning("Unable to locate a source file for the file: " . $self->get_path())
+ unless($self->{src} = $self->locate_in_cache($cache));
+ }
+
+ $self->{src} = $self->{src}->get_path() if (defined $self->{src});
+ return $self->{src};
+}
+
+sub is_the_same($$) {
+ my ($self, $other) = @_;
+
+ if ($self->{is_link} && $other->{is_link}) {
+ # Match by basename of the link and readlink
+ return (basename($self->{dst}) eq basename($other->{dst}) &&
+ basename($self->get_path()) eq basename($other->get_path()));
+ } elsif (!($self->{is_link} && ($other->{is_link}))) {
+ # I.e. file
+ $self->{chksum} = $self->calc_checksum() unless ($self->{chksum});
+ $other->{chksum} = $other->calc_checksum() unless ($other->{chksum});
+
+ return ($self->{chksum} && $other->{chksum} &&
+ $self->{chksum} eq $other->{chksum});
+ } else {
+ return 0;
+ }
+}
+
+###############################################################################
+package DH::AI::Installed;
+
+sub new {
+ my $cls = shift;
+ return bless({d=>{}}, $cls);
+}
+
+sub add {
+ my ($self, $pattern) = @_;
+
+ # Kill any extra slashes. Makes the
+ # stuff more robust.
+ $pattern =~ y:/:/:s;
+ $pattern =~ s:/+$::;
+ $pattern =~ s:^(\./)*::;
+
+ my $bn = main::basename($pattern);
+ $self->{d}->{$bn} = [] unless (exists $self->{d}->{$bn});
+ push @{$self->{d}->{$bn}}, qr{^(?:\Q$pattern\E\/.*|\Q$pattern\E)$};
+}
+
+sub check {
+ my ($self, $file) = @_;
+ my @parts = split /\//, $file;
+
+ my $found = $self->_check_basename(\@parts, $file);
+ while (! $found && @parts > 0 ) {
+ pop @parts;
+ $found = $self->_check_basename(\@parts, $file);
+ }
+ return $found;
+}
+
+sub _check_basename {
+ my ($self, $parts, $file) = @_;
+ my $bn = $parts->[scalar(@$parts) - 1];
+ if (defined $bn && exists $self->{d}->{$bn}) {
+ my $found = 0;
+ my $file = join("/", @$parts);
+ for my $f (@{$self->{d}->{$bn}}) {
+ return 1 if ($file =~ m/$f/);
+ }
+ }
+ return 0;
+}
+
+
+###############################################################################
+package DH::AI::Pattern::Common;
+
+sub new {
+ my ($cls, $negated, $val) = @_;
+ return bless( { negated => $negated, value => $val }, $cls);
+}
+
+sub type {
+ undef;
+}
+
+sub _match {
+ undef;
+}
+
+sub match {
+ my ($self, $file) = @_;
+ my $result = $self->_match($file);
+ return ($self->{negated}) ? !$result : $result;
+}
+
+package DH::AI::Pattern::Src;
+our @ISA = qw( DH::AI::Pattern::Common );
+
+sub new {
+ my $self = DH::AI::Pattern::Common::new(@_);
+ $self->{regex} = qr{$self->{value}};
+ return $self;
+}
+
+sub type {
+ "src";
+}
+
+sub _match_filename {
+ my ($self, $filename) = @_;
+ if (defined $filename) {
+ return $filename =~ m/$self->{regex}/;
+ } else {
+ return 0;
+ }
+}
+
+sub _match {
+ my ($self, $file) = @_;
+ return $self->_match_filename($file->{src});
+}
+
+package DH::AI::Pattern::Dst;
+our @ISA = qw( DH::AI::Pattern::Src );
+
+sub type {
+ "dst";
+}
+
+sub _match {
+ my ($self, $file) = @_;
+ return $self->_match_filename($file->{dst});
+}
+
+package DH::AI::Pattern::Magic;
+our @ISA = qw( DH::AI::Pattern::Common );
+
+sub new {
+ my $self = DH::AI::Pattern::Common::new(@_);
+ $self->{regex} = qr{^$self->{value}$};
+ return $self;
+}
+
+sub type {
+ return "mime";
+}
+
+sub get_mimetype {
+ my $filename = shift;
+ unless (open(CMD_FILE, "file --brief --mime-type '$filename'|")) {
+ main::warning ("Could not run `file'");
+ return undef;
+ }
+ $_ = <CMD_FILE>;
+ chomp;
+ close CMD_FILE;
+ return $_;
+}
+
+sub _match {
+ my ($self, $file) = @_;
+ if (my $path = $file->get_path()) {
+ my $mime = get_mimetype($path);
+ if (defined $mime) {
+ return $mime =~ m/$self->{regex}/;
+ } else {
+ return 0;
+ }
+ }
+ return 0;
+}
+
+###############################################################################
+package DH::AI::Pattern;
+
+sub new {
+ my ($cls, $pattern) = @_;
+ my $p = $pattern->[0];
+ my $action;
+
+ if ($p =~ m/^(inst|miss)(?:all|ing)?$/) {
+ $action = $1;
+ shift @$pattern;
+ } else {
+ $action = "inst"; # default
+ }
+ my $self = bless( { action => $action }, $cls);
+
+ while (@$pattern > 0) {
+ my $negated = 0;
+ my $type;
+ my $value;
+
+ $p = shift @$pattern;
+ if ($p =~ m/^!$/) {
+ $negated = 1;
+ $p = shift @$pattern;
+ }
+ if ($p =~ m/^dst:(.*)$/) {
+ $self->add_pattern(new DH::AI::Pattern::Dst($negated,$1));
+ } elsif ($p =~ m/^src:(.*)$/){
+ $self->add_pattern(new DH::AI::Pattern::Src($negated, $1));
+ } elsif ($p =~ m/^mime:(.*)$/) {
+ $self->add_pattern(new DH::AI::Pattern::Magic($negated, $1));
+ } else {
+ # Default is src
+ $self->add_pattern(new DH::AI::Pattern::Src($negated, $p));
+ }
+ }
+ return $self;
+}
+
+sub add_pattern {
+ my ($self, $p) = @_;
+ if (my $type = $p->type()) {
+ if (exists $self->{$type}) {
+ $self->{$type}++;
+ } else {
+ $self->{$type} = 1;
+ }
+ push @{$self->{pats}}, $p;
+ }
+}
+
+sub has_type {
+ my ($self, $type) = @_;
+ return exists $self->{$type};
+}
+
+sub match {
+ my ($self, $file) = @_;
+ my $lastpat = undef;
+ for my $pat (@{$self->{pats}}) {
+ return undef unless ($pat->match($file));
+ $lastpat = $pat;
+ }
+ return (defined $lastpat) ? $self->action() : undef;
+}
+
+sub action {
+ return shift()->{action};
+}
+
+###########################################################################
+package main;
+
+sub rewrite_install_file($\@\@) {
+ my ($file, $remove, $add) = @_;
+
+ if (@$remove || @$add) {
+ # Read. Remove non-matching patterns
+ open (DH_INSTALL, "<$file") || error("cannot read $file: $!");
+ my $p = shift @$remove;
+ my @lines;
+ my $again = 0;
+ while ($again || ($_ = <DH_INSTALL>)) {
+ if (defined $p && !m/^#/ && m/(?:^|\s+)\Q$p\E(?:\s+|$)/) {
+ my @set = split;
+ if (! defined $dh{AUTODEST} && @set > 1) {
+ s/((?:^|\s+)\Q$p\E\s*)(?!$)/ /;
+ } else {
+ s/((?:^|\s+)\Q$p\E\s*)/ /;
+ }
+ if (@set == 1 || @set == 2) {
+ # Move on
+ $p = shift @$remove;
+ } else {
+ # Check for another match
+ $_ = chomp() . "\n";
+ $again = 1;
+ next;
+ }
+ } else {
+ push @lines, $_;
+ }
+ $again = 0;
+ }
+ close(DH_INSTALL);
+
+ push @lines, map { "$_\n" } @$add if (@$add);
+
+ open (DH_INSTALL, ">$file.tmp") || error("cannot write to ${file}.tmp: $!");
+ for (@lines) {
+ print DH_INSTALL $_;
+ }
+ close(DH_INSTALL);
+ if ($dh{NO_ACT}) {
+ system("diff", "-u", "$file", "$file.tmp");
+ } else {
+ doit("mv", "$file.tmp", "$file");
+ }
+ }
+}
+
+
+init();
+
+my $installed = new DH::AI::Installed;
+
+my $srcdir = '.';
+$srcdir = $dh{SOURCEDIR}."/" if defined $dh{SOURCEDIR};
+
+my $builddir = '.';
+$builddir = $dh{DESTDIR} . "/" if defined $dh{DESTDIR};
+
+my %autoremove;
+my %autoadd;
+
+foreach my $package (@{$dh{DOPACKAGES}}) {
+ my $tmp=tmpdir($package);
+ my $file=pkgfile($package,"install");
+ $autoremove{$package} = [];
+
+ my @install;
+ if ($file) {
+ @install=filedoublearray($file); # no globbing yet
+ }
+
+ 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;
+
+ if (! defined $dh{AUTODEST} && @$set > 1) {
+ $dest=pop @$set;
+ }
+
+ 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 $src (map { glob "$srcdir/$_" } @$set) {
+ next if excludefile($src);
+
+ $installed->add($src);
+ }
+ }
+}
+
+# . as srcdir makes no sense, so this is a special case.
+if ($srcdir eq '.') {
+ $srcdir='debian/tmp';
+}
+
+my @missing = ();
+
+find(sub {
+ -f || -l || return;
+ $_="$File::Find::dir/$_";
+ my $bn = basename($_);
+ if (! excludefile($_) && ! $installed->check($_) ) {
+ push @missing, new DH::AI::File($_);
+ }
+}, $srcdir);
+
+foreach my $package (@{$dh{DOPACKAGES}}) {
+ my $gfile=pkgfile($package, "installgen");
+
+ my @installgen;
+ if ($gfile) {
+ @installgen=filedoublearray($gfile);
+ }
+
+ my @autoadd;
+
+ if (@missing && @installgen) {
+ for my $set (@installgen) {
+ my $pattern = new DH::AI::Pattern($set);
+
+ # Search for the missing files in the source/build tree
+ foreach my $miss (@missing) {
+ next if $miss->{found};
+
+ if ($pattern->has_type("src") && ! defined($miss->{src})) {
+ $miss->locate($builddir);
+ }
+ my $match = $pattern->match($miss);
+ if (defined $match) {
+ if ($match eq "inst") {
+ push @autoadd, $miss->stripped_path($srcdir);
+ } # Otherwise the file was defined as missing on purpose
+ $miss->{found} = 1;
+ }
+ }
+ }
+ }
+
+ $autoadd{$package} = \@autoadd;
+}
+
+if ($dh{LIST_MISSING} || $dh{FAIL_MISSING}) {
+ my $unmatched = 0;
+ foreach (@missing) {
+ unless ($_->{found}) {
+ $unmatched++;
+ warning $_->stripped_path($srcdir) .
+ " exists in $srcdir but is not installed to anywhere" if ($dh{LIST_MISSING});
+ }
+ }
+ if ($dh{FAIL_MISSING} && $unmatched) {
+ error("missing files ($unmatched), aborting");
+ }
+}
+
+foreach my $package (@{$dh{DOPACKAGES}}) {
+ my $file=pkgfile($package, "install");
+
+ rewrite_install_file($file, @{$autoremove{$package}}, @{$autoadd{$package}});
+}
+
Property changes on: scripts/dh_installgen
___________________________________________________________________
Name: svn:executable
+ *
More information about the pkg-kde-commits
mailing list