1package Shell::EnvImporter::Result; 2 3use strict; 4use warnings; 5no warnings 'uninitialized'; 6 7use Shell::EnvImporter::Change; 8 9use Class::MethodMaker 2.0 [ 10 new => [qw(-hash -init new)], 11 scalar => [qw( 12 shell_status 13 command_status 14 env_status 15 16 shell_output 17 command_output 18 stderr 19 )], 20 array => [qw( 21 imported 22 )], 23 hash => [qw( 24 start_env 25 26 changed 27 )], 28 ]; 29 30use constant DEFAULTS => ( 31 shell_status => -255, 32 command_status => -255, 33 env_status => -255, 34); 35 36 37########## 38sub init { 39########## 40 my $self = shift; 41 my %args = @_; 42 my %defaults = (DEFAULTS); 43 44 # Set supplied fields with defaults 45 my @fields = (keys %args, keys %defaults); 46 my %fields; @fields{@fields} = (1) x @fields; 47 @fields = keys %fields; 48 49 foreach my $field (@fields) { 50 if ($self->can($field)) { 51 my $curval = $self->$field(); 52 my $arg = exists($args{$field}) ? $args{$field} : $defaults{$field}; 53 if (ref($curval) =~ /ARRAY/) { 54 $self->$field(@$arg); 55 } elsif (ref($curval) =~ /HASH/) { 56 $self->$field(%$arg); 57 } else { 58 $self->$field($arg); 59 } 60 } 61 } 62 63 # Copy the environment when constructed 64 $self->_copy_env; 65 66 67} 68 69 70############ 71sub failed { 72############ 73 my $self = shift; 74 75 return $self->shell_status || 76 $self->command_status || 77 $self->env_status; 78 79} 80 81 82############### 83sub succeeded { 84############### 85 my $self = shift; 86 87 return $self->shell_status == 0 and 88 $self->command_status == 0 and 89 $self->env_status == 0; 90 91} 92 93 94 95 96 97############################################################################## 98########################### Private subroutines ############################# 99############################################################################## 100 101 102############### 103sub _copy_env { 104############### 105 my $self = shift; 106 107 my %envbak; 108 @envbak{keys %ENV} = values %ENV; 109 110 $self->start_env(%envbak); 111 112} 113 114 115 116 1171; 118 119 120__END__ 121=head1 NAME 122 123package Shell::EnvImporter::Result - Results of a Shell::EnvImporter run 124 125=head1 SYNOPSIS 126 127 use Shell::EnvImporter; 128 129 my $sourcer = Shell::EnvImporter->new( 130 command => $command, 131 ) or die "$@"; 132 133 134 my $result = $sourcer->result; 135 136 if ($result->succeeded()) { 137 138 print "Variables imported: ", join(", ", $result->imported), "\n"; 139 140 } else { 141 142 print "Command failed! with ", $result->command_status, " status\n"; 143 print "STDERR: ", $result->stderr, "\n"; 144 145 } 146 147 148 149 150=head1 DESCRIPTION 151 152Shell::EnvImporter allows you to import environment variable changes 153exported by an external script or command into the current environment. 154The Shell::EnvImporter::Shell object provides more control over 155interaction with the shell. 156 157=head1 METHODS 158 159=over 4 160 161=item B<failed()> 162 163Summary status. Returns true if any of the shell status, user command 164status, or 'env' command status are nonzero, and returns false 165otherwise. 166 167=item B<succeeded()> 168 169Summary status. Returns true if the shell status, user command status, 170and 'env' command status are all zero, and returns false otherwise. 171 172=back 173 174 175=head1 DATA MEMBERS 176 177=over 4 178 179=item B<shell_status()> 180 181Status of the shell - zero if the shell was successfully spawned, nonzero 182otherwise. 183 184=item B<shell_output()> 185 186Output produced by the shell when spawning (e.g. output from startup 187scripts). 188 189 190=item B<command_status()> 191 192Status of the user command. 193 194=item B<command_output()> 195 196Output produced by the user command. 197 198 199=item B<env_status()> 200 201Status of the 'env' command. 202 203 204=item B<stderr()> 205 206Standard error output produced by the shell, the user command, and/or the 207'env' command. 208 209 210=item B<imported()> 211 212List of variables imported by the shell. 213 214 215=head1 AUTHOR 216 217David Faraldo, E<lt>dfaraldo@cpan.orgE<gt> 218 219=head1 COPYRIGHT AND LICENSE 220 221 Copyright (C) 2005-2006 by Dave Faraldo 222 223 This library is free software; you can redistribute it and/or modify it 224 under the same terms as Perl itself. No warranty is expressed or implied. 225 226 227=cut 228