debian/collect_copyright.pl


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45

#!/usr/bin/perl

use v5.36;

sub slurp($file){
    open(my $fh, "<", $file) or die;
    local $/;
    $/ = "\n" if(wantarray);
    <$fh>
}

my $root = $ENV{DPKG_ROOT} // "";

my %pkg;
my $pkg;
for(slurp("$root/var/lib/dpkg/status")){
    $pkg = $1 if(/^Package:\s*([^\s]*)/);
    if(/^Source:\s*([^\s(]*)/){
        my $src = $1;
        next if($src eq $pkg);
        $pkg{$src} //= [];
        push $pkg{$src}->@*, $pkg;
    }
}

my @deps;
for(@ARGV){
    push @deps, map{s/^\s*//; s/\s*$//r}
        map{s/.*?.?=//; split(/, */)}
        grep{/^misc:Static-Built-Using.?=/}
        slurp($_);
}

DEP: for my $namev(@deps){
    my $name = $namev =~ s/\s*\(.*//r;
    for($name, $pkg{$name}->@*){
        if(-f "$root/usr/share/doc/$_/copyright"){
            print("Package: $namev\n");
            print(slurp("/usr/share/doc/$_/copyright"));
            print("\n");
            next DEP;
        }
    }
    die;
}