Contents of /scripts/dh_installgen

#!/usr/bin/perl -w

=head1 NAME

dh_install - install files into package build directories

=cut

use strict;
use File::Find;
use File::Temp ':mktemp';
use File::Spec;
use Digest::MD5;

use Debian::Debhelper::Dh_Lib;
use Getopt::Long;

=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::InstGen::File;

our %builddir_cache = (
    builddir => "",
    cache => undef,
);

sub build_cache($) {
    my $builddir = shift;
    if ($builddir_cache{'builddir'} ne $builddir) {
        my %cache;
        File::Find::find({ wanted => sub {
            my $key;
            if (m/debian$/ && -d) {
                $File::Find::prune = 1;
                return;
            } elsif (-f) {
                $key = ((stat($_))[7] / (1024*256));
            } elsif (-l) {
                $key = 'links';
            } else {
                return;
            }
            $cache{$key} = [] unless exists $cache{$key};
            push @{$cache{$key}}, new DH::InstGen::File($_);
        }, no_chdir => 1 }, $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 is_link {
    return shift()->{is_link};
}

sub get_path($) {
    my $self = shift;

    sub gp_internal($) {
        my $path = shift;
        if ($path && (-l $path)) {
            my $first_path = $path;
            while (-l $path) {
                $_ = readlink($path);
                if (m#^/#) {
                    $path = $_;
                } else {
                    $path = main::dirname($path) . "/" . $_ 
                }
            }
            if (! -f $path && $path =~ m#^/# ) {
                my $old_path = $path;
                my @parts = split /\/+/, $first_path;
                while (! -f $path && @parts) {
                    $path = shift(@parts) . "/" . $path;
                }
                $path = $old_path if (! -f $path);
            }
            return $path;
        } elsif ($path && -f $path) {
            return $path;
        }
        return undef;
    }

    $self->{path} = gp_internal($self->{dst}) if (!exists($self->{path}));
    return $self->{path};
}

sub _stripped_path($$) {
    my ($path, $prefix) = @_;
    if ($path) {
        $path =~ s/^\Q$prefix\E\/?//;
        return $path;
    } else {
        return undef;
    }
}

sub stripped_path($$) {
    my ($self, $prefix) = @_;
    return _stripped_path($self->get_path(), $prefix);
}

sub stripped_dstpath($$) {
    my ($self, $prefix) = @_;
    return _stripped_path($self->{dst}, $prefix);
}

sub calc_checksum {
    my $self = shift;
    my $path = shift;

    return if ($self->{is_link});

    $path = $self->get_path() if (! defined $path);

    if ($path) {
        my $md5 = new Digest::MD5;

        open (FILE, $path) or main::error("Unable to open '$path' for checksuming: $!");
        binmode(FILE);
        $md5->addfile(*FILE)->hexdigest;
        my $sum = $md5->hexdigest;
        close(FILE);

        return $sum;
    } else {
        main::error("Unable to find/open file '$path'");
    }
}

sub get_cache_key($) {
    my $self = shift;
    if ($self->{is_link}) {
        return 'links';
    } elsif (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))) {
            my $path = $self->get_path();
            if (-f $path) {
                my $new_file = new DH::InstGen::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}) {
#        print $self->{dst}, " => ", $other->{dst}, "\n";
        # Match by basename of the link and readlink
        return (main::basename($self->{dst}) eq main::basename($other->{dst}) &&
            $self->get_path() eq $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::InstGen::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::InstGen::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;
}

sub has_value {
    return defined shift()->{value};
}

package DH::InstGen::Pattern::Src;
our @ISA = qw( DH::InstGen::Pattern::Common );

sub new {
    my $self = DH::InstGen::Pattern::Common::new(@_);
    if ($self->{value} && !($self->{value} =~ m/^\s*$/)) {
        $self->{regex} = qr{$self->{value}};
    } else {
        $self->{value} = undef;
        $self->{regex} = qr/.*/;
    }
    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::InstGen::Pattern::Dst;
our @ISA = qw( DH::InstGen::Pattern::Src );

sub type {
    "dst";
}

sub _match {
    my ($self, $file) = @_;
    return $self->_match_filename($file->{dst});
}

package DH::InstGen::Pattern::External;
our @ISA = qw( DH::InstGen::Pattern::Src );

sub new {
    my ($cls, $negated, $value, $type, $desc) = @_;
    my $self = DH::InstGen::Pattern::Src::new(@_);
    $self->{type} = $type;
    $self->{desc} = $desc;
    return $self;
}

sub type {
    return shift()->{type};
}

sub _match {
    my ($self, $file) = @_;
    
    if (my $d = $self->{desc}{$file->{dst}}) {
        return $self->_match_filename($d);
    } else {
        return 0;
    }
}

package DH::InstGen::Pattern::Link;
our @ISA = qw( DH::InstGen::Pattern::Src );

sub type {
    "link";
}

sub _match {
    my ($self, $file) = @_;
    return $file->{is_link} && (!$self->has_value() ||
        $self->_match_filename($file->get_path()));
}

package DH::InstGen::Pattern::Magic;
our @ISA = qw( DH::InstGen::Pattern::Common );

sub new {
    my $self = DH::InstGen::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 (! exists $file->{__mime__}) {
        if (my $path = $file->get_path()) {
            $file->{__mime__} = get_mimetype($path);
        } else {
            $file->{__mime__} = undef;
        }
    }
    my $mime = $file->{__mime__};
    if (defined $mime) {
        return $mime =~ m/$self->{regex}/;
    } else {
        return 0;
    }
    return 0;
}

###############################################################################
package DH::InstGen::Pattern;

my %externals;
my $externals_re;

sub new {
    my ($cls, $pattern) = @_;
    my $p = $pattern->[0];
    my $action;

    if ($p =~ m/^(inst|miss|stop|skip)(?:all|ing)?$/) {
        $action = $1;
        shift @$pattern;
    } elsif ($p =~ m/^depends$/) {
        # Ignore. Not interesting here
        return bless({ action => "ignr", pats => [] }, $cls);
    } else {
        $action = "inst"; # default
    }
    my $self = bless( { action => $action, pats => [] }, $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::InstGen::Pattern::Dst($negated,$1));
        } elsif ($p =~ m/^src:(.*)$/) {
            $self->add_pattern(new DH::InstGen::Pattern::Src($negated, $1));
        } elsif ($p =~ m/^link:(.*)$/) {
            $self->add_pattern(new DH::InstGen::Pattern::Link($negated, $1));
        } elsif ($p =~ m/^mime:(.*)$/) {
            $self->add_pattern(new DH::InstGen::Pattern::Magic($negated, $1));
        } elsif ((defined $externals_re && $p =~ m/^($externals_re):(.*)$/) ||
                 ($p =~ m/^([^:]+):(.+)$/ && -f "$1.ig-external")) {
            my ($type, $value) = ($1, $2);
            if (! exists $externals{$type}) {
                DH::InstGen::Pattern->load_external($type);
            }
            $self->add_pattern(new DH::InstGen::Pattern::External($negated, $2, $1, $externals{$1}));
        } else {
            # Default is src
            $self->add_pattern(new DH::InstGen::Pattern::Src($negated, $p));
        }
    }
    return $self;
}

sub add_pattern {
    my ($self, $p) = @_;
    my $type = $p->type();
    if ($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};
}

sub load_external {
    my ($cls, $desc) = @_;
    my @desc = split(/:/, $desc);
    my ($type, $file);
    if (scalar(@desc) == 1) {
        $type = shift @desc;
        $file = "$type.ig-external";
    } else {
        ($type, $file) = @desc;
        $file = File::Spec->catfile($file, "$type.ig-external") if (-d $file);
    }

    my %desc;
    my $last_key;
    open(FILE, $file) or main::error("Unable to open external '$type' file '$file' for reading");
    while (<FILE>) {
        chomp;
        if (defined $last_key && m/^\s+(.*)$/) {
            $desc{$1} = $last_key;
        } elsif (m/^(.*):$/) {
            $last_key = $1;
        } else {
            main::error("Invalid syntax of the external '$type' file '$file' at line $.");
        }
    }
    close(FILE);
    if (scalar(keys %externals)) {
        $externals_re .= "|" . $type;
    } else {
        $externals_re = $type;
    }
    $externals{$type} = \%desc;
    return 1;
}

###############################################################################
package DH::InstGen::Installgen;

sub new {
    my ($cls, $srcdir, $builddir) = @_;
    return bless( { srcdir => $srcdir,
                    builddir => $builddir,
                    rules => [],
                    processed => {},
                    autoadd => {} }, $cls);
}

sub rules {
    return @{shift()->{rules}};
}

sub is_package_virtual {
    my ($self, $package) = @_;
    return $package =~ /_virtual$/;
}

sub autoadd {
    my ($self, $package) = @_;
    return (exists $self->{autoadd}{$package}) ? $self->{autoadd}{$package} : [];
}

sub add_package {
    my ($self, $package, $patterns) = @_;
    push @{$self->{rules}}, { package => $package, patterns => $patterns };
}

sub parse_installgen($$) {
    my ($self, $file) = @_;
    my $patterns = [];
    my $package;
    my $is_virtual;
    $file = "debian/installgen" unless ($file);

    return undef if (! -r $file);

    open(INSTALLGEN, $file) or main::error("Unable to open installgen rule file $file");
    while (<INSTALLGEN>) {
        if (/^\s*#/ || /^\s*$/) {
            next; # Comment
        } elsif (/^\s*\[\s*(.*)\s*\]\s*$/) {
            if (defined $package && @$patterns && $package ne $1) {
                $self->add_package($package, $patterns);
                $patterns = [];
            }
            $package = $1; # new package name
            $is_virtual = $self->is_package_virtual($package);
        } else {
            if (defined $package) {
                my @patternset = split(/\s+/);
                my $pattern = new DH::InstGen::Pattern(\@patternset);
                if ($is_virtual && $pattern->action() eq "inst") {
                    main::error("install action is forbidden in virtual package ($package) at ${file}:$.");
                } else {
                    push @$patterns, $pattern;
                }
            } else {
                main::error("Expected package name at ${file}:$.");
            }
        }
    }
    if (defined $package && @$patterns) {
        $self->add_package($package, $patterns);
    }
    close(INSTALLGEN);
}

sub verify_against_packagelist {
    my $self = shift;

    # Check if all packages specified in the rule file exist
    my %packages;
    map { $packages{$_} = 1 } @_;
    for my $rule (@{$self->{rules}}) {
        main::error("Package '". $rule->{package} . "' is not defined and is not virtual")
            if (!exists $packages{$rule->{package}} &&
                !$self->is_package_virtual($rule->{package}));
    }
}

sub process_rule {
    my ($self, $rule, $missing) = @_;
    my ($package, $patterns) = ($rule->{package}, $rule->{patterns});
    my @autoadd;

    # Load additional package patterns from $package.installgen
    my $gfile = "debian/$package.installgen";
    if (! exists $self->{processed}{$package} && -r $gfile) {
        my @patternset = Debian::Debhelper::Dh_Lib::filedoublearray($gfile);
        for my $pattern (@patternset) {
            push @{$patterns}, new DH::InstGen::Pattern($pattern);
        }
    }
    $self->{processed}{$package} = 1;

    if (@$missing && @$patterns) {
        for my $pattern (@$patterns) {
            # Search for the missing files in the source/build tree
            foreach my $miss (@$missing) {
                next if $miss->{st_found};
                next if $miss->{st_stop};
                next if (exists $miss->{st_skip} && $miss->{st_skip} eq $package);

                if ($pattern->has_type("src") && ! defined($miss->{src})) {
                    $miss->locate($self->{builddir});
                }
                my $match = $pattern->match($miss);
                if (defined $match) {
                    if ($match eq "skip") {
                        $miss->{st_skip} = $package;
                        next;
                    } elsif ($match eq "stop") {
                        $miss->{st_stop} = 1;
                    } else {
                        if ($match eq "inst") {
                            push @autoadd, $miss->stripped_dstpath($self->{srcdir});
                        } else {
                            # Otherwise the file was defined as missing on purpose
                            $miss->{st_miss} = 1;
                        }
                        $miss->{st_found} = 1;
                    }
                }
            }
        }
    }
    push @{$self->{autoadd}{$package}}, @autoadd;
}

sub process {
    my $self = shift;
    my $missing = shift;
    my %dopackages;

    map { $dopackages{$_} = 1 } @_;

    foreach my $rule (@{$self->{rules}}) {
        if (  exists $dopackages{$rule->{package}} ||
              $self->is_package_virtual($rule->{package})  ) {
            $self->process_rule($rule, $missing);
        }
    }
}

###########################################################################
package main;

my %autoremove;
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;
$instgen_opts{EXTERNALS} = [];
exit 1 unless (GetOptions(
    "builddir|b=s" => \$instgen_opts{BUILDDIR},
    "validate|test|t" => \$instgen_opts{VALIDATE},
    "sort!" => \$instgen_opts{SORT},
    "manpages!" => \$instgen_opts{MANPAGES},
    "external|e=s" => $instgen_opts{EXTERNALS},
));

# Get global debhelper options
Getopt::Long::Configure($prevconfig);
init();

my $installed = new DH::InstGen::Installed;

my $srcdir = '.';
$srcdir = $dh{SOURCEDIR}."/" if defined $dh{SOURCEDIR};

my $builddir = '.';
$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) {
            open (DH_INSTALL, "<$file") or main::error("cannot read $file: $!");
            if ($instgen_opts{VALIDATE}) {
                while (<DH_INSTALL>) {
                    my @set = split;
                    if (! defined $dh{AUTODEST} && @set > 1) {
                        push @lines, $_;
                    }
                }
            } else {
                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;
                    $prevline = $_;
                }
            }
            close(DH_INSTALL);
        }

        # Sort *.install if needed
        if ($instgen_opts{VALIDATE} && $instgen_opts{SORT}) {
            my $needs_sort = 0;
            my @install_data;
            my $prevline = "";

            if (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, ">$tmpfile") or main::error("cannot write to $tmpfile: $!");
        for (@lines) {
            print DH_INSTALL $_;
        }
        close(DH_INSTALL);
        if ($dh{NO_ACT} || $instgen_opts{VALIDATE}) {
            system("diff", "-uN", "$file", "$tmpfile");
            system("rm", "-rf", "$file") if ($delfile);
        } else {
            doit("mv", "$tmpfile", "$file");
        }
    }
}

