#!/usr/bin/perl -w

=head1 NAME

dh_appstream - generate and install AppStream metainfo XML

=cut

use strict;
use warnings;
use Debian::Debhelper::Dh_Lib;
use Cwd qw(abs_path);
use File::Basename ();
use File::Find;
use File::Temp qw(tempdir);
use JSON::PP qw(decode_json);

our $VERSION = DH_BUILTIN_VERSION;

=head1 SYNOPSIS

B<dh_appstream> [S<I<debhelper options>>]

=head1 DESCRIPTION

B<dh_appstream> is a debhelper program that generates AppStream metainfo
XML files from Debian binary package information and installs them
into the package build directory.

Currently, B<dh_appstream> supports generating metainfo for font
packages (C<< <component type="font"> >>).

The tool hooks into the debhelper sequence after B<dh_install>, so it
can discover font files that have been installed into the package build
directory.

B<dh_appstream> reads metadata from F<debian/control> and F<debian/copyright>,
discovers font files using B<fc-query>, and generates the metainfo XML
from a built-in template.

If the file F<debian/I<package>.appstream.xml> exists, it is used as-is
(manual override) and no auto-generation is performed.

When a license is obtained, B<license-detector> is used to convert the
license text to an SPDX expression.

=head1 FILES

=over 4

=item debian/I<package>.appstream.xml

Manual override. If this file exists, it is installed as-is and no
auto-generation is performed.

=item debian/control

The Source stanza's B<Homepage> field and the binary package stanza's
B<Description> field are used to populate the metainfo XML.

=item debian/copyright

If in machine-readable (DEP-5) format, the license is extracted from
the header stanza's B<License> field, or from the B<Files: *> stanza.
If the license cannot be determined from F<debian/copyright>, it is
extracted from the font file's embedded metadata instead. It is then
converted to an SPDX expression with B<license-detector>.

=back

=head1 OPTIONS

=over 4

=item B<-a>, B<--arch-arch>

Act only on architecture-dependent packages.

=item B<-i>, B<--indep>

Act only on architecture-independent packages.

=item B<-p>I<package>, B<--package>=I<package>

Act only on the specified package.

=item B<-N>I<package>, B<--no-package>=I<package>

Do not act on the specified package.

=item B<-s>, B<--same-arch>

Act only on packages that match the build architecture.

=item B<--no-act>

Do not really do anything; just print what would be done.

=back

=cut

init();

