view release on metacpan or  search on metacpan

lib/Shell/Guess.pm  view on Meta::CPAN

  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, 'comm')) || 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 {
    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};

  unless(defined $username)
  {
    $username = eval { getpwuid $< };
  }

  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;