File Coverage

blib/lib/Shell/Guess.pm

Criterion	Covered	Total	%
statement	74	101	73.2
branch	62	110	56.3
condition	3	9	33.3
subroutine	33	34	97.0
pod	29	29	100.0
total	201	283	71.0

package Shell::Guess;

use strict;
use warnings;
use File::Spec;

# TODO: see where we can use P9Y::ProcessTable

# ABSTRACT: Make an educated guess about the shell in use
our $VERSION = '0.07'; # VERSION


sub _win32_getppid
{
  require Win32::Getppid;
  Win32::Getppid::getppid();
}

sub running_shell
{
  if($^O eq 'MSWin32')
  {
    my $shell_name = eval {
      require Win32::Process::List;
      my $parent_pid = _win32_getppid();
      Win32::Process::List->new->{processes}->[0]->{$parent_pid}
    };
    if(defined $shell_name)
    {
      if($shell_name =~ /cmd\.exe$/)
      { return __PACKAGE__->cmd_shell }
      elsif($shell_name =~ /powershell\.exe$/)
      { return __PACKAGE__->power_shell }
      elsif($shell_name =~ /command\.com$/)
      { return __PACKAGE__->command_shell }
    }
  }

  if($^O eq 'MSWin32')
  {
    if($ENV{ComSpec} =~ /cmd\.exe$/)
    { return __PACKAGE__->cmd_shell }
    else
    { return __PACKAGE__->command_shell }
  }

  return __PACKAGE__->dcl_shell     if $^O eq 'VMS';
  return __PACKAGE__->command_shell if $^O eq 'dos';

  my $shell = eval {
    open(my $fh, '<', File::Spec->catfile('', 'proc', getppid, 'cmdline')) || die;
    my $command_line = <$fh>;
    die unless defined $command_line; # don't spew warnings if read failed
    close $fh;
    $command_line =~ s/\0.*$//;
    _unixy_shells($command_line);
  }

  || eval {
    require Unix::Process;
    my $method = $^O eq 'solaris' ? 'comm' : 'command';
    my($command) = map { s/\s+.*$//; $_ } Unix::Process->$method(getppid);
    _unixy_shells($command);
  };

  $shell || __PACKAGE__->login_shell;
}


sub login_shell
{
  shift; # class ignored
  my $shell;

  if($^O eq 'MSWin32')
  {
    if(Win32::IsWin95())
    { return __PACKAGE__->command_shell }
    else
    { return __PACKAGE__->cmd_shell }
  }

  return __PACKAGE__->dcl_shell     if $^O eq 'VMS';
  return __PACKAGE__->command_shell if $^O eq 'dos';

  my $username = shift || $ENV{USER} || $ENV{USERNAME} || $ENV{LOGNAME};

  if($^O eq 'darwin')
  {
    my $command = `dscl . -read /Users/$username UserShell`;
    $shell = _unixy_shells($command);
    return $shell if defined $shell;
  }

  eval {
    my $pw_shell = (getpwnam($username))[-1];
    $shell = _unixy_shells($pw_shell);
    $shell = _unixy_shells(readlink $pw_shell) if !defined($shell) && -l $pw_shell;
  };

  $shell = __PACKAGE__->bourne_shell unless defined $shell;

  return $shell;
}


sub bash_shell { bless { bash => 1, bourne => 1, unix => 1, name => 'bash', default_location => '/bin/bash' }, __PACKAGE__ }


sub bourne_shell { bless { bourne => 1, unix => 1, name => 'bourne', default_location => '/bin/sh' }, __PACKAGE__ }


sub c_shell { bless { c => 1, unix => 1, name => 'c', default_location => '/bin/csh' }, __PACKAGE__ }


sub cmd_shell { bless { cmd => 1, win32 => 1, name => 'cmd', default_location => 'C:\\Windows\\system32\\cmd.exe' }, __PACKAGE__ }


sub command_shell { bless { command => 1, win32 => 1, name => 'command', default_location => 'C:\\Windows\\system32\\command.com' }, __PACKAGE__ }


sub dcl_shell { bless { dcl => 1, vms => 1, name => 'dcl' }, __PACKAGE__ }


sub fish_shell { bless { fish => 1, unix => 1, name => 'fish' }, __PACKAGE__ }


sub korn_shell { bless { korn => 1, bourne => 1, unix => 1, name => 'korn', default_location => '/bin/ksh' }, __PACKAGE__ }


sub power_shell { bless { power => 1, win32 => 1, name => 'power' }, __PACKAGE__ }


sub tc_shell { bless { c => 1, tc => 1, unix => 1, name => 'tc', default_location => '/bin/tcsh' }, __PACKAGE__ }


sub z_shell { bless { z => 1, bourne => 1, unix => 1, name => 'z', default_location => '/bin/zsh' }, __PACKAGE__ }


foreach my $type (qw( cmd command dcl bash fish korn c win32 unix vms bourne tc power z ))
{
  eval qq{
    sub is_$type
    {
      my \$self = ref \$_[0] ? shift : __PACKAGE__->running_shell;
      \$self->{$type} || 0;
    }
  };
  die $@ if $@;
}


sub name
{
  my $self = ref $_[0] ? shift : __PACKAGE__->running_shell;
  $self->{name};
}


sub default_location
{
  my $self = ref $_[0] ? shift : __PACKAGE__->running_shell;
  $self->{default_location};
}

sub _unixy_shells
{
  my $shell = shift;
  if($shell =~ /tcsh$/)
  { return __PACKAGE__->tc_shell     }
  elsif($shell =~ /csh$/)
  { return __PACKAGE__->c_shell      }
  elsif($shell =~ /ksh$/)
  { return __PACKAGE__->korn_shell   }
  elsif($shell =~ /bash$/)
  { return __PACKAGE__->bash_shell   }
  elsif($shell =~ /zsh$/)
  { return __PACKAGE__->z_shell      }
  elsif($shell =~ /fish$/)
  { return __PACKAGE__->fish_shell   }
  elsif($shell =~ /sh$/)
  { return __PACKAGE__->bourne_shell }
  else
  { return; }
}

1;

__END__