#!/bin/sh
# SPDX-FileCopyrightText: 2020-2026  Jonas Smedegaard <dr@jones.dk>
#
# SPDX-FileCopyrightText: 2020-2021  Purism, SPC
#
# SPDX-License-Identifier: GPL-3.0-or-later
#
# Description: helper script to update copyright_hints
#
# Depends:
#  licensecheck,
#  libimage-exiftool-perl,
#  libipc-system-simple-perl,
#  libpath-tiny-perl,
#  libregexp-assemble-perl,
#  perl,

set -eu

copyright_header_field() {
    perl -00 -Mv5.36 -Mbuiltin=trim -- - "$1" debian/copyright <<'EOF'
my $field = shift;
$_ = <ARGV>;
s/^#.*\n//mg;
if (/^\Q$field\E:\K.*(?:\n\h+.*)*/m) {
    $_ = $&;
    s/\n\h+/ /g;
    print trim $_;
}
EOF
}

glob2re() {
    perl -Mv5.36 -- - "$1" <<'EOF'
my $glob = shift;
my $re = '';
for my $g (split " ", $glob) {
    $g =~ s/\\([\\*?])/$1/g;
    $re .= "|" if $re;
    $re .= join "", map { $_ eq "*" ? ".*" : $_ eq "?" ? "." : quotemeta $_ }
        split //, $g;
}
print $re;
EOF
}

glob2exiftool() {
    perl -Mv5.36 -MIPC::System::Simple=system -- - "$1" <<'EOF'
my $glob = shift;
my (@exts, @dirs);
for my $g (split " ", $glob) {
    my $u = $g =~ s/\\([\\*?])/$1/gr;
    if ( $u =~ m{^\*(\.([^.]+))$} and $u !~ m{/} ) {
        push @exts, $2;
    } elsif ( $u =~ m{^(.*)/\*$} and $1 !~ m{[*?]} ) {
        die "Files-Harvested: '$1' (from '$g') is not an existing directory\n"
            unless -d $1;
        push @dirs, $1;
    } elsif ( $u !~ m{[*?]} ) {
        die "Files-Harvested: '$g' is neither an extension nor a directory\n"
            unless -d $u;
        push @dirs, $u;
    } else {
        print STDERR "Files-Harvested: cannot map glob '$g' ";
        print STDERR "to an extension or directory for exiftool\n";
        print STDERR "(use e.g. *.ext or dir/*; ";
        die "multi-dot globs like *.tar.gz are unsupported by -ext)\n";
    }
}
if (@exts) {
    my @cmd = qw(exiftool -textOut! %d%f.%e:meta -short -short -recurse
        -extractEmbedded);
    push @cmd, "-ext", $_ for @exts;
    push @cmd, "--", glob("*");
    system @cmd;
}
if (@dirs) {
    system qw(exiftool -textOut! %d%f.%e:meta -short -short -recurse
        -extractEmbedded -ext * --), @dirs;
}
EOF
}

FILES_meta=$(copyright_header_field Files-Harvested)
FILES_omit=$(copyright_header_field Files-Ignored)
RE_meta=$(glob2re "$FILES_meta")
RE_omit=$(glob2re "$FILES_omit")
RE_hint='skip|meta'

