#!perl
use Config;
use File::Basename qw(basename dirname);
use Cwd;
$origdir = cwd;
chdir dirname($0);
$file = basename($0, '.PL');
$file .= '.com' if $^O eq 'VMS';
open OUT,">$file" or die "Can't create $file: $!";
print "Extracting $file (with variable substitutions)\n";
print OUT <<"!GROK!THIS!";
$Config{startperl}
!GROK!THIS!
# In the following, perl variables are not expanded during extraction.
print OUT <<'!NO!SUBS!';
use strict;
use warnings;
no warnings 'uninitialized';
BEGIN {
($Mac::Glue::Common::PROGVERSION) =
' $Revision: 1.3 $ ' =~ /\$Revision:\s+([^\s]+)/;
$Mac::Glue::Common::PROGDESC = <<'EOT';
Creates application glues for use with Mac::Glue. Pass in scriptable
applications on the command line.
Read the documentation for created glues with the gluedoc program.
-c Check installed glue versions against app versions
-r Re-make all installed glues (with -c, only those glues
where the app versions don't match)
EOT
$Mac::Glue::Common::PROGOPTS = 'cr';
}
use File::Spec::Functions;
use Mac::Glue::Common;
use Mac::Processes;
my $opts = opts();
if ($opts->{c} || $opts->{r}) {
gluecheck();
} else {
glue($opts, \@ARGV);
}
sub gluecheck {
require Mac::Glue;
my @paths;
opendir my $dh, $MACGLUEDIR or die $!;
for my $name (sort readdir $dh) {
next if $name =~ /\.pod$/;
next unless -f catfile($MACGLUEDIR, $name);
next if $name eq 'FontSyncScripting'; # something's wrong ... ?
my $glue = new Mac::Glue $name;
if ($opts->{c}) {
eval {
$glue->{TIMEOUT} = 10;
my($g1, $g2) = ($glue->version, $glue->{VERSION});
if ($g1 ne $g2 || $name eq 'Finder') {
my $path = _get_path($glue);
die "Can't find $name\n" if !$path;
if ($opts->{r}) {
push @paths, $path;
} else {
my $command = "$0 $path";
$command = "sudo $ENV{_} $command" if $ENV{SUDO_COMMAND};
print "$g1 ne $g2:\n $command\n";
}
}
1;
} or warn "Error for $name: $@";
} elsif ($opts->{r}) {
push @paths, _get_path($glue);
}
}
glue($opts, \@paths) if @paths && $opts->{r};
}
sub _get_path {
my($glue) = @_;
my $path;
if ($glue->{ID} && $glue->{ID} ne '????') {
if (length($glue->{ID}) == 4) {
$path = LSFindApplicationForInfo($glue->{ID});
}
$path ||= LSFindApplicationForInfo('', $glue->{ID});
}
$path ||= LSFindApplicationForInfo('', '', $glue->{APPNAME});
$path ||= LSFindApplicationForInfo('', '', $glue->{APPNAME} . '.app');
return $path;
}
__END__
!NO!SUBS!
close OUT or die "Can't close $file: $!";
chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';
chdir $origdir;