diff options
Diffstat (limited to 'Master/tlpkg')
| -rw-r--r-- | Master/tlpkg/tlpostcode/haranoaji-tlpost.pl | 484 | ||||
| -rw-r--r-- | Master/tlpkg/tlpsrc/haranoaji.tlpsrc | 2 |
2 files changed, 486 insertions, 0 deletions
diff --git a/Master/tlpkg/tlpostcode/haranoaji-tlpost.pl b/Master/tlpkg/tlpostcode/haranoaji-tlpost.pl new file mode 100644 index 00000000000..84576fa1c16 --- /dev/null +++ b/Master/tlpkg/tlpostcode/haranoaji-tlpost.pl @@ -0,0 +1,484 @@ +# +# 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; +use Encode::Locale; + +binmode (STDIN, ':encoding(console_in)'); +binmode (STDOUT, ':encoding(console_out)'); +binmode (STDERR, ':encoding(console_out)'); + +print "haranoaji-tlpost\n"; + +if (win32 ()) { + # `use Win32::API;` raises error in non-Windows even within this block. + require Win32::API; + Win32::API->import (); +} else { + print "For non-Windows, do nothing\n"; + 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 +my @cmap_list = ( + '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]); + +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"); +} + +print "\ndone.\n"; + +exit 0; + +# Install +sub do_install { + print "\ndo_install\n"; + + tlgs_check (); + + install_cidfont (); + install_cmap (); + install_snippet (); +} + +# Remove +sub do_remove { + print "\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 { + print "\ninstall_cidfont\n"; + + for my $psname (sort keys %font_list) { + print "\nFor $psname ...\n"; + + my $fontpath_in_cidfontdir = "$cidfontdir/$psname"; + if (wrapper_isfile ($fontpath_in_cidfontdir)) { + print "Already exists: ${fontpath_in_cidfontdir}\n"; + next; + } + my $fontpath_in_texmf = search_fontpath ($font_list{$psname}) or next; + link_or_copy ($fontpath_in_texmf, $fontpath_in_cidfontdir); + } +} + +# Link or copy CMap +sub install_cmap { + print "\ninstall_cmap\n"; + + foreach my $cmapname (@cmap_list) { + print "\nFor $cmapname ...\n"; + + my $cmappath_in_cmapdir = "$cmapdir/$cmapname"; + if (wrapper_isfile ($cmappath_in_cmapdir)) { + print "Already exists: ${cmappath_in_cmapdir}\n"; + next; + } + my $cmappath_in_texmf = search_cmappath ($cmapname) or next; + link_or_copy ($cmappath_in_texmf, $cmappath_in_cmapdir); + } +} + +# Create snippet +sub install_snippet { + print "\ninstall_snippet\n"; + + for my $psname (sort keys %font_list) { + print "\nFor $psname ...\n"; + + foreach my $cmapname (@cmap_list) { + my $snippetpath = "$fontdir/$psname-$cmapname"; + if (wrapper_isfile ($snippetpath)) { + print "Already exists: ${snippetpath}\n"; + next; + } + + 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)); + print "Created: ${snippetpath}\n"; + } + } +} + +# Remove CID font +sub remove_cidfont { + print "\nremove_cidfont\n"; + + for my $psname (sort keys %font_list) { + print "\nFor $psname ...\n"; + + my $fontpath_in_cidfontdir = "$cidfontdir/$psname"; + if (wrapper_isfile ($fontpath_in_cidfontdir)) { + wrapper_unlink ($fontpath_in_cidfontdir); + print "Removed: ${fontpath_in_cidfontdir}\n"; + } else { + print "Not exist: ${fontpath_in_cidfontdir}\n"; + } + } +} + +# Remove snippet +sub remove_snippet { + print "\nremove_snippet\n"; + + for my $psname (sort keys %font_list) { + print "\nFor $psname ...\n"; + + foreach my $cmapname (@cmap_list) { + my $snippetpath = "$fontdir/$psname-$cmapname"; + if (wrapper_isfile ($snippetpath)) { + wrapper_unlink ($snippetpath); + print "Removed: ${snippetpath}\n"; + } else { + print "Not exist: ${snippetpath}\n"; + } + } + } +} + +# Check Windows environment +sub win32 { return ($^O=~/^MSWin(32|64)$/i); } + +# Search TEXMF font path +sub search_fontpath { + my ($filename) = @_; + + my $foo = kpsewhich ($filename); + + if ($foo eq "") { + print "Not found font path: ${filename}\n"; + return; + } + + print "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 "") { + print "Not found CMap path: ${cmapname}\n"; + return; + } + + print "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)) { + print "Symbolic link succeeded: ${newfilename}\n"; + return; + } + + if (wrapper_hardlink ($existingfilename, $newfilename)) { + print "Hard link succeeded: ${newfilename}\n"; + return; + } + + if (wrapper_copy ($existingfilename, $newfilename)) { + print "Copy succeeded: ${newfilename}\n"; + return; + } + + print "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', $filename)) or + die ("Open failed: ${filename}\n"); + print $fh $contents; + close $fh; +} + +# Directory existence check +sub wrapper_isdir { + my ($dirname) = @_; + + # TODO: Directory existence check by -W API on Windows + if ( -d encode ('locale', $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', $filename) ) { + return 1; + } + + return; +} + +# Remove file +sub wrapper_unlink { + my ($filename) = @_; + + # TODO: Remove file by -W API on Windows + return unlink (encode ('locale', $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//; + print "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//; + print "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//; + print "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; +} diff --git a/Master/tlpkg/tlpsrc/haranoaji.tlpsrc b/Master/tlpkg/tlpsrc/haranoaji.tlpsrc index e69de29bb2d..21d6eb3d635 100644 --- a/Master/tlpkg/tlpsrc/haranoaji.tlpsrc +++ b/Master/tlpkg/tlpsrc/haranoaji.tlpsrc @@ -0,0 +1,2 @@ +runpattern +f tlpkg/tlpostcode/haranoaji-tlpost.pl +postaction script file=tlpkg/tlpostcode/haranoaji-tlpost.pl |