foreach my $package (@{$dh{DOPACKAGES}}) {
	my $tmpdir = tmpdir($package);
	my $override = "debian/${package}.appstream.xml";
	my $generated = "debian/${package}.appstream.xml.tmp";
	my $id = "org.debian.fonts.${package}";

	# Check for manual override
	if (-f $override) {
		verbose_print("Using manual override: ${override}");
		$generated = $override;
	} else {
		verbose_print("Generating AppStream metainfo for ${package}");

		# Read metadata
		my $copyright_license = read_copyright_license("debian/copyright");
		my ($source_stanza, $binary_stanza) = read_control_fields("debian/control");

		my $homepage = $source_stanza->{homepage} // "";
		my $description = $binary_stanza->{$package}{description} // "";
		my ($summary, $long_description) = split(/\n/, $description, 2);

		# Discover fonts
		my @font_files = discover_font_files($tmpdir);
		error("No font files found in ${tmpdir}/usr/share/fonts/") unless @font_files;
		my @fonts = extract_font_families(@font_files);
		my $name = $fonts[0];
		$summary //= "";
		my @description_paragraphs = grep { /\S/ } split(/\n\s*\n/, $long_description // "");
		$description = join("\n", map { "    <p>$_</p>" } @description_paragraphs);
		$summary =~ s/^\s+//;
		$summary =~ s/\s+$//;

		# Fallback: extract license from font metadata if not in debian/copyright
		if (!defined $copyright_license) {
			verbose_print("No license in debian/copyright, trying font metadata");
			$copyright_license = extract_font_license($font_files[0]);
			error("Could not determine license from debian/copyright or font metadata") unless defined $copyright_license;
			verbose_print("License text from font metadata: ${copyright_license}");

			my $spdx = resolve_spdx_license($copyright_license);
			error("Could not map font license text to an SPDX identifier") unless defined $spdx;
			$copyright_license = $spdx;
			verbose_print("Mapped to SPDX identifier: ${spdx}");
		}

		# Build font entries
		my $font_entries = join("\n", map { "    <font>$_</font>" } @fonts);

		# Read template
		my $template_dir = "/usr/share/dh-appstream/templates";
		my $template_file = "${template_dir}/font.metainfo.xml";
		error("Template not found: ${template_file}") unless -f $template_file;
		my $template = read_file($template_file);

		# Fill template
		my %vars = (
			ID           => $id,
			LICENSE      => $copyright_license,
			NAME         => $name,
			SUMMARY      => $summary,
			DESCRIPTION  => $description,
			HOMEPAGE     => $homepage,
			FONT_ENTRIES => $font_entries,
		);

		foreach my $key (keys %vars) {
			my $value = $vars{$key};
			$value //= "";
			$template =~ s/__${key}__/$value/g;
		}

		write_file($generated, $template);
	}

	# Validate
	verbose_print("Validating AppStream metainfo");
	doit("appstreamcli", "validate", "--no-net", $generated);

	# Install
	my $target_dir = "${tmpdir}/usr/share/metainfo";
	install_dir($target_dir);
	install_file($generated, "${target_dir}/${id}.metainfo.xml");

	# Clean up temp file if we generated it
	unlink $generated if $generated ne $override;
}

# Parse a deb822-format file into an array of hash references.
# Each hash represents one stanza, with keys lowercased.
sub parse_deb822 {
	my ($filename) = @_;
	my @stanzas;
	my %current;
	my $field_name = "";

	open(my $fh, '<', $filename) or error("Cannot open ${filename}: $!");
	while (my $line = <$fh>) {
		chomp $line;
		$line =~ s/\s+$//;

		# Skip comments
		next if $line =~ /^#/;

		# Continuation line
		if ($line =~ /^\s/) {
			my $value = $line;
			$value =~ s/^\s//;
			$value =~ s/^\.\s*$//;  # Escape for empty lines
			if ($field_name ne "" && exists $current{$field_name}) {
				$current{$field_name} .= "\n" . $value;
			}
			next;
		}

		# Empty line = stanza separator
		if ($line eq "") {
			if (%current) {
				push(@stanzas, { %current });
				%current = ();
				$field_name = "";
			}
			next;
		}

		# Field line
		if ($line =~ /^([A-Za-z0-9][A-Za-z0-9\-]*):\s*(.*)/) {
			$field_name = lc($1);
			$current{$field_name} = $2;
		}
	}

	# Last stanza (if file doesn't end with blank line)
	if (%current) {
		push(@stanzas, { %current });
	}

	close($fh);
	return @stanzas;
}

# Read the license from a DEP-5 copyright file.
# Returns an SPDX license expression.
sub read_copyright_license {
	my ($filename) = @_;
	return undef unless -f $filename;

	my @stanzas = parse_deb822($filename);
	return undef unless @stanzas;

	my $header = $stanzas[0];

	return undef unless exists $header->{format};

	# Check for License in header stanza
	if (exists $header->{license}) {
		return normalize_debian_license($header->{license}, $filename);
	}

	# Look for Files: * stanza
	foreach my $stanza (@stanzas[1..$#stanzas]) {
		if (exists $stanza->{files} && $stanza->{files} eq "*") {
			if (exists $stanza->{license}) {
				return normalize_debian_license($stanza->{license}, $filename);
			}
		}
	}

	# Fallback: return the first Files stanza's license
	foreach my $stanza (@stanzas[1..$#stanzas]) {
		if (exists $stanza->{license}) {
			return normalize_debian_license($stanza->{license}, $filename);
		}
	}

	return undef;
}

# Convert a DEP-5 short name to the SPDX expression reported by
# license-detector. Keep the DEP-5 value when the source tree has no
# detectable license file, since it may already be a valid SPDX expression.
sub normalize_debian_license {
	my ($value, $filename) = @_;
	my $license = extract_license_short($value);
	my $copyright_dir = File::Basename::dirname(abs_path($filename));
	my $project_dir = File::Basename::dirname($copyright_dir);
	my $detected = detect_spdx_license($project_dir);
	return $detected if defined $detected;
	return $license;
}

# Extract the short SPDX license name from a License field value.
# The short name is typically the first word/identifier before whitespace.
sub extract_license_short {
	my ($value) = @_;
	$value =~ s/^\s+//;
	$value =~ s/\s+$//;

	# Handle SPDX expressions: "OFL-1.1", "GPL-2+", "MIT", etc.
	# The short name is everything up to the first newline or
	# if it's a compound expression, the full first line.
	if ($value =~ /^([A-Za-z0-9\.\+\-]+)/) {
		return $1;
	}
	return $value;
}

# Read debian/control and return source stanza and binary stanza hash.
# Returns ($source_stanza_hashref, $binary_stanzas_hashref)
# The binary hash is keyed by package name.
sub read_control_fields {
	my ($filename) = @_;
	error("debian/control not found") unless -f $filename;

	my @stanzas = parse_deb822($filename);
	error("debian/control has no stanzas") unless @stanzas;

	my $source_stanza = $stanzas[0];
	my %binary_stanzas;

	foreach my $stanza (@stanzas[1..$#stanzas]) {
		if (exists $stanza->{package}) {
			$binary_stanzas{$stanza->{package}} = $stanza;
		}
	}

	return ($source_stanza, \%binary_stanzas);
}

# Discover font files in the package build directory.
# Returns a list of font file paths.
sub discover_font_files {
	my ($tmpdir) = @_;
	my $fonts_dir = "${tmpdir}/usr/share/fonts";
	my @font_files;

	if (-d $fonts_dir) {
		find(sub {
			return unless -f $_;
			return unless /\.(ttf|otf)$/i;
			push(@font_files, $File::Find::name);
		}, $fonts_dir);
	}

	return @font_files;
}

# Extract font family names from a list of font files.
# Returns a sorted, unique list of family names.
sub extract_font_families {
	my (@font_files) = @_;
	my @families;

	error("No font files found") unless @font_files;

	foreach my $file (@font_files) {
		my $output = `fc-query --format='%{family[0]}\n' "$file" 2>/dev/null`;
		if ($? == 0) {
			foreach my $line (split(/\n/, $output)) {
				$line =~ s/^\s+//;
				$line =~ s/\s+$//;
				push(@families, $line) if $line ne "";
			}
		} else {
			warning("fc-query failed for ${file}, skipping");
		}
	}

	error("Could not determine any font family names") unless @families;

	my %seen;
	@families = sort grep { !$seen{$_}++ } @families;

	return @families;
}

# Extract license from a font file's Name table (nameID=13).
# Uses python3-fonttools to read the OpenType Name table.
# Returns the license string or undef.
sub extract_font_license {
	my ($font_file) = @_;
	return undef unless defined $font_file && -f $font_file;

	my $python_code = <<'PYEOF';
import sys
from fontTools.ttLib import TTFont

def get_license(path):
    try:
        t = TTFont(path, fontNumber=0)
        name = t['name']
        for record in name.names:
            if record.nameID == 13 and record.platformID == 3:
                return record.toUnicode()
        for record in name.names:
            if record.nameID == 13:
                return record.toUnicode()
        t.close()
    except Exception:
        pass
    return None

license = get_license(sys.argv[1])
if license:
    print(license)
PYEOF

	my $output = `python3 -c '$python_code' "$font_file" 2>/dev/null`;
	chomp $output if defined $output;
	return defined $output && $output ne "" ? $output : undef;
}

# Convert license text to an SPDX expression with license-detector.
# Returns the highest-confidence detected SPDX license or undef.
sub resolve_spdx_license {
	my ($license_text) = @_;
	return undef unless defined $license_text && $license_text ne "";

	my $directory = tempdir(CLEANUP => 1);
	my $license_file = "${directory}/LICENSE";
	open(my $fh, '>', $license_file) or return undef;
	print $fh $license_text;
	close($fh) or return undef;

	return detect_spdx_license($directory);
}

# Return the highest-confidence SPDX license reported for a directory.
sub detect_spdx_license {
	my ($directory) = @_;
	return undef unless defined $directory && -d $directory;

	open(my $detector, '-|', 'license-detector', '--format', 'json', $directory)
		or return undef;
	local $/;
	my $output = <$detector>;
	close($detector);
	return undef unless defined $output && $? == 0;

	my $result = eval { decode_json($output) };
	return undef unless ref($result) eq 'ARRAY' && @$result;
	my $matches = $result->[0]{matches};
	return undef unless ref($matches) eq 'ARRAY' && @$matches;

	@$matches = sort {
		($b->{confidence} // 0) <=> ($a->{confidence} // 0)
	} @$matches;
	return $matches->[0]{license} if defined $matches->[0]{license};
	return undef;
}

# Read a file and return its contents as a string.
sub read_file {
	my ($filename) = @_;
	open(my $fh, '<', $filename) or error("Cannot open ${filename}: $!");
	local $/;
	my $content = <$fh>;
	close($fh);
	return $content;
}

# Write content to a file.
sub write_file {
	my ($filename, $content) = @_;
	open(my $fh, '>', $filename) or error("Cannot write to ${filename}: $!");
	print $fh $content;
	close($fh);
}

=head1 SEE ALSO

L<debhelper(7)>

=cut