sub check_for_autoremove {
    my ($package, $type, $fileset, $sdir) = @_;
    $sdir = "." if (! defined $sdir);

    foreach (@$fileset) {
        my $pat = "$sdir/$_";
        my @files = glob $pat;
        if (@files == 1 && $files[0] eq $pat) {
            # The pattern might have not been expanded.
            # Check manually
            if (! -e $pat && ! -l $pat) {
                push @{$autoremove{$package}{$type}}, $_;
            }
        } elsif ( ! @files ) {
            push @{$autoremove{$package}{$type}}, $_;
        }
    }

    foreach my $src (map { glob "$sdir/$_" } @$fileset) { 
        next if excludefile($src);

        $installed->add($src);
    }
}

sub get_not_installed {
    my $file = shift;
    $file = "debian/not-installed" unless ($file);
    if (-r $file) {
        my %notinstalled;
        open(NOTINSTALLED, $file) or main::error("Unable to $file for reading");
        while (<NOTINSTALLED>) {
            if (m/^\.\/(.*)$/) {
                $notinstalled{$1} = 0;
            }
        }
        close(NOTINSTALLED);
        return \%notinstalled;
    } else {
        return undef;
    }
}

# Initialize some data
foreach my $package (@{$dh{DOPACKAGES}}) {
    $autoremove{$package} = {};
    $autoremove{$package}{install} = [];
    $autoremove{$package}{manpages} = [];
}

