File Coverage

blib/lib/Shell/Source.pm
Criterion Covered Total %
statement 56 58 96.6
branch 13 20 65.0
condition 8 12 66.7
subroutine 10 11 90.9
pod n/a
total 87 101 86.1


line stmt bran cond sub pod time code
1             # Copyright 1997-2001, Paul Johnson (pjcj@cpan.org)
2              
3             # This software is free. It is licensed under the same terms as Perl itself.
4              
5             # The latest version of this software should be available from my homepage:
6             # http://www.pjcj.net
7              
8 6     6   74 use strict;
  6         48  
  6         101  
9              
10             require 5.004;
11              
12             package Shell::Source;
13              
14 6     6   100 use vars qw($VERSION);
  6         42  
  6         96  
15              
16             $VERSION = "0.01";
17              
18 6     6   96 use Carp;
  6         45  
  6         118  
19 6     6   138 use FileHandle;
  6         55  
  6         115  
20              
21             my $shells =
22             {
23             csh => "csh -f -c 'source [[file]]; env' |",
24             tcsh => "tcsh -f -c 'source [[file]]; env' |",
25             sh => "sh -c '. [[file]]; env' |",
26             ksh => "ksh -c '. [[file]]; env' |",
27             zsh => "zsh -c '. [[file]]; env' |",
28             bash => "bash -norc -noprofile -c '. [[file]]; env' |",
29             };
30              
31             sub new
32             {
33 6     6   57 my $class = shift;
34 6         89 my $self = { @_ };
35 6 50       81 croak "Must specify type of shell" unless $self->{shell};
36 6   33     125 $self->{run} ||= $shells->{$self->{shell}};
37 6 50       66 croak "Must specify how to run unknown shell $self->{shell}"
38             unless $self->{run};
39 6         42 push @{$self->{ignore}}, qw( TIMEFMT PWD _ );
  6         74  
40 6         69 bless $self, $class;
41 6 50       89 $self->run if length $self->{file};
42 6         70 $self
43             }
44              
45             sub run
46             {
47 6     6   45 my $self = shift;
48 6   33     98 my $file = shift || $self->{file};
49 6 50       70 croak "Must specify file to source" unless length $self->{file};
50 6         135 (my $run = $self->{run}) =~ s/\[\[file\]\]/$self->{file}/g;
51 6 50       100 my $fh = $self->{fh}
52             = FileHandle->new($run) or croak "Can't run $self->{shell}";
53 6         267 $self->_parse;
54 6 50       175 $fh->close or croak "Can't close $self->{shell}";
55 6         170 $self
56             }
57              
58             sub _parse
59             {
60 6     6   121 my $self = shift;
61 6         70 my $fh = $self->{fh}; # FileHandle ready for reading
62 6         46 my $env = 0; # for control of multi-line variables
63 6         34172 while (defined(my $line = <$fh>))
64             {
65 350 100       3635 if ($line =~ /^(\w+)=(.*)$/)
66             {
67 338         1865 $env = 1;
68 338 100 100     6360 if ((!defined $ENV{$1} || $ENV{$1} ne $2) &&
  114   100     1834  
69 38         313 !grep {$1 eq $_} @{$self->{ignore}})
70             {
71 26         4901 $self->{env}{$1} = $2;
72             }
73             }
74             else
75             {
76 12 100       124 push (@{$self->{output}}, $line) unless $env;
  6         5375  
77             }
78             }
79             $self
80 6         238 }
81              
82             sub inherit
83             {
84 6     6   55 my $self = shift;
85 6         51 while (my ($key, $val) = each (%{$self->{env}}))
  32         571  
86             {
87 26         452 $ENV{$key} = $val;
88             }
89             }
90              
91             sub shell
92             {
93 6     6   48 my $self = shift;
94 6         63 my $shell = "";
95 6         40 while (my ($key, $val) = each (%{$self->{env}}))
  32         414  
96             {
97 26         258 $shell .= qq($key="$val"; export $key\n);
98             }
99             $shell
100 6         90 }
101              
102             sub output
103             {
104 6     6   49 my $self = shift;
105 6 50       81 join("\n", @{$self->{output}}) if defined $self->{output}
  6         126  
106             }
107              
108             sub env
109             {
110 0     0     my $self = shift;
111 0           $self->{env}
112             }
113              
114             1;
115              
116             __END__