trueroad/haranoaji-tlpost.pl

## haranoaji-tlpost.pl
#
# haranoaji-tlpost.pl:
#   Post action for haranoaji to link or copy files for TeX Live tlgs
# https://gist.github.com/trueroad/f83f2fbf68aa49ea7f3ab0708bf5fb9e
#
# Copyright (C) 2020 Masamichi Hosoda.
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions
# are met:
#
# * Redistributions of source code must retain the above copyright notice,
#   this list of conditions and the following disclaimer.
#
# * Redistributions in binary form must reproduce the above copyright notice,
#   this list of conditions and the following disclaimer in the documentation
#   and/or other materials provided with the distribution.
#
# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
# ARE DISCLAIMED.
# IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
# SUCH DAMAGE.
#

use strict;
use warnings;
use utf8;
use feature 'state';
use Encode;

my $verbose = 0;

if (win32 ()) {
    # These packages are not necessarily available on non-Windows, so
    # read them at runtime instead of compile time.
    require Encode::Locale;
    Encode::Locale->import ();

    # ':encoding(console_{in|out})' requires Encode::Locale package.
    binmode (STDIN, ':encoding(console_in)');
    binmode (STDOUT, ':encoding(console_out)');
    binmode (STDERR, ':encoding(console_out)');

    require Win32::API;
    Win32::API->import ();
    require File::Compare;
    File::Compare->import ();
} else {
    # for non-Windows, silently do nothing, to avoid tl-update-tlnet failure.
    exit 0;
}

# Font list: PostScript name => File name in TEXMF
my %font_list = (
    'HaranoAjiMincho-ExtraLight' => 'HaranoAjiMincho-ExtraLight.otf',
    'HaranoAjiMincho-Light'      => 'HaranoAjiMincho-Light.otf',
    'HaranoAjiMincho-Regular'    => 'HaranoAjiMincho-Regular.otf',
    'HaranoAjiMincho-Medium'     => 'HaranoAjiMincho-Medium.otf',
    'HaranoAjiMincho-SemiBold'   => 'HaranoAjiMincho-SemiBold.otf',
    'HaranoAjiMincho-Bold'       => 'HaranoAjiMincho-Bold.otf',
    'HaranoAjiMincho-Heavy'      => 'HaranoAjiMincho-Heavy.otf',

    'HaranoAjiGothic-ExtraLight' => 'HaranoAjiGothic-ExtraLight.otf',
    'HaranoAjiGothic-Light'      => 'HaranoAjiGothic-Light.otf',
    'HaranoAjiGothic-Normal'     => 'HaranoAjiGothic-Normal.otf',
    'HaranoAjiGothic-Regular'    => 'HaranoAjiGothic-Regular.otf',
    'HaranoAjiGothic-Medium'     => 'HaranoAjiGothic-Medium.otf',
    'HaranoAjiGothic-Bold'       => 'HaranoAjiGothic-Bold.otf',
    'HaranoAjiGothic-Heavy'      => 'HaranoAjiGothic-Heavy.otf'
    );

# CMap list for install
my @cmap_list_install = ('2004-H', '2004-V');

# CMap list for snippet
my @cmap_list_snippet = (
    'H', 'V',
    '2004-H', '2004-V',
    'UniJIS-UTF16-H', 'UniJIS-UTF16-V',
    'UniJIS2004-UTF16-H', 'UniJIS2004-UTF16-V',
    'UniJIS-UCS2-H'
    );

my $mode = lc (decode ('locale', $ARGV[0]));
my $texdir = decode ('locale', $ARGV[1]);

unshift (@INC, "$texdir/tlpkg");
require TeXLive::TLUtils;

my_log ("haranoaji-tlpost\n");

my $resourcedir = "$texdir/tlpkg/tlgs/Resource";
my $cidfontdir = "$resourcedir/CIDFont";
my $cmapdir = "$resourcedir/CMap";
my $fontdir = "$resourcedir/Font";

if ($mode eq 'install') {
    do_install();
} elsif ($mode eq 'remove') {
    do_remove();
} else {
    die ("unknown mode: $mode\n");
}

my_log ("\ndone.\n");

exit 0;

# Install
sub do_install {
    my_log ("\ndo_install\n");

    tlgs_check ();

    install_cidfont ();
    install_cmap ();
    install_snippet ();
}

