Contents of /bin/embedded-cleanup

#!/bin/sh

####################
#    Copyright (C) 2009 by Raphael Geissert <atomo64@gmail.com>
#
#
#    This file is free software: you can redistribute it and/or modify
#    it under the terms of the GNU General Public License as published by
#    the Free Software Foundation, either version 3 of the License, or
#    (at your option) any later version.
#
#    This file is distributed in the hope that it will be useful,
#    but WITHOUT ANY WARRANTY; without even the implied warranty of
#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#    GNU General Public License for more details.
#
#    You should have received a copy of the GNU General Public License
#    along with this file.  If not, see <http://www.gnu.org/licenses/>.
####################

set -e

case "$1" in
    -h|--help)
        cat <<FOO
Usage: $(basename "$0") [--help]
    --help: this information.

This script obtains the list of all source packages in the archive and
checks that the list of packages in embedded-code-copies is correct.
Results are written to stderr, everything else in stdout is just informational
and can safely be ignored or redirected to /dev/null.
FOO
    exit
    ;;
esac

[ -f data/embedded-code-copies ] || {
    echo "Please run under the top-level directory of the repository" >&2
    exit 1
}

PKGSLIST=$(mktemp)

echo "Querying UDD via alioth (you may need to enter a password):"
ssh -oBatchMode=yes alioth.debian.org "psql -Atx -c \"SELECT DISTINCT source,release from sources where distribution='debian';\" 'service=udd'" > "$PKGSLIST"

export PKGSLIST

perl -w <<'PSCRIPT'

use strict;

# translate pseudo-names into a package name that exists
my %translate = qw(
        python* python2.5
        drupal drupal6
        typo3 typo3-src
        linux-kernel linux-2.6
        zope zope3
);
$translate{'linux kernels'} = 'linux-2.6';

# archived stable releases
my @oldstables = qw(
        woody
        sarge
);

my %pkgs;

open(PKGS, '<', $ENV{'PKGSLIST'});
{
    my ($pkg, $release, %ref);
    my $entry = 0;
    $ref{'source'} = \$pkg;
    $ref{'release'} = \$release;
    while(<PKGS>) {
        chomp;
        if (m/^$/ && defined($pkg)) {
            next unless $entry;
            $pkgs{$pkg} = {}
                unless (exists $pkgs{$pkg});
            $pkgs{$pkg}{$release} = 1;
            $entry = 0;
            $release = $pkg = '';
            next;
        }
        if($_ eq '') {
            print STDERR "Skipping empty line $., \$pkg not defined\n";
            next;
        }
        my ($k, $v) = split(/\|/);
        ${$ref{$k}} = $v;
        $entry = 1;
    }
}
close(PKGS);

my (@errors, @warnings);

open(DATA, '<', 'data/embedded-code-copies');
my ($seen_flag, $embedded_package, %embedding_packages) = (0, '');
while(<DATA>) {
    if (m/^---BEGIN/) {
        $seen_flag = 1;
        next;
    }
    next unless $seen_flag;
    next if /(?:NOTE|TODO):/;
    s/\(.*?\)//;
    s/(?:^\s+|\s+$)//g;
    next if ($_ eq '');
    $_ = lc;

    if (m/^\w/) {
        s,/.+$,,;
        while (my ($pkg, $count) = each %embedding_packages) {
            push @errors, "Duplicated entry for $pkg (for $embedded_package)"
                if ($count gt 1);
        }
        undef %embedding_packages;
        if (exists($translate{$_})) {
            $embedded_package = $translate{$_};
        } else {
            $embedded_package = $_;
        }
        unless (exists($pkgs{$embedded_package})) {
            # disabled for now, need to check how bin/check-new-issues uses it:
            # push @warnings, "'$embedded_package' does not exist, line:$.";
        }
        next;
    }

    if (m/^(?:\[(\w+)\]\s+)?-\s+(.+?)\s(?:<(.+?)>|\d)/) {
        my ($release, $embedding_package, $status) = ($1 || '', $2, $3 || '');
        my $reported = 0;

        $embedding_package = $translate{$embedding_package}
            if (exists($translate{$embedding_package}));

        unless (exists($pkgs{$embedding_package})
                || $reported || $status eq 'removed' || $status eq 'itp') {
            push @errors, "Non-existing package '$embedding_package', line:$.";
            $reported = 1;
        }

        if ($release) {
            unless ($reported || exists ($pkgs{$embedding_package}{$release})
                    || grep {$_ eq $release} @oldstables) {
                push @errors, "'$embedding_package' does not exist in '$release', line:$.";
                $reported = 1;
            }
            $embedding_package .= '-' . $release;
        }
        $embedding_packages{$embedding_package}++;
    } else {
        push @errors, "Malformed line ($.) detected: '$_'";
    }
}
close(DATA);

print STDERR join("\n", @errors);
print STDERR "\nWarnings\n" if @warnings;
print STDERR join("\n", @warnings);
print STDERR "\n" if @errors or @warnings;

PSCRIPT

