1#! /usr/bin/perl 2require './Clui'; import Term::Clui; 3use Config; 4 5&check_kit; 6 7my $libdir; my $bindir; my $man1dir; my $man3dir; my $comment; my $perlbin; 8my $version = '2.12'; 9($libdir, $bindir, $man1dir, $man3dir) = &defaults(); 10 11if (! -t STDIN) { # not interactive, use defaults ... 12 if (! $libdir) { die "Sorry, can't write to $libdir\n"; } 13 &install("$libdir/Crypt", $bindir, $man1dir, $man3dir); 14 exit 0; 15} 16 17if ($libdir) { 18 my $choice = &choose("Installing\n\n(Arrow-keys and Return, or q to quit)", 19 'using system default locations', 'interactively', 'Cancel'); 20 if ($choice eq 'Cancel') { exit 0; } 21 if ($choice eq 'using system default locations') { 22 if (! $libdir) { die "Sorry, can't write to $libdir\n"; } 23 &install("$libdir/Crypt", $bindir, $man1dir, $man3dir); 24 exit 0; 25 } 26} 27 28$libdir = &libdir; 29$bindir = &bindir; 30($man1dir, $man3dir) = &mandir; 31&install("$libdir/Crypt", $bindir, $man1dir, $man3dir); 32exit 0; 33 34# --------------------- infrastructure --------------------- 35 36sub defaults { 37 my $libdir = $Config{installsitelib}; 38 my $bindir = $Config{installscript}; 39 my $man1dir = $Config{installman1dir}; 40 my $man3dir = $Config{installman3dir}; 41 if (!-w $libdir) { $libdir = ''; } 42 if (!-w $bindir) { $bindir = ''; } 43 if (!-w $man1dir) { $man1dir = ''; } 44 if (!-w $man3dir) { $man3dir = ''; } 45 return ($libdir, $bindir, $man1dir, $man3dir); 46} 47 48sub install { my ($libdir, $bindir, $man1dir, $man3dir) = @_; 49 if (! $libdir) { die "Sorry, can't write to $libdir\n"; } 50 $comment = &comment($libdir, $bindir, $man1dir, $man3dir); 51 $perlbin = &which('perl'); 52 if (! $perlbin) { die "Sorry, no perl in PATH\n"; } 53 54 @localised_lib = &localise('Tea.pm'); 55 56 print STDERR "installing $libdir/Tea.pm ..."; 57 if (!-d $libdir) { mkdir $libdir, 0755; } 58 chmod 0755, $libdir; 59 my $target = "$libdir/Tea.pm"; 60 if (! open (P, "> $target")) { die "\nSorry, can't open $target: $!\n"; } 61 print P @localised_lib; close P; 62 chmod 0644, $target; 63 print STDERR "\n"; 64 65 my @localised_bin; 66 if ($bindir) { 67 print STDERR "installing $bindir/tea ..."; 68 # perl -c tea 69 @localised_bin = &localise('bin/tea'); 70 my $target = "$bindir/tea"; 71 if (! open (P, "> $target")) { die "\nSorry, can't open $target: $!\n"; } 72 print P @localised_bin; close P; 73 chmod 0755, $target; 74 print STDERR "\n"; 75 } 76 77 if ($man3dir) { 78 my $target = "$man3dir/Crypt::Tea.3"; 79 print STDERR "installing $target ..."; 80 my $tmpfile = "/tmp/Install.$$"; # can't pipe into pod2man :-( 81 if (! open (T, ">$tmpfile")) {die "\nSorry, can't open $tmpfile: $!\n";} 82 print T @localised_lib; close T; 83 system "pod2man $tmpfile > $target"; 84 unlink $tmpfile; 85 chmod 0644, $target; 86 print STDERR "\n"; 87 } 88 89 if ($bindir && $man1dir) { 90 my $target = "$man1dir/tea.1"; 91 print STDERR "installing $target ..."; 92 my $tmpfile = "/tmp/Install.$$"; # can't pipe into pod2man :-( 93 if (! open (T, ">$tmpfile")) {die "\nSorry, can't open $tmpfile: $!\n";} 94 print T @localised_bin; close T; 95 system "pod2man $tmpfile > $target"; 96 unlink $tmpfile; 97 chmod 0644, $target; 98 print STDERR "\n"; 99 } 100} 101 102sub localise { my $file = $_[$[]; 103 if (! open(F, $file)) { die "can't open $file: $!\n"; } 104 my @localised = (); 105 while (<F>) { 106 if ($comment) { s/#COMMENT#/$comment/; } 107 s/#PERLBIN#/$perlbin/; 108 s/#!perl/#!$perlbin/; 109 s/#LIBDIR#/$libdir/; 110 if ($bindir) { s/#BINDIR#/$bindir/; } 111 if ($version) { s/#VERSION#/$version/; } 112 push @localised, $_; 113 } 114 close F; 115 return @localised; 116} 117 118sub bindir { 119 my (%tried, %writeable); 120 foreach $dir ('/usr/local/bin',split /:/,$ENV{PATH}) { 121 next if ($dir =~ /sbin$|\/root/); 122 next if ($dir eq '.'); 123 $tried{$dir} = 1; 124 if (-w $dir) { $writeable{$dir} = 1; } 125 } 126 if (! %writeable) { 127 print STDERR <<EOT, " ", join ("\n ", keys %tried), "\n" ; 128Sorry, can't write to any directories in your PATH; tried 129EOT 130 exit 1; 131 } else { 132 $bindir = &choose("Where should the script be installed ?", 133 keys %writeable, 'Somewhere Else', 'Do not install the script'); 134 if ($bindir eq 'Somewhere Else') { 135 $bindir = &ask('in which directory, then ?'); 136 # if (! $bindir) { die "not installing, nowhere to install\n"; } 137 if (! $bindir) { warn "not installing the script\n"; return ''; } 138 if (! -d $bindir) { die "Sorry, $bindir is not a directory.\n"; } 139 if (! -w $bindir) { die "Sorry, $bindir is not writeable.\n"; } 140 } elsif ($bindir eq 'Do not install the script') { 141 return ''; 142 } 143 # if (! $bindir) { die "Sorry, nowhere to install the script\n"; } 144 } 145 $bindir =~ s/\/$//; 146 return $bindir; 147} 148 149sub libdir { 150 my (@libdirs, @tried, @writeable, $libdir); 151 @libdirs = grep (!/^\.$/, @INC); 152 if ($cgidir) { unshift @libdirs, $cgidir; } 153 foreach $dir (@libdirs) { 154 next if ($dir eq '.'); 155 push @tried, $dir; 156 if (-w $dir) { push @writeable, $dir; } 157 } 158 if (! @writeable) { 159 160 $libdir = &ask(<<'EOT'); 161Where should the module be installed ? 162 163You don't have write permission to any of the directories in your 164@INC path; if you wish to install in some other directory, enter it ... 165EOT 166 if (! $libdir) { die "not installing, nowhere to install module\n"; } 167 if (! -d $libdir) { die "Sorry, $libdir is not a directory.\n"; } 168 if (! -w $libdir) { die "Sorry, $libdir is not writeable.\n"; } 169 } else { 170 $libdir = &choose("Where should the module be installed ?", 171 @writeable, 'Somewhere Else'); 172 if ($libdir eq 'Somewhere Else') { 173 $libdir = &ask('in which directory, then ?'); 174 if (! $libdir) { die "not installing, nowhere to install\n"; } 175 if (! -d $libdir) { die "Sorry, $libdir is not a directory.\n"; } 176 if (! -w $libdir) { die "Sorry, $libdir is not writeable.\n"; } 177 } 178 if (! $libdir) { die "Sorry, nowhere to install the module\n"; } 179 } 180 $libdir =~ s/\/$//; 181 return $libdir; 182} 183 184sub mandir { 185 my (@tried, @writeable, $mandir); 186 foreach $dir (split(/:/, $ENV{MANPATH})) { 187 push @tried, $dir; 188 if (-w "$dir/man1") { push @writeable, $dir; } 189 } 190 if (! @writeable) { 191 my $manpath = join ("\n ", @tried); 192 $mandir = &ask(<<EOT); 193Where should the manual be installed ? 194 195You don't have write permission to any of the directories in your 196\@MANPATH; tried: 197 $manpath 198 199If you wish to put the manual in some other directory, enter it ... 200EOT 201 if (! $mandir) { $mandir = 'Do Not Install Manual'; 202 } elsif (! -d $mandir) { die "Sorry, $mandir is not a directory.\n"; 203 } elsif (! -w $mandir) { die "Sorry, $mandir is not writeable.\n"; 204 } 205 } else { 206 $mandir = &choose( 207 "Where should the manual be installed ?", 208 @writeable, 'Somewhere Else', 'Do Not Install Manual'); 209 } 210 if ($mandir eq 'Somewhere Else') { 211 $mandir = &ask('in which directory, then ?'); 212 if (! $mandir) { die "not installing, nowhere to install\n"; } 213 if (! -d $mandir) { die "Sorry, $mandir is not a directory.\n"; } 214 if (! -w $mandir) { die "Sorry, $mandir is not writeable.\n"; } 215 } elsif ($mandir eq 'Do Not Install Manual') { 216 return ''; 217 } elsif (! $mandir) { 218 die "Sorry, nowhere to install the manual\n"; 219 } 220 $mandir =~ s/\/$//; 221 if (!-d "$mandir/man1") { mkdir "$mandir/man1", 0755; } 222 if (!-d "$mandir/man3") { mkdir "$mandir/man3", 0755; } 223 return ("$mandir/man1", "$mandir/man3"); 224} 225 226sub comment { my ($libdir, $bindir, $man3dir) = @_; 227 my $user = (getpwuid($>))[$[]; 228 my $build_dir = `pwd`; $build_dir =~ s/\s+$//; 229 my $datestamp = &datestamp; 230 my $comment = "made $datestamp by $user in $build_dir"; 231 my $mandir = $man3dir; $mandir =~ s#/man[13]$##; 232 if ($libdir) { $comment .= ",\nmodule installed in $libdir"; } 233 if ($bindir) { $comment .= ",\nscript installed in $bindir"; } 234 if ($mandir) { $comment .= ",\nmanual installed in $mandir"; } 235 return $comment; 236} 237sub which { my $file = $_[$[]; # looks for executables, Perl libraries 238 return '' unless $file; 239 my $absfile; 240 if ($file =~ /\.p[lm]$/) { # perl library or module ? 241 foreach $dir (@INC) { 242 $absfile = "$dir/$file"; return $absfile if -r $absfile; 243 } 244 } else { # executable ? 245 foreach $dir (split (":", $ENV{PATH})) { 246 $absfile = "$dir/$file"; return $absfile if -x $absfile; 247 } 248 } 249} 250sub datestamp { # returns current date in "19940314" format 251 local ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime; 252 sprintf ("%4.4d%2.2d%2.2d", $year+1900, $mon+1, $mday); 253} 254 255sub check_kit { 256 print STDERR "Checking your kit ... "; 257 258 my %file_sizes = ( 259 'README', 1306, 260 'Changes', 1808, 261 'MANIFEST', 72, 262 'Tea.pm', 31608, 263 'bin/tea', 3109, 264 'examples/tea_demo.cgi', 4610, 265 'Clui', 27374, 266 'test.pl', 10734, 267 ); 268 269 my $problem_found = 0; 270 foreach $file (keys %file_sizes) { 271 if (! -f $file) { 272 if (! $problem_found) { $problem_found = 1; print STDERR "\n"; } 273 print STDERR " missing: $file\n" 274 } elsif (-s $file != $file_sizes{$file}) { 275 if (! $problem_found) { $problem_found = 1; print STDERR "\n"; } 276 my $is = -s $file; 277 my $should = $file_sizes{$file}; 278 print STDERR " wrong size: $file is $is, should be $should bytes\n" 279 } 280 } 281 if ($problem_found) { exit 1; 282 } else { print STDERR "Looks good.\n"; return 1; 283 } 284} 285