# Remove
sub do_remove {
    my_log ("\ndo_remove\n");

    tlgs_check ();

    remove_cidfont ();
    # We don't remove CMaps because other components may use them.
    #remove_cmap ();
    remove_snippet ();
}

# tlgs directories existence check
sub tlgs_check {
    wrapper_isdir ($resourcedir) or
        die ("Not found: tlgs Resource directory: ${resourcedir}\n");

    wrapper_isdir ($cidfontdir) or
        die ("Not found: tlgs CIDFont directory: ${cidfontdir}\n");

    wrapper_isdir ($cmapdir) or
        die ("Not found: tlgs CMap directory: ${cmapdir}\n");

    wrapper_isdir ($cmapdir) or
        die ("Not found: tlgs Font directory: ${fontdir}\n");
}

# Link or copy CID font
sub install_cidfont {
    my_log ("\ninstall_cidfont\n");

    for my $psname (sort keys %font_list) {
        my_log ("\nFor $psname ...\n");

        my $fontpath_in_texmf = search_fontpath ($font_list{$psname});
        if (! $fontpath_in_texmf) {
            my_log ("Not found: Font in TEXMF: $font_list{$psname}\n");
            next;
        }

        my $fontpath_in_cidfontdir = "$cidfontdir/$psname";
        if (wrapper_isfile ($fontpath_in_cidfontdir)) {
            my_log ("Already exists: ${fontpath_in_cidfontdir}\n");
            if (file_compare ($fontpath_in_texmf, $fontpath_in_cidfontdir)) {
                my_log ("Different from the file in TEXMF. Deleting.\n");
                wrapper_unlink ($fontpath_in_cidfontdir);
            } else {
                my_log ("Same as the file in TEXMF. Skipping.\n");
                next;
            }
        }

        link_or_copy ($fontpath_in_texmf, $fontpath_in_cidfontdir);
    }
}

# Link or copy CMap
sub install_cmap {
    my_log ("\ninstall_cmap\n");

    foreach my $cmapname (@cmap_list_install) {
        my_log ("\nFor $cmapname ...\n");

        my $cmappath_in_texmf = search_cmappath ($cmapname);
        if (! $cmappath_in_texmf) {
            my_log ("Not found: CMap in TEXMF: $cmapname\n");
            next;
        }

        my $cmappath_in_cmapdir = "$cmapdir/$cmapname";
        if (wrapper_isfile ($cmappath_in_cmapdir)) {
            my_log ("Already exists: ${cmappath_in_cmapdir}\n");
            if (file_compare ($cmappath_in_texmf, $cmappath_in_cmapdir)) {
                my_log ("Different from the file in TEXMF. Deleting.\n");
                wrapper_unlink ($cmappath_in_cmapdir);
            } else {
                my_log ("Same as the file in TEXMF. Skipping.\n");
                next;
            }
        }

        link_or_copy ($cmappath_in_texmf, $cmappath_in_cmapdir);
    }
}

# Create snippet
sub install_snippet {
    my_log ("\ninstall_snippet\n");

    for my $psname (sort keys %font_list) {
        my_log ("\nFor $psname ...\n");

        foreach my $cmapname (@cmap_list_snippet) {
            my $snippetpath = "$fontdir/$psname-$cmapname";
            if (wrapper_isfile ($snippetpath)) {
                my_log ("Already exists: ${snippetpath}\nDeleting.\n");
                wrapper_unlink ($snippetpath);
            }

            my $contents = <<"EOS";
%!PS-Adobe-3.0 Resource-Font
%%DocumentNeededResources: $cmapname (CMap)
%%IncludeResource: $cmapname (CMap)
%%BeginResource: Font ($psname-$cmapname)
($psname-$cmapname)
($cmapname) /CMap findresource
[($psname) /CIDFont findresource]
composefont
pop
%%EndResource
%%EOF
EOS
            create_file_with_contents ($snippetpath,
                                       encode ('UTF-8', $contents));
            my_log ("Created: ${snippetpath}\n");
        }
    }
}

