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