#!/usr/bin/perl -w

=head1 NAME

dh_gtkmodules - create Gtk module files for Gtk modules

=cut

use strict;
use Debian::Debhelper::Dh_Lib;
use Cwd;

=head1 SYNOPSIS

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

=head1 DESCRIPTION

B<dh_gtkmodules> is a debhelper program that handles correctly
generating a dependency on the versionned Gtk+ module ABI and
indexes for GdkPixbuf loaders and IM modules that it finds in the
Gtk+ module directories.

This command automatically adds a "<package>.loaders" file to the
current package with the package name or "<package>.immodules" if it
finds any GdkPixbuf loaders or IM modules.

If this command finds the versionned standard module directory in the
current package, it will generate a dependency on the earliest Gtk
version that Gtk currently has compatibility for in ${misc:Depends}
("binary version").

=head1 OPTIONS

=over 4

=item B<-k>

Do not generate any dependencies in ${misc:Depends}.

=cut

init();

warning("This program is deprecated, everything is handled by triggers now.");
exit 0;

# 'abs_path' from Cwd resolves symlinks, and we don't want that to happen
# (otherwise it's harder to remove the prefix of the generated output)
sub make_absolute_path {
    my $path = shift;
    if ($path =~ m#^/#) {
        return $path;
    }
    my $cwd = getcwd;
    return "$cwd/$path";
}

# gdk-pixbuf-query-loaders helper (generates a GdkPixbuf loaders module
# file on its stdout with *.so passed on its command-line)
my $queryloaders;
if ($ENV{GTK_QUERYLOADERS}) {
    $queryloaders = $ENV{GTK_QUERYLOADERS};
} else {
    $queryloaders = '/usr/lib/x86_64-linux-gnu/libgtk2.0-0/gdk-pixbuf-query-loaders';
}

# gtk-query-immodules-2.0 helper (generates an IM module file on its
# stdout with *.so passed on its command-line)
my $queryimmodules;
if ($ENV{GTK_QUERYIMMODULES}) {
    $queryimmodules = $ENV{GTK_QUERYIMMODULES};
} else {
    $queryimmodules = '/usr/lib/x86_64-linux-gnu/libgtk2.0-0/gtk-query-immodules-2.0';
}

# relative Gtk base module path
my $modules_base_path = 'usr/lib/x86_64-linux-gnu/gtk-2.0/2.10.0';

# relative path to GdkPixbuf loaders modules (separated by ":")
my $loaders_modules_path = "$modules_base_path/loaders";
# relative directory to store the generated loader module file
my $loader_module_files_d = "$modules_base_path/loader-files.d";

# relative path to IM modules (separated by ":")
my $im_modules_path = "$modules_base_path/immodules";
# relative directory to store the generated IM module file
my $im_module_files_d = "$modules_base_path/immodule-files.d";

# Gtk binary version virtual Provide
my $gtk_binver_dep = 'gtk2.0-binver-2.10.0';

sub find_modules {
    # where to store the modules we find
    my $modules_ref = shift;
    # base directory to prepend to the list of locations
    my $basedir = shift;
    # list of locations to search relative to $basedir separated with ":"
    my $path = shift;

    foreach (map("$basedir/$_", split(/:/, $path))) {
        # it's necessary to make the path absolute to strip the build-time
        # prefix later on
        my $path = make_absolute_path($_);
        if (! -e $path) {
            verbose_print("skipping $path.");
            next;
        }
        if (-d $path) {
            # if path is a directory (or symlink to a directory), search for
            # *.so files or symlinks
            open(FIND,
              "find '$path' -name '*.so' \\( -type f -or -type l \\) |")
              or die "Can't run find: $!";
            while (<FIND>) {
                chomp;
                push @$modules_ref, $_;
            }
            close FIND or die "Error while running find: $!";
        } elsif (-f $path or -l $path) {
            # if path is a file or symlink, simply add it to the list
            push @$modules_ref, $path;
        } else {
            error("$path has unknown file type.");
        }
    }
}

sub query_modules {
    # absolute pathname to query helper
    my $querymodules = shift;
    # base directory to prepend to the output module file and to strip
    # of the output
    my $basedir = shift;
    # relative directory where to write the module file
    my $module_files_d = shift;
    # relative path of the module file
    my $module_file = shift;
    # modules to query
    my @modules = @_;

    my $do_query = join ' ', $querymodules, @modules;
    open(QUERY, "$do_query 2>&1 |")
        or die "Can't query modules with $querymodules: $!";

    doit("rm", "-f", "$module_file");
    if (! -d "$basedir/$module_files_d") {
        doit("install", "-d", "$basedir/$module_files_d");
    }
    complex_doit("printf '%s\\n' '# automatically generated by dh_gtkmodules, do not edit' >>$module_file");

    my $absolute_basedir = make_absolute_path($basedir);
    my $n_lines = 0;
    while (<QUERY>) {
        next if m/^#/;
        chomp;
        # if some module couldn't be loaded by the query helper, bail out
        if (m#^g_module_open\(\) failed for #) {
            error("$querymodules could not load a module:\n$_\nYou should probably make the libraries built by your package available via LD_LIBRARY_PATH.");
        }
        # strip build-time prefix from output
        if (m#^\Q"$absolute_basedir/\E#) {
            s#^\Q"$absolute_basedir/\E#"/#;
        }
        complex_doit("printf '%s\\n' '$_' >>$module_file");
        $n_lines++;
    }
    # nothing written to the module file, fail miserably
    if (0 == $n_lines) {
        doit("rm", "-f", "$module_file");
        error("Internal error: could not find any module in the output of $querymodules.");
    }

    doit("chmod", 644, "$module_file");
    doit("chown", "0:0", "$module_file");

    close QUERY or die "Error while querying modules with $querymodules: $!";
}

foreach my $package (@{$dh{DOPACKAGES}}) {
    my $tmp = tmpdir($package);
    my @loaders_modules = ();
    my @im_modules = ();

    # if the versionned directory isn't present, give up on package
    if (! -d "$tmp/$modules_base_path") {
        next;
    }

    # since the versionned module directory exists, generate a dependency
    # on the Gtk binary version
    if (! $dh{K_FLAG}) {
        addsubstvar($package, "misc:Depends", $gtk_binver_dep);
    }

    # search for specific module types
    find_modules(\@loaders_modules, $tmp, $loaders_modules_path);
    find_modules(\@im_modules, $tmp, $im_modules_path);

    warning("Package $package has " . @loaders_modules . " GdkPixbuf loaders and " . @im_modules . " Gtk IM modules.");

    # if no modules of these types were found, we're done
    if (0 == @loaders_modules + @im_modules) {
        next;
    }

    if (@loaders_modules) {
        query_modules($queryloaders,
                      $tmp,
                      $loader_module_files_d,
                      "$tmp/$loader_module_files_d/$package.loaders",
                      @loaders_modules);
    }
    if (@im_modules) {
        query_modules($queryimmodules,
                      $tmp,
                      $im_module_files_d,
                      "$tmp/$im_module_files_d/$package.immodules",
                      @im_modules);
    }
}

=back

=head1 SEE ALSO

L<debhelper>

This program relies on Debhelper, but is shipped with the Gtk
development files.

=head1 AUTHOR

Loic Minier <lool@dooz.org>

=cut