# Remove CID font
sub remove_cidfont {
    my_log ("\nremove_cidfont\n");

    for my $psname (sort keys %font_list) {
        my_log ("\nFor $psname ...\n");

        my $fontpath_in_cidfontdir = "$cidfontdir/$psname";
        if (wrapper_isfile ($fontpath_in_cidfontdir)) {
            wrapper_unlink ($fontpath_in_cidfontdir);
            my_log ("Removed: ${fontpath_in_cidfontdir}\n");
        } else {
            my_log ("Not exist: ${fontpath_in_cidfontdir}\n");
        }
    }
}

# Remove snippet
sub remove_snippet {
    my_log ("\nremove_snippet\n");

    for my $psname (sort keys %font_list) {
        my_log ("\nFor $psname ...\n");

        foreach my $cmapname (@cmap_list_snippet) {
            my $snippetpath = "$fontdir/$psname-$cmapname";
            if (wrapper_isfile ($snippetpath)) {
                wrapper_unlink ($snippetpath);
                my_log ("Removed: ${snippetpath}\n");
            } else {
                my_log ("Not exist: ${snippetpath}\n");
            }
        }
    }
}

# Check Windows environment
sub win32 { return ($^O=~/^MSWin(32|64)$/i); }

# Log
sub my_log {
    my ($msg) = @_;

    print $msg if ($verbose);
    TeXLive::TLUtils::log ($msg);
}

# Warn
sub my_warn {
    my ($msg) = @_;

    TeXLive::TLUtils::tlwarn ($msg);
}

# Search TEXMF font path
sub search_fontpath {
    my ($filename) = @_;

    my $foo = kpsewhich ($filename);

    if ($foo eq "") {
        my_log ("Not found font path: ${filename}\n");
        return;
    }

    my_log ("Font path is ${foo}.\n");
    return $foo;
}

# Search TEXMF CMap path
sub search_cmappath {
    my ($cmapname) = @_;

    my $foo = kpsewhich ("-format=cmap $cmapname");

    if ($foo eq "") {
        my_log ("Not found CMap path: ${cmapname}\n");
        return;
    }

    my_log ("CMap path is ${foo}.\n");
    return $foo;
}

# Invoke kpsewhich
sub kpsewhich {
    my ($name) = @_;

    # We use perl's active code page for invoking kpsewhich
    # because perl passes the command line string to the invoking API.
    my $cmdline = encode ('locale', "kpsewhich $name");
    chomp (my $result = `$cmdline`);

    # !!!FIXME!!!
    # We can not know the character code output by kpsewhich.
    # So we assume that it is the same as perl's active code page.
    # The active code pages for perl and kpsewhich may be different,
    # in which case non-US-ASCII characters are garbled.
    # There is no problem when the path name contains only US-ASCII.
    $result = decode ('locale', $result);

    return $result;
}

# Try symbolic link, hard link, copy
sub link_or_copy {
    my ($existingfilename, $newfilename) = @_;

    if (wrapper_symlink ($existingfilename, $newfilename)) {
        my_log ("Symbolic link succeeded: ${newfilename}\n");
        return;
    }

    if (wrapper_hardlink ($existingfilename, $newfilename)) {
        my_log ("Hard link succeeded: ${newfilename}\n");
        return;
    }

    if (wrapper_copy ($existingfilename, $newfilename)) {
        my_log ("Copy succeeded: ${newfilename}\n");
        return;
    }

    my_warn ("Link/copy failed: ${newfilename}\n");
}

# Create file with contents
sub create_file_with_contents {
    my ($filename, $contents) = @_;

    # TODO: Create file by -W API on Windows
    open (my $fh, ">:raw", encode ('locale_fs', $filename)) or
        die ("Open failed: ${filename}\n");
    print $fh $contents;
    close $fh;
}

# File compare
sub file_compare {
    my ($filename1, $filename2) = @_;

    # TODO: Compare file by -W API on Windows
    my $result = compare (encode ('locale_fs', $filename1),
                          encode ('locale_fs', $filename2));
    if ($result == -1) {
        die ("File compare failed: ${filename1}, ${filename2}\n");
    }

    return $result;
}

# Directory existence check
sub wrapper_isdir {
    my ($dirname) = @_;

    # TODO: Directory existence check by -W API on Windows
    if ( -d encode ('locale_fs', $dirname) ) {
        return 1;
    }

    return;
}

# File existence check
sub wrapper_isfile {
    my ($filename) = @_;

    # TODO: File existence check by -W API on Windows
    if ( -f encode ('locale_fs', $filename) ) {
        return 1;
    }

    return;
}

