My Expectation:
I have to use the following command to send the value of first argument to all the files calling perl.pl file.
./perl.pl 1
The one is read using the following file: (perl.pl)
#!/usr/bin/perl
package Black;
use strict;
use warnings;
#subroutines
sub get_x();
#variables
our $XE = -1;
my ($param1, $param2, $param3) = #ARGV;
my $x = get_x();
sub get_x()
{
$XE = $param1;
return $XE;
}
exit;
Then I wrote another script which performs some code base on the input to perl.pl (0 or 1).
The file is ./per.pl and I invoke in from linux terminal like this: ./per.pl
Here is the code I wrote for it:
#!/usr/bin/perl
require "perl.pl";
my $xd = Black::get_x();
if ($xd ==1){
print $xd;}
else {
print "5";
}
exit;
But this is what I get when I write these commands:
./perl.pl 1
I tried to print it and it prints 1...removed the print like from the code in this case
./per.pl
And now I get nothing. I would like the 1 getting printed out but no it doesn't
Thanks in Advance
Before we get started, you cannot possibly get the output you say you get because you tell the process to exit when the module is executed by require, so Black::get_x() is never reached. Change exit; to 1;.
Now on to your question. If I understand correctly, you want to pass a value to one process via its command line, and fetch that value by executing the same script without the parameter.
You did not even attempt to pass the variable from one process to another, so it shouldn't be a surprise that it doesn't work. Since the two processes don't even exist at the same time, you'll need to store the value somewhere such as the file system.
#!/usr/bin/perl
use strict;
use warnings;
my $conf_file = "$ENV{HOME}/.black";
my $default = -1;
sub store {
my ($val) = #_;
open(my $fh, '>', $conf_file) or die $!;
print $fh "$val\n";
return $val;
}
sub retrieve {
open(my $fh, '<', $conf_file)
or do {
return $default if $!{ENOENT};
die $!;
};
my $val = <$fh>;
chomp($val);
return $val;
}
my $xd = #ARGV ? store($ARGV[0]) : retrieve();
print("$xd\n");
Related
the string to to be searched is:
the file_is being created_automaically {
period=20ns }
the perl script i am using is following ( this script is working fine for single line string but not working for multi line )
#!/usr/bin/perl
my $dir = "/home/vikas";
my #files = glob( $dir . '/*' );
#print "#files";
system ("rm -rf $dir/log.txt");
my $list;
foreach $list(#files){
if( !open(LOGFILE, "$list")){
open (File, ">>", "$dir/log.txt");
select (File);
print " $list \: unable to open file";
close (File);
else {
while (<LOGFILE>){
if($_ =~ /".*the.*automaically.*\{\n.*period\=20ns.*\}"/){
open (File, ">>", "$dir/log.txt");
select (File);
print " $list \: File contain the required string\n";
close (File);
break;
}
}
close (LOGFILE);
}
}
This code does not compile, it contains errors that causes it to fail to execute. You should never post code that you have not first tried to run.
The root of your problem is that for a multiline match, you cannot read the file in line-by-line mode, you have to slurp the whole file into a variable. However, your program contains many flaws. I will demonstrate. Here follows excerpts of your code (with fixed indentation and missing curly braces).
First off, always use:
use strict;
use warnings;
This will save you many headaches and long searches for hidden problems.
system ("rm -rf $dir/log.txt");
This is better done in Perl, where you can control for errors:
unlink "$dir/log.txt" or die "Cannot delete '$dir/log.txt': $!";
foreach my $list (#files) {
# ^^
Declare the loop variable in the loop itself, not before it.
if( !open(LOGFILE, "$list")){
open (File, ">>", "$dir/log.txt");
select (File);
print " $list \: unable to open file";
close (File);
You never have to explicitly select a file handle before you print to it. You just print to the file handle: print File "....". What you are doing is just changing the STDOUT file handle, which is not a good thing to do.
Also, this is error logging, which should go to STDERR instead. This can be done simply by opening STDERR to a file at the beginning of your program. Why do this? If you are not debugging a program at a terminal, for example via the web or some other process where STDERR does not show up on your screen. Otherwise it is just extra work while debugging.
open STDERR, ">", "$dir/log.txt" or die "Cannot open 'log.txt' for overwrite: $!";
This has the added benefit of you not having to delete the log first. And now you do this instead:
if (! open LOGFILE, $list ) {
warn "Unable to open file '$list': $!";
} else ....
warn goes to STDERR, so it is basically the same as print STDERR.
Speaking of open, you should use three argument open with explicit file handle. So it becomes:
if (! open my $fh, "<", $list )
} else {
while (<LOGFILE>) {
Since you are looking for a multiline match, you need to slurp the file(s) instead. This is done by setting the input record separator to undef. Typically like this:
my $file = do { local $/; <$fh> }; # $fh is our file handle, formerly LOGFILE
Next how to apply the regex:
if($_ =~ /".*the.*automaically.*\{\n.*period\=20ns.*\}"/) {
$_ =~ is optional. A regex automatically matches against $_ if no other variable is used.
You should probably not use " in the regex. Unless you have " in the target string. I don't know why you put it there, maybe you think strings need to be quoted inside a regex. If you do, that is wrong. To match the string you have above, you do:
if( /the.*automaically.*{.*period=20ns.*}/s ) {
You don't have to escape \ curly braces {} or equal sign =. You don't have to use quotes. The /s modifier makes . (wildcard character period) also match newline, so we can remove \n. We can remove .* from start or end of string, because that is implied, regex matches are always partial unless anchors are used.
break;
The break keyword is only used with the switch feature, which is experimental, plus you don't use it, or have it enabled. So it is just a bareword, which is wrong. If you want to exit a loop prematurely, you use last. Note that we don't have to use last because we slurp the file, so we have no loop.
Also, you generally should pick suitable variable names. If you have a list of files, the variable that contains the file name should not be called $list, I think. It is logical that it is called $file. And the input file handle should not be called LOGFILE, it should be called $input, or $infh (input file handle).
This is what I get if I apply the above to your program:
use strict;
use warnings;
my $dir = "/home/vikas";
my #files = glob( $dir . '/*' );
my $logfile = "$dir/log.txt";
open STDERR, ">", $logfile or die "Cannot open '$logfile' for overwrite: $!";
foreach my $file (#files) {
if(! open my $input, "<", $file) {
warn "Unable to open '$file': $!";
} else {
my $txt = do { local $/; <$fh> };
if($txt =~ /the.*automaically.*{.*period=20ns.*}/) {
print " $file : File contain the required string\n";
}
}
}
Note that the print goes to STDOUT, not to the error log. It is not common practice to have STDOUT and STDERR to the same file. If you want, you can simply redirect output in the shell, like this:
$ perl foo.pl > output.txt
The following sample code demonstrates usage of regex for multiline case with logger($fname,$msg) subroutine.
Code snippet assumes that input files are relatively small and can be read into a variable $data (an assumption is that computer has enough memory to read into).
NOTE: input data files should be distinguishable from rest files in home directory $ENV{HOME}, in this code sample these files assumed to match pattern test_*.dat, perhaps you do not intend to scan absolutely all files in your home directory (there could be many thousands of files but you interested in a few only)
#!/usr/bin/env perl
use strict;
use warnings;
use feature 'say';
my($dir,$re,$logfile);
$dir = '/home/vikas/';
$re = qr/the file_is being created_automaically \{\s+period=20ns\s+\}/;
$logfile = $dir . 'logfile.txt';
unlink $logfile if -e $logfile;
for ( glob($dir . "test_*.dat") ) {
if( open my $fh, '<', $_ ) {
my $data = do { local $/; <$fh> };
close $fh;
logger($logfile, "INFO: $_ contains the required string")
if $data =~ /$re/gsm;
} else {
logger($logfile, "WARN: unable to open $_");
}
}
exit 0;
sub logger {
my $fname = shift;
my $text = shift;
open my $fh, '>>', $fname
or die "Couldn't to open $fname";
say $fh $text;
close $fh;
}
Reference: regex modifies, unlink, perlvar
In Perl 5, I can create a filehandle to a string and read or write from the string as if it were a file. This is great for working with tests or templates.
For example:
use v5.10; use strict; use warnings;
my $text = "A\nB\nC\n";
open(my $fh, '<', \$text);
while(my $line = readline($fh)){
print $line;
}
How can I do that in Perl 6? The following doesn't work for Perl 6 (at least not for my instance of Perl6 running on MoarVM 2015.01 from the January 2015 release of Rakudo Star on 64-bit CentOS 6.5):
# Warning: This code does not work
use v6;
my $text = "A\nB\nC\n";
my $fh = $text;
while (my $line = $fh.get ) {
$line.say;
}
# Warning: Example of nonfunctional code
I get the error message:
No such method 'get' for invocant of type 'Str'
in block <unit> at string_fh.p6:8
It's not very surprising that Perl5's open(my $fh, '<', \$text) is not the same as Perl6's my $fh = $text;. So the question is: How does one create a virtual file handle from a string in Perl 6 like open(my $fh, '<', \$str) in Perl 5? Or is that something that has yet to be implemented?
UPDATE (writing to a filehandle in Perl 5)
Likewise, you can write to string filehandles in Perl 5:
use v5.10; use strict; use warnings;
my $text = "";
open(my $fh, '>', \$text);
print $fh "A";
print $fh "B";
print $fh "C";
print "My string is '$text'\n";
Outputs:
My string is 'ABC'
I haven't seen anything remotely similar in Perl 6, yet.
Reading
The idiomatic way to read line-by-line is the .lines method, which is available on both Str and IO::Handle.
It returns a lazy list which you can pass on to for, as in
my $text = "A\nB\nC\n";
for $text.lines -> $line {
# do something with $line
}
Writing
my $scalar;
my $fh = IO::Handle.new but
role {
method print (*#stuff) { $scalar ~= #stuff };
method print-nl { $scalar ~= "\n" }
};
$fh.say("OH HAI");
$fh.say("bai bai");
say $scalar
# OH HAI
# bai bai
(Adapted from #perl6, thanks to Carl Mäsak.)
More advanced cases
If you need a more sophisticated mechanism to fake file handles, there's IO::Capture::Simple and IO::String in the ecosystem.
For example:
use IO::Capture::Simple;
my $result;
capture_stdout_on($result);
say "Howdy there!";
say "Hai!";
capture_stdout_off();
say "Captured string:\n" ~$result;
I'm running a perl script consisting of 30 threads to run a subroutine. For each thread, I'm supplying 100 data. In the subroutine, after the code does what its supposed to, I'm storing the output in a csv file. However, I find that on execution, the csv file has some data overlapped. For example, in the csv file, I'm storing name, age, gender, country this way-
print OUTPUT $name.",".$age.",".$gender.",".$country.",4\n";
The csv file should have outputs as such-
Randy,35,M,USA,4
Tina,76,F,UK,4
etc.
However, in the csv file, I see that some columns has overlapped or has been entered haphazardly in this way-
Randy,35,M,USA,4
TinaMike,76,UK
23,F,4
Is it because some threads are executing at the same time? What could I do to avoid this? I'm using the print statement only after I'm getting the data. Any suggestions?
4 is the group id which will remain constant.
Below is the code snippet:
#!/usr/bin/perl
use DBI;
use strict;
use warnings;
use threads;
use threads::shared;
my $host = "1.1.1.1";
my $database = "somedb";
my $user = "someuser";
my $pw = "somepwd";
my #threads;
open(PUT,">/tmp/file1.csv") || die "can not open file";
open(OUTPUT,">/tmp/file2.csv") || die "can not open file";
my $dbh = DBI->connect("DBI:mysql:$database;host=$host", $user, $pw ,) || die "Could not connect to database: $DBI::errstr";
$dbh->{'mysql_auto_reconnect'} = 1;
my $sql = qq{
//some sql to get a primary keys
};
my $sth = $dbh->prepare($sql);
$sth->execute();
while(my #request = $sth->fetchrow_array())
{
#get other columns and print to file1.csv
print PUT $net.",".$sub.",4\n";
$i++; #this has been declared before
}
for ( my $count = 1; $count <= 30; $count++) {
my $t = threads->new(\&sub1, $count);
push(#threads,$t);
}
foreach (#threads) {
my $num = $_->join;
print "done with $num\n";
}
sub sub1 {
my $num = shift;
//calculated start_num and end_num based on an internal logic
for(my $x=$start_num; $x<=$end_num; $x++){
print OUTPUT $name.",".$age.",".$gender.",".$country.",4\n";
$j++; #this has been declared before
}
sleep(1);
return $num;
}
I have problem in the file2 which has the OUTPUT handler
You are multithreading and printing to a file from multiple threads. This will always end badly - print is not an 'atomic' operation, so different prints can interrupt each other.
What you need to do is serialize your output such that this cannot happen. The simplest way is to use a lock or a semaphore:
my $print_lock : shared;
{
lock $print_lock;
print OUTPUT $stuff,"\n";
}
when the 'lock' drifts out of scope, it'll be released.
Alternatively, have a separate thread that 'does' file IO, and use Thread::Queue to feed lines to it. Depends somewhat on whether you need any ordering/processing of the contents of 'OUTPUT'.
Something like:
use Thread::Queue;
my $output_q = Thread::Queue -> new();
sub output_thread {
open ( my $output_fh, ">", "output_filename.csv" ) or die $!;
while ( my $output_line = $output_q -> dequeue() ) {
print {$output_fh} $output_line,"\n";
}
close ( $output_fh );
sub doing_stuff_thread {
$output_q -> enqueue ( "something to output" ); #\n added by sub!
}
my $output_thread = threads -> create ( \&output_thread );
my $doing_stuff_thread = threads -> create ( \&doing_stuff_thread );
#wait for doing_stuff to finish - closing the queue will cause output_thread to flush/exit.
$doing_stuff_thread -> join();
$output_q -> end;
$output_thread -> join();
Open the File handle globally, then try using flock on the file handle as demonstrated:
sub log_write {
my $line = shift;
flock(OUTPUT, LOCK_EX) or die "can't lock: $!";
seek(OUTPUT, 0, SEEK_END) or die "can't fast forward: $!";
print OUTPUT $line;
flock(OUTPUT, LOCK_UN) or die "can't unlock: $!";
}
Other example:
perlfaq5 - I still don't get locking. I just want to increment the number in the file. How can I do this?
I have a Perl script with contains
open (FILE, '<', "$ARGV[0]") || die "Unable to open $ARGV[0]\n";
while (defined (my $line = <FILE>)) {
# do stuff
}
close FILE;
and I would like to run this script on all .pp files in a directory, so I have written a wrapper script in Bash
#!/bin/bash
for f in /etc/puppet/nodes/*.pp; do
/etc/puppet/nodes/brackets.pl $f
done
Question
Is it possible to avoid the wrapper script and have the Perl script do it instead?
Yes.
The for f in ...; translates to the Perl
for my $f (...) { ... } (in the case of lists) or
while (my $f = ...) { ... } (in the case of iterators).
The glob expression that you use (/etc/puppet/nodes/*.pp) can be evaluated inside Perl via the glob function: glob '/etc/puppet/nodes/*.pp'.
Together with some style improvements:
use strict; use warnings;
use autodie; # automatic error handling
while (defined(my $file = glob '/etc/puppet/nodes/*.pp')) {
open my $fh, "<", $file; # lexical file handles, automatic error handling
while (defined( my $line = <$fh> )) {
do stuff;
}
close $fh;
}
Then:
$ /etc/puppet/nodes/brackets.pl
This isn’t quite what you asked, but another possibility is to use <>:
while (<>) {
my $line = $_;
# do stuff
}
Then you would put the filenames on the command line, like this:
/etc/puppet/nodes/brackets.pl /etc/puppet/nodes/*.pp
Perl opens and closes each file for you. (Inside the loop, the current filename and line number are $ARGV and $. respectively.)
Jason Orendorff has the right answer:
From Perlop (I/O Operators)
The null filehandle <> is special: it can be used to emulate the behavior of sed and awk, and any other Unix filter program that takes a list of filenames, doing the same to each line of input from all of them. Input from <> comes either from standard input, or from each file listed on the command line.
This doesn't require opendir. It doesn't require using globs or hard coding stuff in your program. This is the natural way to read in all files that are found on the command line, or piped from STDIN into the program.
With this, you could do:
$ myprog.pl /etc/puppet/nodes/*.pp
or
$ myprog.pl /etc/puppet/nodes/*.pp.backup
or even:
$ cat /etc/puppet/nodes/*.pp | myprog.pl
take a look at this documentation it explains all you need to know
#!/usr/bin/perl
use strict;
use warnings;
my $dir = '/tmp';
opendir(DIR, $dir) or die $!;
while (my $file = readdir(DIR)) {
# We only want files
next unless (-f "$dir/$file");
# Use a regular expression to find files ending in .pp
next unless ($file =~ m/\.pp$/);
open (FILE, '<', $file) || die "Unable to open $file\n";
while (defined (my $line = <FILE>)) {
# do stuff
}
}
closedir(DIR);
exit 0;
I would suggest to put all filenames to array and then use this array as parameters list to your perl method or script. Please see following code:
use Data::Dumper
$dirname = "/etc/puppet/nodes";
opendir ( DIR, $dirname ) || die "Error in opening dir $dirname\n";
my #files = grep {/.*\.pp/} readdir(DIR);
print Dumper(#files);
closedir(DIR);
Now you can pass \#files as parameter to any perl method.
my #x = <*>;
foreach ( #x ) {
chomp;
if ( -f "$_" ) {
print "process $_\n";
# do stuff
next;
};
};
Perl can shell out to execute system commands in various ways, the most straightforward is using backticks ``
use strict;
use warnings FATAL => 'all';
my #ls = `ls /etc/puppet/nodes/*.pp`;
for my $f ( #ls ) {
open (my $FILE, '<', $f) || die "Unable to open $f\n";
while (defined (my $line = <$FILE>)) {
# do stuff
}
close $FILE;
}
(Note: you should always use strict; and use warnings;)
i have a script, that parse log and find errors and warnings.
And i want to use user-friendly interpretation of this log.
For this reason, i use notepad.
Here is code:
use v5.16;
use strict;
use warnings;
use Win32::Clipboard;
use threads;
use utf8;
my $kp = Win32::Clipboard->new();
my $output = shift || "out_log.txt";
#my ($input, $output)=#ARGV;
#open my $ih, "<", $input or die "can't open input file with log\n";
open my $oh, ">", $output or die "can't open output file with log\n";
my #alls=split /\n/,$kp->Get();
for my $k(0..$#alls){
$_ = $alls[$k];
if(/^ERR.+|^WARN.+/){
print {$oh} qq(at position $k --> ).$_."\n";
}
}
my $thread =
threads->create(sub{
$SIG{INT}=sub{die"All good\n";};
qx(notepad $output);
}
);
print qq(type 'y' for quit);
do{
print "want to quit?\n>" ;
chomp;
do{
say "I will kill this thread";
$thread->kill('INT') if defined($thread);
say "and delete output";
unlink $output;
exit(0);
}if (m/y/);
}while(<>);
It falls down, when i trying to kill thread which run notepad.
How to do this, using signals and threads? Is it possible?
And your ideas about solution, please.
Thanks!
This isn't working because your SIGINT never gets passed to notepad. So it never gets closed. (And that handler - probably never gets processed).
You need to approach this differently. Look at Win32::Process for some examples of how to spawn/kill a notepad process.
my $ProcessObj;
Win32::Process::Create( $ProcessObj,
"C:\\Windows\\system32\\notepad.exe",
"notepad", 0, NORMAL_PRIORITY_CLASS, "." )
or die $!;
And then you can use
$ProcessObj -> Kill(1);
I'd suggest using Thread::Semaphore or some sort of shared variable to decide if you want to kill your notepad.