#! /usr/bin/perl
require './Clui'; import Term::Clui;
use Config;
&check_kit;
my $libdir; my $bindir; my $man1dir; my $man3dir; my $comment; my $perlbin;
my $version = '2.12';
($libdir, $bindir, $man1dir, $man3dir) = &defaults();
if (! -t STDIN) { # not interactive, use defaults ...
if (! $libdir) { die "Sorry, can't write to $libdir\n"; }
&install("$libdir/Crypt", $bindir, $man1dir, $man3dir);
exit 0;
}
if ($libdir) {
my $choice = &choose("Installing\n\n(Arrow-keys and Return, or q to quit)",
'using system default locations', 'interactively', 'Cancel');
if ($choice eq 'Cancel') { exit 0; }
if ($choice eq 'using system default locations') {
if (! $libdir) { die "Sorry, can't write to $libdir\n"; }
&install("$libdir/Crypt", $bindir, $man1dir, $man3dir);
exit 0;
}
}
$libdir = &libdir;
$bindir = &bindir;
($man1dir, $man3dir) = &mandir;
&install("$libdir/Crypt", $bindir, $man1dir, $man3dir);
exit 0;
# --------------------- infrastructure ---------------------
sub defaults {
my $libdir = $Config{installsitelib};
my $bindir = $Config{installscript};
my $man1dir = $Config{installman1dir};
my $man3dir = $Config{installman3dir};
if (!-w $libdir) { $libdir = ''; }
if (!-w $bindir) { $bindir = ''; }
if (!-w $man1dir) { $man1dir = ''; }
if (!-w $man3dir) { $man3dir = ''; }
return ($libdir, $bindir, $man1dir, $man3dir);
}
sub install { my ($libdir, $bindir, $man1dir, $man3dir) = @_;
if (! $libdir) { die "Sorry, can't write to $libdir\n"; }
$comment = &comment($libdir, $bindir, $man1dir, $man3dir);
$perlbin = &which('perl');
if (! $perlbin) { die "Sorry, no perl in PATH\n"; }
@localised_lib = &localise('Tea.pm');
print STDERR "installing $libdir/Tea.pm ...";
if (!-d $libdir) { mkdir $libdir, 0755; }
chmod 0755, $libdir;
my $target = "$libdir/Tea.pm";
if (! open (P, "> $target")) { die "\nSorry, can't open $target: $!\n"; }
print P @localised_lib; close P;
chmod 0644, $target;
print STDERR "\n";
my @localised_bin;
if ($bindir) {
print STDERR "installing $bindir/tea ...";
# perl -c tea
@localised_bin = &localise('bin/tea');
my $target = "$bindir/tea";
if (! open (P, "> $target")) { die "\nSorry, can't open $target: $!\n"; }
print P @localised_bin; close P;
chmod 0755, $target;
print STDERR "\n";
}
if ($man3dir) {
my $target = "$man3dir/Crypt::Tea.3";
print STDERR "installing $target ...";
my $tmpfile = "/tmp/Install.$$"; # can't pipe into pod2man :-(
if (! open (T, ">$tmpfile")) {die "\nSorry, can't open $tmpfile: $!\n";}
print T @localised_lib; close T;
system "pod2man $tmpfile > $target";
unlink $tmpfile;
chmod 0644, $target;
print STDERR "\n";
}
if ($bindir && $man1dir) {
my $target = "$man1dir/tea.1";
print STDERR "installing $target ...";
my $tmpfile = "/tmp/Install.$$"; # can't pipe into pod2man :-(
if (! open (T, ">$tmpfile")) {die "\nSorry, can't open $tmpfile: $!\n";}
print T @localised_bin; close T;
system "pod2man $tmpfile > $target";
unlink $tmpfile;
chmod 0644, $target;
print STDERR "\n";
}
}
sub localise { my $file = $_[$[];
if (! open(F, $file)) { die "can't open $file: $!\n"; }
my @localised = ();
while (<F>) {
if ($comment) { s/#COMMENT#/$comment/; }
s/#PERLBIN#/$perlbin/;
s/#!perl/#!$perlbin/;
s/#LIBDIR#/$libdir/;
if ($bindir) { s/#BINDIR#/$bindir/; }
if ($version) { s/#VERSION#/$version/; }
push @localised, $_;
}
close F;
return @localised;
}
sub bindir {
my (%tried, %writeable);
foreach $dir ('/usr/local/bin',split /:/,$ENV{PATH}) {
next if ($dir =~ /sbin$|\/root/);
next if ($dir eq '.');
$tried{$dir} = 1;
if (-w $dir) { $writeable{$dir} = 1; }
}
if (! %writeable) {
print STDERR <<EOT, " ", join ("\n ", keys %tried), "\n" ;
Sorry, can't write to any directories in your PATH; tried
EOT
exit 1;
} else {
$bindir = &choose("Where should the script be installed ?",
keys %writeable, 'Somewhere Else', 'Do not install the script');
if ($bindir eq 'Somewhere Else') {
$bindir = &ask('in which directory, then ?');
# if (! $bindir) { die "not installing, nowhere to install\n"; }
if (! $bindir) { warn "not installing the script\n"; return ''; }
if (! -d $bindir) { die "Sorry, $bindir is not a directory.\n"; }
if (! -w $bindir) { die "Sorry, $bindir is not writeable.\n"; }
} elsif ($bindir eq 'Do not install the script') {
return '';
}
# if (! $bindir) { die "Sorry, nowhere to install the script\n"; }
}
$bindir =~ s/\/$//;
return $bindir;
}
sub libdir {
my (@libdirs, @tried, @writeable, $libdir);
@libdirs = grep (!/^\.$/, @INC);
if ($cgidir) { unshift @libdirs, $cgidir; }
foreach $dir (@libdirs) {
next if ($dir eq '.');
push @tried, $dir;
if (-w $dir) { push @writeable, $dir; }
}
if (! @writeable) {
$libdir = &ask(<<'EOT');
Where should the module be installed ?
You don't have write permission to any of the directories in your
@INC path; if you wish to install in some other directory, enter it ...
EOT
if (! $libdir) { die "not installing, nowhere to install module\n"; }
if (! -d $libdir) { die "Sorry, $libdir is not a directory.\n"; }
if (! -w $libdir) { die "Sorry, $libdir is not writeable.\n"; }
} else {
$libdir = &choose("Where should the module be installed ?",
@writeable, 'Somewhere Else');
if ($libdir eq 'Somewhere Else') {
$libdir = &ask('in which directory, then ?');
if (! $libdir) { die "not installing, nowhere to install\n"; }
if (! -d $libdir) { die "Sorry, $libdir is not a directory.\n"; }
if (! -w $libdir) { die "Sorry, $libdir is not writeable.\n"; }
}
if (! $libdir) { die "Sorry, nowhere to install the module\n"; }
}
$libdir =~ s/\/$//;
return $libdir;
}
sub mandir {
my (@tried, @writeable, $mandir);
foreach $dir (split(/:/, $ENV{MANPATH})) {
push @tried, $dir;
if (-w "$dir/man1") { push @writeable, $dir; }
}
if (! @writeable) {
my $manpath = join ("\n ", @tried);
$mandir = &ask(<<EOT);
Where should the manual be installed ?
You don't have write permission to any of the directories in your
\@MANPATH; tried:
$manpath
If you wish to put the manual in some other directory, enter it ...
EOT
if (! $mandir) { $mandir = 'Do Not Install Manual';
} elsif (! -d $mandir) { die "Sorry, $mandir is not a directory.\n";
} elsif (! -w $mandir) { die "Sorry, $mandir is not writeable.\n";
}
} else {
$mandir = &choose(
"Where should the manual be installed ?",
@writeable, 'Somewhere Else', 'Do Not Install Manual');
}
if ($mandir eq 'Somewhere Else') {
$mandir = &ask('in which directory, then ?');
if (! $mandir) { die "not installing, nowhere to install\n"; }
if (! -d $mandir) { die "Sorry, $mandir is not a directory.\n"; }
if (! -w $mandir) { die "Sorry, $mandir is not writeable.\n"; }
} elsif ($mandir eq 'Do Not Install Manual') {
return '';
} elsif (! $mandir) {
die "Sorry, nowhere to install the manual\n";
}
$mandir =~ s/\/$//;
if (!-d "$mandir/man1") { mkdir "$mandir/man1", 0755; }
if (!-d "$mandir/man3") { mkdir "$mandir/man3", 0755; }
return ("$mandir/man1", "$mandir/man3");
}
sub comment { my ($libdir, $bindir, $man3dir) = @_;
my $user = (getpwuid($>))[$[];
my $build_dir = `pwd`; $build_dir =~ s/\s+$//;
my $datestamp = &datestamp;
my $comment = "made $datestamp by $user in $build_dir";
my $mandir = $man3dir; $mandir =~ s#/man[13]$##;
if ($libdir) { $comment .= ",\nmodule installed in $libdir"; }
if ($bindir) { $comment .= ",\nscript installed in $bindir"; }
if ($mandir) { $comment .= ",\nmanual installed in $mandir"; }
return $comment;
}
sub which { my $file = $_[$[]; # looks for executables, Perl libraries
return '' unless $file;
my $absfile;
if ($file =~ /\.p[lm]$/) { # perl library or module ?
foreach $dir (@INC) {
$absfile = "$dir/$file"; return $absfile if -r $absfile;
}
} else { # executable ?
foreach $dir (split (":", $ENV{PATH})) {
$absfile = "$dir/$file"; return $absfile if -x $absfile;
}
}
}
sub datestamp { # returns current date in "19940314" format
local ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime;
sprintf ("%4.4d%2.2d%2.2d", $year+1900, $mon+1, $mday);
}
sub check_kit {
print STDERR "Checking your kit ... ";
my %file_sizes = (
'README', 1306,
'Changes', 1808,
'MANIFEST', 72,
'Tea.pm', 31608,
'bin/tea', 3109,
'examples/tea_demo.cgi', 4610,
'Clui', 27374,
'test.pl', 10734,
);
my $problem_found = 0;
foreach $file (keys %file_sizes) {
if (! -f $file) {
if (! $problem_found) { $problem_found = 1; print STDERR "\n"; }
print STDERR " missing: $file\n"
} elsif (-s $file != $file_sizes{$file}) {
if (! $problem_found) { $problem_found = 1; print STDERR "\n"; }
my $is = -s $file;
my $should = $file_sizes{$file};
print STDERR " wrong size: $file is $is, should be $should bytes\n"
}
}
if ($problem_found) { exit 1;
} else { print STDERR "Looks good.\n"; return 1;
}
}