# Remove file
sub wrapper_unlink {
    my ($filename) = @_;

    # TODO: Remove file by -W API on Windows
    return unlink (encode ('locale_fs', $filename));
}

# Create symbolic link
sub wrapper_symlink {
    my ($existingfilename, $newfilename) = @_;

    # We use CreateSymbolicLinkW API directly for creating symbolic link
    # because perl's symlink function may not work in Windows.
    state $createsymboliclinkw = load_createsymboliclinkw ();

    $existingfilename =~ s|/|\\|g;
    $newfilename =~ s|/|\\|g;

    my $r = $createsymboliclinkw->Call (
        encode ('UTF-16LE', $newfilename),
        encode ('UTF-16LE', $existingfilename),
        0
        );
    if (ord($r) != 0) {
        return 1;
    }
    my $msg = decode ('locale',
                      Win32::FormatMessage (Win32::GetLastError ()));
    $msg =~ s/[\r\n]+\z//;
    my_log ("CreateSymbolicLinkW failed: ${msg}\n");

    return 0;
}

# Create hard link
sub wrapper_hardlink {
    my ($existingfilename, $newfilename) = @_;

    # We use CreateHardLinkW API directly for creating hard link
    # because -W API is not affected by the perl's active code page.
    state $createhardlinkw = load_createhardlinkw ();

    $existingfilename =~ s|/|\\|g;
    $newfilename =~ s|/|\\|g;

    my $r = $createhardlinkw->Call (
        encode ('UTF-16LE', $newfilename),
        encode ('UTF-16LE', $existingfilename),
        0
        );
    if ($r) {
        return 1;
    }
    my $msg = decode ('locale',
                      Win32::FormatMessage (Win32::GetLastError ()));
    $msg =~ s/[\r\n]+\z//;
    my_log ("CreateHardLinkW failed: ${msg}\n");

    return 0;
}

# Copy file
sub wrapper_copy {
    my ($existingfilename, $newfilename) = @_;

    # We use CopyFileW API directly for copying file
    # because -W API is not affected by the perl's active code page.
    state $copyfilew = load_copyfilew ();

    $existingfilename =~ s|/|\\|g;
    $newfilename =~ s|/|\\|g;

    my $r = $copyfilew->Call (
        encode ('UTF-16LE', $existingfilename),
        encode ('UTF-16LE', $newfilename),
        1
        );
    if ($r) {
        return 1;
    }
    my $msg = decode ('locale',
                      Win32::FormatMessage (Win32::GetLastError ()));
    $msg =~ s/[\r\n]+\z//;
    my_log ("CopyFileW failed: ${msg}\n");

    return 0;
}

# Load CreateSymbolicLinkW API
sub load_createsymboliclinkw {
    my $createsymboliclinkw = Win32::API::More->new (
        'kernel32.dll',
        'BOOLEAN CreateSymbolicLinkW(
           LPCWSTR lpSymlinkFileName,
           LPCWSTR lpTargetFileName,
           DWORD   dwFlags
         )'
        ) or die ('Failed: Win32::API::More->new CreateSymbolicLinkW');

    return $createsymboliclinkw;
}
# Load CreateHardLinkW API
sub load_createhardlinkw {
    my $createhardlinkw = Win32::API::More->new (
        'kernel32.dll',
        'BOOL CreateHardLinkW(
           LPCWSTR  lpFileName,
           LPCWSTR  lpExistingFileName,
           UINT_PTR lpSecurityAttributes
          )'
        ) or die ('Failed: Win32::API::More->new CreateHardLinkW');

    return $createhardlinkw;
}

