#! /usr/perl5/bin/perl -w

#

# Copyright (c) 2010, 2014, Oracle and/or its affiliates. All rights reserved.

#

# Permission is hereby granted, free of charge, to any person obtaining a

# copy of this software and associated documentation files (the "Software"),

# to deal in the Software without restriction, including without limitation

# the rights to use, copy, modify, merge, publish, distribute, sublicense,

# and/or sell copies of the Software, and to permit persons to whom the

# Software is furnished to do so, subject to the following conditions:

#

# The above copyright notice and this permission notice (including the next

# paragraph) shall be included in all copies or substantial portions of the

# Software.

#

# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR

# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,

# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL

# THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER

# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING

# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER

# DEALINGS IN THE SOFTWARE.

#

#

require 5.005;				# minimal Perl version required

use strict;				#

use diagnostics;			#

use integer;				#

use File::Spec;				# pathname manipulation routines

use English qw( -nomatchvars );

use Getopt::Long;

# Required arguments:

# -p <proto_area>

# -m <manifest>

my $proto_dir;

my $manifest;

my $result = GetOptions('p|protodir=s' => \$proto_dir,

                        'm|manifest=s' => \$manifest);

if (!defined($proto_dir)) {

  print STDERR "Missing required protodir argument\n";

  exit(1);

}

if (!defined($manifest)) {

  print STDERR "Missing required manifest argument\n";

  exit(1);

}

# Directories containing font files

my %fontdirs = ();

open my $MANIFEST, '<', $manifest

  or die "Cannot open manifest $manifest: $!\n";

while (my $man = <$MANIFEST>) {

  if ($man =~ m{path=(\S+)/fonts.dir}) {

    $fontdirs{$1} = $1;

  }

}

close $MANIFEST;

foreach my $fd (keys %fontdirs) {

  my $protofontpath = join('/', $proto_dir, $fd);

  my $protometafile = join('/', $proto_dir, $fd, 'fonts.dir');

  my %xlfds = ();

  if (! -f $protometafile) {

      # mkfontscale -b -s -l is equivalent to mkfontdir

      run_cmd("$proto_dir/usr/bin/mkfontscale", "-b", "-s", "-l",

	      $protofontpath);

  }

  open my $XFILE, '<', $protometafile

    or die "Cannot open $protometafile: $!\n";

  while (my $x = <$XFILE>) {

    chomp($x);

    if ($x =~ m{\s+}) {

      my ($fontfile, $fontxlfd) = split(/\s+/, $x, 2);

      $xlfds{$fontxlfd} = $fontfile;

      printf

	qq(<transform file path="$fd/%s" -> add info.file.font.xlfd "%s">\n),

	$fontfile, $fontxlfd;

    }

  }

  close $XFILE;

  $protometafile = join('/', $proto_dir, $fd, 'fonts.alias');

  if (-f $protometafile) {

    open my $XFILE, '<', $protometafile

      or die "Cannot open $protometafile: $!\n";

    while (my $x = <$XFILE>) {

      chomp($x);

      if ($x =~ m{\s+}) {

	my ($fontalias, $fontxlfd) = split(/\s+/, $x, 2);

	$fontxlfd =~ s{^"(.*)"$}{$1};

	if (exists $xlfds{$fontxlfd}) {

	  my $fontfile = $xlfds{$fontxlfd};

	  printf

	    qq(<transform file path="$fd/%s" -> add info.file.font.xlfd "%s">\n),

	      $fontfile, $fontalias;

	} else {

#	  print STDERR qq(No match found for "$fontxlfd" in $protometafile\n);

	}

      }

    }

    close $XFILE;

  }

}

# Run fc-scan from the proto area, since it wasn't delivered until build 141

my $fc_scan = "$proto_dir/usr/bin/fc-scan";

# See FcPatternFormat(3) for the full definition of the format syntax

#  %{file} => print the named value for this font

#  %{fullname|cescape} => print the named value with C-style string escapes

#			  (adds \ in front of \ or " characters)

#  %{?fullname{..A..}{..B..}} => if fullname is defined, then print A, else B

#  []fullname,fullnamelang{..A..} => for each pair of fullname & fullnamelang,

#					print A with those values substituted

my $fc_scan_format = q(--format=%{?fullname{%{[]fullname,fullnamelang{<transform file path="%{file}" -> add info.file.font.name:%{fullnamelang} "%{fullname|cescape}">\n}}}{%{[]family,style{<transform file path="%{file}" -> add info.file.font.name "%{family|cescape} %{style|cescape} %{pixelsize}">\n}}}});

chdir($proto_dir);

run_cmd($fc_scan, $fc_scan_format, keys %fontdirs);

exit(0);

sub run_cmd {

    my $cmd = $_[0];

    system(@_);

    if ($? == -1) {

	print STDERR "failed to execute $cmd: $!\n";

    }

    elsif ($? & 127) {

	printf STDERR "$cmd died with signal %d, %s coredump\n",

	($? & 127),  ($? & 128) ? 'with' : 'without';

    }

    elsif ($? != 0) {

	my $exit_code = $? >> 8;

	if ($exit_code != 1) {

	    printf STDERR "$cmd exited with value %d\n", $exit_code;

	    exit($exit_code);

	}

    }

}