I Didn't quite understand the fork function.
How could i print output from the files simultaneously, use separate process for each file?
my $regex = $ARGV[0];
for (#ARGV[1 .. $#ARGV]){
open (my $fh, "<", $_);
foreach (<$fh>){
print "$1\n" if $_ =~ /(\b$regex\b)/;
}
}
Presumably, you also want to limit the number of simultaneous processes. Parallel::ForkManager makes this easy.
use Parallel::ForkManager qw( );
my $pm = Parallel::ForkManager->new($MAX_PROCESSES);
my $filter = shift(#ARGV);
$filter = qr/$filter/;
for my $qfn (#ARGV) {
$pm->start() and next;
open(my $fh, '<', $qfn)
or die("Can't open \"$qfn\": $!\n");
while (<$fh>) {
print "$1\n" if /(\b$regex\b)/;
}
}
$pm->finish();
If you didn't want to limit the number of simultaneous processes, it would look really similar.
my $filter = shift(#ARGV);
$filter = qr/$filter/;
for my $qfn (#ARGV) {
fork() and next;
open(my $fh, '<', $qfn)
or die("Can't open \"$qfn\": $!\n");
while (<$fh>) {
print "$1\n" if /(\b$regex\b)/;
}
}
1 while wait() > 0;
Related
This script is looping only once. I want to make it an infinite loop.
open( FILE, "<$ARGV[0]" );
if ( $LOOP == 1) {
while ( <FILE> ) {
if ( $. == $LOOP ) {
next
};
}
}
while ( <FILE> ) {
$LIST = $_;
print "$LIST";
}
I want make it looping back to the first line, like this
abc
abcd
abcde
abc
abcd
abcde
...
Just wrap what you want to loop with while (1) { ... }.
Cleaned up, you get:
my $qfn = $ARGV[0];
while (1) {
open(my $fh, '<', $qfn)
or die("Can't open \"$qfn\": $!\n");
while (<$fh>) {
print;
}
}
A very minor optimization is to avoid re-opening the file, seeking instead.
use Fcntl qw( SEEK_SET );
my $qfn = $ARGV[0];
open(my $fh, '<', $qfn)
or die("Can't open \"$qfn\": $!\n");
while (1) {
while (<$fh>) {
print;
}
seek($fh, 0, SEEK_SET);
}
Use seek to go reset the position in the filehandle. eof is true if the filehandle is on the last line.
open FILE,'<',$ARGV[0];
while (my $line = <FILE>) {
print $line;
if (eof) {
seek FILE,0,0;
}
}
You can try something like this...
my ( $filename ) = #ARGV;
while ( 1 )
{
open my $fh, '<', $filename or die $!;
my #lines = <$fh>;
close $fh;
print #lines;
}
It should open the file, read it in, close it, print contents and then repeat.
how can i remove the first line from my list of file , this is my code,
open my directory:
use strict;
use warnings;
use utf8;
use Encode;
use Encode::Guess;
use Devel::Peek;
my $new_directory = '/home/lenovo/corpus';
my $directory = '/home/lenovo/corpus';
open( my $FhResultat, '>:encoding(UTF-8)', $FichierResulat );
my $dir = '/home/corpus';
opendir (DIR, $directory) or die $!;
my #tab;
while (my $file = readdir(DIR)) {
next if ($file eq "." or $file eq ".." );
#print "$file\n";
my $filename_read = decode('utf8', $file);
#print $FichierResulat "$file\n";
push #tab, "$filename_read";
}
closedir(DIR);
open my file:
foreach my $val(#tab){
utf8::encode($val);
my $filename = $val;
open(my $in, '<:utf8', $filename) or die "Unable to open '$filename' for read: $!";
rename file
my $newfile = "$filename.new";
open(my $out, '>:utf8', $newfile) or die "Unable to open '$newfile' for write: $!";
remove the first line
my #ins = <$in>; # read the contents into an array
chomp #ins;
shift #ins; # remove the first element from the array
print $out #ins;
close($in);
close $out;
the probem my new file is empty !
rename $newfile,$filename or die "unable to rename '$newfile' to '$filename': $!";
}
It seems true but the result is an empty file.
The accepted pattern for doing this kind of thing is as follows:
use strict;
use warnings;
my $old_file = '/path/to/old/file.txt';
my $new_file = '/path/to/new/file.txt';
open(my $old, '<', $old_file) or die $!;
open(my $new, '>', $new_file) or die $!;
while (<$old>) {
next if $. == 1;
print $new $_;
}
close($old) or die $!;
close($new) or die $!;
rename($old_file, "$old_file.bak") or die $!;
rename($new_file, $old_file) or die $!;
In your case, we're using $. (the input line number variable) to skip over the first line.
How can I remove the matched pattern that I print in output file from the original file. I used below script to print out all matched into the FILE6
open FILE4,'<RM' or die $!;
open FILE5,'<OR' or die $!;
open FILE6, '>Compare3.txt' or die $!;
my #array3 = <FILE4>;
my #array4 = <FILE5>;
foreach $x (#array3) {
if($x =~ /(\S+) (\d+) (\S+)/) {
$temp_allreg = $3;
foreach $y (#array4) {
if($y =~ /\b$temp_allreg\b/i) {
print FILE6 "$x$y\n";
}
}
}
}
Based on above coding, I print out the matched data from 2 file to the output file which is FILE6. So how to modify this code to remove matched pattern that print out in FILE 6 from original file which is FILE4 and FILE5. So that FILE4 and FILE5 only leave the pattern/data that are not matched.
use strict;
use warnings;
my $rm_qfn = 'RM';
my $or_qfn = 'OR';
my $out_qfn = 'Compare3.txt';
open(my $rm_fh, '<', $rm_qfn)
or die("Can't open \"$rm_qfn\": $!\n");
open(my $or_fh, '<', $or_qfn)
or die("Can't open \"$or_qfn\": $!\n");
open(my $out_fh, '>', $out_qfn)
or die("Can't create \"$out_qfn\": $!\n");
open(my $out_rm_fh, '>', "$rm_qfn.tmp")
or die("Can't create \"$rm_qfn.tmp\": $!\n");
open(my $out_or_fh, '>', "$or_qfn.tmp")
or die("Can't create \"$or_qfn.tmp\": $!\n");
chomp( my #ors = <$or_fh> );
my #matched_ors;
while (my $rm = <$rm_fh>) {
chomp($rm);
my $matched_rm = 0;
if (my ($all_reg) = $rm =~ /\S+ \d+ (\S+)/) {
for my $or_idx (0..$#ors) {
my $or = $ors[$or_idx];
if ($or =~ /\b\Q$all_reg\E\b/i) {
++$matched_rm;
++$matched_ors[$or_idx];
print($out_fh "$rm$or\n");
}
}
}
if (!$matched_rm) {
print($out_rm_fh "$rm\n");
}
}
close($rm_fh);
close($or_fh);
for my $or_idx (0..$#ors) {
if (!$matched_ors[$or_idx]) {
my $or = $ors[$or_idx];
print($out_or_fh "$or\n");
}
}
close($out_rm_fh);
close($out_or_fh);
rename("$rm_qfn.tmp", $rm_qfn)
or die("Can't rename \"$rm_qfn.tmp\" to \"$rm_qfn\": $!\n");
rename("$or_qfn.tmp", $or_qfn)
or die("Can't rename \"$or_qfn.tmp\" to \"$or_qfn\": $!\n");
Do it in the same loop?
use File::Slurp qw(read_file write_file);
my $data = read_file $filename, {binmode => ':utf8'};
foreach $x (#array3) {
if($x =~ /(\S+) (\d+) (\S+)/) {
$temp_allreg = $3;
foreach $y (#array4) {
if($y =~ /\b$temp_allreg\b/i){
#print to output file
print FILE6 "$x$y\n";
#remove from input file
$data =~ s/$x$y//g;
write_file $filename, {binmode => ':utf8'}, $data;
}
}
}
}
Since you can't use File::Slurp module, you can consider writing those subroutines yourself.
sub read_file {
my ($filename) = #_;
open my $in, '<:encoding(UTF-8)', $filename or die "Could not open '$filename' for reading $!";
local $/ = undef;
my $all = <$in>;
close $in;
return $all;
}
sub write_file {
my ($filename, $content) = #_;
open my $out, '>:encoding(UTF-8)', $filename or die "Could not open '$filename' for writing $!";;
print $out $content;
close $out;
return;
}
See: How to replace a string in a file [perlmaven]
This is what I have so far, but the code is only showing contents of column 1. I'm not sure how to compute columns. I am really new to programming, so this may be an easy question.
my $filename = "Q5.txt";
open(my $fh, "<", $filename) or die "Could not open '$filename'\n";
while (my $line = <$fh>) {
$count++;
#line = $line;
for (#line) {
...
}
}
print $line[0];
Something like this should suit you
use strict;
use warnings;
use autodie;
my $filename = 'Q5.txt';
my ($n, #totals);
open my $fh, '<', $filename;
while (<$fh>) {
my #fields = split;
$totals[$_] += $fields[$_] for 0 .. $#fields;
++$n;
}
$_ /= $n for #totals;
print "#totals\n";
I have a file that looks like
NAME|JOHN|TOKYO|JPN
AGE|32|M
INFO|SINGLE|PROFESSIONAL|IT
NAME|MARK|MANILA|PH
AGE|37|M
INFO|MARRIED|PROFESSIONAL|BPO
NAME|SAMANTHA|SYDNEY|AUS
AGE|37|F
INFO|MARRIED|PROFESSIONAL|OFFSHORE
NAME|LUKE|TOKYO|JPN
AGE|27|M
INFO|SINGLE|PROFESSIONAL|IT
I want to separate the records by country. I have stored each line into array variable #fields
my #fields = split(/\|/, $_ );
making $fields[3] as my basis for sorting it. I wanted it to separate into 2 output text files
OUTPUT TEXT FILE 1:
NAME|JOHN|TOKYO|JPN
AGE|32|M
INFO|SINGLE|PROFESSIONAL|IT
NAME|LUKE|TOKYO|JPN
AGE|27|M
INFO|SINGLE|PROFESSIONAL|IT
OUTPUT TEXT FILE 2
NAME|MARK|MANILA|PH
AGE|37|M
INFO|MARRIED|PROFESSIONAL|BPO
NAME|SAMANTHA|SYDNEY|AUS
AGE|37|F
INFO|MARRIED|PROFESSIONAL|OFFSHORE
Putting all that is from JPN to output text 1 & non-JPN country to output text file 2
here's the code that what trying to work out
use strict;
use warnings;
use Data::Dumper;
use Carp qw(croak);
my #fields;
my $tmp_var;
my $count;
;
my ($line, $i);
my $filename = 'data.txt';
open(my $input_fh, '<', $filename ) or croak "Can't open $filename: $!";
open(OUTPUTA, ">", 'JPN.txt') or die "wsl_reformat.pl: could not open $ARGV[0]";
open(OUTPUTB, ">", 'Non-JPN.txt') or die "wsl_reformat.pl: could not open $ARGV[0]";
my $fh;
while (<$input_fh>) {
chomp;
my #fields = split /\|/;
if ($fields[0] eq 'NAME') {
for ($i=1; $i < #fields; $i++) {
if ($fields[3] eq 'JPN') {
$fh = $_;
print OUTPUTA $fh;
}
else {
$fh = $_;
print OUTPUTB $fh;
}
}
}
}
close(OUTPUTA);
close(OUTPUTB)
Still has no luck on it :(
Here is the way I think ikegami was saying, but I've never tried this before (although it gave the correct results).
#!/usr/bin/perl
use strict;
use warnings;
open my $jpn_fh, ">", 'o33.txt' or die $!;
open my $other_fh, ">", 'o44.txt' or die $!;
my $fh;
while (<DATA>) {
if (/^NAME/) {
if (/JPN$/) {
$fh = $jpn_fh;
}
else {
$fh = $other_fh;
}
}
print $fh $_;
}
close $jpn_fh or die $!;
close $other_fh or die $!;
__DATA__
NAME|JOHN|TOKYO|JPN
AGE|32|M
INFO|SINGLE|PROFESSIONAL|IT
NAME|MARK|MANILA|PH
AGE|37|M
INFO|MARRIED|PROFESSIONAL|BPO
NAME|SAMANTHA|SYDNEY|AUS
AGE|37|F
INFO|MARRIED|PROFESSIONAL|OFFSHORE
NAME|LUKE|TOKYO|JPN
AGE|27|M
INFO|SINGLE|PROFESSIONAL|IT
You didn't say what you needed help with, so I'm assuming it's coming up with an algorithm. Here's a good one:
Open the file to read.
Open the file for the JPN entries.
Open the file for the non-JPN entries.
While not eof,
Read a line.
Parse the line.
If it's the first line of a record,
If the person's country is JPN,
Set current file handle to the file handle for JPN entries.
Else,
Set current file handle to the file handle for non-JPN entries.
Print the line to the current file handle.
my $jpn_qfn = '...';
my $other_qfn = '...';
open(my $jpn_fh, '>', $jpn_qfn)
or die("Can't create $jpn_qfn: $!\n");
open(my $other_fh, '>', $other_qfn)
or die("Can't create $other_qfn: $!\n");
my $fh;
while (<>) {
chomp;
my #fields = split /\|/;
if ($fields[0] eq 'NAME') {
$fh = $fields[3] eq 'JPN' ? $jpn_fh : $other_fh;
}
say $fh $_;
}
#!/usr/bin/env perl
use 5.012;
use autodie;
use strict;
use warnings;
# store per country output filehandles
my %output;
# since this is just an example, read from __DATA__ section
while (my $line = <DATA>) {
# split the fields
my #cells = split /[|]/, $line;
# if first field is NAME, this is a new record
if ($cells[0] eq 'NAME') {
# get the country code, strip trailing whitespace
(my $country = $cells[3]) =~ s/\s+\z//;
# if we haven't created and output file for this
# country, yet, do so
unless (defined $output{$country}) {
open my $fh, '>', "$country.out";
$output{$country} = $fh;
}
my $out = $output{$country};
# output this and the next two lines to
# country specific output file
print $out $line, scalar <DATA>, scalar <DATA>;
}
}
close $_ for values %output;
__DATA__
NAME|JOHN|TOKYO|JPN
AGE|32|M
INFO|SINGLE|PROFESSIONAL|IT
NAME|MARK|MANILA|PH
AGE|37|M
INFO|MARRIED|PROFESSIONAL|BPO
NAME|SAMANTHA|SYDNEY|AUS
AGE|37|F
INFO|MARRIED|PROFESSIONAL|OFFSHORE
NAME|LUKE|TOKYO|JPN
AGE|27|M
INFO|SINGLE|PROFESSIONAL|IT
Thanks for your Help heaps
I was able to solved this problem in perl,
many thanks
#!/usr/local/bin/perl
use strict;
use warnings;
use Data::Dumper;
use Carp qw(croak);
my #fields;
my $tmp_var;
my ($rec_type, $country);
my $filename = 'data.txt';
open (my $input_fh, '<', $filename ) or croak "Can't open $filename: $!";
open my $OUTPUTA, ">", 'o33.txt' or die $!;
open my $OUTPUTB, ">", 'o44.txt' or die $!;
my $Combline;
while (<$input_fh>) {
$_ = _trim($_);
#fields = split (/\|/, $_);
$rec_type = $fields[0];
$country = $fields[3];
if ($rec_type eq 'NAME') {
if ($country eq 'JPN') {
*Combline = $OUTPUTA;
}
else {
*Combline = $OUTPUTB;
}
}
print Combline;
}
close $OUTPUTA or die $!;
close $OUTPUTB or die $!;
sub _trim {
my $word = shift;
if ( $word ) {
$word =~ s/\s*\|/\|/g; #remove trailing spaces
$word =~ s/"//g; #remove double quotes
}
return $word;
}