view release on metacpan or  search on metacpan

lib/Psh/Builtins/Firsttime.pm  view on Meta::CPAN

	} 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;