# Initialize externals
for my $external (@{$instgen_opts{EXTERNALS}}) {
    DH::InstGen::Pattern->load_external($external);
}

# 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 (($package eq $dh{FIRSTPACKAGE} || $dh{PARAMS_ALL}) && @ARGV) {
            push @install, [@ARGV];
        }

        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);
        }

        if ($instgen_opts{MANPAGES}) {
            # Handle .manpages files
            $file = pkgfile($package, "manpages");
            if ($file) {
                @install=filearray($file);
            }
            check_for_autoremove($package, "manpages", \@install);
        }
    }
}

# . as srcdir makes no sense, so this is a special case.
if ($srcdir eq '.') {
    $srcdir='debian/tmp';
}

main::error("Unable to find sourcedir: '$srcdir'") unless (-d $srcdir);

my @missing = ();
my $found_file;

find( { wanted => sub {
    $found_file = 1;
    -f || -l || return;
    if (! excludefile($_) && ! $installed->check($_) ) {
        push @missing, new DH::InstGen::File($_);
    }
}, no_chdir => 1 }, $srcdir);

main::error("Sorry, but '$srcdir' appears to be empty") unless ($found_file);

# Process packages with installgen
my $installgen = new DH::InstGen::Installgen($srcdir, $builddir);
$installgen->parse_installgen("debian/installgen");

