summaryrefslogtreecommitdiff
path: root/Build/source
diff options
context:
space:
mode:
Diffstat (limited to 'Build/source')
-rw-r--r--Build/source/texk/texlive/linked_scripts/ketcindy/ketcindy.pl203
1 files changed, 203 insertions, 0 deletions
diff --git a/Build/source/texk/texlive/linked_scripts/ketcindy/ketcindy.pl b/Build/source/texk/texlive/linked_scripts/ketcindy/ketcindy.pl
index e69de29bb2d..e5efbc0c98e 100644
--- a/Build/source/texk/texlive/linked_scripts/ketcindy/ketcindy.pl
+++ b/Build/source/texk/texlive/linked_scripts/ketcindy/ketcindy.pl
@@ -0,0 +1,203 @@
+#!/usr/bin/env perl
+#
+# KETCindy starter script
+#
+# (C) 2017-2018 Norbert Preining
+# Licensed under the same license terms as ketpic itself, that is GPLv3+
+#
+
+use strict;
+$^W = 1;
+
+use Digest::MD5;
+use File::Copy;
+
+my $BinaryName = "Cinderella2";
+my $TemplateFile = "template1basic.cdy";
+my $devnull = "/dev/null";
+my $prog = "ketcindy";
+my $systype;
+if (win32()) {
+ $systype = "Windows";
+ $devnull = "nul";
+} else {
+ $systype = `uname`;
+ chomp($systype);
+}
+my $HOME = ($systype eq "Windows") ? $ENV{'USERPROFILE'} : $ENV{'HOME'};
+my $workdir ="$HOME/ketcindy";
+
+my $cinderella;
+if ($#ARGV >= 0) {
+ if ($ARGV[0] eq '-c') {
+ $cinderella = ($ARGV[1] ? $ARGV[1] : "");
+ }
+} else {
+ $cinderella = which($BinaryName);
+}
+
+if (! "$cinderella") {
+ if ($systype eq 'Darwin') {
+ if (-r '/Applications/Cinderella2.app/Contents/MacOS/Cinderella2') {
+ $cinderella = '/Applications/Cinderella2.app/Contents/MacOS/Cinderella2';
+ }
+ } elsif ($systype eq 'Windows') {
+ if (-f 'c:/Program Files (x86)/Cinderella/Cinderella2.exe') {
+ $cinderella = 'c:/Program Files (x86)/Cinderella/Cinderella2.exe';
+ }
+ }
+}
+
+if (! "$cinderella") {
+ die "$prog: Cannot find $BinaryName!";
+}
+
+if ( ! -x "$cinderella" ) {
+ die "$prog: Program $cinderella is not executable!";
+}
+
+# find real path
+my $realcind = win32() ? $cinderella : `realpath "$cinderella"`;
+chomp($realcind);
+my ($cinddir, $bn) = dirname_and_basename($realcind);
+
+my $plugindir = ($systype eq 'Darwin') ? "$cinddir/../PlugIns" : "$cinddir/Plugins";
+
+my $plugin = "$plugindir/KetCindyPlugin.jar";
+my $dirheadplugin = "$plugindir/ketcindy.ini";
+
+# find Jar
+chomp(my $KetCdyJar = `kpsewhich -format=texmfscripts KetCindyPlugin.jar`);
+# search for template.cdy
+chomp(my $TempCdy = `kpsewhich -format=texmfscripts $TemplateFile`);
+chomp(my $DirHead=`kpsewhich -format=texmfscripts ketcindy.ini`);
+
+if (-z "$TempCdy" || -z "$KetCdyJar") {
+ die "$prog: Cannot find $TemplateFile via kpsewhich, is ketpic installed?";
+}
+
+
+if ( ! -r "$plugin" || ! -r "$dirheadplugin" ) {
+ print "$prog: Cinderella is *NOT* set up for KETCindy!\n";
+ print "$prog: You need to copy\n";
+ print "$prog: $KetCdyJar\n";
+ print "$prog: $DirHead\n";
+ print "$prog: into\n";
+ print "$prog: $plugindir\n";
+ print "\n";
+ exit(1);
+}
+
+my $myjarmd = md5digest($KetCdyJar);
+my $sysjarmd = md5digest($plugin);
+
+if ( $myjarmd ne $sysjarmd ) {
+ print "$prog: The installed version of the plugin in\n";
+ print "$prog: $plugin\n";
+ print "$prog: differs from the version shipped in\n";
+ print "$prog: $KetCdyJar\n";
+ print "$prog: You might need to update the former one with the later one!\n";
+}
+
+# print "DEBUG workdir =$workdir=\n";
+# print "DEBUG TemplateFile =$TemplateFile=\n";
+mkdir($workdir);
+copy($TempCdy, $workdir) or die "$prog: Copy failed: $!";
+
+# print "Exec $cinderella $workdir/$TemplateFile\n";
+if (win32()) {
+ # no idea why a normal call with exec did not find the template file
+ my $out = `"$cinderella" "$workdir/$TemplateFile"`;
+} else {
+ exec($cinderella, "$workdir/$TemplateFile");
+}
+
+
+sub md5digest {
+ my $file = shift;
+ open(FILE, $file) || die "$prog: open($file) failed: $!";
+ binmode(FILE);
+ my $out = Digest::MD5->new->addfile(*FILE)->hexdigest;
+ close(FILE);
+ return $out;
+}
+
+# taken from TeXLive::TLUtils.pm
+sub win32 {
+ if ($^O =~ /^MSWin/i) {
+ return 1;
+ } else {
+ return 0;
+ }
+}
+sub which {
+ my ($prog) = @_;
+ my @PATH;
+ my $PATH = getenv('PATH');
+
+ if (&win32) {
+ my @PATHEXT = split (';', getenv('PATHEXT'));
+ push (@PATHEXT, ''); # in case argument contains an extension
+ @PATH = split (';', $PATH);
+ for my $dir (@PATH) {
+ for my $ext (@PATHEXT) {
+ if (-f "$dir/$prog$ext") {
+ return "$dir/$prog$ext";
+ }
+ }
+ }
+
+ } else { # not windows
+ @PATH = split (':', $PATH);
+ for my $dir (@PATH) {
+ if (-x "$dir/$prog") {
+ return "$dir/$prog";
+ }
+ }
+ }
+ return "";
+}
+sub dirname_and_basename {
+ my $path=shift;
+ my ($share, $base) = ("", "");
+ if (win32()) {
+ $path=~s!\\!/!g;
+ }
+ # do not try to make sense of paths ending with /..
+ return (undef, undef) if $path =~ m!/\.\.$!;
+ if ($path=~m!/!) { # dirname("foo/bar/baz") -> "foo/bar"
+ # eliminate `/.' path components
+ while ($path =~ s!/\./!/!) {};
+ # UNC path? => first split in $share = //xxx/yy and $path = /zzzz
+ if (win32() and $path =~ m!^(//[^/]+/[^/]+)(.*)$!) {
+ ($share, $path) = ($1, $2);
+ if ($path =~ m!^/?$!) {
+ $path = $share;
+ $base = "";
+ } elsif ($path =~ m!(/.*)/(.*)!) {
+ $path = $share.$1;
+ $base = $2;
+ } else {
+ $base = $path;
+ $path = $share;
+ }
+ return ($path, $base);
+ }
+ # not a UNC path
+ $path=~m!(.*)/(.*)!; # works because of greedy matching
+ return ((($1 eq '') ? '/' : $1), $2);
+ } else { # dirname("ignore") -> "."
+ return (".", $path);
+ }
+}
+sub getenv {
+ my $envvar=shift;
+ my $var=$ENV{"$envvar"};
+ return 0 unless (defined $var);
+ if (&win32) {
+ $var=~s!\\!/!g; # change \ -> / (required by Perl)
+ }
+ return "$var";
+}
+
+