#!/usr/bin/perl

####################
#    Copyright (C) 2012 Niels Thykier <niels@thykier.net>
#     - Based on a shell script 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 2 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/>.
####################

use strict;
use warnings;

use File::Temp qw(tempfile);
use POSIX qw (strftime);

my $datapath = shift;
my %archs = ();
my %files = ();

# Adding data files to be updated by this file is as simple as calling
# add_data_file and give it a hash of the following:
#
# filename => name of the data file in the data dir
# line-spec => List-ref of line descriptions.  Variables from
#              dpkg-architecture can be used via @VAR@.  There will be
#              one line in the list-ref times the architectures listed
#              by $(dpkg-architecture -L).
# header => Optional text header text.  Lines should start with "#".
#           The script will add the "Last updated", "With" and a
#           "This file was auto-generated by $0" automatically.
# keep =>   If present and a truth value, the file will use
#           "keep:" comments to hard-code some values
#
#
# All lines (except the header) will be sorted before they are written
# to minimize the diff.
#

add_data_file (
    'filename' => 'binaries/multiarch-dirs',
    'line-spec' => ['@DEB_HOST_ARCH@ @DEB_HOST_MULTIARCH@'],
    'header'  => <<EOF
# List of "Multiarch dirs" relationships as provided by
# dpkg-architecture - arch -> dir mapping
EOF
);

add_data_file (
    'filename' => 'files/triplets',
    'line-spec' => ['@DEB_HOST_MULTIARCH@ @DEB_HOST_ARCH@'],
    'header' => <<EOF
# List of "triplet architecture" relationships as provided by
# dpkg-architecture'
EOF
);

add_data_file (
    'filename' => 'common/architectures',
    'line-spec' => ['@DEB_HOST_ARCH@ || @DEB_HOST_ARCH_OS@ @DEB_HOST_ARCH_CPU@'],
    'header' => <<EOF
# List of known architectures as provided by dpkg-architecture
# (excluding "all" and "any", which are handled specially)
EOF
);

add_data_file (
    'filename' => 'shared-libs/ldconfig-dirs',
    'line-spec' => ['lib/@DEB_HOST_MULTIARCH@',
                    'usr/lib/@DEB_HOST_MULTIARCH@'],
    'keep' => 1,
    'header' => <<EOF
# The list of directories searched by default by the dynamic linker.
# Packages installing shared libraries into these directories must call
# ldconfig, must have shlibs files, and must ensure those libraries have
# proper SONAMEs.
#
# Directories listed here must not have leading slashes.
#
# On the topic of multi-arch dirs.  Hopefully including the ones not
# native to the local platform won't hurt.
#
# See Bug#469301 and Bug#464796 for more details.
#
EOF
);

unless ($datapath) {
    print STDERR "Usage: $0 path/to/lintian/data\n";
    exit 1;
}

$ENV{'LC_ALL'} = 'C';

my $dver = `dpkg-architecture --version | head -n1`;
chomp $dver;

open my $dlfd, '-|', "dpkg-architecture -L 2>/dev/null" or die "dpkg-architecture -L: $!";
while ( my $archstr = <$dlfd> ) {
    chomp $archstr;
    open my $dafd, '-|', "dpkg-architecture -a$archstr 2>/dev/null" or die "dpkg-architecture -a$archstr: $!";
    while ( my $var = <$dafd> ) {
        chomp $var;
        my ($key, $value) = split /=/, $var, 2;
        $archs{$archstr}{$key} = $value;
    }
    close $dafd;
}
close $dlfd;


open_data_files($dver);
foreach my $archstr (sort keys %archs) {
    my $arch = $archs{$archstr};
    write_data_line ($arch);
}

close_and_rename();

exit 0;

sub write_data_line {
    my ($vars) = @_;
    foreach my $filename (keys %files) {
        my $fd = $files{$filename}->{'fd'};
        foreach my $orig (@{ $files{$filename}->{'line-spec'} }) {
            my $line = $orig; # copy the template
            $line =~ s#\@([^@ \t]+)\@#$vars->{$1}//die "Unknown var: $1"#eg;
            push @{ $files{$filename}->{'lines'} }, $line;
        }
    }
}

sub open_data_files {
    my ($version) = @_;
    my $date = strftime '%Y-%m-%d', gmtime;
    foreach my $filename (keys %files) {
        my ($fd, $temp) = tempfile();
        $files{$filename}->{'temp-file'} = $temp;
        $files{$filename}->{'fd'} = $fd;
        $files{$filename}->{'lines'} = [];
        if ($files{$filename}->{'header'}) {
            print $fd $files{$filename}->{'header'};
        }
        print $fd "# Last updated: $date\n";
        print $fd "# With: $version\n";
        print $fd "# This file was auto-generated by $0\n";
        if ($files{$filename}->{'keep'}) {
            open my $orig, '<', "$datapath/$filename" or die "Opening $datapath/$filename: $!";
            print $fd "#\n# Lines to always be include\n";
            while ( my $line = <$orig> ) {
                next unless $line =~ m/^#\s*Keep:\s*(.*\S)\s*$/io;
                my $v = $1;
                print $fd "# Keep: $v\n";
                push @{ $files{$filename}->{'lines'} } , $v;
            }
            close $orig;
        }
        print $fd "\n";
    }
}

sub add_data_file {
    my (%data) = @_;
    my $file = $data{'filename'} or die "Missing filename.\n";
    @{ $data{'line-spec'} } or die "Missing line spec for $file.\n";
    $data{'header'} //= '';
    $data{'keep'} //= 0;
    $files{$file} = \%data;
}

sub close_and_rename {
    foreach my $filename (keys %files) {
        my $tf = $files{$filename}->{'temp-file'};
        my $fd = $files{$filename}->{'fd'};
        foreach my $line (sort @{ $files{$filename}->{'lines'} }) {
            print $fd "$line\n";
        }
        close $files{$filename}->{'fd'} or die "Closing $tf ($filename): $!";
    }
    foreach my $filename (keys %files) {
        my $tf = $files{$filename}->{'temp-file'};
        my $df = "$datapath/$filename";
        system ('mv', '-f', $tf, $df) == 0 or die "mv -f $tf $df failed.\n";
    }
}