#!/usr/bin/perl -w
# Copyright (C) Steve Haslam 1999. This is free software.
# Distributable under the terms of the GNU General Public License, version 2
# See the file 'COPYING' for license text.

require 5;
use strict;
use POSIX;
use Debian::ThemeConverters qw[printv printi printw printe wrapsystem wchdir direntries];

my $delondie;

$SIG{'__WARN__'} = \&printw;
$SIG{'__DIE__'} = sub { printe @_; if ($delondie) { wchdir('/'); wrapsystem("/bin/rm", "-rf", $delondie); } exit 255; };

Debian::ThemeConverters::main \&gtkthemetodeb;

exit 0;

sub fixthemefile {
  my $filename = shift;
  printv "Fixing up $filename";
  my $outfile = tmpnam;
  my $madechanges = 0;
  open(THEMEFILE, $filename) || die "Can't read $filename: $!";
  open(OUTFILE, ">$outfile") || die "Can't write $outfile: $!";
  while (<THEMEFILE>) {
    # Remove evil pixmap_path lines
    $madechanges++ if (s/\s*pixmap_path/\#$&/);
    print OUTFILE;
  }
  close THEMEFILE;
  close OUTFILE;
  if ($madechanges) {
    printi "$filename changed";
    unlink($filename) || die "Can't unlink $filename: $!";
    rename($outfile, $filename) || die "Can't rename $outfile to $filename: $!";
  }
}

sub findengines {
  my $gtkrc = shift;
  printv "Finding engines in $gtkrc";
  my %engines;
  open(GTKRC, $gtkrc) || die "Can't read $gtkrc: $!";
  while (<GTKRC>) {
    if (/^\s+engine\s+\"(\S+)\"/) {
      $engines{$1}=1;
    }
  }
  close GTKRC;
  keys %engines;
}

sub gtkthemetodeb {
  my $themepkgfilename = shift;
  my $destdir = shift;

  my $themename = $themepkgfilename;
  $themename =~ s@.*/@@;

  # Create working area
  my $tmpdir = tmpnam;
  mkdir($tmpdir, 0755) || die "Can't create $tmpdir: $!";
  $delondie = $tmpdir;
  wchdir($tmpdir);

  # Prepare to get files
  my $installpath = "usr/share/themes";
  if (wrapsystem("/usr/bin/install", "-d", "$tmpdir/$installpath") != 0) {
    die "Unable to create directory $tmpdir/$installpath";
  }
  wchdir("$tmpdir/$installpath") || die "Unable to change directory to $tmpdir/$installpath: $!";

  # Unpack original
  if (wrapsystem("/bin/tar", "xzf", $themepkgfilename) != 0) {
    die "$themepkgfilename: Extraction failed";
  }

  # Look at results of extractions
  # Hopefully, now have a single directory in the current directory
  my @dirlist = grep { $_ ne '.' && $_ ne '..' } Debian::ThemeConverters::direntries('.');
  if (@dirlist > 1) {
    printv "More than one directory entry in theme top level";
    if (-f "gtk/gtkrc") {
      printv "But gtk/gtkrc exists, creating top level";
      mkdir($themename, 0755) || die "Can't make directory $themename: $!";
      # Move files into new top level
      if (wrapsystem('/bin/mv', @dirlist, $themename) != 0) {
	die "Unable to move theme files into new top level";
      }
    }
    else {
      # Can't handle this yet
      die "Can't deal with this, man";
    }
  }
  else {
    # Set theme name from this
    $themename = shift @dirlist;
    printv "Set theme name to $themename";
    # Where have they put the gtkrc file?
    if (-f "$themename/gtkrc") {
      # "Wrong" place
      printv "$themename/gtkrc exists, moving stuff into gtk subdirectory";
      my @files = map { $_ = "$themename/$_" }  grep { $_ ne '.' && $_ ne '..' } direntries($themename);
      mkdir("$themename/gtk", 0755) || die "Unable to make directory $themename/gtk: $!";
      if (wrapsystem('/bin/mv', @files, "$themename/gtk") != 0) {
	die "Unable to move theme data files into 'gtk' subdirectory";
      }
    }
  }
  if (-f "$themename/gtk/gtkrc") {
    printv "$themename/gtk/gtkrc exists, OK.";
  }
  else {
    die "$themepkgfilename: No $themename/gtk/gtkrc found";
  }

  # Make Debian package name
  # Name convention entirely invented by me and probably crap
  # "gtk-xyyzy-theme"
  my $dpkgname = $themename;
  my $dpkgversion = "0.0";
  my $dpkgmaintainer = "Unknown";
  my $dpkgdescription = "GTK+ theme";

  $dpkgname =~ tr/A-Z/a-z/;
  $dpkgname =~ s/[^a-z+.-]//g;
  $dpkgname = "gtk-$dpkgname-theme";
  printv "Debian package: $dpkgname";

  # Read LSM file
  my %lsminfo = Debian::ThemeConverters::readlsminfo($tmpdir);
  $dpkgdescription = $lsminfo{'description'} if (exists $lsminfo{'description'});
  $dpkgmaintainer = $lsminfo{'author'} if (exists $lsminfo{'author'});

  # Process theme control files
  fixthemefile("$themename/gtk/gtkrc");

  # Determine engine(s) from theme control file
  my @engines = map { "gtk-engines-$_" } findengines("$themename/gtk/gtkrc");

  my $longdescription = "This package was automagically created from a GTK+ theme called $themename";

  my $dpkgfile = "${dpkgname}_${dpkgversion}_all.deb";
  wchdir $destdir;

  my $depends = join(', ', @engines);
  Debian::ThemeConverters::makedeb($dpkgfile, $tmpdir,
				   { Name => $dpkgname,
				     Version => $dpkgversion,
				     Maintainer => $dpkgmaintainer,
				     Depends => $depends,
				     Description => $dpkgdescription,
				     LongDescription => $longdescription
				   });

  # Clean up
  wchdir('/');
  undef $delondie;
  if (wrapsystem("/bin/rm", "-rf", $tmpdir) != 0) {
    die "Failed to remove work directory $tmpdir";
  }

  return $dpkgfile;
}

=head1 NAME

gtkthemetodeb - Convert GTK+ theme to Debian package

=head1 SYNOPSIS

B<gtkthemetodeb>
[B<-p>]
[B<-i>]
[B<-r> I<command>]
[B<-R> I<command>]
I<tarball>...

=head1 DESCRIPTION

B<gtkthemetodeb> converts GTK themes in the ".tar.gz" files named in
its command line to ".deb" Debian packages.

With no options, the tarballs will be converted to .deb files only. In
order to do this, the .deb builder (dpkg-deb(1)) need to be run at
least through fakeroot(1). The command used to get "root privileges"
is specified with the B<-r> option.

The B<-i> option will automatically install the converted packages and
then delete the .deb files. In order to install a package, B<real>
root privileges are needed. The command needed to get these is
specified with the B<-R> option, if different from the command given
by B<-r>.

The B<-p> option will cause B<gtkthemetodeb> to print out which .deb
files were made in a program-parseable fashion. This is used
internally when the B<-r> option is used.

The output will look like this:

    gtkthemetodeb:I: qw[foo.deb bar.deb quux.deb]

=head1 EXAMPLES

   gtkthemetodeb -rfakeroot -Rsudo -i marble3D.tar.gz
   gtkthemetodeb -rsudo -i BrushedMetal.tar.gz

=head1 SEE ALSO

dpkg(1), dpkg-deb(1), Debian::ThemeConverters(3pm), fakeroot(1),
sudo(1)

=head1 AUTHOR

Steve Haslam <araqnid@debian.org>

=cut
