#!/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"; }