#! /usr/bin/perl
#########################################################################
#        This Perl script is Copyright (c) 2002, Peter J Billam         #
#               c/o P J B Computing, www.pjb.com.au                     #
#                                                                       #
#     This script is free software; you can redistribute it and/or      #
#            modify it under the same terms as Perl itself.             #
#########################################################################

use Term::Clui;
use Term::Clui::FileSelect;
my $home = $ENV{'HOME'} || $ENV{'LOGDIR'}  || (getpwuid($<))[7];
my $user = $ENV{'USER'} || $ENV{'LOGNAME'} || (getpwuid($<))[0];
my @path = split ':', $ENV{PATH};
my $browser = '';
my $mailer = '';
use Cwd; my $dir = cwd();

while (1) {
	my @tasks = ('Browser','Config','ChDir','Edit','FTP', 'IRC','Mail');
	if (-r './Makefile') { push (@tasks, 'Make'); }
	push (@tasks, 'Manual', 'News');
	if (-d "$home/.ssh") { push (@tasks, 'SSH'); }
	push (@tasks, 'View');

	my $shortdir = $dir;
	if ((index $shortdir,$home)==0) {substr($shortdir,0,(length $home))= '~';}
	my $task = &choose ("$user $shortdir", @tasks);
	if (! $task) { exit 0;
	} else { $task =~ s/ /_/g; eval "&$task";
	}
}
sub Config {
	my @files = grep (-w "$home/$_",
	'.cshrc', '.efaxrc', '.emacspeak', '.edbrowse', '.exrc',
	'.fvwmrc', '.html2psrc', '.jnewsrc',
	'.login', '.lynxrc', 'lynx_bookmarks.html',
	'.mailrc', '.mplayer/config', '.netrc', '.newsrc',
	'.perltidyrc', '.pinerc', '.popslurp', '.profile',
	'.rhosts', '.sig', '.slrnrc', '.ssh/config',
	'.tiprc', '.xauth', '.Xauthority', '.xinitrc',
	);
	my $file;
	$file = &choose("Edit which file ?", @files);
	return unless $file;
	&edit("$home/$file");
}
sub Browser {
	if (! $browser) {
		my ($bin, $prog);
		DIR: foreach $bin (@path) {
			foreach $prog ('lynx', 'w3m', 'links') {
				if (-e "$bin/$prog") { $browser = "$bin/$prog"; last DIR; }
			}
		}
	}
	if (! $browser) {
		&sorry("can't find a browser: tried lynx, w3m and links") ; return;
	}
	system $browser;
}
sub ChDir {
	my $newdir = &ask('to which directory ?');
	return unless $newdir;
	$newdir =~ s/^~\//$home\//;
	if (! -d $newdir) { &sorry("$newdir isn't a directory"); return; }
	if (! chdir $newdir) { &sorry("can't chdir to $newdir: $!"); return; }
	$dir = cwd();
}
sub Edit {
	if (!opendir(D,'.')) { &sorry("can't open current directory: $!"); return; }
	my @textfiles = sort grep (-T && !/^\./, readdir D); closedir D;
	my $file = 'Create new file';
	if (@textfiles) {
		$file = &choose('Edit which file ?',@textfiles,'Create new file');
		return unless $file;
	}
	if ($file eq 'Create new file') {
		$file = &ask('New file name ?'); return unless $file;
		system "touch $file";
	}
	&edit($file);
}
sub FTP {
	if (!open(F,"$home/.netrc")) {
		&sorry("can't open $home/.netrc: $!"); return;
	}
	my (%login, %password);
	while (<F>) {
		if (/^machine\s+(\S+)\s+login\s+(\S+)\s+password\s+(\S+)\s*$/) {
			$login{$1} = $2; $password{$1} = $3;
		}
	}
	close F;
	my $task = &choose('FTP to :',keys %login,'Somewhere else','Edit ~/.netrc');
	if (! $task) { return 1;
	} elsif ($task eq 'Somewhere else') {
		my $host = &ask('FTP to where ?'); if ($host) { system "ftp $host"; }
	} elsif ($task eq 'Edit ~/.netrc') { &edit("$home/.netrc");
	} else { system "ftp $task";
	}
}
sub IRC {
	if (! $ircclient) {
		my ($bin, $prog);
		DIR: foreach $bin (@path) {
			foreach $prog ('sirc','tinyirc') {
				if (-e "$bin/$prog") { $ircclient = "$bin/$prog"; last DIR; }
			}
		}
	}
	if (! $ircclient) {
		&sorry("can't find a ircclient: tried sirc and tinyirc") ; return;
	}
	system $ircclient;
}
sub Mail {
	if (! $mailer) {
		my ($bin, $prog);
		DIR: foreach $bin (@path) {
			foreach $prog ('alpine','pine', 'elm') {
				if (-e "$bin/$prog") { $mailer = "$bin/$prog"; last DIR; }
			}
		}
	}
	if (! $mailer) {
		&sorry("can't find a mailer: tried alpine, pine and elm") ; return;
	}
	system $mailer;
}
sub Make {
	if (!open(F,'./Makefile')) { &sorry("can't open Makefile: $!"); return; }
	my (%vars, @targets, $target);
	while (<F>) {
		if (/^\s*(\S+)\s*=\s*(\S+)/) { $vars{$1} = $2; }
		if (/^\s*(\S+)\s*:/) {
			$target = $1;
			while ($target =~ /\$[({](\w+)[)}]/ && $vars{$1}) {
				$target =~ s/\$[({](\w+)[)}]/$vars{$1}/;
			}
			push (@targets, $target);
		}
	}
	close F;
	$target = &choose("$dir : Make what ?", @targets);
	return unless $target;
	system "make $target";
}
sub Manual {
	my $topic = &ask('Topic ?'); return unless $topic;
	if (system "man '$topic'") {
		my $txt = `man -k '$topic'`;
		&view("Keyword search on $topic", $txt);
	}
}
sub News {
	system 'slrn';  # /usr/bin/trn ?
}
sub SSH {
 	# make sure ~/.ssh/config contains:  HashKnownHosts no
	if (! open(F,"$home/.ssh/known_hosts")) {
		&sorry("can't open $home/.ssh/known_hosts: $!"); return;
	}
	my (%hosts);
	while (<F>) { if (/^([.\w]+)/) { $hosts{$1}++; } }
	close F;
	my @hosts = sort keys %hosts;
	my $host = &choose('SSH to :', @hosts, 'Somewhere else');
	if (! $host) { return 1;
	} elsif ($host eq 'Somewhere else') {
		$host = &ask('ssh to which host ?');
		if ($host) { system "ssh $host"; }
	} else { system "ssh $host";
	}
}
sub View {
	my $file = select_file(-Readable=>1);
	&view($file);
}

=pod

=head1 NAME

login_shell - wrapper for text-based browser, mail, news, ssh, ftp etc.


=head1 SYNOPSIS

$ login_shell

=head1 DESCRIPTION

This script offers the naive user arrow-key-and-return access to a
text-based browser, a mail client, a news client, ssh, ftp, man
and various other stuff.

=head1 AUTHOR

Peter J Billam  www.pjb.com.au/comp/contact.html

=head1 CREDITS

Based on Term::Clui

=head1 SEE ALSO

http://www.pjb.com.au/ ,
http://search.cpan.org/~pjb , 
Term::Clui,
Term::Clui::FileSelect,
lynx(1),
slrn(1),
pine(1),
ssh(1),
ftp(1),
make(1),
man(1)

=cut