diff options
4 files changed, 813 insertions, 559 deletions
diff --git a/Build/source/texk/texlive/linked_scripts/cjk-gs-integrate/cjk-gs-integrate.pl b/Build/source/texk/texlive/linked_scripts/cjk-gs-integrate/cjk-gs-integrate.pl index 270600e38fa..68ea6e6198b 100755 --- a/Build/source/texk/texlive/linked_scripts/cjk-gs-integrate/cjk-gs-integrate.pl +++ b/Build/source/texk/texlive/linked_scripts/cjk-gs-integrate/cjk-gs-integrate.pl @@ -6,6 +6,7 @@ # Copyright 2016-2020 by Japanese TeX Development Community # # This work is based on research and work by (in alphabetical order) +# Masamichi Hosoda # Yusuke Kuroki # Yusuke Terada # Bruno Voisin @@ -31,30 +32,37 @@ # # Note that symlink names should be consistent with ptex-fontmaps! -$^W = 1; use Getopt::Long qw(:config no_autoabbrev ignore_case_always); use File::Basename; use File::Path qw(make_path); use Cwd 'abs_path'; use strict; +use warnings; +use utf8; +use feature 'state'; +use Encode; +use Encode::Alias; -(my $prg = basename($0)) =~ s/\.pl$//; -my $version = '20200307.0'; +my $debug_msg_before_init; +init_encode_locale (); + +binmode (STDIN, ':encoding(console_in)'); +binmode (STDOUT, ':encoding(console_out)'); +binmode (STDERR, ':encoding(console_out)'); + +@ARGV = map{ decode('locale', $_) }@ARGV; + +(my $prg = basename(decode('locale', $0))) =~ s/\.pl$//; +my $version = '20201206.0'; if (win32()) { - # conversion between internal (utf-8) and console (cp932): - # multibyte characters should be encoded in cp932 at least during - # * kpathsea file search - # * abs_path existence test - # * input/output on console - # * batch file output - # routines. make sure all of these should be restricted to win32 mode! - # TODO: what to do with $opt_fontdef, @opt_aliases and $opt_filelist, - # with regard to encodings? - use utf8; - use Encode; # some perl functions (symlink, -l test) does not work print_warning("Sorry, we have only partial support for Windows!\n"); + + require Win32::API; + Win32::API->import (); + require File::Compare; + File::Compare->import (); } # The followings are installed by ptex-fontmaps (texjporg): @@ -272,10 +280,6 @@ my $akotfps_pathpart = "dvips/ps2otfps"; my $akotfps_datafilename = "psnames-for-otf"; my $akotfps_datacontent = ''; -# if windows, we might create batch file for links -my $winbatch = "makefontlinks.bat"; -my $winbatch_content = ''; - # dump output for data file (for easy editing for users) my $dump_datafile = "$prg-data.dat"; @@ -335,6 +339,10 @@ if (! GetOptions( die "Try \"$0 --help\" for more information.\n"; } +if ($debug_msg_before_init) { + print_debug ($debug_msg_before_init); +} + sub win32 { return ($^O=~/^MSWin(32|64)$/i); } sub macosx { return ($^O=~/^darwin$/i); } my $nul = (win32() ? 'nul' : '/dev/null') ; @@ -356,12 +364,15 @@ if (system("kpsewhich --version >$nul 2>&1 <$nul" ) != 0) { if ($opt_debug >= 2) { require Data::Dumper; + no warnings qw(once); $Data::Dumper::Indent = 1; } my $zrlistttc = kpse_miscfont("zrlistttc.lua"); my $zrlistttc_available; -chomp(my $zrlistttc_help = `texlua $zrlistttc 2>$nul`); +my $cmdl = "texlua $zrlistttc 2>$nul"; +$cmdl = encode('locale', $cmdl); +chomp(my $zrlistttc_help = `$cmdl`); if ($?) { if ($opt_strictpsname) { print_error("The script 'zrlistttc.lua' not found, cannot proceed!\n"); @@ -385,7 +396,7 @@ if (macosx()) { $macos_ver_major =~ s/^(\d+)\.(\d+).*/$1/; my $macos_ver_minor = $macos_ver; $macos_ver_minor =~ s/^(\d+)\.(\d+).*/$2/; - if ($macos_ver_major==10 && $macos_ver_minor>=8) { + if ($macos_ver_major>=11 || ($macos_ver_major==10 && $macos_ver_minor>=8)) { if (!$opt_cleanup && !$opt_fontdef && !@opt_fontdef_add) { # if built-in only print_warning("Our built-in database does not support recent\n"); print_warning("versions of Mac OS (10.8 Mountain Lion or later)!\n"); @@ -402,7 +413,11 @@ if (defined($opt_texmflink)) { if ($opt_texmflink eq '') { # option was passed but didn't receive a value # -> use TEXMFLOCAL - chomp($foo = `kpsewhich -var-value=TEXMFLOCAL`); + $foo = `kpsewhich -var-value=TEXMFLOCAL`; + # We assume that the output of kpsewhich is + # the same as perl's locale (or active code page). + decode('locale', $foo); + chomp($foo); } else { # option was passed with an argument # -> use it @@ -417,7 +432,11 @@ if (defined($opt_akotfps)) { if (defined($opt_texmflink)) { $foo = $opt_texmflink; } else { - chomp($foo = `kpsewhich -var-value=TEXMFLOCAL`); + $foo = `kpsewhich -var-value=TEXMFLOCAL`; + # We assume that the output of kpsewhich is + # the same as perl's locale (or active code page). + decode('locale', $foo); + chomp($foo); } } else { $foo = $opt_akotfps; @@ -426,26 +445,10 @@ if (defined($opt_akotfps)) { } if (defined($opt_winbatch)) { - if ($opt_winbatch ne '') { - $winbatch = $opt_winbatch; - } - if (win32()) { - $opt_winbatch = 1; - unlink $winbatch if (-f $winbatch); - } else { - print_warning("ignoring --winbatch option due to non-Windows\n"); - $opt_winbatch = 0; - } -} else { - $opt_winbatch = 0; + print_warning("ignoring --winbatch option due to being obsolete\n"); } if ($opt_hardlink) { - if (win32()) { - $opt_hardlink = 1; - } else { - print_warning("ignoring --hardlink option due to non-Windows\n"); - $opt_hardlink = 0; - } + print_warning("ignoring --hardlink option due to being obsolete\n"); } if (defined($opt_dump_data)) { @@ -453,7 +456,8 @@ if (defined($opt_dump_data)) { $dump_datafile = $opt_dump_data; } $opt_dump_data = 1; - unlink $dump_datafile if (-f $dump_datafile); + unlink encode('locale_fs', $dump_datafile) + if (-f encode('locale_fs', $dump_datafile)); } else { $opt_dump_data = 0; } @@ -497,7 +501,7 @@ sub main { if ($opt_dump_data) { # with --dump-data, dump only effective database and exit dump_font_database(); - if (-f $dump_datafile) { + if (-f encode('locale_fs', $dump_datafile)) { print_info("*** Data dumped to $dump_datafile ***\n"); exit(0); } else { @@ -549,8 +553,8 @@ sub main { $opt_output = $gsres; } } - if (! -d $opt_output) { - $dry_run || mkdir($opt_output) || + if (! -d encode('locale_fs', $opt_output)) { + $dry_run || mkdir(encode('locale_fs', $opt_output)) || die("Cannot create directory $opt_output: $!"); } if ($opt_cleanup) { @@ -570,7 +574,6 @@ sub main { print_info(($opt_remove ? "removing" : "generating") . " links, snippets and cidfmap.local for non-CID fonts ...\n"); do_nonotf_fonts(); } - write_winbatch() if $opt_winbatch; } print_info(($opt_remove ? "removing" : "generating") . " snippets and cidfmap.aliases for font aliases ...\n"); do_aliases(); @@ -581,15 +584,6 @@ sub main { system("mktexlsr"); } print_info("finished\n"); - if ($opt_winbatch) { - if (-f $winbatch) { - print_info("*** Batch file $winbatch created ***\n"); - print_info("*** to complete, run it as administrator privilege.***\n"); - } else { - print_error("Failed to create $winbatch!\n"); - exit(1); - } - } } sub do_all_fonts { @@ -613,7 +607,8 @@ sub do_all_fonts { # due to previous bugs for my $class (%encode_list) { for my $enc (@{$encode_list{$class}}) { - unlink "$fontdest/$k-$enc" if (-f "$fontdest/$k-$enc"); + unlink encode('locale_fs', "$fontdest/$k-$enc") + if (-f encode('locale_fs', "$fontdest/$k-$enc")); } } # @@ -646,8 +641,8 @@ sub do_all_fonts { } update_master_cidfmap('cidfmap.local'); # we are in cleanup mode, also remove cidfmap.local itself - if (-f "$opt_output/$cidfmap_local_pathpart") { - unlink "$opt_output/$cidfmap_local_pathpart"; + if (-f encode('locale_fs', "$opt_output/$cidfmap_local_pathpart")) { + unlink encode('locale_fs', "$opt_output/$cidfmap_local_pathpart"); } } @@ -699,11 +694,13 @@ sub do_nonotf_fonts { } return if $dry_run; if ($outp) { - if (! -d "$opt_output/Init") { - mkdir("$opt_output/Init") || + if (! -d encode('locale_fs', "$opt_output/Init")) { + mkdir(encode('locale_fs', "$opt_output/Init")) || die("Cannot create directory $opt_output/Init: $!"); } - open(FOO, ">$opt_output/$cidfmap_local_pathpart") || + # It seems that tlgs can handle UTF-8 TTF filename in cidfmap.local. + open(FOO, ">:encoding(UTF-8)", + encode('locale_fs', "$opt_output/$cidfmap_local_pathpart")) || die("Cannot open $opt_output/$cidfmap_local_pathpart: $!"); print FOO $outp; close(FOO); @@ -775,8 +772,10 @@ sub do_aliases { } # special case for native CID fonts in ancient days # if not readable, add aliases for substitution - push @jal, "/HeiseiMin-W3 /Ryumin-Light ;" if (! -r "$ciddest/HeiseiMin-W3"); - push @jal, "/HeiseiKakuGo-W5 /GothicBBB-Medium ;" if (! -r "$ciddest/HeiseiKakuGo-W5"); + push @jal, "/HeiseiMin-W3 /Ryumin-Light ;" + if (! -r encode('locale_fs', "$ciddest/HeiseiMin-W3")); + push @jal, "/HeiseiKakuGo-W5 /GothicBBB-Medium ;" + if (! -r encode('locale_fs', "$ciddest/HeiseiKakuGo-W5")); # $outp .= "\n% Japanese fonts\n" . join("\n", @jal) . "\n" if @jal; $outp .= "\n% Korean fonts\n" . join("\n", @kal) . "\n" if @kal; @@ -786,19 +785,21 @@ sub do_aliases { # return if $dry_run; if ($outp && !$opt_remove) { - if (! -d "$opt_output/Init") { - mkdir("$opt_output/Init") || + if (! -d encode('locale_fs', "$opt_output/Init")) { + mkdir(encode('locale_fs', "$opt_output/Init")) || die("Cannot create directory $opt_output/Init: $!"); } - open(FOO, ">$opt_output/$cidfmap_aliases_pathpart") || + open(FOO, ">:encoding(UTF-8)", + encode('locale_fs', "$opt_output/$cidfmap_aliases_pathpart")) || die("Cannot open $opt_output/$cidfmap_aliases_pathpart: $!"); print FOO $outp; close(FOO); } update_master_cidfmap('cidfmap.aliases'); # if we are in cleanup mode, also remove cidfmap.aliases itself - if (-f "$opt_output/$cidfmap_aliases_pathpart") { - unlink "$opt_output/$cidfmap_aliases_pathpart" if $opt_cleanup; + if (-f encode('locale_fs', "$opt_output/$cidfmap_aliases_pathpart")) { + unlink encode('locale_fs', "$opt_output/$cidfmap_aliases_pathpart") + if $opt_cleanup; } } @@ -815,11 +816,13 @@ sub do_cmaps { # by others or distributed by gs itself for my $class (%encode_list) { for my $enc (@{$encode_list{$class}}) { - if (-l "$cmapdest/$enc") { - my $linkt = readlink("$cmapdest/$enc"); + if (-l encode('locale_fs', "$cmapdest/$enc")) { + my $linkt = decode('locale_fs', + readlink(encode('locale_fs', + "$cmapdest/$enc"))); if ($linkt) { if ($linkt eq search_cmap($enc)) { - unlink("$cmapdest/$enc"); + unlink(encode('locale_fs', "$cmapdest/$enc")); } } } @@ -828,7 +831,7 @@ sub do_cmaps { return; } # add mode - if (! -d "$cmapdest") { + if (! -d encode('locale_fs', "$cmapdest")) { print_debug("Creating directory $cmapdest ...\n"); make_dir("$cmapdest", "cannot create CMap directory"); } @@ -838,7 +841,7 @@ sub do_cmaps { next if (!$fontdb{$1}{'available'}); } for my $enc (@{$encode_list{$class}}) { - if (! -f "$cmapdest/$enc") { + if (! -f encode('locale_fs', "$cmapdest/$enc")) { print_debug("CMap $enc is not found in gs resource directory\n"); my $dest = search_cmap($enc); if ($dest) { @@ -858,7 +861,14 @@ sub search_cmap { my ($cmap) = @_; # search CMap with kpsewhich and cache if (! exists $cmap_cache{$cmap}) { - chomp($cmap_cache{$cmap} = `kpsewhich -format=cmap $cmap`); + my $cmdl = "kpsewhich -format=cmap $cmap"; + $cmdl = encode('locale', $cmdl); + $cmap_cache{$cmap} = `$cmdl`; + # We assume that the output of kpsewhich is + # the same as perl's locale (or active code page). + $cmap_cache{$cmap} = decode('locale', $cmap_cache{$cmap}); + chomp($cmap_cache{$cmap}); + $cmap_cache{$cmap} =~ s/[\r\n]+\z//; # perl's chomp() on git-bash cannot strip CR of CRLF ?? } return $cmap_cache{$cmap}; } @@ -876,8 +886,8 @@ sub update_master_cidfmap { my $cidfmap_master = "$opt_output/$cidfmap_pathpart"; print_info(sprintf("%s $add %s cidfmap file ...\n", ($opt_remove ? "removing" : "adding"), ($opt_remove ? "from" : "to"))); - if (-r $cidfmap_master) { - open(FOO, "<", $cidfmap_master) || + if (-r encode('locale_fs', $cidfmap_master)) { + open(FOO, "<:encoding(UTF-8)", encode('locale_fs', $cidfmap_master)) || die("Cannot open $cidfmap_master for reading: $!"); my $found = 0; my $found_tl = 0; @@ -916,7 +926,7 @@ sub update_master_cidfmap { if ($opt_remove) { if ($found || $found_tl) { return if $dry_run; - open(FOO, ">", $cidfmap_master) || + open(FOO, ">:encoding(UTF-8)", encode('locale_fs', $cidfmap_master)) || die("Cannot clean up $cidfmap_master: $!"); print FOO $newmaster; close FOO; @@ -926,7 +936,7 @@ sub update_master_cidfmap { print_info("$add already loaded in $cidfmap_master, no changes\n"); } else { return if $dry_run; - open(FOO, ">", $cidfmap_master) || + open(FOO, ">:encoding(UTF-8)", encode('locale_fs', $cidfmap_master)) || die("Cannot open $cidfmap_master for appending: $!"); print FOO $newmaster; print FOO "($add) .runlibfile\n"; @@ -936,7 +946,7 @@ sub update_master_cidfmap { } else { return if $dry_run; return if $opt_remove; - open(FOO, ">", $cidfmap_master) || + open(FOO, ">:encoding(UTF-8)", encode('locale_fs', $cidfmap_master)) || die("Cannot open $cidfmap_master for writing: $!"); print FOO "($add) .runlibfile\n"; close(FOO); @@ -987,10 +997,11 @@ sub generate_font_snippet { } for my $enc (@{$encode_list{$c}}) { if ($opt_remove) { - unlink "$fd/$n-$enc" if (-f "$fd/$n-$enc"); + unlink encode('locale_fs', "$fd/$n-$enc") + if (-f encode('locale_fs', "$fd/$n-$enc")); next; } - open(FOO, ">$fd/$n-$enc") || + open(FOO, ">:encoding(UTF-8)", encode('locale_fs', "$fd/$n-$enc")) || die("cannot open $fd/$n-$enc for writing: $!"); print FOO "%!PS-Adobe-3.0 Resource-Font %%DocumentNeededResources: $enc (CMap) @@ -1053,16 +1064,16 @@ sub link_font { } my $target = "$cd/$n"; my $do_unlink = 0; - if (-l $target) { + if (-l encode('locale_fs', $target)) { if ($opt_cleanup) { $do_unlink = 1; } else { - my $linkt = readlink($target); + my $linkt = decode('locale_fs', readlink(encode('locale_fs', $target))); if ($linkt) { if ($linkt eq $f) { # case 1: exists, link, targets agree $do_unlink = 1; - } elsif (-r $linkt) { + } elsif (-r encode('locale_fs', $linkt)) { # case 3: exists, link, targets different if ($opt_force) { print_info("Removing link $target due to --force!\n"); @@ -1081,12 +1092,24 @@ sub link_font { exit(1); } } - } elsif (-r $target) { + } elsif (-r encode('locale_fs', $target)) { # case 4: exists, but not link (NTFS hardlink on win32 falls into this) - if (-s $target) { + if (-s encode('locale_fs', $target)) { if ($opt_force) { print_info("Removing $target due to --force!\n"); $do_unlink = 1; + } elsif (win32()) { + my $result = compare (encode ('locale_fs', $f), + encode ('locale_fs', $target)); + if ($result == -1) { + print_error("file compare failed: ${f}, ${target}\n"); + exit(1); + } elsif ($result) { + print_error("$target already existing and different content, exiting!\n"); + exit(1); + } + print_debug("$target already existing but same content, skipping!\n"); + return; } else { print_error("$target already existing, exiting!\n"); exit(1); @@ -1107,107 +1130,175 @@ sub link_font { sub make_dir { my ($d, $w) = @_; - if (-r $d) { - if (! -d $d) { + if (-r encode('locale_fs', $d)) { + if (! -d encode('locale_fs', $d)) { print_error("$d is not a directory, $w\n"); exit(1); } } else { - $dry_run || make_path($d); + $dry_run || make_path(encode('locale', $d)); } } -# perl symlink function does not work on windows, so leave it to -# cmd.exe mklink function (or write to batch file). -# if target already exists, do not try to override it. otherwise -# "mklink error: Cannot create a file when that file already exists" -# is thrown many times +# perl symlink function does not work on windows, so we use Win32 API. sub maybe_symlink { my ($realname, $targetname) = @_; if (win32()) { - # hardlink vs. symlink -- HY 2017/04/26 - # * readablitiy: hardlink is easier, but it seems that current gs can read - # symlink properly, so it doesn't matter - # * permission: hardlink creation does not require administrator privilege, - # but is likely to fail for c:/windows/fonts/* system files - # due to "Access denied" - # symlink creation requires administrator privilege, but - # it can link to all files in c:/windows/fonts/ - # * versatility: symlink can point to a file on a different/remote volume - # for these reasons, we try to create symlink by default. - # if --hardlink option is given, we create hardlink instead. - # also, if --winbatch option is given, we prepare batch file for link generation, - # instead of creating links right away. - $realname =~ s!/!\\!g; - $targetname =~ s!/!\\!g; - if ($opt_winbatch) { - # re-encoding of $winbatch_content is done by write_winbatch() - $winbatch_content .= "if not exist \"$targetname\" mklink "; - $winbatch_content .= "/h " if $opt_hardlink; - $winbatch_content .= "\"$targetname\" \"$realname\"\n"; - } else { - # should be encoded in cp932 for win32 console - $realname = encode_utftocp($realname); - $targetname = encode_utftocp($targetname); - my $cmdl = "cmd.exe /c if not exist \"$targetname\" mklink "; - $cmdl .= "/h " if $opt_hardlink; - $cmdl .= "\"$targetname\" \"$realname\""; - my @ret = `$cmdl`; - # sometimes hard link creation may fail due to "Access denied" - # (especially when $realname is located in c:/windows/fonts). - # TODO: what should we do to ensure resources, which might be - # different from $realname? -- HY (2017/03/21) - # -- one possibility: - # if (@ret) { - # @ret ="done"; - # } else { - # print_info("Hard link creation for $realname failed. I will copy this file instead.\n"); - # $cmdl = "cmd.exe /c if not exist \"$targetname\" copy \"$realname\" \"$targetname\""; - # @ret = `$cmdl`; - # } - # -- however, both tlgs (TeX Live) and standalone gswin32/64 (built - # by Akira Kakuto) can search in c:/windows/fonts by default. - # Thus, copying such files is waste of memory + # Try symbolic link, hard link, copy by Win32 API + + # On Windows, the creation of a symbolic link requires a privilege. + # Therefore, if the creation of the symbolic link fails, + # create a hard link. + # However, the creation of the hard link requires the write permission + # to the original existing file. + # Thus, if the hard link also fails, copy the file. + + if (win32_symlink ($realname, $targetname)) { + print_debug ("Symbolic link succeeded: ${targetname}\n"); + return 1; + } + + if (win32_hardlink ($realname, $targetname)) { + print_debug ("Hard link succeeded: ${targetname}\n"); + return 1; + } + + if (win32_copy ($realname, $targetname)) { + print_debug ("Copy succeeded: ${targetname}\n"); + return 1; } + + print_warning ("Link/copy failed: ${targetname}\n"); } else { symlink ($realname, $targetname); } } -# unlink function actually works also on windows, however, -# leave it to batch file for consistency. otherwise -# option $opt_force may not work as expected sub maybe_unlink { my ($targetname) = @_; - if (win32()) { - $targetname =~ s!/!\\!g; - if ($opt_winbatch) { - # re-encoding of $winbatch_content is done by write_winbatch() - $winbatch_content .= "if exist \"$targetname\" del \"$targetname\"\n"; - } else { - # should be encoded in cp932 for win32 console - $targetname = encode_utftocp($targetname); - my $cmdl = "cmd.exe /c if exist \"$targetname\" del \"$targetname\""; - my @ret = `$cmdl`; + unlink (encode('locale_fs', $targetname)); +} + +# For Windows: Create symbolic link +sub win32_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; } - } else { - unlink ($targetname); - } + my $msg = decode ('locale', + Win32::FormatMessage (Win32::GetLastError ())); + $msg =~ s/[\r\n]+\z//; + print_debug ("CreateSymbolicLinkW failed: ${msg}\n"); + + return 0; } -# write batch file (windows only) -sub write_winbatch { - return if $dry_run; - open(FOO, ">$winbatch") || - die("cannot open $winbatch for writing: $!"); - # $winbatch_content may contain multibyte characters, and they - # should be encoded in cp932 in batch file - $winbatch_content = encode_utftocp($winbatch_content); - print FOO "\@echo off\n", - "$winbatch_content", - "\@echo symlink ", ($opt_remove ? "removed\n" : "generated\n"), - "\@pause 1\n"; - close(FOO); +# For Windows: Create hard link +sub win32_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_debug ("CreateHardLinkW failed: ${msg}\n"); + + return 0; +} + +# For Windows: Copy file +sub win32_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_debug ("CopyFileW failed: ${msg}\n"); + + return 0; +} + +# For Windows: 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; +} +# For Windows: 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; +} + +# For Windows: 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; } # write to psnames-for-otfps @@ -1215,7 +1306,9 @@ sub write_akotfps_datafile { return if $dry_run; make_dir("$opt_akotfps/$akotfps_pathpart", "cannot create $akotfps_datafilename in it!"); - open(FOO, ">$opt_akotfps/$akotfps_pathpart/$akotfps_datafilename") || + open(FOO, ">:encoding(UTF-8)", + encode('locale_fs', + "$opt_akotfps/$akotfps_pathpart/$akotfps_datafilename")) || die("cannot open $opt_akotfps/$akotfps_pathpart/$akotfps_datafilename for writing: $!"); print FOO "% psnames-for-otf % @@ -1240,10 +1333,6 @@ sub info_found_fonts { print "Type: $fontdb{$k}{'type'}\n"; print "Class: $fontdb{$k}{'class'}\n"; my $fn = $fontdb{$k}{'target'}; - # cp932 for win32 console - if (win32()) { - $fn = encode_utftocp($fn); - } if ($fontdb{$k}{'type'} eq 'TTC' || $fontdb{$k}{'type'} eq 'OTC') { $fn .= "($fontdb{$k}{'subfont'})"; } @@ -1285,10 +1374,6 @@ sub info_list_aliases { for my $p (@ks) { my $t = $aliases{$al}{$p}; my $fn = ($opt_listallaliases ? "-" : $fontdb{$t}{'target'} ); - # cp932 for win32 console - if (win32()) { - $fn = encode_utftocp($fn); - } # should always be the same ;-) $cl = $fontdb{$t}{'class'}; if (!$opt_listallaliases && ($fontdb{$t}{'type'} eq 'TTC' || $fontdb{$t}{'type'} eq 'OTC')) { @@ -1345,7 +1430,8 @@ sub make_all_available { sub check_for_files { my @foundfiles; if ($opt_filelist) { - open(FOO, "<", $opt_filelist) || die("Cannot open $opt_filelist: $!"); + open(FOO, "<", encode('locale_fs', $opt_filelist)) || + die("Cannot open $opt_filelist: $!"); @foundfiles = <FOO>; close(FOO) || warn "Cannot close $opt_filelist: $!"; } else { @@ -1371,13 +1457,15 @@ sub check_for_files { for my $d (qw!/Library/Fonts /System/Library/Fonts /System/Library/Assets /System/Library/AssetsV2 /Network/Library/Fonts /usr/share/fonts!) { - push @extradirs, "$d//" if (-d $d); # recursive search + push @extradirs, "$d//" + if (-d encode('locale_fs', $d)); # recursive search } # the path contains white space, so hack required for my $d (qw!/Library/Application__Support/Apple/Fonts!) { my $sd = $d; $sd =~ s/__/ /; - push @extradirs, "$sd//" if (-d "$sd"); # recursive search + push @extradirs, "$sd//" + if (-d encode('locale_fs', "$sd")); # recursive search } # office for mac 2016 for my $d (qw!/Applications/Microsoft__Word.app @@ -1385,11 +1473,14 @@ sub check_for_files { /Applications/Microsoft__PowerPoint.app!) { my $sd = $d; $sd =~ s/__/ /; - push @extradirs, "$sd/Contents/Resources/Fonts/" if (-d "$sd/Contents/Resources/Fonts"); - push @extradirs, "$sd/Contents/Resources/DFonts/" if (-d "$sd/Contents/Resources/DFonts"); + push @extradirs, "$sd/Contents/Resources/Fonts/" + if (-d encode('locale_fs', "$sd/Contents/Resources/Fonts")); + push @extradirs, "$sd/Contents/Resources/DFonts/" + if (-d encode('locale_fs', "$sd/Contents/Resources/DFonts")); } my $home = $ENV{'HOME'}; - push @extradirs, "$home/Library/Fonts//" if (-d "$home/Library/Fonts"); + push @extradirs, "$home/Library/Fonts//" + if (-d encode('locale_fs', "$home/Library/Fonts")); } # if (@extradirs) { @@ -1426,23 +1517,20 @@ sub check_for_files { $cmdl .= " \"$f\" "; } # shoot up kpsewhich - # this call (derived from the database) contains multibyte characters, - # and they should be encoded in cp932 for win32 console - if (win32()) { - $cmdl = encode_utftocp($cmdl); - } print_ddebug("checking for $cmdl\n"); + $cmdl = encode('locale', $cmdl); @foundfiles = `$cmdl`; + # We assume that the output of kpsewhich is + # the same as perl's locale (or active code page). + @foundfiles = map { decode('locale', $_) } @foundfiles; } - # at this point, on windows, @foundfiles is encoded in cp932 - # which is suitable for the next few lines chomp(@foundfiles); print_ddebug("Found files @foundfiles\n"); # map basenames to filenames my %bntofn; for my $f (@foundfiles) { $f =~ s/[\r\n]+\z//; # perl's chomp() on git-bash cannot strip CR of CRLF ?? - my $realf = abs_path($f); + my $realf = decode('locale_fs', abs_path(encode('locale_fs', $f))); if (!$realf) { print_warning("dead link or strange file found: $f - ignored!\n"); next; @@ -1458,11 +1546,6 @@ sub check_for_files { $temp_realfdir =~ s!^(.*)/(.*)$!$1!; next if ($temp_realfdir =~ $otf_pathpart || $temp_realfdir =~ $ttf_pathpart); } - # decode now on windows! (cp932 -> internal utf-8) - if (win32()) { - $f = encode_cptoutf($f); - $realf = encode_cptoutf($realf); - } my $bn = basename($f); # kpsewhich -all might return multiple files with the same basename; # collect all of them @@ -1511,7 +1594,9 @@ sub check_for_files { print_debug("We need to test whether\n"); print_debug(" $b:$index\n"); print_debug("is the correct one ($k). Invoking zrlistttc ...\n"); - chomp($actualpsname = `texlua $zrlistttc -i $index "$b"`); + my $cmdl = "texlua $zrlistttc -i $index \"$b\""; + $cmdl = encode('locale', $cmdl); + chomp($actualpsname = `$cmdl`); if ($?) { # something is wrong with the font file, or zrlistttc does not support it; # still there is a chance that Ghostscript supports, so don't discard it @@ -1521,6 +1606,9 @@ sub check_for_files { $bname = $b; last; } + # We assume that the output of texlua is + # the same as perl's locale (or active code page). + $actualpsname = decode('locale', $actualpsname); $actualpsname =~ s/[\r\n]+\z//; # perl's chomp() on git-bash cannot strip CR of CRLF ?? if ($actualpsname ne $k) { print_debug("... PSName returned by zrlistttc ($actualpsname) is\n"); @@ -1688,7 +1776,7 @@ sub read_font_database { # use "foo" as a substitute; otherwise, use built-in database if ($opt_fontdef) { my $foo = kpse_miscfont($opt_fontdef); - open(FDB, "<$foo") || + open(FDB, "<:encoding(UTF-8)", encode('locale_fs', $foo)) || die("Cannot find $opt_fontdef: $!"); @dbl = <FDB>; close(FDB); @@ -1702,7 +1790,7 @@ sub read_font_database { # overwrite existing one (that is, the addition wins) for (@opt_fontdef_add) { my $foo = kpse_miscfont($_); - open(FDB, "<$foo") || + open(FDB, "<:encoding(UTF-8)", encode('locale_fs', $foo)) || die("Cannot find $_: $!"); @dbl = <FDB>; close(FDB); @@ -1773,7 +1861,7 @@ sub read_each_font_database { next if (!$opt_cleanup); my @dbl; my $foo = kpse_miscfont($1); - if (!open(FDB, "<$foo")) { + if (!open(FDB, "<:encoding(UTF-8)", encode('locale_fs', $foo))) { print_warning("Cannot find $1, skipping!\n"); next; } @@ -1786,7 +1874,7 @@ sub read_each_font_database { if ($l =~ m/^INCLUDE\s*(.*)$/) { my @dbl; my $foo = kpse_miscfont($1); - if (!open(FDB, "<$foo")) { + if (!open(FDB, "<:encoding(UTF-8)", encode('locale_fs', $foo))) { print_warning("Cannot find $1, skipping!\n"); next; } @@ -1807,12 +1895,7 @@ sub read_each_font_database { if ($l =~ m/^OTFname(\((\d+)\))?:\s*(.*)$/) { my $fn = $3; $fontfiles{$fn}{'priority'} = ($2 ? $2 : 10); - # cp932 for win32 console - my $encoded_fn; - if (win32()) { - $encoded_fn = encode_utftocp($fn); - } - print_dddebug("filename: ", ($encoded_fn ? "$encoded_fn" : "$fn"), "\n"); + print_dddebug("filename: ${fn}\n"); print_dddebug("type: otf\n"); $fontfiles{$fn}{'type'} = 'OTF'; next; @@ -1820,12 +1903,7 @@ sub read_each_font_database { if ($l =~ m/^OTCname(\((\d+)\))?:\s*(.*)$/) { my $fn = $3; $fontfiles{$fn}{'priority'} = ($2 ? $2 : 10); - # cp932 for win32 console - my $encoded_fn; - if (win32()) { - $encoded_fn = encode_utftocp($fn); - } - print_dddebug("filename: ", ($encoded_fn ? "$encoded_fn" : "$fn"), "\n"); + print_dddebug("filename: ${fn}\n"); print_dddebug("type: otc\n"); $fontfiles{$fn}{'type'} = 'OTC'; next; @@ -1833,12 +1911,7 @@ sub read_each_font_database { if ($l =~ m/^TTFname(\((\d+)\))?:\s*(.*)$/) { my $fn = $3; $fontfiles{$fn}{'priority'} = ($2 ? $2 : 10); - # cp932 for win32 console - my $encoded_fn; - if (win32()) { - $encoded_fn = encode_utftocp($fn); - } - print_dddebug("filename: ", ($encoded_fn ? "$encoded_fn" : "$fn"), "\n"); + print_dddebug("filename: ${fn}\n"); print_dddebug("type: ttf\n"); $fontfiles{$fn}{'type'} = 'TTF'; next; @@ -1846,12 +1919,7 @@ sub read_each_font_database { if ($l =~ m/^TTCname(\((\d+)\))?:\s*(.*)$/) { my $fn = $3; $fontfiles{$fn}{'priority'} = ($2 ? $2 : 10); - # cp932 for win32 console - my $encoded_fn; - if (win32()) { - $encoded_fn = encode_utftocp($fn); - } - print_dddebug("filename: ", ($encoded_fn ? "$encoded_fn" : "$fn"), "\n"); + print_dddebug("filename: ${fn}\n"); print_dddebug("type: ttc\n"); $fontfiles{$fn}{'type'} = 'TTC'; next; @@ -1860,12 +1928,7 @@ sub read_each_font_database { if ($l =~ m/^Filename(\((\d+)\))?:\s*(.*)$/) { my $fn = $3; $fontfiles{$fn}{'priority'} = ($2 ? $2 : 10); - # cp932 for win32 console - my $encoded_fn; - if (win32()) { - $encoded_fn = encode_utftocp($fn); - } - print_dddebug("filename: ", ($encoded_fn ? "$encoded_fn" : "$fn"), "\n"); + print_dddebug("filename: ${fn}\n"); if ($fn =~ m/\.otf$/i) { print_dddebug("type: otf\n"); $fontfiles{$fn}{'type'} = 'OTF'; @@ -1888,12 +1951,7 @@ sub read_each_font_database { if ($l =~ m/^RMVname(\((\d+)\))?:\s*(.*)$/) { my $fn = $3; $fontfiles{$fn}{'priority'} = ($2 ? $2 : 10); - # cp932 for win32 console - my $encoded_fn; - if (win32()) { - $encoded_fn = encode_utftocp($fn); - } - print_dddebug("filename: ", ($encoded_fn ? "$encoded_fn" : "$fn"), "\n"); + print_dddebug("filename: ${fn}\n"); print_dddebug("type: remove\n"); $fontfiles{$fn}{'type'} = 'RMV'; next; @@ -1906,7 +1964,7 @@ sub read_each_font_database { } sub dump_font_database { - open(FOO, ">$dump_datafile") || + open(FOO, ">:encoding(UTF-8)", encode('locale_fs', $dump_datafile)) || die("cannot open $dump_datafile for writing: $!"); for my $k (sort keys %fontdb) { print FOO "Name: $fontdb{$k}{'origname'}\n"; @@ -1937,15 +1995,19 @@ sub find_gs_resource { my $foundres = ''; if (win32()) { # determine tlgs or native gs - chomp(my $foo = `kpsewhich -var-value=SELFAUTOPARENT`); - if ( -d "$foo/tlpkg/tlgs" ) { + my $foo = `kpsewhich -var-value=SELFAUTOPARENT`; + # We assume that the output of kpsewhich is + # the same as perl's locale (or active code page). + decode('locale', $foo); + chomp($foo); + if ( -d encode('locale_fs', "$foo/tlpkg/tlgs") ) { # should be texlive with tlgs print_debug("Assuming tlgs win32 ...\n"); $foundres = "$foo/tlpkg/tlgs/Resource"; # for TL2016, tlgs binary has built-in Resource, # so we cannot set up CJK fonts correctly. # the following test forces to exit in such case - if ( ! -d $foundres ) { + if ( ! -d encode('locale_fs', $foundres) ) { print_error("No Resource directory available for tlgs,\n"); print_error("we cannot support such gs, sorry.\n"); $foundres = ''; @@ -1957,18 +2019,20 @@ sub find_gs_resource { } else { # we assume gswin32c is in the path # TODO: what should we do for gswin64c? - chomp($foundres = `where gswin32c 2>$nul`); # assume 'where' is available + $foundres = `where gswin32c 2>$nul`; # assume 'where' is available if ($?) { print_error("Cannot run where gswin32c ...\n"); } else { + # We assume that the output of 'where' is + # the same as perl's locale (or active code page). + chomp($foundres = decode('locale', $foundres)); # trial 1: assume the relative path # when C:\path\to\bin\gswin32c.exe is found, then there should be # C:\path\to\Resource (note that 'where' returns backslash-ed path) print_debug("Finding gs resource by assuming relative path ...\n"); - $foundres = encode_cptoutf($foundres); # 99.99% unnecessary $foundres =~ s!\\!/!g; $foundres =~ s!/bin/gswin32c\.exe$!/Resource!; - if ( ! -d $foundres ) { + if ( ! -d encode('locale_fs', $foundres) ) { $foundres = ''; } if (!$foundres) { @@ -1983,7 +2047,7 @@ sub find_gs_resource { # trial 2: assume the fixed path, c:/gs/gs$gsver/Resource print_debug("Finding gs resource by assuming fixed path ...\n"); $foundres = "c:/gs/gs$gsver/Resource"; - if ( ! -d $foundres ) { + if ( ! -d encode('locale_fs', $foundres) ) { $foundres = ''; } if (!$foundres) { @@ -2002,9 +2066,13 @@ sub find_gs_resource { # when /path/to/bin/gs is found, then there should be # /path/to/share/ghostscript/$(gs --version)/Resource print_debug("Finding gs resource by assuming relative path ...\n"); - chomp($foundres = `which gs`); + $foundres = `which gs`; + # We assume that the output of 'which' is + # the same as perl's locale (or active code page). + $foundres = decode('locale', $foundres); + chomp($foundres); $foundres =~ s!/bin/gs$!/share/ghostscript/$gsver/Resource!; - if ( ! -d $foundres ) { + if ( ! -d encode('locale_fs', $foundres) ) { $foundres = ''; } if (!$foundres) { @@ -2012,10 +2080,14 @@ sub find_gs_resource { } } if (!$foundres) { - chomp(my @ret = `gs --help 2>$nul`); + my @ret = `gs --help 2>$nul`; if ($?) { print_error("Cannot run gs --help ...\n"); } else { + # We assume that the output of gs is + # the same as perl's locale (or active code page). + @ret = map { decode('locale', $_) } @ret; + chomp(@ret); # trial 2: parse gs help message print_debug("Finding gs resource by parsing help message ...\n"); $foundres = ''; @@ -2042,25 +2114,38 @@ sub kpse_miscfont { my ($file) = @_; my $foo = ''; # first, prioritize GitHub repository diretory structure - $foo = "database/$file" if (-f "database/$file"); + $foo = "database/$file" if (-f encode('locale_fs', "database/$file")); if ($foo eq "") { - chomp($foo = `kpsewhich -format=miscfont $file`); + my $cmdl = "kpsewhich -format=miscfont $file"; + $cmdl = encode('locale', $cmdl); + $foo = `$cmdl`; + # We assume that the output of kpsewhich is + # the same as perl's locale (or active code page). + $foo = decode('locale', $foo); + chomp($foo); } return $foo; } -sub encode_utftocp { - my ($foo) = @_; - $foo = Encode::decode('utf-8', $foo); - $foo = Encode::encode('cp932', $foo); - return $foo; -} +sub init_encode_locale { + eval { + require Encode::Locale; + Encode::Locale->import(); -sub encode_cptoutf { - my ($foo) = @_; - $foo = Encode::decode('cp932', $foo); - $foo = Encode::encode('utf-8', $foo); - return $foo; + $debug_msg_before_init .= "Encode::Locale is loaded.\n"; + }; + if ($@) { + if (win32) { + die ("For Windows, Encode::Locale is required.\n"); + } + + $debug_msg_before_init .= + "Encode::Locale is not found. Assuming all encodings are UTF-8.\n"; + Encode::Alias::define_alias('locale' => 'UTF-8'); + Encode::Alias::define_alias('locale_fs' => 'UTF-8'); + Encode::Alias::define_alias('console_in' => 'UTF-8'); + Encode::Alias::define_alias('console_out' => 'UTF-8'); + } } sub version { @@ -2107,13 +2192,6 @@ sub Usage { -h, --help this help "; - my $winonlyoptions = " ---hardlink create hardlinks instead of symlinks ---winbatch [FILE] prepare a batch file for link generation, instead of - generating links right away - the batch file name defaults to $winbatch -"; - my $commandoptions = " --dump-data [FILE] dump the set of font definitions which is currently effective, where FILE (the dump output) defaults to @@ -2269,8 +2347,9 @@ requirements of `LL` and `RR` must be fulfilled: my $authors = " The script and its documentation was written by Norbert Preining, based -on research and work by Yusuke Kuroki, Yusuke Terada, Bruno Voisin, -Hironobu Yamashita, Munehiro Yamamoto and the TeX Q&A wiki page. +on research and work by Masamichi Hosoda, Yusuke Kuroki, Yusuke Terada, +Bruno Voisin, Hironobu Yamashita, Munehiro Yamamoto and the TeX Q&A wiki +page. Maintained by Japanese TeX Development Community. For development, see https://github.com/texjporg/cjk-gs-support @@ -2286,8 +2365,6 @@ The contained font data is not copyrightable. print "\n$shortdesc\nUsage\n-----\n\n`````\n$usage\n`````\n\n"; print "#### Options ####\n\n`````"; print_for_out($options, " "); - print "`````\n\n#### Windows only options ####\n\n`````"; - print_for_out($winonlyoptions, " "); print "`````\n\n#### Command like options ####\n\n`````"; print_for_out($commandoptions, " "); print "`````\n\nOperation\n---------\n$operation\n"; @@ -2303,10 +2380,6 @@ The contained font data is not copyrightable. print "\nUsage: $usage\n\n$headline\n$shortdesc"; print "\nOptions:\n"; print_for_out($options, " "); - if (win32()) { - print "\nWindows only options:\n"; - print_for_out($winonlyoptions, " "); - } print "\nCommand like options:\n"; print_for_out($commandoptions, " "); print "\nOperation:\n"; diff --git a/Master/texmf-dist/doc/fonts/cjk-gs-integrate/ChangeLog b/Master/texmf-dist/doc/fonts/cjk-gs-integrate/ChangeLog index c09836b0910..bac77bb47b8 100644 --- a/Master/texmf-dist/doc/fonts/cjk-gs-integrate/ChangeLog +++ b/Master/texmf-dist/doc/fonts/cjk-gs-integrate/ChangeLog @@ -1,10 +1,126 @@ +2020-12-06 Hironobu Yamashita <h.y.acetaminophen@gmail.com> + + * Release 20201206.0 (HEAD -> master) [0652eb8] + +2020-12-06 Hironobu Yamashita <h.y.acetaminophen@gmail.com> + + * README (tag: 20201206.0, origin/master, origin/HEAD) [6ad1f11] + +2020-12-06 Hironobu Yamashita <h.y.acetaminophen@gmail.com> + + * clean [6495a34] + +2020-11-28 Masamichi Hosoda <trueroad@users.noreply.github.com> + + * Merge pull request #45 from trueroad/add-win32-symlink [f5269d3] + +2020-11-21 Masamichi Hosoda <trueroad@trueroad.jp> + + * Update README.md [13a4810] + +2020-11-21 Masamichi Hosoda <trueroad@trueroad.jp> + + * Add author [4fa99d7] + +2020-11-21 Masamichi Hosoda <trueroad@trueroad.jp> + + * Add compare files on Windows [42493f7] + +2020-11-21 Masamichi Hosoda <trueroad@trueroad.jp> + + * Remove `--hardlink` option [79c537a] + +2020-11-21 Masamichi Hosoda <trueroad@trueroad.jp> + + * Remove `--winbatch` option [cbe0bac] + +2020-11-21 Masamichi Hosoda <trueroad@trueroad.jp> + + * Use Windows symbolic link, hard link, copy by Win32 API [a2926da] + +2020-11-16 Hironobu Yamashita <aminophen@users.noreply.github.com> + + * Merge pull request #43 from trueroad/remove-cp932-dependency [15856ab] + +2020-11-16 Hironobu Yamashita <aminophen@users.noreply.github.com> + + * Merge pull request #44 from junkurihara/master [535653d] + +2020-11-16 Jun Kurihara <kurihara@ieee.org> + + * Support macOS 11.0 Big Sur [caa0466] + +2020-03-23 Masamichi Hosoda <trueroad@trueroad.jp> + + * Add support for environments without Encode::Locale [7f0ebd9] + +2020-03-23 Masamichi Hosoda <trueroad@trueroad.jp> + + * Limit warning suppression range [09b2b51] + +2020-03-22 Masamichi Hosoda <trueroad@trueroad.jp> + + * Delete win32 encoding comment [576256d] + +2020-03-22 Masamichi Hosoda <trueroad@trueroad.jp> + + * Add output files encoding settings [b1baa54] + +2020-03-22 Masamichi Hosoda <trueroad@trueroad.jp> + + * Add backquote execution encoding settings [3903bdf] + +2020-03-22 Masamichi Hosoda <trueroad@trueroad.jp> + + * Add kpsewhich output encoding settings [e0eb8a0] + +2020-03-22 Masamichi Hosoda <trueroad@trueroad.jp> + + * Add filename encoding settings [eb67742] + +2020-03-22 Masamichi Hosoda <trueroad@trueroad.jp> + + * Add finding font absolute path encoding settings [63176b7] + +2020-03-22 Masamichi Hosoda <trueroad@trueroad.jp> + + * Add dumping database encoding settings [af2062d] + +2020-03-22 Masamichi Hosoda <trueroad@trueroad.jp> + + * Add reading database encoding settings [af69825] + +2020-03-21 Masamichi Hosoda <trueroad@trueroad.jp> + + * Add support for non-CP932 Windows [e13f078] + +2020-03-21 Masamichi Hosoda <trueroad@trueroad.jp> + + * Add `@ARGV` and `$0` encoding settings [0b44e94] + +2020-03-20 Masamichi Hosoda <trueroad@trueroad.jp> + + * Add standard input/output encoding settings [e738a74] + +2020-03-20 Masamichi Hosoda <trueroad@trueroad.jp> + + * Replace `$^W = 1` with `use warnings` [14fa341] + +2020-03-20 Masamichi Hosoda <trueroad@trueroad.jp> + + * Move `use` functions inside `if` block to out of the block [aae7d7f] + +2020-03-08 Hironobu Yamashita <h.y.acetaminophen@gmail.com> + + * trailing CR in kpsewhich result [b18313b] + 2020-03-07 Hironobu Yamashita <h.y.acetaminophen@gmail.com> - * Release 20200307.0 (HEAD -> master) [57531f5] + * Release 20200307.0 (tag: 20200307.0) [57531f5] 2020-03-07 Hironobu Yamashita <h.y.acetaminophen@gmail.com> - * cjk-gs-integrate-macos.pl: support Catalina (at least nothing is wrong) (origin/master, origin/HEAD) [d43852e] + * cjk-gs-integrate-macos.pl: support Catalina (at least nothing is wrong) [d43852e] 2020-03-07 Hironobu Yamashita <h.y.acetaminophen@gmail.com> diff --git a/Master/texmf-dist/doc/fonts/cjk-gs-integrate/README.md b/Master/texmf-dist/doc/fonts/cjk-gs-integrate/README.md index a3081b78fd1..6aed0948199 100644 --- a/Master/texmf-dist/doc/fonts/cjk-gs-integrate/README.md +++ b/Master/texmf-dist/doc/fonts/cjk-gs-integrate/README.md @@ -54,15 +54,6 @@ Usage -h, --help this help ````` -#### Windows only options #### - -````` - --hardlink create hardlinks instead of symlinks - --winbatch [FILE] prepare a batch file for link generation, instead of - generating links right away - the batch file name defaults to makefontlinks.bat -````` - #### Command like options #### ````` @@ -216,8 +207,9 @@ Authors, Contributors, and Copyright ------------------------------------ The script and its documentation was written by Norbert Preining, based -on research and work by Yusuke Kuroki, Yusuke Terada, Bruno Voisin, -Hironobu Yamashita, Munehiro Yamamoto and the TeX Q&A wiki page. +on research and work by Masamichi Hosoda, Yusuke Kuroki, Yusuke Terada, +Bruno Voisin, Hironobu Yamashita, Munehiro Yamamoto and the TeX Q&A wiki +page. Maintained by Japanese TeX Development Community. For development, see https://github.com/texjporg/cjk-gs-support diff --git a/Master/texmf-dist/scripts/cjk-gs-integrate/cjk-gs-integrate.pl b/Master/texmf-dist/scripts/cjk-gs-integrate/cjk-gs-integrate.pl index 270600e38fa..68ea6e6198b 100755 --- a/Master/texmf-dist/scripts/cjk-gs-integrate/cjk-gs-integrate.pl +++ b/Master/texmf-dist/scripts/cjk-gs-integrate/cjk-gs-integrate.pl @@ -6,6 +6,7 @@ # Copyright 2016-2020 by Japanese TeX Development Community # # This work is based on research and work by (in alphabetical order) +# Masamichi Hosoda # Yusuke Kuroki # Yusuke Terada # Bruno Voisin @@ -31,30 +32,37 @@ # # Note that symlink names should be consistent with ptex-fontmaps! -$^W = 1; use Getopt::Long qw(:config no_autoabbrev ignore_case_always); use File::Basename; use File::Path qw(make_path); use Cwd 'abs_path'; use strict; +use warnings; +use utf8; +use feature 'state'; +use Encode; +use Encode::Alias; -(my $prg = basename($0)) =~ s/\.pl$//; -my $version = '20200307.0'; +my $debug_msg_before_init; +init_encode_locale (); + +binmode (STDIN, ':encoding(console_in)'); +binmode (STDOUT, ':encoding(console_out)'); +binmode (STDERR, ':encoding(console_out)'); + +@ARGV = map{ decode('locale', $_) }@ARGV; + +(my $prg = basename(decode('locale', $0))) =~ s/\.pl$//; +my $version = '20201206.0'; if (win32()) { - # conversion between internal (utf-8) and console (cp932): - # multibyte characters should be encoded in cp932 at least during - # * kpathsea file search - # * abs_path existence test - # * input/output on console - # * batch file output - # routines. make sure all of these should be restricted to win32 mode! - # TODO: what to do with $opt_fontdef, @opt_aliases and $opt_filelist, - # with regard to encodings? - use utf8; - use Encode; # some perl functions (symlink, -l test) does not work print_warning("Sorry, we have only partial support for Windows!\n"); + + require Win32::API; + Win32::API->import (); + require File::Compare; + File::Compare->import (); } # The followings are installed by ptex-fontmaps (texjporg): @@ -272,10 +280,6 @@ my $akotfps_pathpart = "dvips/ps2otfps"; my $akotfps_datafilename = "psnames-for-otf"; my $akotfps_datacontent = ''; -# if windows, we might create batch file for links -my $winbatch = "makefontlinks.bat"; -my $winbatch_content = ''; - # dump output for data file (for easy editing for users) my $dump_datafile = "$prg-data.dat"; @@ -335,6 +339,10 @@ if (! GetOptions( die "Try \"$0 --help\" for more information.\n"; } +if ($debug_msg_before_init) { + print_debug ($debug_msg_before_init); +} + sub win32 { return ($^O=~/^MSWin(32|64)$/i); } sub macosx { return ($^O=~/^darwin$/i); } my $nul = (win32() ? 'nul' : '/dev/null') ; @@ -356,12 +364,15 @@ if (system("kpsewhich --version >$nul 2>&1 <$nul" ) != 0) { if ($opt_debug >= 2) { require Data::Dumper; + no warnings qw(once); $Data::Dumper::Indent = 1; } my $zrlistttc = kpse_miscfont("zrlistttc.lua"); my $zrlistttc_available; -chomp(my $zrlistttc_help = `texlua $zrlistttc 2>$nul`); +my $cmdl = "texlua $zrlistttc 2>$nul"; +$cmdl = encode('locale', $cmdl); +chomp(my $zrlistttc_help = `$cmdl`); if ($?) { if ($opt_strictpsname) { print_error("The script 'zrlistttc.lua' not found, cannot proceed!\n"); @@ -385,7 +396,7 @@ if (macosx()) { $macos_ver_major =~ s/^(\d+)\.(\d+).*/$1/; my $macos_ver_minor = $macos_ver; $macos_ver_minor =~ s/^(\d+)\.(\d+).*/$2/; - if ($macos_ver_major==10 && $macos_ver_minor>=8) { + if ($macos_ver_major>=11 || ($macos_ver_major==10 && $macos_ver_minor>=8)) { if (!$opt_cleanup && !$opt_fontdef && !@opt_fontdef_add) { # if built-in only print_warning("Our built-in database does not support recent\n"); print_warning("versions of Mac OS (10.8 Mountain Lion or later)!\n"); @@ -402,7 +413,11 @@ if (defined($opt_texmflink)) { if ($opt_texmflink eq '') { # option was passed but didn't receive a value # -> use TEXMFLOCAL - chomp($foo = `kpsewhich -var-value=TEXMFLOCAL`); + $foo = `kpsewhich -var-value=TEXMFLOCAL`; + # We assume that the output of kpsewhich is + # the same as perl's locale (or active code page). + decode('locale', $foo); + chomp($foo); } else { # option was passed with an argument # -> use it @@ -417,7 +432,11 @@ if (defined($opt_akotfps)) { if (defined($opt_texmflink)) { $foo = $opt_texmflink; } else { - chomp($foo = `kpsewhich -var-value=TEXMFLOCAL`); + $foo = `kpsewhich -var-value=TEXMFLOCAL`; + # We assume that the output of kpsewhich is + # the same as perl's locale (or active code page). + decode('locale', $foo); + chomp($foo); } } else { $foo = $opt_akotfps; @@ -426,26 +445,10 @@ if (defined($opt_akotfps)) { } if (defined($opt_winbatch)) { - if ($opt_winbatch ne '') { - $winbatch = $opt_winbatch; - } - if (win32()) { - $opt_winbatch = 1; - unlink $winbatch if (-f $winbatch); - } else { - print_warning("ignoring --winbatch option due to non-Windows\n"); - $opt_winbatch = 0; - } -} else { - $opt_winbatch = 0; + print_warning("ignoring --winbatch option due to being obsolete\n"); } if ($opt_hardlink) { - if (win32()) { - $opt_hardlink = 1; - } else { - print_warning("ignoring --hardlink option due to non-Windows\n"); - $opt_hardlink = 0; - } + print_warning("ignoring --hardlink option due to being obsolete\n"); } if (defined($opt_dump_data)) { @@ -453,7 +456,8 @@ if (defined($opt_dump_data)) { $dump_datafile = $opt_dump_data; } $opt_dump_data = 1; - unlink $dump_datafile if (-f $dump_datafile); + unlink encode('locale_fs', $dump_datafile) + if (-f encode('locale_fs', $dump_datafile)); } else { $opt_dump_data = 0; } @@ -497,7 +501,7 @@ sub main { if ($opt_dump_data) { # with --dump-data, dump only effective database and exit dump_font_database(); - if (-f $dump_datafile) { + if (-f encode('locale_fs', $dump_datafile)) { print_info("*** Data dumped to $dump_datafile ***\n"); exit(0); } else { @@ -549,8 +553,8 @@ sub main { $opt_output = $gsres; } } - if (! -d $opt_output) { - $dry_run || mkdir($opt_output) || + if (! -d encode('locale_fs', $opt_output)) { + $dry_run || mkdir(encode('locale_fs', $opt_output)) || die("Cannot create directory $opt_output: $!"); } if ($opt_cleanup) { @@ -570,7 +574,6 @@ sub main { print_info(($opt_remove ? "removing" : "generating") . " links, snippets and cidfmap.local for non-CID fonts ...\n"); do_nonotf_fonts(); } - write_winbatch() if $opt_winbatch; } print_info(($opt_remove ? "removing" : "generating") . " snippets and cidfmap.aliases for font aliases ...\n"); do_aliases(); @@ -581,15 +584,6 @@ sub main { system("mktexlsr"); } print_info("finished\n"); - if ($opt_winbatch) { - if (-f $winbatch) { - print_info("*** Batch file $winbatch created ***\n"); - print_info("*** to complete, run it as administrator privilege.***\n"); - } else { - print_error("Failed to create $winbatch!\n"); - exit(1); - } - } } sub do_all_fonts { @@ -613,7 +607,8 @@ sub do_all_fonts { # due to previous bugs for my $class (%encode_list) { for my $enc (@{$encode_list{$class}}) { - unlink "$fontdest/$k-$enc" if (-f "$fontdest/$k-$enc"); + unlink encode('locale_fs', "$fontdest/$k-$enc") + if (-f encode('locale_fs', "$fontdest/$k-$enc")); } } # @@ -646,8 +641,8 @@ sub do_all_fonts { } update_master_cidfmap('cidfmap.local'); # we are in cleanup mode, also remove cidfmap.local itself - if (-f "$opt_output/$cidfmap_local_pathpart") { - unlink "$opt_output/$cidfmap_local_pathpart"; + if (-f encode('locale_fs', "$opt_output/$cidfmap_local_pathpart")) { + unlink encode('locale_fs', "$opt_output/$cidfmap_local_pathpart"); } } @@ -699,11 +694,13 @@ sub do_nonotf_fonts { } return if $dry_run; if ($outp) { - if (! -d "$opt_output/Init") { - mkdir("$opt_output/Init") || + if (! -d encode('locale_fs', "$opt_output/Init")) { + mkdir(encode('locale_fs', "$opt_output/Init")) || die("Cannot create directory $opt_output/Init: $!"); } - open(FOO, ">$opt_output/$cidfmap_local_pathpart") || + # It seems that tlgs can handle UTF-8 TTF filename in cidfmap.local. + open(FOO, ">:encoding(UTF-8)", + encode('locale_fs', "$opt_output/$cidfmap_local_pathpart")) || die("Cannot open $opt_output/$cidfmap_local_pathpart: $!"); print FOO $outp; close(FOO); @@ -775,8 +772,10 @@ sub do_aliases { } # special case for native CID fonts in ancient days # if not readable, add aliases for substitution - push @jal, "/HeiseiMin-W3 /Ryumin-Light ;" if (! -r "$ciddest/HeiseiMin-W3"); - push @jal, "/HeiseiKakuGo-W5 /GothicBBB-Medium ;" if (! -r "$ciddest/HeiseiKakuGo-W5"); + push @jal, "/HeiseiMin-W3 /Ryumin-Light ;" + if (! -r encode('locale_fs', "$ciddest/HeiseiMin-W3")); + push @jal, "/HeiseiKakuGo-W5 /GothicBBB-Medium ;" + if (! -r encode('locale_fs', "$ciddest/HeiseiKakuGo-W5")); # $outp .= "\n% Japanese fonts\n" . join("\n", @jal) . "\n" if @jal; $outp .= "\n% Korean fonts\n" . join("\n", @kal) . "\n" if @kal; @@ -786,19 +785,21 @@ sub do_aliases { # return if $dry_run; if ($outp && !$opt_remove) { - if (! -d "$opt_output/Init") { - mkdir("$opt_output/Init") || + if (! -d encode('locale_fs', "$opt_output/Init")) { + mkdir(encode('locale_fs', "$opt_output/Init")) || die("Cannot create directory $opt_output/Init: $!"); } - open(FOO, ">$opt_output/$cidfmap_aliases_pathpart") || + open(FOO, ">:encoding(UTF-8)", + encode('locale_fs', "$opt_output/$cidfmap_aliases_pathpart")) || die("Cannot open $opt_output/$cidfmap_aliases_pathpart: $!"); print FOO $outp; close(FOO); } update_master_cidfmap('cidfmap.aliases'); # if we are in cleanup mode, also remove cidfmap.aliases itself - if (-f "$opt_output/$cidfmap_aliases_pathpart") { - unlink "$opt_output/$cidfmap_aliases_pathpart" if $opt_cleanup; + if (-f encode('locale_fs', "$opt_output/$cidfmap_aliases_pathpart")) { + unlink encode('locale_fs', "$opt_output/$cidfmap_aliases_pathpart") + if $opt_cleanup; } } @@ -815,11 +816,13 @@ sub do_cmaps { # by others or distributed by gs itself for my $class (%encode_list) { for my $enc (@{$encode_list{$class}}) { - if (-l "$cmapdest/$enc") { - my $linkt = readlink("$cmapdest/$enc"); + if (-l encode('locale_fs', "$cmapdest/$enc")) { + my $linkt = decode('locale_fs', + readlink(encode('locale_fs', + "$cmapdest/$enc"))); if ($linkt) { if ($linkt eq search_cmap($enc)) { - unlink("$cmapdest/$enc"); + unlink(encode('locale_fs', "$cmapdest/$enc")); } } } @@ -828,7 +831,7 @@ sub do_cmaps { return; } # add mode - if (! -d "$cmapdest") { + if (! -d encode('locale_fs', "$cmapdest")) { print_debug("Creating directory $cmapdest ...\n"); make_dir("$cmapdest", "cannot create CMap directory"); } @@ -838,7 +841,7 @@ sub do_cmaps { next if (!$fontdb{$1}{'available'}); } for my $enc (@{$encode_list{$class}}) { - if (! -f "$cmapdest/$enc") { + if (! -f encode('locale_fs', "$cmapdest/$enc")) { print_debug("CMap $enc is not found in gs resource directory\n"); my $dest = search_cmap($enc); if ($dest) { @@ -858,7 +861,14 @@ sub search_cmap { my ($cmap) = @_; # search CMap with kpsewhich and cache if (! exists $cmap_cache{$cmap}) { - chomp($cmap_cache{$cmap} = `kpsewhich -format=cmap $cmap`); + my $cmdl = "kpsewhich -format=cmap $cmap"; + $cmdl = encode('locale', $cmdl); + $cmap_cache{$cmap} = `$cmdl`; + # We assume that the output of kpsewhich is + # the same as perl's locale (or active code page). + $cmap_cache{$cmap} = decode('locale', $cmap_cache{$cmap}); + chomp($cmap_cache{$cmap}); + $cmap_cache{$cmap} =~ s/[\r\n]+\z//; # perl's chomp() on git-bash cannot strip CR of CRLF ?? } return $cmap_cache{$cmap}; } @@ -876,8 +886,8 @@ sub update_master_cidfmap { my $cidfmap_master = "$opt_output/$cidfmap_pathpart"; print_info(sprintf("%s $add %s cidfmap file ...\n", ($opt_remove ? "removing" : "adding"), ($opt_remove ? "from" : "to"))); - if (-r $cidfmap_master) { - open(FOO, "<", $cidfmap_master) || + if (-r encode('locale_fs', $cidfmap_master)) { + open(FOO, "<:encoding(UTF-8)", encode('locale_fs', $cidfmap_master)) || die("Cannot open $cidfmap_master for reading: $!"); my $found = 0; my $found_tl = 0; @@ -916,7 +926,7 @@ sub update_master_cidfmap { if ($opt_remove) { if ($found || $found_tl) { return if $dry_run; - open(FOO, ">", $cidfmap_master) || + open(FOO, ">:encoding(UTF-8)", encode('locale_fs', $cidfmap_master)) || die("Cannot clean up $cidfmap_master: $!"); print FOO $newmaster; close FOO; @@ -926,7 +936,7 @@ sub update_master_cidfmap { print_info("$add already loaded in $cidfmap_master, no changes\n"); } else { return if $dry_run; - open(FOO, ">", $cidfmap_master) || + open(FOO, ">:encoding(UTF-8)", encode('locale_fs', $cidfmap_master)) || die("Cannot open $cidfmap_master for appending: $!"); print FOO $newmaster; print FOO "($add) .runlibfile\n"; @@ -936,7 +946,7 @@ sub update_master_cidfmap { } else { return if $dry_run; return if $opt_remove; - open(FOO, ">", $cidfmap_master) || + open(FOO, ">:encoding(UTF-8)", encode('locale_fs', $cidfmap_master)) || die("Cannot open $cidfmap_master for writing: $!"); print FOO "($add) .runlibfile\n"; close(FOO); @@ -987,10 +997,11 @@ sub generate_font_snippet { } for my $enc (@{$encode_list{$c}}) { if ($opt_remove) { - unlink "$fd/$n-$enc" if (-f "$fd/$n-$enc"); + unlink encode('locale_fs', "$fd/$n-$enc") + if (-f encode('locale_fs', "$fd/$n-$enc")); next; } - open(FOO, ">$fd/$n-$enc") || + open(FOO, ">:encoding(UTF-8)", encode('locale_fs', "$fd/$n-$enc")) || die("cannot open $fd/$n-$enc for writing: $!"); print FOO "%!PS-Adobe-3.0 Resource-Font %%DocumentNeededResources: $enc (CMap) @@ -1053,16 +1064,16 @@ sub link_font { } my $target = "$cd/$n"; my $do_unlink = 0; - if (-l $target) { + if (-l encode('locale_fs', $target)) { if ($opt_cleanup) { $do_unlink = 1; } else { - my $linkt = readlink($target); + my $linkt = decode('locale_fs', readlink(encode('locale_fs', $target))); if ($linkt) { if ($linkt eq $f) { # case 1: exists, link, targets agree $do_unlink = 1; - } elsif (-r $linkt) { + } elsif (-r encode('locale_fs', $linkt)) { # case 3: exists, link, targets different if ($opt_force) { print_info("Removing link $target due to --force!\n"); @@ -1081,12 +1092,24 @@ sub link_font { exit(1); } } - } elsif (-r $target) { + } elsif (-r encode('locale_fs', $target)) { # case 4: exists, but not link (NTFS hardlink on win32 falls into this) - if (-s $target) { + if (-s encode('locale_fs', $target)) { if ($opt_force) { print_info("Removing $target due to --force!\n"); $do_unlink = 1; + } elsif (win32()) { + my $result = compare (encode ('locale_fs', $f), + encode ('locale_fs', $target)); + if ($result == -1) { + print_error("file compare failed: ${f}, ${target}\n"); + exit(1); + } elsif ($result) { + print_error("$target already existing and different content, exiting!\n"); + exit(1); + } + print_debug("$target already existing but same content, skipping!\n"); + return; } else { print_error("$target already existing, exiting!\n"); exit(1); @@ -1107,107 +1130,175 @@ sub link_font { sub make_dir { my ($d, $w) = @_; - if (-r $d) { - if (! -d $d) { + if (-r encode('locale_fs', $d)) { + if (! -d encode('locale_fs', $d)) { print_error("$d is not a directory, $w\n"); exit(1); } } else { - $dry_run || make_path($d); + $dry_run || make_path(encode('locale', $d)); } } -# perl symlink function does not work on windows, so leave it to -# cmd.exe mklink function (or write to batch file). -# if target already exists, do not try to override it. otherwise -# "mklink error: Cannot create a file when that file already exists" -# is thrown many times +# perl symlink function does not work on windows, so we use Win32 API. sub maybe_symlink { my ($realname, $targetname) = @_; if (win32()) { - # hardlink vs. symlink -- HY 2017/04/26 - # * readablitiy: hardlink is easier, but it seems that current gs can read - # symlink properly, so it doesn't matter - # * permission: hardlink creation does not require administrator privilege, - # but is likely to fail for c:/windows/fonts/* system files - # due to "Access denied" - # symlink creation requires administrator privilege, but - # it can link to all files in c:/windows/fonts/ - # * versatility: symlink can point to a file on a different/remote volume - # for these reasons, we try to create symlink by default. - # if --hardlink option is given, we create hardlink instead. - # also, if --winbatch option is given, we prepare batch file for link generation, - # instead of creating links right away. - $realname =~ s!/!\\!g; - $targetname =~ s!/!\\!g; - if ($opt_winbatch) { - # re-encoding of $winbatch_content is done by write_winbatch() - $winbatch_content .= "if not exist \"$targetname\" mklink "; - $winbatch_content .= "/h " if $opt_hardlink; - $winbatch_content .= "\"$targetname\" \"$realname\"\n"; - } else { - # should be encoded in cp932 for win32 console - $realname = encode_utftocp($realname); - $targetname = encode_utftocp($targetname); - my $cmdl = "cmd.exe /c if not exist \"$targetname\" mklink "; - $cmdl .= "/h " if $opt_hardlink; - $cmdl .= "\"$targetname\" \"$realname\""; - my @ret = `$cmdl`; - # sometimes hard link creation may fail due to "Access denied" - # (especially when $realname is located in c:/windows/fonts). - # TODO: what should we do to ensure resources, which might be - # different from $realname? -- HY (2017/03/21) - # -- one possibility: - # if (@ret) { - # @ret ="done"; - # } else { - # print_info("Hard link creation for $realname failed. I will copy this file instead.\n"); - # $cmdl = "cmd.exe /c if not exist \"$targetname\" copy \"$realname\" \"$targetname\""; - # @ret = `$cmdl`; - # } - # -- however, both tlgs (TeX Live) and standalone gswin32/64 (built - # by Akira Kakuto) can search in c:/windows/fonts by default. - # Thus, copying such files is waste of memory + # Try symbolic link, hard link, copy by Win32 API + + # On Windows, the creation of a symbolic link requires a privilege. + # Therefore, if the creation of the symbolic link fails, + # create a hard link. + # However, the creation of the hard link requires the write permission + # to the original existing file. + # Thus, if the hard link also fails, copy the file. + + if (win32_symlink ($realname, $targetname)) { + print_debug ("Symbolic link succeeded: ${targetname}\n"); + return 1; + } + + if (win32_hardlink ($realname, $targetname)) { + print_debug ("Hard link succeeded: ${targetname}\n"); + return 1; + } + + if (win32_copy ($realname, $targetname)) { + print_debug ("Copy succeeded: ${targetname}\n"); + return 1; } + + print_warning ("Link/copy failed: ${targetname}\n"); } else { symlink ($realname, $targetname); } } -# unlink function actually works also on windows, however, -# leave it to batch file for consistency. otherwise -# option $opt_force may not work as expected sub maybe_unlink { my ($targetname) = @_; - if (win32()) { - $targetname =~ s!/!\\!g; - if ($opt_winbatch) { - # re-encoding of $winbatch_content is done by write_winbatch() - $winbatch_content .= "if exist \"$targetname\" del \"$targetname\"\n"; - } else { - # should be encoded in cp932 for win32 console - $targetname = encode_utftocp($targetname); - my $cmdl = "cmd.exe /c if exist \"$targetname\" del \"$targetname\""; - my @ret = `$cmdl`; + unlink (encode('locale_fs', $targetname)); +} + +# For Windows: Create symbolic link +sub win32_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; } - } else { - unlink ($targetname); - } + my $msg = decode ('locale', + Win32::FormatMessage (Win32::GetLastError ())); + $msg =~ s/[\r\n]+\z//; + print_debug ("CreateSymbolicLinkW failed: ${msg}\n"); + + return 0; } -# write batch file (windows only) -sub write_winbatch { - return if $dry_run; - open(FOO, ">$winbatch") || - die("cannot open $winbatch for writing: $!"); - # $winbatch_content may contain multibyte characters, and they - # should be encoded in cp932 in batch file - $winbatch_content = encode_utftocp($winbatch_content); - print FOO "\@echo off\n", - "$winbatch_content", - "\@echo symlink ", ($opt_remove ? "removed\n" : "generated\n"), - "\@pause 1\n"; - close(FOO); +# For Windows: Create hard link +sub win32_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_debug ("CreateHardLinkW failed: ${msg}\n"); + + return 0; +} + +# For Windows: Copy file +sub win32_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_debug ("CopyFileW failed: ${msg}\n"); + + return 0; +} + +# For Windows: 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; +} +# For Windows: 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; +} + +# For Windows: 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; } # write to psnames-for-otfps @@ -1215,7 +1306,9 @@ sub write_akotfps_datafile { return if $dry_run; make_dir("$opt_akotfps/$akotfps_pathpart", "cannot create $akotfps_datafilename in it!"); - open(FOO, ">$opt_akotfps/$akotfps_pathpart/$akotfps_datafilename") || + open(FOO, ">:encoding(UTF-8)", + encode('locale_fs', + "$opt_akotfps/$akotfps_pathpart/$akotfps_datafilename")) || die("cannot open $opt_akotfps/$akotfps_pathpart/$akotfps_datafilename for writing: $!"); print FOO "% psnames-for-otf % @@ -1240,10 +1333,6 @@ sub info_found_fonts { print "Type: $fontdb{$k}{'type'}\n"; print "Class: $fontdb{$k}{'class'}\n"; my $fn = $fontdb{$k}{'target'}; - # cp932 for win32 console - if (win32()) { - $fn = encode_utftocp($fn); - } if ($fontdb{$k}{'type'} eq 'TTC' || $fontdb{$k}{'type'} eq 'OTC') { $fn .= "($fontdb{$k}{'subfont'})"; } @@ -1285,10 +1374,6 @@ sub info_list_aliases { for my $p (@ks) { my $t = $aliases{$al}{$p}; my $fn = ($opt_listallaliases ? "-" : $fontdb{$t}{'target'} ); - # cp932 for win32 console - if (win32()) { - $fn = encode_utftocp($fn); - } # should always be the same ;-) $cl = $fontdb{$t}{'class'}; if (!$opt_listallaliases && ($fontdb{$t}{'type'} eq 'TTC' || $fontdb{$t}{'type'} eq 'OTC')) { @@ -1345,7 +1430,8 @@ sub make_all_available { sub check_for_files { my @foundfiles; if ($opt_filelist) { - open(FOO, "<", $opt_filelist) || die("Cannot open $opt_filelist: $!"); + open(FOO, "<", encode('locale_fs', $opt_filelist)) || + die("Cannot open $opt_filelist: $!"); @foundfiles = <FOO>; close(FOO) || warn "Cannot close $opt_filelist: $!"; } else { @@ -1371,13 +1457,15 @@ sub check_for_files { for my $d (qw!/Library/Fonts /System/Library/Fonts /System/Library/Assets /System/Library/AssetsV2 /Network/Library/Fonts /usr/share/fonts!) { - push @extradirs, "$d//" if (-d $d); # recursive search + push @extradirs, "$d//" + if (-d encode('locale_fs', $d)); # recursive search } # the path contains white space, so hack required for my $d (qw!/Library/Application__Support/Apple/Fonts!) { my $sd = $d; $sd =~ s/__/ /; - push @extradirs, "$sd//" if (-d "$sd"); # recursive search + push @extradirs, "$sd//" + if (-d encode('locale_fs', "$sd")); # recursive search } # office for mac 2016 for my $d (qw!/Applications/Microsoft__Word.app @@ -1385,11 +1473,14 @@ sub check_for_files { /Applications/Microsoft__PowerPoint.app!) { my $sd = $d; $sd =~ s/__/ /; - push @extradirs, "$sd/Contents/Resources/Fonts/" if (-d "$sd/Contents/Resources/Fonts"); - push @extradirs, "$sd/Contents/Resources/DFonts/" if (-d "$sd/Contents/Resources/DFonts"); + push @extradirs, "$sd/Contents/Resources/Fonts/" + if (-d encode('locale_fs', "$sd/Contents/Resources/Fonts")); + push @extradirs, "$sd/Contents/Resources/DFonts/" + if (-d encode('locale_fs', "$sd/Contents/Resources/DFonts")); } my $home = $ENV{'HOME'}; - push @extradirs, "$home/Library/Fonts//" if (-d "$home/Library/Fonts"); + push @extradirs, "$home/Library/Fonts//" + if (-d encode('locale_fs', "$home/Library/Fonts")); } # if (@extradirs) { @@ -1426,23 +1517,20 @@ sub check_for_files { $cmdl .= " \"$f\" "; } # shoot up kpsewhich - # this call (derived from the database) contains multibyte characters, - # and they should be encoded in cp932 for win32 console - if (win32()) { - $cmdl = encode_utftocp($cmdl); - } print_ddebug("checking for $cmdl\n"); + $cmdl = encode('locale', $cmdl); @foundfiles = `$cmdl`; + # We assume that the output of kpsewhich is + # the same as perl's locale (or active code page). + @foundfiles = map { decode('locale', $_) } @foundfiles; } - # at this point, on windows, @foundfiles is encoded in cp932 - # which is suitable for the next few lines chomp(@foundfiles); print_ddebug("Found files @foundfiles\n"); # map basenames to filenames my %bntofn; for my $f (@foundfiles) { $f =~ s/[\r\n]+\z//; # perl's chomp() on git-bash cannot strip CR of CRLF ?? - my $realf = abs_path($f); + my $realf = decode('locale_fs', abs_path(encode('locale_fs', $f))); if (!$realf) { print_warning("dead link or strange file found: $f - ignored!\n"); next; @@ -1458,11 +1546,6 @@ sub check_for_files { $temp_realfdir =~ s!^(.*)/(.*)$!$1!; next if ($temp_realfdir =~ $otf_pathpart || $temp_realfdir =~ $ttf_pathpart); } - # decode now on windows! (cp932 -> internal utf-8) - if (win32()) { - $f = encode_cptoutf($f); - $realf = encode_cptoutf($realf); - } my $bn = basename($f); # kpsewhich -all might return multiple files with the same basename; # collect all of them @@ -1511,7 +1594,9 @@ sub check_for_files { print_debug("We need to test whether\n"); print_debug(" $b:$index\n"); print_debug("is the correct one ($k). Invoking zrlistttc ...\n"); - chomp($actualpsname = `texlua $zrlistttc -i $index "$b"`); + my $cmdl = "texlua $zrlistttc -i $index \"$b\""; + $cmdl = encode('locale', $cmdl); + chomp($actualpsname = `$cmdl`); if ($?) { # something is wrong with the font file, or zrlistttc does not support it; # still there is a chance that Ghostscript supports, so don't discard it @@ -1521,6 +1606,9 @@ sub check_for_files { $bname = $b; last; } + # We assume that the output of texlua is + # the same as perl's locale (or active code page). + $actualpsname = decode('locale', $actualpsname); $actualpsname =~ s/[\r\n]+\z//; # perl's chomp() on git-bash cannot strip CR of CRLF ?? if ($actualpsname ne $k) { print_debug("... PSName returned by zrlistttc ($actualpsname) is\n"); @@ -1688,7 +1776,7 @@ sub read_font_database { # use "foo" as a substitute; otherwise, use built-in database if ($opt_fontdef) { my $foo = kpse_miscfont($opt_fontdef); - open(FDB, "<$foo") || + open(FDB, "<:encoding(UTF-8)", encode('locale_fs', $foo)) || die("Cannot find $opt_fontdef: $!"); @dbl = <FDB>; close(FDB); @@ -1702,7 +1790,7 @@ sub read_font_database { # overwrite existing one (that is, the addition wins) for (@opt_fontdef_add) { my $foo = kpse_miscfont($_); - open(FDB, "<$foo") || + open(FDB, "<:encoding(UTF-8)", encode('locale_fs', $foo)) || die("Cannot find $_: $!"); @dbl = <FDB>; close(FDB); @@ -1773,7 +1861,7 @@ sub read_each_font_database { next if (!$opt_cleanup); my @dbl; my $foo = kpse_miscfont($1); - if (!open(FDB, "<$foo")) { + if (!open(FDB, "<:encoding(UTF-8)", encode('locale_fs', $foo))) { print_warning("Cannot find $1, skipping!\n"); next; } @@ -1786,7 +1874,7 @@ sub read_each_font_database { if ($l =~ m/^INCLUDE\s*(.*)$/) { my @dbl; my $foo = kpse_miscfont($1); - if (!open(FDB, "<$foo")) { + if (!open(FDB, "<:encoding(UTF-8)", encode('locale_fs', $foo))) { print_warning("Cannot find $1, skipping!\n"); next; } @@ -1807,12 +1895,7 @@ sub read_each_font_database { if ($l =~ m/^OTFname(\((\d+)\))?:\s*(.*)$/) { my $fn = $3; $fontfiles{$fn}{'priority'} = ($2 ? $2 : 10); - # cp932 for win32 console - my $encoded_fn; - if (win32()) { - $encoded_fn = encode_utftocp($fn); - } - print_dddebug("filename: ", ($encoded_fn ? "$encoded_fn" : "$fn"), "\n"); + print_dddebug("filename: ${fn}\n"); print_dddebug("type: otf\n"); $fontfiles{$fn}{'type'} = 'OTF'; next; @@ -1820,12 +1903,7 @@ sub read_each_font_database { if ($l =~ m/^OTCname(\((\d+)\))?:\s*(.*)$/) { my $fn = $3; $fontfiles{$fn}{'priority'} = ($2 ? $2 : 10); - # cp932 for win32 console - my $encoded_fn; - if (win32()) { - $encoded_fn = encode_utftocp($fn); - } - print_dddebug("filename: ", ($encoded_fn ? "$encoded_fn" : "$fn"), "\n"); + print_dddebug("filename: ${fn}\n"); print_dddebug("type: otc\n"); $fontfiles{$fn}{'type'} = 'OTC'; next; @@ -1833,12 +1911,7 @@ sub read_each_font_database { if ($l =~ m/^TTFname(\((\d+)\))?:\s*(.*)$/) { my $fn = $3; $fontfiles{$fn}{'priority'} = ($2 ? $2 : 10); - # cp932 for win32 console - my $encoded_fn; - if (win32()) { - $encoded_fn = encode_utftocp($fn); - } - print_dddebug("filename: ", ($encoded_fn ? "$encoded_fn" : "$fn"), "\n"); + print_dddebug("filename: ${fn}\n"); print_dddebug("type: ttf\n"); $fontfiles{$fn}{'type'} = 'TTF'; next; @@ -1846,12 +1919,7 @@ sub read_each_font_database { if ($l =~ m/^TTCname(\((\d+)\))?:\s*(.*)$/) { my $fn = $3; $fontfiles{$fn}{'priority'} = ($2 ? $2 : 10); - # cp932 for win32 console - my $encoded_fn; - if (win32()) { - $encoded_fn = encode_utftocp($fn); - } - print_dddebug("filename: ", ($encoded_fn ? "$encoded_fn" : "$fn"), "\n"); + print_dddebug("filename: ${fn}\n"); print_dddebug("type: ttc\n"); $fontfiles{$fn}{'type'} = 'TTC'; next; @@ -1860,12 +1928,7 @@ sub read_each_font_database { if ($l =~ m/^Filename(\((\d+)\))?:\s*(.*)$/) { my $fn = $3; $fontfiles{$fn}{'priority'} = ($2 ? $2 : 10); - # cp932 for win32 console - my $encoded_fn; - if (win32()) { - $encoded_fn = encode_utftocp($fn); - } - print_dddebug("filename: ", ($encoded_fn ? "$encoded_fn" : "$fn"), "\n"); + print_dddebug("filename: ${fn}\n"); if ($fn =~ m/\.otf$/i) { print_dddebug("type: otf\n"); $fontfiles{$fn}{'type'} = 'OTF'; @@ -1888,12 +1951,7 @@ sub read_each_font_database { if ($l =~ m/^RMVname(\((\d+)\))?:\s*(.*)$/) { my $fn = $3; $fontfiles{$fn}{'priority'} = ($2 ? $2 : 10); - # cp932 for win32 console - my $encoded_fn; - if (win32()) { - $encoded_fn = encode_utftocp($fn); - } - print_dddebug("filename: ", ($encoded_fn ? "$encoded_fn" : "$fn"), "\n"); + print_dddebug("filename: ${fn}\n"); print_dddebug("type: remove\n"); $fontfiles{$fn}{'type'} = 'RMV'; next; @@ -1906,7 +1964,7 @@ sub read_each_font_database { } sub dump_font_database { - open(FOO, ">$dump_datafile") || + open(FOO, ">:encoding(UTF-8)", encode('locale_fs', $dump_datafile)) || die("cannot open $dump_datafile for writing: $!"); for my $k (sort keys %fontdb) { print FOO "Name: $fontdb{$k}{'origname'}\n"; @@ -1937,15 +1995,19 @@ sub find_gs_resource { my $foundres = ''; if (win32()) { # determine tlgs or native gs - chomp(my $foo = `kpsewhich -var-value=SELFAUTOPARENT`); - if ( -d "$foo/tlpkg/tlgs" ) { + my $foo = `kpsewhich -var-value=SELFAUTOPARENT`; + # We assume that the output of kpsewhich is + # the same as perl's locale (or active code page). + decode('locale', $foo); + chomp($foo); + if ( -d encode('locale_fs', "$foo/tlpkg/tlgs") ) { # should be texlive with tlgs print_debug("Assuming tlgs win32 ...\n"); $foundres = "$foo/tlpkg/tlgs/Resource"; # for TL2016, tlgs binary has built-in Resource, # so we cannot set up CJK fonts correctly. # the following test forces to exit in such case - if ( ! -d $foundres ) { + if ( ! -d encode('locale_fs', $foundres) ) { print_error("No Resource directory available for tlgs,\n"); print_error("we cannot support such gs, sorry.\n"); $foundres = ''; @@ -1957,18 +2019,20 @@ sub find_gs_resource { } else { # we assume gswin32c is in the path # TODO: what should we do for gswin64c? - chomp($foundres = `where gswin32c 2>$nul`); # assume 'where' is available + $foundres = `where gswin32c 2>$nul`; # assume 'where' is available if ($?) { print_error("Cannot run where gswin32c ...\n"); } else { + # We assume that the output of 'where' is + # the same as perl's locale (or active code page). + chomp($foundres = decode('locale', $foundres)); # trial 1: assume the relative path # when C:\path\to\bin\gswin32c.exe is found, then there should be # C:\path\to\Resource (note that 'where' returns backslash-ed path) print_debug("Finding gs resource by assuming relative path ...\n"); - $foundres = encode_cptoutf($foundres); # 99.99% unnecessary $foundres =~ s!\\!/!g; $foundres =~ s!/bin/gswin32c\.exe$!/Resource!; - if ( ! -d $foundres ) { + if ( ! -d encode('locale_fs', $foundres) ) { $foundres = ''; } if (!$foundres) { @@ -1983,7 +2047,7 @@ sub find_gs_resource { # trial 2: assume the fixed path, c:/gs/gs$gsver/Resource print_debug("Finding gs resource by assuming fixed path ...\n"); $foundres = "c:/gs/gs$gsver/Resource"; - if ( ! -d $foundres ) { + if ( ! -d encode('locale_fs', $foundres) ) { $foundres = ''; } if (!$foundres) { @@ -2002,9 +2066,13 @@ sub find_gs_resource { # when /path/to/bin/gs is found, then there should be # /path/to/share/ghostscript/$(gs --version)/Resource print_debug("Finding gs resource by assuming relative path ...\n"); - chomp($foundres = `which gs`); + $foundres = `which gs`; + # We assume that the output of 'which' is + # the same as perl's locale (or active code page). + $foundres = decode('locale', $foundres); + chomp($foundres); $foundres =~ s!/bin/gs$!/share/ghostscript/$gsver/Resource!; - if ( ! -d $foundres ) { + if ( ! -d encode('locale_fs', $foundres) ) { $foundres = ''; } if (!$foundres) { @@ -2012,10 +2080,14 @@ sub find_gs_resource { } } if (!$foundres) { - chomp(my @ret = `gs --help 2>$nul`); + my @ret = `gs --help 2>$nul`; if ($?) { print_error("Cannot run gs --help ...\n"); } else { + # We assume that the output of gs is + # the same as perl's locale (or active code page). + @ret = map { decode('locale', $_) } @ret; + chomp(@ret); # trial 2: parse gs help message print_debug("Finding gs resource by parsing help message ...\n"); $foundres = ''; @@ -2042,25 +2114,38 @@ sub kpse_miscfont { my ($file) = @_; my $foo = ''; # first, prioritize GitHub repository diretory structure - $foo = "database/$file" if (-f "database/$file"); + $foo = "database/$file" if (-f encode('locale_fs', "database/$file")); if ($foo eq "") { - chomp($foo = `kpsewhich -format=miscfont $file`); + my $cmdl = "kpsewhich -format=miscfont $file"; + $cmdl = encode('locale', $cmdl); + $foo = `$cmdl`; + # We assume that the output of kpsewhich is + # the same as perl's locale (or active code page). + $foo = decode('locale', $foo); + chomp($foo); } return $foo; } -sub encode_utftocp { - my ($foo) = @_; - $foo = Encode::decode('utf-8', $foo); - $foo = Encode::encode('cp932', $foo); - return $foo; -} +sub init_encode_locale { + eval { + require Encode::Locale; + Encode::Locale->import(); -sub encode_cptoutf { - my ($foo) = @_; - $foo = Encode::decode('cp932', $foo); - $foo = Encode::encode('utf-8', $foo); - return $foo; + $debug_msg_before_init .= "Encode::Locale is loaded.\n"; + }; + if ($@) { + if (win32) { + die ("For Windows, Encode::Locale is required.\n"); + } + + $debug_msg_before_init .= + "Encode::Locale is not found. Assuming all encodings are UTF-8.\n"; + Encode::Alias::define_alias('locale' => 'UTF-8'); + Encode::Alias::define_alias('locale_fs' => 'UTF-8'); + Encode::Alias::define_alias('console_in' => 'UTF-8'); + Encode::Alias::define_alias('console_out' => 'UTF-8'); + } } sub version { @@ -2107,13 +2192,6 @@ sub Usage { -h, --help this help "; - my $winonlyoptions = " ---hardlink create hardlinks instead of symlinks ---winbatch [FILE] prepare a batch file for link generation, instead of - generating links right away - the batch file name defaults to $winbatch -"; - my $commandoptions = " --dump-data [FILE] dump the set of font definitions which is currently effective, where FILE (the dump output) defaults to @@ -2269,8 +2347,9 @@ requirements of `LL` and `RR` must be fulfilled: my $authors = " The script and its documentation was written by Norbert Preining, based -on research and work by Yusuke Kuroki, Yusuke Terada, Bruno Voisin, -Hironobu Yamashita, Munehiro Yamamoto and the TeX Q&A wiki page. +on research and work by Masamichi Hosoda, Yusuke Kuroki, Yusuke Terada, +Bruno Voisin, Hironobu Yamashita, Munehiro Yamamoto and the TeX Q&A wiki +page. Maintained by Japanese TeX Development Community. For development, see https://github.com/texjporg/cjk-gs-support @@ -2286,8 +2365,6 @@ The contained font data is not copyrightable. print "\n$shortdesc\nUsage\n-----\n\n`````\n$usage\n`````\n\n"; print "#### Options ####\n\n`````"; print_for_out($options, " "); - print "`````\n\n#### Windows only options ####\n\n`````"; - print_for_out($winonlyoptions, " "); print "`````\n\n#### Command like options ####\n\n`````"; print_for_out($commandoptions, " "); print "`````\n\nOperation\n---------\n$operation\n"; @@ -2303,10 +2380,6 @@ The contained font data is not copyrightable. print "\nUsage: $usage\n\n$headline\n$shortdesc"; print "\nOptions:\n"; print_for_out($options, " "); - if (win32()) { - print "\nWindows only options:\n"; - print_for_out($winonlyoptions, " "); - } print "\nCommand like options:\n"; print_for_out($commandoptions, " "); print "\nOperation:\n"; |