unlink "$PKGSLIST"
1	atomo64-guest	11861	#!/bin/sh
2
3			####################
4			# Copyright (C) 2009 by Raphael Geissert <atomo64@gmail.com>
5			#
6			#
7			# This file is free software: you can redistribute it and/or modify
8			# it under the terms of the GNU General Public License as published by
9			# the Free Software Foundation, either version 3 of the License, or
10			# (at your option) any later version.
11			#
12			# This file is distributed in the hope that it will be useful,
13			# but WITHOUT ANY WARRANTY; without even the implied warranty of
14			# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15			# GNU General Public License for more details.
16			#
17			# You should have received a copy of the GNU General Public License
18			# along with this file. If not, see <http://www.gnu.org/licenses/>.
19			####################
20
21			set -e
22
23			case "$1" in
24			-h\|--help)
25			cat <<FOO
26			Usage: $(basename "$0") [--help]
27			--help: this information.
28
29			This script obtains the list of all source packages in the archive and
30			checks that the list of packages in embedded-code-copies is correct.
31			Results are written to stderr, everything else in stdout is just informational
32			and can safely be ignored or redirected to /dev/null.
33			FOO
34			exit
35			;;
36			esac
37
38			[ -f data/embedded-code-copies ] \|\| {
39			echo "Please run under the top-level directory of the repository" >&2
40			exit 1
41			}
42
43			PKGSLIST=$(mktemp)
44
45			echo "Querying UDD via alioth (you may need to enter a password):"
46			ssh -oBatchMode=yes alioth.debian.org "psql -Atx -c \"SELECT DISTINCT source,release from sources where distribution='debian';\" 'service=udd'" > "$PKGSLIST"
47
48			export PKGSLIST
49
50			perl -w <<'PSCRIPT'
51
52			use strict;
53
54			# translate pseudo-names into a package name that exists
55			my %translate = qw(
56			python* python2.5
57			drupal drupal6
58			typo3 typo3-src
59			linux-kernel linux-2.6
60			zope zope3
61			);
62			$translate{'linux kernels'} = 'linux-2.6';
63
64			# archived stable releases
65			my @oldstables = qw(
66			woody
67			sarge
68			);
69
70			my %pkgs;
71
72			open(PKGS, '<', $ENV{'PKGSLIST'});
73			{
74			my ($pkg, $release, %ref);
75			my $entry = 0;
76			$ref{'source'} = \$pkg;
77			$ref{'release'} = \$release;
78			while(<PKGS>) {
79			chomp;
80			if (m/^$/ && defined($pkg)) {
81			next unless $entry;
82			$pkgs{$pkg} = {}
83			unless (exists $pkgs{$pkg});
84			$pkgs{$pkg}{$release} = 1;
85			$entry = 0;
86			$release = $pkg = '';
87			next;
88			}
89			if($_ eq '') {
90			print STDERR "Skipping empty line $., \$pkg not defined\n";
91			next;
92			}
93			my ($k, $v) = split(/\\|/);
94			${$ref{$k}} = $v;
95			$entry = 1;
96			}
97			}
98			close(PKGS);
99
100			my (@errors, @warnings);
101
102			open(DATA, '<', 'data/embedded-code-copies');
103			my ($seen_flag, $embedded_package, %embedding_packages) = (0, '');
104			while(<DATA>) {
105			if (m/^---BEGIN/) {
106			$seen_flag = 1;
107			next;
108			}
109			next unless $seen_flag;
110			next if /(?:NOTE\|TODO):/;
111			s/\(.*?\)//;
112			s/(?:^\s+\|\s+$)//g;
113			next if ($_ eq '');
114			$_ = lc;
115
116			if (m/^\w/) {
117			s,/.+$,,;
118			while (my ($pkg, $count) = each %embedding_packages) {
119			push @errors, "Duplicated entry for $pkg (for $embedded_package)"
120			if ($count gt 1);
121			}
122			undef %embedding_packages;
123			if (exists($translate{$_})) {
124			$embedded_package = $translate{$_};
125			} else {
126			$embedded_package = $_;
127			}
128			unless (exists($pkgs{$embedded_package})) {
129			# disabled for now, need to check how bin/check-new-issues uses it:
130			# push @warnings, "'$embedded_package' does not exist, line:$.";
131			}
132			next;
133			}
134
135			if (m/^(?:\[(\w+)\]\s+)?-\s+(.+?)\s(?:<(.+?)>\|\d)/) {
136			my ($release, $embedding_package, $status) = ($1 \|\| '', $2, $3 \|\| '');
137			my $reported = 0;
138
139			$embedding_package = $translate{$embedding_package}
140			if (exists($translate{$embedding_package}));
141
142			unless (exists($pkgs{$embedding_package})
143			\|\| $reported \|\| $status eq 'removed' \|\| $status eq 'itp') {
144			push @errors, "Non-existing package '$embedding_package', line:$.";
145			$reported = 1;
146			}
147
148			if ($release) {
149			unless ($reported \|\| exists ($pkgs{$embedding_package}{$release})
150			\|\| grep {$_ eq $release} @oldstables) {
151			push @errors, "'$embedding_package' does not exist in '$release', line:$.";
152			$reported = 1;
153			}
154			$embedding_package .= '-' . $release;
155			}
156			$embedding_packages{$embedding_package}++;
157			} else {
158			push @errors, "Malformed line ($.) detected: '$_'";
159			}
160			}
161			close(DATA);
162
163			print STDERR join("\n", @errors);
164			print STDERR "\nWarnings\n" if @warnings;
165			print STDERR join("\n", @warnings);
166	jwilk-guest	13131	print STDERR "\n" if @errors or @warnings;
167	atomo64-guest	11861
168			PSCRIPT
169
170			unlink "$PKGSLIST"