Is there any way i can call a make utility through perl script.
I used the below code in myscript
$cmd=system("/...path../make");
print "$cmd";
but its not working
You can call any command you wish. It is typically done in backquotes for simplicity:
my $output = `make`;
print( $output );
Another common technique is to open a process for reading just like a file:
my $filehandle;
if ( ! open( $filehandle, "make |" ) ) {
die( "Failed to start process: $!" );
}
while ( defined( my $line = <$filehandle> ) ) {
print( $line );
}
close( $line );
The advantage of this is you can see the output as it is delivered from the process.
You may wish to capture STDERR output as well as STDOUT output by adding 2>&1 to the command line:
my $filehandle;
if ( ! open( $filehandle, "make 2>&1 |" ) ) {
die( "Failed to start process: $!" );
}
while ( defined( my $line = <$filehandle> ) ) {
print( $line );
}
close( $line );
You just need to use backquotes.
my $command = `make`;
print $command;
The return value of system is the exit status.
See here
EDIT: Link to system
Related
How to run more than 1 command inside open?
I have a code below. Here, I am running make $i inside open, but now I want to run more than 1 command here, say make $i; sleep 30; echo abc. How can I do that?
foreach $i (#testCases) {
my $filehandle;
if ( ! (my $pid = open( $filehandle, "make $i 2>&1 |" ) )) {
die( "Failed to start process: $!" );
}
else {
print "Test started\n";
}
}
Just to add the following is not working properly:
if (!($pid = open( my $pipe, "make $i; sleep 30; echo abc |" ))) " {
print "Problem in openeing a filehandle\n";
} else {
print "$pid is pid\n";
my $detailedPs=`tasklist | grep "$pid"`;
chomp ($detailedPs);
print "$detailedPs is detailedPs\n";
}
Here, I am getting $detailedPs as empty. If things would have run correctly, I would have got something in $detailedPs
open( my $pipe, "make $i; sleep 30; echo abc |" )
or die( "Can't launch shell: $!\n" );
my $stdout = join "", <$pipe>; # Or whatever.
close( $pipe )
or die( "A problem occurred running the command.\n" );
Preferred:
open( my $pipe, "-|", "make $i; sleep 30; echo abc" )
Short for: (non-Windows)
open( my $pipe, "-|", "/bin/sh", "-c", "make $i; sleep 30; echo abc" )
But note that you have a code injection bug. Fixed:
open( my $pipe, "-|", "/bin/sh", "-c", 'make "$1"; sleep 30; echo abc', "dummy", $i )
With IPC::Run:
use IPC::Run qw( run );
run(
[ "/bin/sh", "-c", 'make "$1"; sleep 30; echo abc', "dummy", $i ],
'>', \my $stdout # Or whatever.
)
or die( "A problem occurred running the command.\n" );
But you'd be better off avoiding a shell.
use IPC::Run qw( run );
run(
[ 'make', $i ],
'|', [ 'sleep', '30' ],
'|', [ 'echo', 'abc' ],
'>', \my $stdout
)
or die( "A problem occurred running the command.\n" );
I have a Perl script that is executed from Nagios XI.
It has two subroutines: SendEmail and SendTraps.
The script works fine when executed manually by passing the required parameters, but it doesn't work when triggered from Nagios. The script gets executed but the subroutines are skipped.
echo is working, but the two subroutines are not working even if the condition is met.
if ( ( $hoststatetype =~ m/HARD/ ) && ( $hoststate =~ m/DOWN/ ) ) {
`echo "HOST::$prihost $hostoutput">>/tmp/failover_log.txt`;
sendMail();
send_trap();
}
Full script here:
use strict;
use warnings;
use Text::CSV;
# Declared all the variables here
# Parsing input arguments
if ( $#ARGV > -1 ) {
if ( $ARGV[0] eq "-nagiosxi_trigger" ) {
$prihost = $ARGV[1];
$hoststate = $ARGV[2];
$hoststatetype = $ARGV[3];
$hostoutput = $ARGV[4];
}
elsif ( $ARGV[0] eq "-manual_trigger" ) {
$comment = $ARGV[1];
$userid = $ARGV[2];
$flag = "Failover-Trigger_Manual";
print "Maunal Failover triggered with comment: $comment by $userid\n";
$error_desc = "Maunal Failover triggered with comment: $comment by $userid";
send_trap();
sendMail();
exit 0;
}
else {
print STDERR "Invalid parameter $ARGV[0] \n";
exit 1;
}
}
else {
print STDERR "ERROR:No Arguments Passed.\n";
exit 1
}
# Check if Host or Service is in Hard/down state
if ( ( $hoststatetype =~ m/HARD/ ) && ( $hoststate =~ m/DOWN/ ) ) {
`echo "HOST::$prihost $hostoutput">>/tmp/failover_log.txt`;
sendMail();
send_trap();
}
elsif ( ( $hoststatetype =~ m/SOFT/ ) && ( $hoststate =~ m/DOWN/ ) ) {
`echo "HOST::$prihost $hostoutput">>/tmp/failover_log.txt`;
}
else {
`echo "HOST Good, $prihost $hostoutput">>/tmp/failover_log.txt`;
}
# Sub-Routines
sub failover {
my $csv = Text::CSV->new({ sep_char => ',' }) or die "Cannot use CSV: ".Text::CSV->error_diag ();;
my $file = "myxilist";
my $primary;
my $secondary;
#my $xienv;
my $host = `hostname`;
chomp $host;
open( my $data, '<', $file ) or die "Could not open '$file' $!\n";
while ( my $xi = <$data> ) {
chomp $xi;
if ( $csv->parse($xi) ) {
my #fields = $csv->fields();
if ( $fields[0] =~ m/$host/ ) {
$primary = $fields[1];
$secondary = $fields[0];
$xienv = $fields[2];
}
elsif ( $fields[1] =~ m/$host/ ) {
$primary = $fields[0];
$secondary = $fields[1];
$xienv = $fields[2];
}
}
else {
warn "Line could not be parsed: $xi\n";
exit 1;
}
}
my $failovermsg="failover successful from $primary to $secondary server";
return $failovermsg;
}
sub sendMail {
# Build the list for mailing out results
my $mailSubject;
my $mailID = "test\#mail.com";
my #results = failover();
$mailSubject = "Failover Successful on $xienv instance";
print "Sending email to $mailID \n";
`echo "sending Email">>/tmp/failover_log.txt`;
open MAILX, "|/usr/bin/mailx -s \"$mailSubject\" $mailID " or die $!;
print MAILX "#results";
close MAILX;
return;
}
sub send_trap {
# Sending SNMP traps
my #results = failover();
my $trap = `/usr/bin/snmptrap -v 2c -c public tcp:server:1010 '' MIB::Event Hostname s "$xienv" nSvcDesc s "$flag" nSvcStateID i 2 nSvcOutput s "#results"`;
return;
}
Any thoughts what could be missing?
Issue was in the failover() SubRoutine. I was calling a file "myxilist" that was present in the same directory as the script.
So, the script was working fine when called manually, but when it is triggered from application, script is getting executed from some other directory and the failover sub exits, as it's not able to open the file.
I've provided the full path of the file and the script works fine.
Thank you all for your help.
My goal is to find and print all the lines in a "big.v" file starting from pattern match "module" until "endmodule" into individual files.
big.v: module test;
<bunch of code>
endmodule
module foo;
<bunch of code>
endmodule
And the individual files would look like:
test.v : module test;
..
endmodule
foo.v: module test1;
..
endmodule
I got most of it working using:
use strict;
use warnings;
#open(my $fh, ">", $f1) || die "Couldn't open '".$f."' for writing because: ".$!;
while (<>) {
my $line = $_;
if ($line =~ /(module)(\s+)(\w+)(.*)/) {
my $modname = $3;
open(my $fh1, ">", $modname.".v") ;
print $fh1 $line."\n";
## how do i keep writing next lines to this file until following pattern
if ($line =~ /(endmodule)(\s+)(.*)/) { close $fh1;}
}
}
Thanks,
There's a useful perl construct called the 'range operator':
http://perldoc.perl.org/perlop.html#Range-Operators
It works like this:
while ( <$file> ) {
if ( m/startpattern/ .. m/endpattern/ ) {
print;
}
}
So given your example - I think this should do the trick:
my $output;
while ( my $line = <STDIN> ) {
if ( $line =~ m/module/ .. m/endmodule/ ) {
my ( $modname ) = ( $line =~ m/module\s+(\w+)/ );
if ( defined $modname) {
open ( $output, ">", "$modname.v" ) or warn $!;
}
print {$output} $line;
}
}
Edit: But given your source data - you don't actually need to use a range operator I don't think. You could just close/reopen new 'output' files as you go. This assumes that you could 'cut up' your file based on 'module' lines, which isn't necessarily a valid assumption.
But sort of more like this:
use strict;
use warnings;
open ( my $input, "<", "big.v" ) or die $!;
my $output;
while ( my $line = <$input> ) {
if ( $line =~ m/^\s*module/ ) {
#start of module line found
#close filehandle if it's open
close($output) if defined $output;
#extract the module name from the line.
my ($modulename) = ( $line =~ m/module\s+(\w+)/ );
#open new output file (overwriting)
open( $output, ">", "$modulename.v" ) or warn $!;
}
#this test might not be necessary.
if ( defined $output ) {
print {$output} $line;
}
}
I have a script that starts of with asking the user for a filename.
I want to add a feature so that i can supply a filename in the commandline even before running the program.
To the point:
If i started my program with "perl wordcounter.pl text.txt",
How could i access the string after the name of the program (ie text.txt), from within the code?
I started doing something like:
$filename = "Filename supplied in the commandline";
if ($filename == 0) {
print "Word frequancy counter.\nEnter the name of the file that you wish to analyze.\n";
chomp ($filename = <STDIN>);
}
Basically if no textfile was supplied at the commandline, $filename would still 0 and then it would proceed to ask for a file.
Anyone know how i can access the "Filename supplied in the commandline" in the code?
try using array #ARGV
$x1 = $ARGV[0] || 'NONE';
although #ARGV is a promising option but i would rather use getopts
here is the sample code that can be used according to your need
try this perl sample.pl -file text.txt and again without file argument perl sample.pl
#!/usr/bin/perl
use Getopt::Long;
# setup my defaults
GetOptions(
'file=s' => \$file,
'help!' => \$help,
) or die "Incorrect usage!\n";
if( $help ) {
print "Common on, it's really not that hard.\n";
} else {
print "reading the $name.\n";
if ( -e $file ){
open( DATA ,'<',$file ) or die "unable to open \$file = $file\n";
while (<DATA>){
print "$_\n";
}
} else {
chomp ($file = <STDIN>);
open( DATA ,'<',$file ) or die "unable to open \$file = $file\n";
while (<DATA>){
print "$_\n";
}
}
}
~
I have this below code:
$cmd = system ("p4 change -o 3456789");
I want to print the output -description of the change list - into a file.
$cmd = system ("p4 change -o 3456789 > output_cl.txt");
will write the output in to output_cl.txt file.
But, is there anyway to get the output through $cmd?
open(OUTPUT, ">$output_cl.txt") || die "Wrong Filename";
print OUTPUT ("$cmd");
will write 0 or 1 to the file. How to get the output from $cmd?
To store the output of your p4 command into an array, use qx:
my #lines = qx(p4 change -o 3456789);
In addition to grabbing the entire output of a command with qx// or backticks, you can get a handle on a command's output. For example
open my $p4, "-|", "p4 change -o 3456789"
or die "$0: open p4: $!";
Now you can read $p4 a line at a time and possibly manipulate it as in
while (<$p4>) {
print OUTPUT lc($_); # no shouting please!
}
If you find it confusing remembering what you need to run in order to get a command's return value, vs. its output, or how to handle different return codes, or forget to right-shift the resulting code, you need IPC::System::Simple, which makes all this, well, simple:
use IPC::System::Simple qw(system systemx capture capturex);
my $change_num = 3456789;
my $output = capture(qw(p4 change -o), $change_num);
You can always use the following process to dump output straight to a file.
1) dup the system STDOUT file descriptor, 2) open STDOUT, 3) system, 4) copy the IO slot back into STDOUT:
open( my $save_stdout, '>&1' ); # dup the file
open( STDOUT, '>', '/path/to/output/glop' ); # open STDOUT
system( qw<cmd.exe /C dir> ); # system (on windows)
*::STDOUT = $save_stdout; # overwrite STDOUT{IO}
print "Back to STDOUT!"; # this should show up in output
But qx// is probably what you're looking for.
reference: perlopentut
Of course this could be generalized:
sub command_to_file {
my $arg = shift;
my ( $command, $rdir, $file ) = $arg =~ /(.*?)\s*(>{1,2})\s*([^>]+)$/;
unless ( $command ) {
$command = $arg;
$arg = shift;
( $rdir, $file ) = $arg =~ /\s*(>{1,2})\s*([^>]*)$/;
if ( !$rdir ) {
( $rdir, $file ) = ( '>', $arg );
}
elsif ( !$file ) {
$file = shift;
}
}
open( my $save_stdout, '>&1' );
open( STDOUT, $rdir, $file );
print $command, "\n\n";
system( split /\s+/, $command );
*::STDOUT = $save_stdout;
return;
}