File Coverage

blib/lib/Shell/Source.pm

Criterion	Covered	Total	%
statement	56	58	96.5
branch	12	20	60.0
condition	7	12	58.3
subroutine	10	11	90.9
pod	0	6	0.0
total	85	107	79.4

# Copyright 1997-2001, Paul Johnson ([e-mail])

# This software is free.  It is licensed under the same terms as Perl itself.

# The latest version of this software should be available from my homepage:
# http://www.pjcj.net

use strict;

require 5.004;

package Shell::Source;

use vars qw($VERSION);

$VERSION = "0.01";

use Carp;
use FileHandle;

my $shells =
{
    csh  => "csh -f -c 'source [[file]]; env' |",
    tcsh => "tcsh -f -c 'source [[file]]; env' |",
    sh   => "sh -c '. [[file]]; env' |",
    ksh  => "ksh -c '. [[file]]; env' |",
    zsh  => "zsh -c '. [[file]]; env' |",
    bash => "bash -norc -noprofile -c '. [[file]]; env' |",
};

sub new
{
    my $class = shift;
    my $self = { @_ };
    croak "Must specify type of shell" unless $self->{shell};
    $self->{run} ||= $shells->{$self->{shell}};
    croak "Must specify how to run unknown shell $self->{shell}"
        unless $self->{run};
    push @{$self->{ignore}}, qw( TIMEFMT PWD _ );
    bless $self, $class;
    $self->run if length $self->{file};
    $self
}

sub run
{
    my $self = shift;
    my $file = shift || $self->{file};
    croak "Must specify file to source" unless length $self->{file};
    (my $run = $self->{run}) =~ s/\[\[file\]\]/$self->{file}/g;
    my $fh = $self->{fh}
           = FileHandle->new($run) or croak "Can't run $self->{shell}";
    $self->_parse;
    $fh->close or croak "Can't close $self->{shell}";
    $self
}

sub _parse
{
    my $self = shift;
    my $fh = $self->{fh};                         # FileHandle ready for reading
    my $env = 0;                           # for control of multi-line variables
    while (defined(my $line = <$fh>))
    {
        if ($line =~ /^(\w+)=(.*)$/)
        {
            $env = 1;
            if ((!defined $ENV{$1} || $ENV{$1} ne $2) &&
                !grep {$1 eq $_} @{$self->{ignore}})
            {
                $self->{env}{$1} = $2;
            }
        }
        else
        {
            push (@{$self->{output}}, $line) unless $env;
        }
    }
    $self
}

sub inherit
{
    my $self = shift;
    while (my ($key, $val) = each (%{$self->{env}}))
    {
        $ENV{$key} = $val;
    }
}

sub shell
{
    my $self = shift;
    my $shell = "";
    while (my ($key, $val) = each (%{$self->{env}}))
    {
        $shell .= qq($key="$val"; export $key\n);
    }
    $shell
}

sub output
{
    my $self = shift;
    join("\n", @{$self->{output}}) if defined $self->{output}
}

sub env
{
    my $self = shift;
    $self->{env}
}

1;

__END__