texlive[57238] Master/tlpkg: ptex-fontmaps-tlpost.pl: prepare for
commits+hironobu at tug.org
commits+hironobu at tug.org
Sun Dec 27 13:34:58 CET 2020
Revision: 57238
http://tug.org/svn/texlive?view=revision&revision=57238
Author: hironobu
Date: 2020-12-27 13:34:58 +0100 (Sun, 27 Dec 2020)
Log Message:
-----------
ptex-fontmaps-tlpost.pl: prepare for 20201227.0
Modified Paths:
--------------
trunk/Master/tlpkg/tlpsrc/ptex-fontmaps.tlpsrc
Added Paths:
-----------
trunk/Master/tlpkg/tlpostcode/ptex-fontmaps-tlpost.pl
Added: trunk/Master/tlpkg/tlpostcode/ptex-fontmaps-tlpost.pl
===================================================================
--- trunk/Master/tlpkg/tlpostcode/ptex-fontmaps-tlpost.pl (rev 0)
+++ trunk/Master/tlpkg/tlpostcode/ptex-fontmaps-tlpost.pl 2020-12-27 12:34:58 UTC (rev 57238)
@@ -0,0 +1,402 @@
+#
+# ptex-fontmaps-tlpost.pl:
+# Post action for ptex-fontmaps to link or copy files for TeX Live tlgs
+# https://gist.github.com/trueroad/d5468b8d0f93e8082c20c59964792a90
+#
+# 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;
+}
+
+# CMap list for install
+my @cmap_list_install = ('2004-H', '2004-V');
+
+my $mode = lc (decode ('locale', $ARGV[0]));
+my $texdir = decode ('locale', $ARGV[1]);
+
+unshift (@INC, "$texdir/tlpkg");
+require TeXLive::TLUtils;
+
+my_log ("ptex-fontmaps-tlpost\n");
+
+my $resourcedir = "$texdir/tlpkg/tlgs/Resource";
+my $cmapdir = "$resourcedir/CMap";
+
+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_cmap ();
+}
+
+# Remove
+sub do_remove {
+ my_log ("\ndo_remove\n");
+
+ tlgs_check ();
+
+ remove_cmap ();
+}
+
+# tlgs directories existence check
+sub tlgs_check {
+ wrapper_isdir ($resourcedir) or
+ die ("Not found: tlgs Resource directory: ${resourcedir}\n");
+
+ wrapper_isdir ($cmapdir) or
+ die ("Not found: tlgs CMap directory: ${cmapdir}\n");
+}
+
+# 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);
+ }
+}
+
+# Remove CMap
+sub remove_cmap {
+ my_log ("\nremove_cmap\n");
+
+ for my $cmapname (@cmap_list_install) {
+ my_log ("\nFor $cmapname ...\n");
+
+ my $cmappath_in_cmapdir = "$cmapdir/$cmapname";
+ if (wrapper_isfile ($cmappath_in_cmapdir)) {
+ wrapper_unlink ($cmappath_in_cmapdir);
+ my_log ("Removed: ${cmappath_in_cmapdir}\n");
+ } else {
+ my_log ("Not exist: ${cmappath_in_cmapdir}\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 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");
+}
+
+# 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;
+}
Property changes on: trunk/Master/tlpkg/tlpostcode/ptex-fontmaps-tlpost.pl
___________________________________________________________________
Added: svn:eol-style
## -0,0 +1 ##
+native
\ No newline at end of property
Modified: trunk/Master/tlpkg/tlpsrc/ptex-fontmaps.tlpsrc
===================================================================
--- trunk/Master/tlpkg/tlpsrc/ptex-fontmaps.tlpsrc 2020-12-27 02:02:34 UTC (rev 57237)
+++ trunk/Master/tlpkg/tlpsrc/ptex-fontmaps.tlpsrc 2020-12-27 12:34:58 UTC (rev 57238)
@@ -1,7 +1,3 @@
-# default fonts for embedding settings (sc/tc, ko, jaEmbed)
-depend arphic-ttf
-depend baekmuk
-depend haranoaji
runpattern +d texmf-dist/fonts/map/dvipdfmx/${PKGNAME}
runpattern +d texmf-dist/fonts/misc/${PKGNAME}
runpattern +d texmf-dist/fonts/cmap/${PKGNAME}
@@ -9,3 +5,5 @@
binpattern f bin/${ARCH}/kanji-config-updmap-sys
binpattern f bin/${ARCH}/kanji-config-updmap-user
binpattern f bin/${ARCH}/kanji-fontmap-creator
+runpattern +f tlpkg/tlpostcode/ptex-fontmaps-tlpost.pl
+postaction script file=tlpkg/tlpostcode/ptex-fontmaps-tlpost.pl
More information about the tex-live-commits
mailing list.