How can I properly import the environment from running a subcommand in Perl? - perl

In importing the environment from a subcommand, I want to add all environment variables exported from a bash script to a hash. When program gets run, it will set up some variables and export them. I'd like to save those variables in the Perl script for later. However I don't want to take the bash functions defined in the subcommand. Currently, I have a block like:
foreach (`program; env`)
{
next if /^\(\)/;
my ($a, $b) = split("=", $_);
if( /^(\w+)=(.*)$/ ) {
$hash{$1} = $2;
}
}
Is there a better way to do this? I'm not sure if matching the initial () is safe. Bonus points for handling newlines in environment variables, which I'm just closing my eyes for right now.

What you want is there: Shell-EnvImporter
An example:
use Shell::EnvImporter;
# Import environment variables exported from a shell script
my $sourcer = Shell::EnvImporter->new(
file => $filename,
);
my $result = $sourcer->run() or die "Run failed: $#";

I am assuming that the environment variables after program has executed are not same as the environment passed to it (which you can find in %ENV as explained in jeje's answer.
I am by no means knowledgeable about bash, so I am only going to address the part of the question about parsing the output of env.
#!/usr/bin/perl
use strict;
use warnings;
use autodie qw( open close );
$ENV{WACKO} = "test\nstring\nwith\nnewlines\n\n";
my %SUBENV;
open my $env_h, '-|', 'env';
my $var;
while ( my $line = <$env_h> ) {
chomp $line;
if ( my ($this_var, $this_val) = $line =~ /^([^=]+)=(.+)$/ ) {
if ( $this_val =~ /^\Q()\E/ ) {
$var = q{};
next;
}
$var = $this_var;
$SUBENV{ $var } = $this_val;
}
elsif ( $var ) {
$SUBENV{ $var } .= "\n$line";
}
}
use Data::Dumper;
print Dumper \%SUBENV;

This should be fine for getting all of the environment variables.
for(`program; env`){
if( /^([^=]+)=(.*)$/ ) {
$hash{$1} = $2;
}
}
If you want to start with a clean slate this might work better.
for(`env -i bash -c "program; env"`){
next if /\(\)/;
if( /^([^=]+)=(.*)$/ ) {
$hash{$1} = $2;
}
}
env -i makes it's subcommand start off with a clean slate.
It calls bash with the -c argument, and the commands to run. We need to do that because otherwise the second env wouldn't get the environment variables from the program.

Related

Variable was returned to previous value in Perl

I'm just one-month experience in perl.
For perl-based program executing problem, the commend variable was returned to previous value.
What is the problem?
Here is the code.
1st();
2nd();
sub 1st {
$cmd = "cat asdf";
}
sub 2nd {
if ( $code =~ /aa/ ) {
my $cmd = "$reg $annotation";
out_log($cmd);
} else {
my $cmd = "$reg $annotation";
out_log($cmd);
}
out_log("$cmd");
open (Work,$cmd);
}
In this state, the $cmd was registered in if statement, but executing $cmd after if statement, the $cmd value was returned subroutine 1st's value.
Thanks for your advices.
You are mixing lexical and package variables. If your program had use strict and use warnings, this would be quite obvious.
If you do not declare a variable with my, Perl will assume it's a package variable. It will be visible from every part of your program (in the same namespace).
If you declare the variable with my, it will be lexical. That means that it only exists inside the scope it was created in.
my $foo = 1; #
#
if ($foo) { # #
my $bar = 2; # #
} # #
^ ^
| | scope that $foo exists in
| scope that $bar exists in
The same thing is happening here.
You are setting the package variable $::cmd (with :: being the main namespace) to "cat asdf" inside the 1st sub. You then call the 2nd sub, which will go into the else branch. In that scope, it will create a new lexical $cmd. It's only valid in that part of the program. It is then passed to out_log(), which probably prints it. Afterwards, you pass $::cmd with the "cat asdf" value to out_log(). At that point the new $cmd does not exist any more.
If you had use strict in your program, the program would not work at all, because the default package variable behavior is turned off in that case, so you have to define variables.
In fact you should not operate with package variables at all, but instead pass arguments to your functions.
In addition to that, there are a few other things that are not good practice in your program. You should use 3-argument open and a lexical filehandle, and also check the return value of open.
Names of functions cannot start with numbers, so 1st and 2nd are not valid names. It's better to name things after what they do or represent. That makes it easier to read your program later.
A full program might look like that.
use strict;
use warnings;
my ($code, $reg, $annotation); # these values come from somewhere...
run_cmd( compose_cmd(), $code, $reg, $annotation );
sub compose_cmd {
return "cat asdf";
}
sub run_cmd {
my ( $cmd, $code, $reg, $annotation ) = #_;
if ( $code =~ /aa/ ) {
my $cmd = "$reg $annotation";
out_log($cmd);
}
else {
my $cmd = "$reg $annotation";
out_log($cmd);
}
out_log("$cmd");
open my $fh, '<', $cmd or die $!;
# do stuff with $fh ...
}
sub out_log {
print #_;
}

Show bash script output in live on perl - curses script

I'm a newb' on Perl, and try to do a simple script's launcher in Perl with Curses (Curses::UI)
On Stackoverflow I found a solution to print (in Perl) in real time the output of a Bash script.
But I can't do this with my Curses script, to write this output in a TextEditor field.
For example, the Perl script :
#!/usr/bin/perl -w
use strict;
use Curses::UI;
use Curses::Widgets;
use IO::Select;
my $cui = new Curses::UI( -color_support => 1 );
[...]
my $process_tracking = $container_middle_right->add(
"text", "TextEditor",
-readonly => 1,
-text => "",
);
sub launch_and_read()
{
my $s = IO::Select->new();
open my $fh, '-|', './test.sh';
$s->add($fh);
while (my #readers = $s->can_read()) {
for my $fh (#readers) {
if (eof $fh) {
$s->remove($fh);
next;
}
my $l = <$fh>;
$process_tracking->text( $l );
my $actual_text = $process_tracking->text() . "\n";
my $new_text = $actual_text . $l;
$process_tracking->text( $new_text );
$process_tracking->cursor_to_end();
}
}
}
[...]
$cui->mainloop();
This script contains a button to launch launch_and_read().
And the test.sh :
#!/bin/bash
for i in $( seq 1 5 )
do
sleep 1
echo "from $$ : $( date )"
done
The result is my application freeze while the bash script is executed, and the final output is wrote on my TextEditor field at the end.
Is there a solution to show in real time what's happened in the Shell script, without blocking the Perl script ?
Many thanks, and sorry if this question seems to be stupid :x
You can't block. Curses's loop needs to run to process events. So you must poll. select with a timeout of zero can be used to poll.
my $sel;
sub launch_child {
$sel = IO::Select->new();
open my $fh, '-|', './test.sh';
$sel->add($fh);
}
sub read_from_child {
if (my #readers = $sel->can_read(0)) {
for my $fh (#readers) {
my $rv = sysread($fh, my $buf, 64*1024);
if (!$rv) {
$sel->remove($fh);
close($fh);
next;
}
... add contents of $buf to the ui here ...
}
}
}
launch_child();
$cui->set_timer(read_from_child => \&read_from_child, 1);
$cui->mainloop();
Untested.
Note that I switched from readline (<>) to sysread since the former blocks until a newline is received. Using blocking calls like read or readline defies the point of using select. Furthermore, using buffering calls like read or readline can cause select to say nothing is waiting when there actually is. Never use read and readline with select.

debugging perl script - variable interpolation

Try to debug this script. I think it maybe an issue of variable interpolation? I'm not sure.
It works using options if I pass the values like so:
perl test-file-exists.pl --file /proj/Output/20111126/_GOOD
I am trying to remove the option of passing in --file since I need to generate the date
dynamically.
perl test-file-exists.pl
Given the code changes below (I commented out the options piece). I am trying to create the string (see $chkfil). I am getting errors passing in $dt4. Somehow, its not passing in the file string that I am creating into this other module.
use strict;
use warnings;
use lib '/home/test/lib';
use ProxyCmd;
use Getopt::Long;
#
### Set up for Getopt
#
#my $chkfil;
#my $help;
#usage() if ( #ARGV < 1 or
# ! GetOptions('help|?' => \$help,
# 'file=s' => \$chkfil)
# or defined $help );
my $cmd = ProxyCmd->new( User=>"test_acct",
AuthToken=>"YToken",
loginServer=>"host.com");
# Get previous day
my $dt4 = qx {date --date='-1day' +'%Y%m%d'};
# Check file
my $chkfil = qq{/proj/Output/$dt4/_GOOD};
# Now test the fileExists function
print "Checking 'fileExists':\n";
my $feResults = $cmd->fileExists("$chkfil");
if ($feResults == 0) {
print "File Exists!\n";
} else {
print "File Does Not Exist\n";
}
sub usage
{
print "Unknown option: #_\n" if ( #_ );
print "usage: program [--file /proj/Output/20111126/_GOOD] [--help|-?]\n";
exit;
}
When you use backticks or qx, you get the trailing newline included so chomp it off:
my $dt4 = qx {date --date='-1day' +'%Y%m%d'};
chomp $dt4;
and you'll get a sensible filename.
You could also use DateTime and friends to avoid shelling out entirely.

What is the equivalent of bash export in Perl?

I am converting a bash script to Perl. I am not sure what the equivalent of an export is.
LOC=/tmp/1/
export LOC
For example, for the above two lines, what would be the equivalent Perl code?
my $LOC = '/tmp/1/';
# what should go here?
$ENV{LOC} = "/tmp/1";
The contents of %ENV are propagated to the environment of the child processes of a Perl script.
Module Env (see http://perldoc.perl.org/Env.html)
Inside the bash, you might want to do something like this:
EXPORT_CMD=/tmp/${0}_exports.bsh
perl ...
chmod +x $EXPORT_CMD
$EXPORT_CMD
rm $EXPORT_CMD
Inside the Perl, this:
sub export (#) {
state $exh;
unless ( $exh ) {
my $export_cmd_path = $ENV{EXPORT_CMD};
open( $exh, '>>', $export_cmd_path )
or die "Could not open $export_cmd_path!"
;
}
while ( #_ > 1 ) {
my ( $name, $value ) = (( uc shift ), shift );
# If you want it visible in the current script:
{ no strict 'refs';
${"::$name"} = $value;
}
$exh->print( qq{export $name "$value"\n} );
}
}
And then, it's simply a matter of coding this:
export LOC => '/tmp/1/';
The problem is that most programs cannot change shell variables that they were called from.

Calling a function in Perl with different properties

I have written a Perl script that would start a SNMP session and extracting the data/counters and it's value to a csv file. There are 7 perl scripts; different properties/definition/variables on the top.. but the engine is the same.
At this point, those 7 perl scripts are redundant except for the defined variables. Is there a way to keep the execution perl script as a properties/execution file and keep the engine in a another file? This properties/execution perl script will call the engine (using the properties defined in it's own script).
So in short, I want to use the variables in their own script (as an execution as well), but calls a specific function from a unified "engine".
i.e.
retrieve_mibs1.pl retrieve_mibs2.pl
retrieve_mibs3.pl
retrieve_mibs4.pl
retrieve_mibs5.pl
retrieve_mibs6.pl
retrieve_mibs7.pl
retrieve_mibs1.pl
#!/usr/local/bin/perl
use Net::SNMP;
##DEFINITION START
my #Servers = (
'server1',
'server2',
);
my $PORT = 161;
my $COMMUNITY = 'secret';
my $BASEOID = '1.2.3.4.5.6.7.8';
my $COUNTERS = [
[11,'TotalIncomingFromPPH'],
[12,'TotalFailedIncomingFromPPH'],
];
##ENGINE START
sub main {
my $stamp = gmtime();
my #oids = ();
foreach my $counter (#$COUNTERS) {
push #oids,("$BASEOID.$$counter[0].0");
}
foreach my $server (#Servers) {
print "$stamp$SEPARATOR$server";
my ($session,$error) = Net::SNMP->session(-version => 1,-hostname => $server,-port => $PORT,-community => $COMMUNITY);
if ($session) {
my $result = $session->get_request(-varbindlist => \#oids);
if (defined $result) {
foreach my $oid (#oids) {
print $SEPARATOR,$result->{$oid};
}
} else {
print STDERR "$stamp Request error: ",$session->error,"\n";
print "$SEPARATOR-1" x scalar(#oids);
}
} else {
print STDERR "$stamp Session error: $error\n";
print "$SEPARATOR-1" x scalar(#oids);
}
print "\n";
}
}
main();
You could do it using eval: set up the variables in one file, then open the engine and eval it's content.
variables.pl (set up your variables and call the engine):
use warnings;
use strict;
use Carp;
use English '-no_match_vars';
require "engine.pl"; # so that we can call it's subs
# DEFINITION START
our $VAR1 = "Hello";
our $VAR2 = "World";
# CALL THE ENGINE
print "START ENGINE:\n";
engine(); # call engine
print "DONE\n";
engine.pl (the actual working stuff):
sub engine{
print "INSIDE ENGINE\n";
print "Var1: $VAR1\n";
print "Var2: $VAR2\n";
}
1; # return a true value
Other alternatives would be:
pass the definitions as command line parameters directly to engine.pl and evaluate the contents of #ARGV
write a perl module containing the engine and use this module
store the parameters in a config file and read it in from your engine (e.g. using Config::IniFiles)
Two thoughts come to mind immediately:
Build a Perl module for your common code, and then require or use the module as your needs dictate. (The difference is mostly whether you want to run LynxLee::run_servers() or run_servers() -- do you want the module to influence your current scope or not.)
Use symbolic links: create these symlinks: retrieve_mibs1.pl -> retrieve_mibs.pl retrieve_mibs2.pl -> retrieve_mibs.pl, and so on, then set the variables based on the program name:
#!/usr/bin/perl -w
use File::Basename;
my $name = basename($0);
my #Servers, $PORT, $COMMUNITY, $BASEOID, $COUNTERS;
if($name ~= /retrieve_mibs1\.pl/) {
#Servers = (
'server1',
'server2',
);
# ...
} elsif ($name ~= /retrieve_mibs2\.pl/) {
#Servers = (
'server3',
'server4',
);
# ...
}
Indexing into a hash with the name of the program to retrieve the parameters would be much cleaner, but I'm not so good at Perl references. :)
I'm not sure what the problem is so I'm guessing a little. You have code in various places that is the same each time save for some variables. This is the very definition of a subroutine.
Maybe the problem is that you don't know how to include the common code in those various scripts. This is fairly easy: You write that code in a perl module. This is basically a file ending in pm instead of pl. Of course you have to take care of a bunch of things such as exporting your functions. Perldoc should be of great help.