#!/usr/bin/perl

# ttf2tex-mkpkg - Generated a Debian package to use a TTF family
# Copyright (C) 2007  Rafael Laboissiere

# ttf2tex-mkpkg 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.

# ttf2tex-mkpkg  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.

# $Id: ttf2tex-mkpkg 2777 2007-03-26 20:32:38Z rafael $

use YAML qw [LoadFile];

(my $prog = $0) =~ s{.*/}{};

my $default_desc = "ttf2tex.yaml";

die "Usage $prog [$default_desc]\n"
  if $#ARGV > 0;

my $desc = $#ARGV == 0 ? $ARGV [0] : $default_desc;

### Default values for package name, version and generalfamily
my %defaults = (version => "0.1",
                generalfamily => "rm");

while (($k, $v) = each (%defaults)) {
  ${$k} = $v;
}

### Create variables whose names are the fields in the YAML description file
my $hashref = LoadFile ($desc)
 or "$prog:E: Cannot find YAML description file $desc";

map {
  ${$_} = $hashref->{$_};
} keys %$hashref;

map {
  die "$prog:E: Mandatory field `$_' is lacking in $desc\n"
    if not defined ${$_};
} ("foundry", "font", "family");

### Check generalfamily
die "$prog:E: General family '$generalfamily' must be one of 'rm', 'sf', or 'tt'!\n"
  if not defined {(rm=>1, sf=>1, tt=>1)}->{$generalfamily};

mkdir $pkgdir;

### Copy TTF files locally
my $found = 0;
map {
  my $weight = $_;
  map {
    my $stem = "$weight$_";
    if (defined ${$stem}) {
      system ("cp ${$stem} $family${stem}16.ttf") == 0
        or warn "$prog:W: File ${$stem} not found\n";
      $found = 1;
    }
  } ("", "i");
} ("a", "j", "l", "k", "r", "m", "d", "s", "b", "x", "h", "c", "u", "p");

if (not $found) {
  rmdir $pkgdir;
  die "$prog:E: No TTF was found.  Giving up.\n"
}

$package = "latex-$font-font";
$username = get_username ();
$email = get_email ();
$date = qx {date --rfc-2822};
chomp $date;
$year = qx {date +%Y};
chomp $year;

my $templates_dir = "/usr/share/ttf2tex";

$dashline = "-" x length ("$package for Debian");

mkdir "debian"
  or die "$prog:E: Unable to create debian directory\n";

map {
  process_file ("$templates_dir/$_", "debian/$_")
} ("rules", "control", "copyright", "changelog", "README.Debian", "links",
   "compat", "install", "font.sty", "test.tex", "examples", "genmap");

map {
  chmod (0755, $_)
    or die "$prog:E: Unable to make $_ executable\n";
} ("debian/rules","debian/genmap");

print "Your package is ready to be built.  Edit the files in the\n"
  . "debian/ directory and run debuild or dpkg-buildpackage.\n";

### The following sburoutines (process_file, get_username, and get_email)
### are either highly inspired or simply stolen verbatim from the
### dh-make package
### Copyright (C) 1998-2006 Craig Small <csmall@debian.org>
### Released under the terms of the GNU GPL version 2 or later

sub process_file (@) {
  my ($infile, $outfile) = @_;
  my $line;

  open (IN, "< $infile")
    or die "$prog:E:Unable to open template file $infile for reading\n";
  open (OUT, "> $outfile")
    or die "$prog:E:Unable to open template file $outfile for writing\n";

  while (defined ($line = <IN>)) {

    map {
      $line =~ s/#$_#/${lc $_}/eg;
    } ("PACKAGE", "VERSION", "USERNAME", "EMAIL", "DATE", "YEAR",
       "FOUNDRY", "FAMILY",  "FONT", "DASHLINE", "GENERALFAMILY");

    print OUT $line;
  }
  close IN;
  close OUT;
}

sub get_username
{
  my $tmpusername = '';

  if (exists($ENV{'DEBFULLNAME'})) {
    $tmpusername = $ENV{'DEBFULLNAME'};
  }
  return $tmpusername if ($tmpusername ne "");

  if (-x '/usr/bin/getent')
  {
    $tmpusername = `/usr/bin/getent passwd $ENV{LOGNAME}|awk -F: '\{ print \$5;
\}' | cut -f1 -d,`;
  }
  chomp($tmpusername);
  return $tmpusername if ($tmpusername ne "");

  $tmpusername =`awk -F: -vUSER=$ENV{LOGNAME} '\$1 == USER \{ print \$5; \}' /etc/passwd | cut -f1 -d,`;
  chomp($tmpusername);
  return $tmpusername if ($tmpusername ne "");

  if (-x '/usr/bin/ypmatch')
  {
    $tmpusername=`ypmatch $ENV{LOGNAME} passwd.byname|awk -F: '\{ print \$5; \}' | cut -f1 -d,`;
  }
  chomp($tmpusername);
  return $tmpusername if ($tmpusername ne "");

  if (-x '/usr/bin/ldapsearch')
  {
    $tmpusername = [map {/^(?:gecos|cn): (.*)/} `ldapsearch -Q -LLL uid=$ENV{LOGNAME} gecos cn`]->[0];
  }
  chomp($tmpusername);
  return $tmpusername if ($tmpusername ne "");

  return "unknown";
}

sub get_email()
{
  if ($ENV{DEBEMAIL} )
  {
    return $ENV{DEBEMAIL};
  }
  if ($ENV{EMAIL} )
  {
    return $ENV{EMAIL};
  }
  if (-x '/usr/bin/ldapsearch')
  {
    my $mail;
    $mail = [map {/^mail: (.*)/ && $1} `ldapsearch -Q -LLL uid=$ENV{LOGNAME} mail`]->[0];
      return $mail if $mail;
  }
  if ($ENV{LOGNAME} )
  {
    my $mailhost;
    if ( -e '/etc/mailname'){
      chomp($mailhost = `cat /etc/mailname`);
    } else {
      $mailhost='unknown';
    }
    return  ($ENV{LOGNAME} . '@' . $mailhost);
  }
}

