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.
Related
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]
i ve writted thsi script to compare lines of two files, and output common/not common lines into two different files. The script is :
use strict;
use warnings;
use autodie;
my $f1 = shift || "CSP8216.TXT";
my $f2 = shift || "CSP8217.TXT";
open my $fh1, '>', 'file1';
open FH2, '>', 'file2';
my %results;
open my $file1, '<', $f1;
while (my $line = <$file1>) {
$results{$line} = 1
}
open my $file2, '<', $f2;
while (my $line = <$file2>) {
$results{$line}++
}
foreach my $line (sort { $results{$b} <=> $results{$a} } keys %results)
{
if ($results{$line} >= 1)
{
print {$fh1} "$line";
}
else
{
print FH2 "$line";
}
}
My problem is when i try to mod this script but run the comparisons based on specific substrings of each line, ie :
If a specific substring of a line of file A matches another specific substring of a line in File B, then output said /entire/ line of File B into fh1, otherwise output it into fh2.
I tried this, but it doesnt work - really new to Perl still, any help will be really appreciated :
use strict;
use warnings;
use autodie;
my $f1 = shift || "CSP8216.TXT";
my $f2 = shift || "CSP8216.TXT";
open my $fh1, '>', 'file1';
open FH2, '>', 'file2';
my %results;
open my $file1, '<', $f1;
while (my $line = <$file1>)
{
my $sbs1 = substr($line, 0, 10);
$results{$sbs1} = 1
}
open my $file2, '<', $f2;
while (my $line = <$file2>)
{
my $sbs2 = substr($line, 0, 10);
$results{$sbs2}++
}
foreach my $line (sort { $results{$b} <=> $results{$a} } keys %results)
{
if ($results{$line} >= 1)
{
print {$fh1} "$line";
}
else
{
print FH2 "$line";
}
}
This does not work, and i have a feeling its a problem in the logic, it outputs just the substrings in a single line.
As per my comment, we need to keep the lines from file A and file B separate if we need to support that a single line can appear twice in one file.
On option is to solve the basic problem like this
open my $fh1, '<', $filename1 or die "Can't open $file1: $!";
while (my $line = <$fh1>) {
$combined{$line} = $file1{$line} = 1;
}
open my $fh2, '<', $filename2 or die "Can't open $file2: $!";
while (my $line = <$fh2>) {
$combined{$line} = $file2{$line} = 1;
}
open my $out1, '>', $outfilename1 or die "...";
open my $out2, '>', $outfilename2 or die "...";
for my $line (keys %combined) {
if ($file1{$line} && $file2{$line}) {
print $out1 $line;
} else {
print $out2 $line;
}
}
To solve the substring issue I would keep the substrings from each file as keys in the hashes. But instead of just storing the true value I would store the full string as value in %file2:
open my $fh1, '<', $filename1 or die "Can't open $file1: $!";
while (my $line = <$fh1>) {
my $substr = substr($line, 0, 10);
$combined{$line} = $file1{$substr} = 1;
}
open my $fh2, '<', $filename2 or die "Can't open $file2: $!";
while (my $line = <$fh2>) {
my $substr = substr($line, 20, 30);
$combined{$line} = 1;
$file2{$substr} = $line;
}
open my $out1, '>', $outfilename1 or die "...";
open my $out2, '>', $outfilename2 or die "...";
for my $line (keys %combined) {
my $substr1 = substr($line, 0, 10);
my $substr2 = substr($line, 20, 30);
if ($file1{$substr1} && $file2{$substr2}) {
print $out1 $file2{$substr2};
} else {
print $out2 $line;
}
}
This works for me
#!/usr/bin/perl
use warnings;
use autodie;
my %results;
my $f1 = shift || "CSP8216.TXT";
my $f2 = shift || "CSP8217.TXT";
open my $fh1, '>', 'file1';
open my $fh2, '>', 'file2';
open my $file1, '<', $f1;
while (my $line = <$file1>) {
my $sbs1 = substr($line, 0, 10);
$results{$sbs1} = 1
}
open my $file2, '<', $f2;
while (my $line = <$file2>) {
my $sbs2 = substr($line, 0, 10);
if (!$results{$sbs2}) {
$results{$sbs2} = 1;
}
$results{$sbs2}++
}
foreach my $line (sort { $results{$b} <=> $results{$a} } keys %results) {
if ($results{$line} > 1) {
print {$fh1} "$line";
}
else {
print {$fh2} "$line";
}
}
In Perl, I know this method :
open( my $in, "<", "inputs.txt" );
reads a file but it only does so if the file exists.
Doing the other way, the one with the +:
open( my $in, "+>", "inputs.txt" );
writes a file/truncates if it exists so I don't get the chance to read the file and store it in the program.
How do I read files in Perl considering if the file exists or not?
Okay, I've edited my code but still the file isn't being read. The problem is it doesn't enter the loop. Anything mischievous with my code?
open( my $in, "+>>", "inputs.txt" ) or die "Can't open inputs.txt : $!\n";
while (<$in>) {
print "Here!";
my #subjects = ();
my %information = ();
$information{"name"} = $_;
$information{"studNum"} = <$in>;
$information{"cNum"} = <$in>;
$information{"emailAdd"} = <$in>;
$information{"gwa"} = <$in>;
$information{"subjNum"} = <$in>;
for ( $i = 0; $i < $information{"subjNum"}; $i++ ) {
my %subject = ();
$subject{"courseNum"} = <$in>;
$subject{"courseUnt"} = <$in>;
$subject{"courseGrd"} = <$in>;
push #subjects, \%subject;
}
$information{"subj"} = \#subjects;
push #students, \%information;
}
print "FILE LOADED.\n";
close $in or die "Can't close inputs.txt : $!\n";
Use the proper test file operator:
use strict;
use warnings;
use autodie;
my $filename = 'inputs.txt';
unless(-e $filename) {
#Create the file if it doesn't exist
open my $fc, ">", $filename;
close $fc;
}
# Work with the file
open my $fh, "<", $filename;
while( my $line = <$fh> ) {
#...
}
close $fh;
But if the file is new (without contents), the while loop won't be processed. It's easier to read the file only if the test is fine:
if(-e $filename) {
# Work with the file
open my $fh, "<", $filename;
while( my $line = <$fh> ) {
#...
}
close $fh;
}
You can use +>> for read/append, creates the file if it doesn't exist but doesn't truncate it:
open(my $in,"+>>","inputs.txt");
First check whether the file exists or not. Check the sample code below :
#!/usr/bin/perl
use strict;
use warnings;
my $InputFile = $ARGV[0];
if ( -e $InputFile ) {
print "File Exists!";
open FH, "<$InputFile";
my #Content = <FH>;
open OUT, ">outfile.txt";
print OUT #Content;
close(FH);
close(OUT);
} else {
print "File Do not exists!! Create a new file";
open OUT, ">$InputFile";
print OUT "Hello World";
close(OUT);
}
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;
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;
}