Initial commit of OpenSPARC T2 design and verification files.

[OpenSPARC-T2-DV] / tools / perl-5.8.0 / lib / site_perl / 5.8.0 / Psh / Builtins / Firsttime.pm

package Psh::Builtins::Firsttime;
use strict;

require Psh::Util;

=item * C<firsttime>

firsttime is a setup utility which should be used by first-time
psh users. It will parse existing shell rc files and try to
convert as much settings as possible and generate a .pshrc
file. It currently can only convert aliases, bash completions
and environment variables.

=cut

my (%aliases,$env,$complete);

sub bi_firsttime
{
	my $line;

	print <<EOT;
Welcome to the Firsttime Setup Utility!

This utility will try to setup an initial .pshrc file for you.
You can interrupt the process anytime using ^C

EOT

	my $home=Psh::OS::get_home_dir();

	unless ($home) {
		print <<EOT;
You unfortunately do not have a home directory where the .pshrc file could
be stored. Please set the environment variable HOME to a sensible value.
EOT
        return (0,undef);
    }

	my $tmp;

	$tmp= Psh::OS::catfile($home,'.pshrc');
	if (-r $tmp) {
		$line=Psh::Util::prompt('yn',
					 "Warning - you already have a .pshrc file!!!!\n".
					  "Do you really want to continue (y/n)? ");
		return (0,undef) if $line eq 'n';
	}

	my $text= "# This file was autogenerated by psh firsttime\n\n";
	print "Please press ENTER to start...\n";
	$line=<STDIN>;

	%aliases=();
	$env='';
	$complete='';

	my @sh_files=qw(.bashrc .bash_login .login);
	my @csh_files=qw(.cshrc);

	# .alias files usually _only_ contain aliases and functions
	# so we offer to source them
	$tmp= Psh::OS::catfile($home,'.alias');
	if (-r $tmp) {
		$line=Psh::Util::prompt('ics',
					  "We have found a .alias file. Do you want to\n".
					  "(c)all it from your .pshrc file\n".
					  "(i)nsert it into your .pshrc file\n".
					  "(s)kip ? ");

		if ($line eq 'c') {
			$text.="source ~/.alias\n";
		} elsif ($line eq 'i') {
			_parse_sh_file($tmp);
		}
	}

	$line=Psh::Util::prompt('cs',"Parse (s) bash/sh files or\n      (c) csh files? ");
	if ($line eq 's') {
		foreach my $file (@sh_files) {
			$tmp= Psh::OS::catfile($home,$file);
			if (-r $tmp) {
				$line=Psh::Util::prompt('yn',
							  "Found file $file - parse it (y/n)? ");
				if ($line eq 'y') {
					_parse_sh_file($tmp);
				}
			}
		}
	} else {
		foreach my $file (@csh_files) {
			$tmp= Psh::OS::catfile($home,$file);
			if (-r $tmp) {
				$line=Psh::Util::prompt('yn',
							  "Found file $file - parse it (y/n)? ");
				if ($line eq 'y') {
					_parse_csh_file($tmp);
				}
			}
		}
	}

	$text.=_generate_stuff();

	print "The setup process is finished now.\n";
	print "Press ENTER to save to $home/.pshrc now or ^C to stop.\n";
	$line=<STDIN>;
	open(FILE,"> $home/.pshrc");
	print FILE $text;
	close(FILE);
	print "$home/.pshrc saved\n";
	return (1,undef);
}

sub _generate_stuff {
	my $text='';
	my ($key,$value);

	$text=$env.$complete;
	while ( ($key,$value)= each %aliases) {
		$text.="alias $key=$value\n";
	}
	return $text;
}

sub _parse_sh_file {
	my $file= shift;
	my $text='';
	open(FILE,"< $file");
	while (<FILE>) {
		my $line=$_;
		chomp $line;
		next if $line=~/^\s*#/;
		if ($line=~/^\s*alias (\S+)\=(.+)$/) {
			my $key= $1;
			my $value= $2;
			if (exists $aliases{$key}) {
				print STDERR "Warning: alias $key redefined.\n";
			}
			$aliases{$key}=$value;
		} elsif ($line=~/^\s*function (\S+) \{/) {
			my $tmp=$line;
			while (Psh::Parser::incomplete_expr($tmp)>0 && <FILE>) {
				$tmp.=$_;
			}
			$env.="$tmp\n";
		} elsif ($line=~/^\s*(\S+)\=(.*)$/) {
			my $key= uc($1);
			my $value= _change_env_value($2);
			$env.="setenv $key=$value\n";
		} elsif ($line=~/^\s*export (\S+)\=(.+)$/) {
			my $key= uc($1);
			my $value= _change_env_value($2);
			$env.="setenv $key=$value\n";
		}

	}
	close(FILE);
	return undef;
}


sub _parse_csh_file {
	my $file= shift;
	my $text='';
	open(FILE,"< $file");
	while (<FILE>) {
		my $line=$_;
		chomp $line;
		next if $line=~/^\s*#/;
		if ($line=~/^\s*alias (\S+)\s+(.+)$/) {
			my $key= $1;
			my $value= $2;
			if (exists $aliases{$key}) {
				print STDERR "Warning: alias $key redefined.\n";
			}
			$aliases{$key}=$value;
		} elsif ($line=~/^\s*setenv\s+(\S+)\s+(.+)$/) {
			my $key= uc($1);
			my $value= _change_env_value($2);
			$env.="setenv $key=\"$value\"\n";
		} elsif ($line=~/^\s*set\s+(\S+)\=\s*["]([^\"]+)["]\s*$/ ||
				 $line=~/^\s*set\s+(\S+)\=\s*[']([^\']+)[']\s*$/ ||
				 $line=~/^\s*set\s+(\S+)\=\s*(\([^\']+\))\s*$/ ||
				 $line=~/^\s*set\s+(\S+)\=([^#\s]+)\s*/) {
			my $key= uc($1);
			my $value= _change_env_value($2);
			$env.="setenv $key=$value\n";
		}
	}
	close(FILE);
	return undef;
}

sub _change_env_value
{
	my $val= shift;
	return $val if ($val=~/^\'(.*)\'$/); # do not modify if single quotes
	$val=~s/\$([a-zA-Z0-9_]+)/\$ENV\{$1\}/g;
	$val=~s/\@/\\@/g;
	return "\"$val\"" if ($val !~ /^\"(.*)\"$/);
	return $val;
}

1;