if ($installgen->rules()) {
    $installgen->verify_against_packagelist(getpackages());
    $installgen->process(\@missing, @{$dh{DOPACKAGES}});
}

if ($dh{LIST_MISSING} || $dh{FAIL_MISSING}) {
    my $unmatched = 0;
    foreach (@missing) {
        unless ($_->{st_found}) {
            $unmatched++;
            warning "Not installed files are listed below:" if ($unmatched == 1 && $dh{LIST_MISSING});
            print STDERR $_->stripped_dstpath($srcdir), "\n" if ($dh{LIST_MISSING});
#            warning $_->stripped_dstpath($srcdir) .
#                " exists in $srcdir but is not installed to anywhere" if ($dh{LIST_MISSING});
        }
    }
    if ($dh{FAIL_MISSING} && $unmatched) {
        main::error("missing files ($unmatched), aborting");
    }
}

# Verify against missing on purpose files against debian/not-installed
if (my $notinstalled = get_not_installed("debian/not-installed")) {
    my @missing_in_notinstalled;
    my @excess_in_notinstalled;
    foreach (@missing) {
        next unless (exists $_->{st_miss});
        my $filepath = $_->stripped_dstpath($srcdir);
        if (!exists $notinstalled->{$filepath}) {
            push @missing_in_notinstalled, $filepath;
        } else {
            $notinstalled->{$filepath} = 1;
        }
    }
    foreach (keys %$notinstalled) {
        push @excess_in_notinstalled, $_ if ($notinstalled->{$_} == 0);
    }

    if (@missing_in_notinstalled || @excess_in_notinstalled) {
        warning "debian/not-installed is out of sync:";
        map { print STDERR "-", $_, "\n" } sort @excess_in_notinstalled;
        map { print STDERR "+", $_, "\n" } sort @missing_in_notinstalled;

        if (@missing_in_notinstalled && !($instgen_opts{VALIDATE} or $dh{NO_ACT})) {
            main::error("Aborting, please update debian/not-installed");
        }
    }
}

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}{install}},
        @{$installgen->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);
    }
}