# cleanup stray hint files from a previous run
find ./* -type f -regextype posix-egrep -regex "^\./.*:($RE_hint)$" -delete

if [ -n "$RE_meta" ]; then
    echo 'extract metadata from binary files ...' 1>&2
    glob2exiftool "$FILES_meta"
fi

if [ -n "$RE_omit" ]; then
    echo 'skip binary files without parsable metadata ...' 1>&2
    find ./* -type f -regextype posix-egrep \
        -regex "^\./($RE_omit)$" ! -regex "^\./.*:($RE_hint)$" \
        -exec sh -c 'echo "License: UNKNOWN" > "$1:skip"' shell {} ';'
fi

# resolve file regex from contained license or shebang, or path regex
_file_regex() {
    perl -Mv5.36 -MGetopt::Long=:config,gnu_getopt -MPath::Tiny \
    -MRegexp::Assemble -MList::Util=any -- - "$@" <<'EOF'
my (%opt, @license, @files, @match);
GetOptions \%opt,
    "shortname=s@", "grantglob=s@", "regex=s@", "shebang=s@", "nonverb=s@";
my @section = split /\n\n+/, path("debian/copyright")->slurp_utf8;
for my $name ( @{ $opt{shortname} // [] } ) {
    push @license, map {/^License:\h*\Q$name\E\n\h+(\S[^\n]*(?:\n\h+\S[^\n]*)*)/}
    @section; }
for my $glob ( @{ $opt{grantglob} // [] } ) {
    push @files, grep {/^Files:\n?\h(?:\S[^\n]*\n?\h)*\Q$glob\E\s/} @section; }
my @grant = map {
    /^License(?:-Grant:|:\h*\S[^\n]*)\h*\n\h+(\S[^\n]*(?:\n\h+\S[^\n]*)*)/mg
} @files;
my @firstline_re = map {qr/^\Q$_\E/} @{ $opt{shebang} // [] };
my $nonverb_re = Regexp::Assemble->new
    ->add("\\W+", map {"\\W+(?:$_)\\W+"} @{ $opt{nonverb} // [] })
    ->as_string;
my @content_re = map {
    s/\W+/[**]/g;
    s/\Q[**]\E\d\Q[**]\E/[**]\\S{0,2}[**]/g;
    s/\Q[**]\E/$nonverb_re/g;
    qr/$_/
} @license, @grant;
my $inspect = sub {
    return if $_[0]->is_dir;
    if (@firstline_re) {
        my ($head) = $_[0]->lines({ count => 1 });
        push @match, quotemeta($_[0]) and return
            if any { $head =~ $_ } @firstline_re;
    }
    push @match, quotemeta($_[0])
        if any { $_[0]->slurp_raw =~ $_ } @content_re;
};
for (@ARGV) {
    my $p = path($_);
    $p->is_dir ? $p->visit($inspect, { recurse => 1 }) : $inspect->($p);
}
my $files_re = Regexp::Assemble->new->add(@match, @{ $opt{regex} // [] });
print $files_re->as_string =~ s/\(\?:/\(/gr;
EOF
}

RE_SKIP="${RE_omit:+$RE_omit|}${RE_meta:+$RE_meta|}debian/.*"

# common licensing patterns
RE_main=$(_file_regex --grantglob '*' -- *)

# TODO: automate more of this manual cleanup:
#  * strip garbage copyright holders
#  * optionally merge equally licensed Files sections
#  * do "sort -k2 -k1,1 -u" on copyright holders
#  * merge copyright years for each copyright holder
# TODO: strip files matching glob in current (only, no later) section
_licensecheck() {
    perl -Mv5.36 -MGetopt::Long=:config,gnu_getopt \
        -MIPC::System::Simple=capture -MList::Util=uniq \
        -- - --hint="$RE_hint" "$@" <<'EOF' >> debian/copyright_hints
my %opt;
GetOptions ( \%opt, "merge-licenses",
    "hint=s", "check=s", "ignore=s", "shortname=s", "subset=s" );
my @subset = exists $opt{subset} ? split(" ", $opt{subset}) : ();
my $subset_globs = join( "\n ", @subset );
if ( $subset_globs =~ /^[*]$/ ) {
    say STDERR "check default section(s) ..." }
elsif ( @subset and $opt{shortname} ) {
    say STDERR "check $opt{shortname} section(s) @subset ..." }
elsif (@subset) {
    say STDERR "check section(s) @subset ..." }
elsif ( $opt{shortname} ) {
    say STDERR "check $opt{shortname} section(s) ..." }
else {
    say STDERR "check remaining upstream section(s) ..." }
my @cmd = ( qw(licensecheck --copyright --deb-machine --recursive --lines 0),
    "--check",  $opt{check}, "--ignore", $opt{ignore},
    ($opt{"merge-licenses"} ? "--merge-licenses" : ()), "--" );
say STDERR "@cmd *" if $ENV{DEBUG};
local $_ = capture( @cmd, glob "*" );
if ( !$ENV{NOGLOBMERGE} and grep /[*]/, @subset ) {
    s/^.*?\n\nFiles: \K.*?(?=\n\w)/$subset_globs/s }
elsif (@subset) {
    s/^.*?\n\nFiles: \K/$subset_globs\n /s }
s/^.*?\n\n//s if exists $opt{subset} and (!@subset or $subset[0] ne "*");
s/^Files:\K /\n /mg;
s/^[C]opyright:\K /\n  /mg;
s/(?:(?<=^  )|(?<=\d{4})),\K (?=\d{4})//mg;
s/:(?:$opt{hint})$//mg if $opt{hint};
if ($opt{shortname}) {
    s/^License: \K(.*)/
        join " and\/or ", uniq sort grep(
            !m{\AUNKNOWN\Z}, split(" and\/or ", $1), $opt{shortname}
        )
    /mge
}
print;
EOF
}

rm -f debian/copyright_hints

# check initially without subsets or same-license merging to identify patterns
#_licensecheck --check '.*' --ignore "^($RE_SKIP)$"
#exit 0

# check common subsets first, with merging where reliable, and then generally
_licensecheck --subset '*' --check '.*' --ignore "^($RE_main|$RE_SKIP)$"
_licensecheck --subset 'debian/*' --check '^debian/' --merge-licenses \
    --ignore "^debian/(changelog|copyright(_hints)?|source/lintian-overrides)$"

# cleanup hint files
find ./* -type f -regextype posix-egrep -regex "^\./.*:($RE_hint)$" -delete