# Load CopyFileW API
sub load_copyfilew {
    my $copyfilew = Win32::API::More->new (
        'kernel32.dll',
        'BOOL CopyFileW(
           LPCWSTR lpExistingFileName,
           LPCWSTR lpNewFileName,
           BOOL    bFailIfExists
         )'
        ) or die ('Failed: Win32::API::More->new CopyFileW');

    return $copyfilew;
}
	#
	# haranoaji-tlpost.pl:
	# Post action for haranoaji to link or copy files for TeX Live tlgs
	# https://gist.github.com/trueroad/f83f2fbf68aa49ea7f3ab0708bf5fb9e
	#
	# Copyright (C) 2020 Masamichi Hosoda.
	# All rights reserved.
	#
	# Redistribution and use in source and binary forms, with or without
	# modification, are permitted provided that the following conditions
	# are met:
	#
	# * Redistributions of source code must retain the above copyright notice,
	# this list of conditions and the following disclaimer.
	#
	# * Redistributions in binary form must reproduce the above copyright notice,
	# this list of conditions and the following disclaimer in the documentation
	# and/or other materials provided with the distribution.
	#
	# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
	# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
	# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
	# ARE DISCLAIMED.
	# IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
	# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
	# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
	# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
	# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
	# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
	# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
	# SUCH DAMAGE.
	#

	use strict;
	use warnings;
	use utf8;
	use feature 'state';
	use Encode;

	my $verbose = 0;

	if (win32 ()) {
	# These packages are not necessarily available on non-Windows, so
	# read them at runtime instead of compile time.
	require Encode::Locale;
	Encode::Locale->import ();

	# ':encoding(console_{in\|out})' requires Encode::Locale package.
	binmode (STDIN, ':encoding(console_in)');
	binmode (STDOUT, ':encoding(console_out)');
	binmode (STDERR, ':encoding(console_out)');

	require Win32::API;
	Win32::API->import ();
	require File::Compare;
	File::Compare->import ();
	} else {
	# for non-Windows, silently do nothing, to avoid tl-update-tlnet failure.
	exit 0;
	}

	# Font list: PostScript name => File name in TEXMF
	my %font_list = (
	'HaranoAjiMincho-ExtraLight' => 'HaranoAjiMincho-ExtraLight.otf',
	'HaranoAjiMincho-Light' => 'HaranoAjiMincho-Light.otf',
	'HaranoAjiMincho-Regular' => 'HaranoAjiMincho-Regular.otf',
	'HaranoAjiMincho-Medium' => 'HaranoAjiMincho-Medium.otf',
	'HaranoAjiMincho-SemiBold' => 'HaranoAjiMincho-SemiBold.otf',
	'HaranoAjiMincho-Bold' => 'HaranoAjiMincho-Bold.otf',
	'HaranoAjiMincho-Heavy' => 'HaranoAjiMincho-Heavy.otf',

	'HaranoAjiGothic-ExtraLight' => 'HaranoAjiGothic-ExtraLight.otf',
	'HaranoAjiGothic-Light' => 'HaranoAjiGothic-Light.otf',
	'HaranoAjiGothic-Normal' => 'HaranoAjiGothic-Normal.otf',
	'HaranoAjiGothic-Regular' => 'HaranoAjiGothic-Regular.otf',
	'HaranoAjiGothic-Medium' => 'HaranoAjiGothic-Medium.otf',
	'HaranoAjiGothic-Bold' => 'HaranoAjiGothic-Bold.otf',
	'HaranoAjiGothic-Heavy' => 'HaranoAjiGothic-Heavy.otf'
	);

	# CMap list for install
	my @cmap_list_install = ('2004-H', '2004-V');

	# CMap list for snippet
	my @cmap_list_snippet = (
	'H', 'V',
	'2004-H', '2004-V',
	'UniJIS-UTF16-H', 'UniJIS-UTF16-V',
	'UniJIS2004-UTF16-H', 'UniJIS2004-UTF16-V',
	'UniJIS-UCS2-H'
	);

	my $mode = lc (decode ('locale', $ARGV[0]));
	my $texdir = decode ('locale', $ARGV[1]);

	unshift (@INC, "$texdir/tlpkg");
	require TeXLive::TLUtils;

	my_log ("haranoaji-tlpost\n");

	my $resourcedir = "$texdir/tlpkg/tlgs/Resource";
	my $cidfontdir = "$resourcedir/CIDFont";
	my $cmapdir = "$resourcedir/CMap";
	my $fontdir = "$resourcedir/Font";

	if ($mode eq 'install') {
	do_install();
	} elsif ($mode eq 'remove') {
	do_remove();
	} else {
	die ("unknown mode: $mode\n");
	}

	my_log ("\ndone.\n");

	exit 0;

	# Install
	sub do_install {
	my_log ("\ndo_install\n");

	tlgs_check ();

	install_cidfont ();
	install_cmap ();
	install_snippet ();
	}

	# Remove
	sub do_remove {
	my_log ("\ndo_remove\n");

	tlgs_check ();

	remove_cidfont ();
	# We don't remove CMaps because other components may use them.
	#remove_cmap ();
	remove_snippet ();
	}

	# tlgs directories existence check
	sub tlgs_check {
	wrapper_isdir ($resourcedir) or
	die ("Not found: tlgs Resource directory: ${resourcedir}\n");

	wrapper_isdir ($cidfontdir) or
	die ("Not found: tlgs CIDFont directory: ${cidfontdir}\n");

	wrapper_isdir ($cmapdir) or
	die ("Not found: tlgs CMap directory: ${cmapdir}\n");

	wrapper_isdir ($cmapdir) or
	die ("Not found: tlgs Font directory: ${fontdir}\n");
	}

	# Link or copy CID font
	sub install_cidfont {
	my_log ("\ninstall_cidfont\n");

	for my $psname (sort keys %font_list) {
	my_log ("\nFor $psname ...\n");

	my $fontpath_in_texmf = search_fontpath ($font_list{$psname});
	if (! $fontpath_in_texmf) {
	my_log ("Not found: Font in TEXMF: $font_list{$psname}\n");
	next;
	}

	my $fontpath_in_cidfontdir = "$cidfontdir/$psname";
	if (wrapper_isfile ($fontpath_in_cidfontdir)) {
	my_log ("Already exists: ${fontpath_in_cidfontdir}\n");
	if (file_compare ($fontpath_in_texmf, $fontpath_in_cidfontdir)) {
	my_log ("Different from the file in TEXMF. Deleting.\n");
	wrapper_unlink ($fontpath_in_cidfontdir);
	} else {
	my_log ("Same as the file in TEXMF. Skipping.\n");
	next;
	}
	}

	link_or_copy ($fontpath_in_texmf, $fontpath_in_cidfontdir);
	}
	}

	# Link or copy CMap
	sub install_cmap {
	my_log ("\ninstall_cmap\n");

	foreach my $cmapname (@cmap_list_install) {
	my_log ("\nFor $cmapname ...\n");

	my $cmappath_in_texmf = search_cmappath ($cmapname);
	if (! $cmappath_in_texmf) {
	my_log ("Not found: CMap in TEXMF: $cmapname\n");
	next;
	}

	my $cmappath_in_cmapdir = "$cmapdir/$cmapname";
	if (wrapper_isfile ($cmappath_in_cmapdir)) {
	my_log ("Already exists: ${cmappath_in_cmapdir}\n");
	if (file_compare ($cmappath_in_texmf, $cmappath_in_cmapdir)) {
	my_log ("Different from the file in TEXMF. Deleting.\n");
	wrapper_unlink ($cmappath_in_cmapdir);
	} else {
	my_log ("Same as the file in TEXMF. Skipping.\n");
	next;
	}
	}

	link_or_copy ($cmappath_in_texmf, $cmappath_in_cmapdir);
	}
	}

	# Create snippet
	sub install_snippet {
	my_log ("\ninstall_snippet\n");

	for my $psname (sort keys %font_list) {
	my_log ("\nFor $psname ...\n");

	foreach my $cmapname (@cmap_list_snippet) {
	my $snippetpath = "$fontdir/$psname-$cmapname";
	if (wrapper_isfile ($snippetpath)) {
	my_log ("Already exists: ${snippetpath}\nDeleting.\n");
	wrapper_unlink ($snippetpath);
	}

	my $contents = <<"EOS";
	%!PS-Adobe-3.0 Resource-Font
	%%DocumentNeededResources: $cmapname (CMap)
	%%IncludeResource: $cmapname (CMap)
	%%BeginResource: Font ($psname-$cmapname)
	($psname-$cmapname)
	($cmapname) /CMap findresource
	[($psname) /CIDFont findresource]
	composefont
	pop
	%%EndResource
	%%EOF
	EOS
	create_file_with_contents ($snippetpath,
	encode ('UTF-8', $contents));
	my_log ("Created: ${snippetpath}\n");
	}
	}
	}

	# Remove CID font
	sub remove_cidfont {
	my_log ("\nremove_cidfont\n");

	for my $psname (sort keys %font_list) {
	my_log ("\nFor $psname ...\n");

	my $fontpath_in_cidfontdir = "$cidfontdir/$psname";
	if (wrapper_isfile ($fontpath_in_cidfontdir)) {
	wrapper_unlink ($fontpath_in_cidfontdir);
	my_log ("Removed: ${fontpath_in_cidfontdir}\n");
	} else {
	my_log ("Not exist: ${fontpath_in_cidfontdir}\n");
	}
	}
	}

	# Remove snippet
	sub remove_snippet {
	my_log ("\nremove_snippet\n");

	for my $psname (sort keys %font_list) {
	my_log ("\nFor $psname ...\n");

	foreach my $cmapname (@cmap_list_snippet) {
	my $snippetpath = "$fontdir/$psname-$cmapname";
	if (wrapper_isfile ($snippetpath)) {
	wrapper_unlink ($snippetpath);
	my_log ("Removed: ${snippetpath}\n");
	} else {
	my_log ("Not exist: ${snippetpath}\n");
	}
	}
	}
	}

	# Check Windows environment
	sub win32 { return ($^O=~/^MSWin(32\|64)$/i); }

	# Log
	sub my_log {
	my ($msg) = @_;

	print $msg if ($verbose);
	TeXLive::TLUtils::log ($msg);
	}

	# Warn
	sub my_warn {
	my ($msg) = @_;

	TeXLive::TLUtils::tlwarn ($msg);
	}

	# Search TEXMF font path
	sub search_fontpath {
	my ($filename) = @_;

	my $foo = kpsewhich ($filename);

	if ($foo eq "") {
	my_log ("Not found font path: ${filename}\n");
	return;
	}

	my_log ("Font path is ${foo}.\n");
	return $foo;
	}

	# Search TEXMF CMap path
	sub search_cmappath {
	my ($cmapname) = @_;

	my $foo = kpsewhich ("-format=cmap $cmapname");

	if ($foo eq "") {
	my_log ("Not found CMap path: ${cmapname}\n");
	return;
	}

	my_log ("CMap path is ${foo}.\n");
	return $foo;
	}

	# Invoke kpsewhich
	sub kpsewhich {
	my ($name) = @_;

	# We use perl's active code page for invoking kpsewhich
	# because perl passes the command line string to the invoking API.
	my $cmdline = encode ('locale', "kpsewhich $name");
	chomp (my $result = `$cmdline`);

	# !!!FIXME!!!
	# We can not know the character code output by kpsewhich.
	# So we assume that it is the same as perl's active code page.
	# The active code pages for perl and kpsewhich may be different,
	# in which case non-US-ASCII characters are garbled.
	# There is no problem when the path name contains only US-ASCII.
	$result = decode ('locale', $result);

	return $result;
	}

	# Try symbolic link, hard link, copy
	sub link_or_copy {
	my ($existingfilename, $newfilename) = @_;

	if (wrapper_symlink ($existingfilename, $newfilename)) {
	my_log ("Symbolic link succeeded: ${newfilename}\n");
	return;
	}

	if (wrapper_hardlink ($existingfilename, $newfilename)) {
	my_log ("Hard link succeeded: ${newfilename}\n");
	return;
	}

	if (wrapper_copy ($existingfilename, $newfilename)) {
	my_log ("Copy succeeded: ${newfilename}\n");
	return;
	}

	my_warn ("Link/copy failed: ${newfilename}\n");
	}

	# Create file with contents
	sub create_file_with_contents {
	my ($filename, $contents) = @_;

	# TODO: Create file by -W API on Windows
	open (my $fh, ">:raw", encode ('locale_fs', $filename)) or
	die ("Open failed: ${filename}\n");
	print $fh $contents;
	close $fh;
	}

	# File compare
	sub file_compare {
	my ($filename1, $filename2) = @_;

	# TODO: Compare file by -W API on Windows
	my $result = compare (encode ('locale_fs', $filename1),
	encode ('locale_fs', $filename2));
	if ($result == -1) {
	die ("File compare failed: ${filename1}, ${filename2}\n");
	}

	return $result;
	}

	# Directory existence check
	sub wrapper_isdir {
	my ($dirname) = @_;

	# TODO: Directory existence check by -W API on Windows
	if ( -d encode ('locale_fs', $dirname) ) {
	return 1;
	}

	return;
	}

	# File existence check
	sub wrapper_isfile {
	my ($filename) = @_;

	# TODO: File existence check by -W API on Windows
	if ( -f encode ('locale_fs', $filename) ) {
	return 1;
	}

	return;
	}

	# Remove file
	sub wrapper_unlink {
	my ($filename) = @_;

	# TODO: Remove file by -W API on Windows
	return unlink (encode ('locale_fs', $filename));
	}

	# Create symbolic link
	sub wrapper_symlink {
	my ($existingfilename, $newfilename) = @_;

	# We use CreateSymbolicLinkW API directly for creating symbolic link
	# because perl's symlink function may not work in Windows.
	state $createsymboliclinkw = load_createsymboliclinkw ();

	$existingfilename =~ s\|/\|\\\|g;
	$newfilename =~ s\|/\|\\\|g;

	my $r = $createsymboliclinkw->Call (
	encode ('UTF-16LE', $newfilename),
	encode ('UTF-16LE', $existingfilename),
	0
	);
	if (ord($r) != 0) {
	return 1;
	}
	my $msg = decode ('locale',
	Win32::FormatMessage (Win32::GetLastError ()));
	$msg =~ s/[\r\n]+\z//;
	my_log ("CreateSymbolicLinkW failed: ${msg}\n");

	return 0;
	}

	# Create hard link
	sub wrapper_hardlink {
	my ($existingfilename, $newfilename) = @_;

	# We use CreateHardLinkW API directly for creating hard link
	# because -W API is not affected by the perl's active code page.
	state $createhardlinkw = load_createhardlinkw ();

	$existingfilename =~ s\|/\|\\\|g;
	$newfilename =~ s\|/\|\\\|g;

	my $r = $createhardlinkw->Call (
	encode ('UTF-16LE', $newfilename),
	encode ('UTF-16LE', $existingfilename),
	0
	);
	if ($r) {
	return 1;
	}
	my $msg = decode ('locale',
	Win32::FormatMessage (Win32::GetLastError ()));
	$msg =~ s/[\r\n]+\z//;
	my_log ("CreateHardLinkW failed: ${msg}\n");

	return 0;
	}

	# Copy file
	sub wrapper_copy {
	my ($existingfilename, $newfilename) = @_;

	# We use CopyFileW API directly for copying file
	# because -W API is not affected by the perl's active code page.
	state $copyfilew = load_copyfilew ();

	$existingfilename =~ s\|/\|\\\|g;
	$newfilename =~ s\|/\|\\\|g;

	my $r = $copyfilew->Call (
	encode ('UTF-16LE', $existingfilename),
	encode ('UTF-16LE', $newfilename),
	1
	);
	if ($r) {
	return 1;
	}
	my $msg = decode ('locale',
	Win32::FormatMessage (Win32::GetLastError ()));
	$msg =~ s/[\r\n]+\z//;
	my_log ("CopyFileW failed: ${msg}\n");

	return 0;
	}

	# Load CreateSymbolicLinkW API
	sub load_createsymboliclinkw {
	my $createsymboliclinkw = Win32::API::More->new (
	'kernel32.dll',
	'BOOLEAN CreateSymbolicLinkW(
	LPCWSTR lpSymlinkFileName,
	LPCWSTR lpTargetFileName,
	DWORD dwFlags
	)'
	) or die ('Failed: Win32::API::More->new CreateSymbolicLinkW');

	return $createsymboliclinkw;
	}
	# Load CreateHardLinkW API
	sub load_createhardlinkw {
	my $createhardlinkw = Win32::API::More->new (
	'kernel32.dll',
	'BOOL CreateHardLinkW(
	LPCWSTR lpFileName,
	LPCWSTR lpExistingFileName,
	UINT_PTR lpSecurityAttributes
	)'
	) or die ('Failed: Win32::API::More->new CreateHardLinkW');

	return $createhardlinkw;
	}

	# Load CopyFileW API
	sub load_copyfilew {
	my $copyfilew = Win32::API::More->new (
	'kernel32.dll',
	'BOOL CopyFileW(
	LPCWSTR lpExistingFileName,
	LPCWSTR lpNewFileName,
	BOOL bFailIfExists
	)'
	) or die ('Failed: Win32::API::More->new CopyFileW');

	return $copyfilew;
	}