view release on metacpan or  search on metacpan

examples/login_shell  view on Meta::CPAN

#! /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';