How can I tell if a filehandle is empty in Perl? - perl

For example:
open (PS , " tail -n 1 $file | grep win " );
I want to find whether the file handle is empty or not.

You can also use eof to check whether a file handle is exhausted. Here is an illustration based loosely on your code. Also note the use of a lexical file handle with the 3-arg form of open.
use strict;
use warnings;
my ($file_name, $find, $n) = #ARGV;
open my $fh, '-|', "tail -n $n $file_name | grep $find" or die $!;
if (eof $fh){
print "No lines\n";
}
else {
print <$fh>;
}

Although calling eof before you attempt to read from it produces the result you expect in this particular case, give heed to the advice at the end of the perlfunc documentation on eof:
Practical hint: you almost never need to use eof in Perl, because the input operators typically return undef when they run out of data, or if there was an error.
Your command will produce at most one line, so stick it in a scalar, e.g.,
chomp(my $gotwin = `tail -n 1 $file | grep win`);
Note that the exit status of grep tells you whether your pattern matched:
2.3 Exit Status
Normally, the exit status is 0 if selected lines are found and 1 otherwise …
Also, tail exits 0 on success or non-zero on failure. Use that information to your advantage:
#! /usr/bin/perl
use strict;
use warnings;
my $file = "input.dat";
chomp(my $gotwin = `tail -n 1 $file | grep win`);
my $status = $? >> 8;
if ($status == 1) {
print "$0: no match [$gotwin]\n";
}
elsif ($status == 0) {
print "$0: hit! [$gotwin]\n";
}
else {
die "$0: command pipeline exited $status";
}
For example:
$ > input.dat
$ ./prog.pl
./prog.pl: no match []
$ echo win >input.dat
$ ./prog.pl
./prog.pl: hit! [win]
$ rm input.dat
$ ./prog.pl
tail: cannot open `input.dat' for reading: No such file or directory
./prog.pl: no match []

open (PS,"tail -n 1 $file|");
if($l=<PS>)
{print"$l"}
else
{print"$file is empty\n"}

well ... scratch this ... I didn't make the connection about the filehandle actually being the output of a pipe.
You should use stat to determine the size of a file but you're going to need to
ensure the file is flushed first:
#!/usr/bin/perl
my $fh;
open $fh, ">", "foo.txt" or die "cannot open foo.txt - $!\n";
my $size = (stat $fh)[7];
print "size of file is $size\n";
print $fh "Foo";
$size = (stat $fh)[7];
print "size of file is $size\n";
$fh->flush;
$size = (stat $fh)[7];
print "size of file is $size\n";
close $fh;

Related

Need to loop through directory - delete lines that match pattern

Need to loop through a Unix directory and search each line in each file. If there is a pattern match delete the line. Was not able to get the line deletion to work so i'm just trying to find pattern and replace with another.
Populating an array with file names and looping through. I have a counter set it's looking at each of the lines in each file (at least they count is correct).
#!/usr/bin/perl -l
#!/usr/bin/perl -i.bak -w
#!/usr/bin/env perl
use strict;
use warnings;
use File::Find;
# 4-1-19
# pfs
# remove lines with dental code ADD2999 from all HMO Max load files in /home/hsxxx/dat/feeLoad directory
$| = 1;
chdir "/home/hstrn/dat/feeLoad";
chdir;
my $dir = </home/hstrn/dat/feeLoad/>;
my #files;
my $count=0;
opendir(DIR, $dir) or die "Cannot open directory $dir, Perl says $!\n";
while (my $file = readdir DIR)
{
push #files, "$dir/$file" unless -d "$dir/$file";
}
closedir DIR;
{
local #ARGV = #files;
while (<>)
{
s/ADD2999/sometext/g;
$count++;
}
print "Total lines read are: $count";
}
Would expect all strings ADD2999 to be replaced with sometext
To remove lines, you need to avoid printing them when writing to the new file. Your code doesn't write to any files at all???
This might be a job for existing tools.
find /home/hstrn/dat/feeLoad -maxdepth 1 -type f \
-exec perl -i~ -ne'print if !/ADD2999/' {} +
Use -i instead of -i~ if you want to avoid creating a backup. I prefer creating the backups, then deleting them once I've confirmed that everything is ok.
Show the files that are going to get deleted:
find /home/hstrn/dat/feeLoad -maxdepth 1 -type f -name '*~'
Delete the files:
find /home/hstrn/dat/feeLoad -maxdepth 1 -type f -name '*~' -delete
This would be my first attempt at the problem, but it could use some more corner case checking. E.g. how do you handle write-protected files, etc. It also assumes that the files are small enough to fit into memory for processing.
#!/usr/bin/perl
use warnings;
use strict;
use autodie;
use File::Spec;
use File::Slurper qw(read_text write_text);
my $count = 0;
my $dir = "tmp";
opendir(my $dh, $dir);
while (readdir $dh) {
# skip anything that shouldn't be processed
next if /^\.\.?$/; # . && ..
my $file = File::Spec->catfile($dir, $_);
next if -d $file; # directories
# slurp file content and replace text
my $content = read_text($file);
my $matches = ($content =~ s/ADD2999/sometext/g);
# count lines
my #eols = ($content =~ /(\n)/g);
$count += #eols;
# replace original file if contents were modified
write_text($file, $content) if $matches;
}
closedir($dh);
print "Total lines read are: $count\n";
exit 0;
Test run:
$ wc -l tmp/test*.txt
5 tmp/test2.txt
6 tmp/test.txt
11 total
$ fgrep ADD2999 tmp/*.txt
tmp/test2.txt:asddsada ADD2999 asdsadasd
tmp/test2.txt:21312398 ADD2999 dasdas
$ perl dummy.pl
Total lines read are: 11
$ fgrep ADD2999 tmp/*.txt
$ fgrep sometext tmp/*.txt
tmp/test2.txt:asddsada sometext asdsadasd
tmp/test2.txt:21312398 sometext dasdas
If the files are large you will need to use line-by-line processing approach (just showing the contents of the loop). That has the side-effect that all files will be touched, although they might not have any replacements in it:
# read file and replace text
open(my $ifh, '<', $file);
my $tmpfile = File::Spec->catfile($dir, "$_.$$");
open(my $ofh, '>', $tmpfile);
while (<$ifh>) {
s/ADD2999/sometext/g;
print $ofh $_;
}
$count += $.; # total lines in $ifh
close($ofh);
close($ifh);
# replace original file with new file
unlink($file);
rename($tmpfile, $file);

Return file handle from subroutine and pass to other subroutine

I am trying to create a couple of functions that will work together. getFH should take in the mode to open the file (either > or < ), and then the file itself (from the command line). It should do some checking to see if the file is okay to open, then open it, and return the file handle. doSomething should take in the file handle, and loop over the data and do whatever. However when the program lines to the while loop, I get the error:
readline() on unopened filehandle 1
What am I doing wrong here?
#! /usr/bin/perl
use warnings;
use strict;
use feature qw(say);
use Getopt::Long;
use Pod::Usage;
# command line param(s)
my $infile = '';
my $usage = "\n\n$0 [options] \n
Options
-infile Infile
-help Show this help message
\n";
# check flags
GetOptions(
'infile=s' => \$infile,
help => sub { pod2usage($usage) },
) or pod2usage(2);
my $inFH = getFh('<', $infile);
doSomething($inFH);
## Subroutines ##
## getFH ##
## #params:
## How to open file: '<' or '>'
## File to open
sub getFh {
my ($read_or_write, $file) = #_;
my $fh;
if ( ! defined $read_or_write ) {
die "Read or Write symbol not provided", $!;
}
if ( ! defined $file ) {
die "File not provided", $!;
}
unless ( -e -f -r -w $file ) {
die "File $file not suitable to use", $!;
}
unless ( open( $fh, $read_or_write, $file ) ) {
die "Cannot open $file",$!;
}
return($fh);
}
#Take in filehandle and do something with data
sub doSomething{
my $fh = #_;
while ( <$fh> ) {
say $_;
}
}
my $fh = #_;
This line does not mean what you think it means. It sets $fh to the number of items in #_ rather than the filehandle that is passed in - if you print the value of $fh, it will be 1 instead of a filehandle.
Use my $fh = shift, my $fh = $_[0], or my ($fh) = #_ instead.
As has been pointed out, my $fh = #_ will set $fh to 1, which is not a file handle. Use
my ($fh) = #_
instead to use list assignment
In addition
-e -f -r -w $file will not do what you want. You need
-e $file and -f $file and -r $file and -w $file
And you can make this more concise and efficient by using underscore _ in place of the file name, which will re-use the information fetched for the previous file test
-e $file and -f _ and -r _ and -w _
However, note that you will be rejecting a request if a file isn't writeable, which makes no sense if the request is to open a file for reading. Also, -f will return false if the file doesn't exist, so -e is superfluous
It is good to include $! in your die strings as it contains the reason for the failure, but your first two tests don't set this value up, and so should be just die "Read or Write symbol not provided"; etc.
In addition, die "Cannot open $file", $! should probably be
die qq{Cannot open "$file": $!}
to make it clear if the file name is empty, and to add some space between the message and the value of $!
The lines read from the file will have a newline character at the end, so there is no need for say. Simply print while <$fh> is fine
Perl variable names are conventionally snake_case, so get_fh and do_something is more usual

Perl code to check the last line number of a file

I have writeen a perl code that writes the number of lines it is one by one processing. I would like to get only the last line number of a file. The code is as follows:
#!/usr/bin/perl
using strict;
using warnings;
my $qbsid_dir = "/root/deep/";
opendir (DIR, "$qbsid_dir") or die "Cannot open the directory!\n";
while (my $file = readdir DIR){
next if ($file =~ m/^\./);
open(FH, "$qbsid_dir/$file") or die "Cannot open the file\n";
while (my $line = <FH>){
print "$.\n";
}
close (FH);
}
closedir (DIR);
The '/root/deep' directory contains two files. One with 90 lines and other with 100 lines written in the files.
I want those numbers to be printed instead of individual numbers such as 1..90 and 1..100 by $.
Thanks.
Do you really want to use Perl ?
wc -l <File>
If you want the last line number, wait to print $. until outside the while loop for processing the file:
open my $fh, '<', "$qbsid_dir/$file" or die "Can't open $file: $!";
1 while (<$fh>);
print "$file -> $.\n";
close $fh;
Be sure to read: perlfaq5 - How do I count the number of lines in a file?
Try this. It also print the last number of the filename.
$filedir = '/root/deep/';
opendir (dir, "$filedir");
#directory = readdir(dir);
#grep = grep{m/.*\.txt/g} #directory; #It matches the particular file format
foreach $dir(#grep){
open(file,"$filedir/$dir");
#line =<file>;
$total = #line; #$total variable store the last file number from array (#line)
print "File $dir Last line \t: $total\n";
}
You can use oneliner too
perl -nE '}{say $.' filename
#or
command | perl -nE '}{say $.'
test
$ seq 10 | perl -nE '}{say $.'
10
$ seq 10 | wc -l
10

Unique element in file - perl

I want to get the unique elements (lines) from a file which I will further send through email.
I have tried 2 methods but both are not working:
1st way:
my #array = "/tmp/myfile.$device";
my %seen = ();
my $file = grep { ! $seen{ $_ }++ } #array;
2nd way :
my $filename = "/tmp/myfile.$device";
cat $filename |sort | uniq > $file
How can I do it?
You seem to have forgotten to read the file!
open(my $fh, '<', $file_name)
or die("Can't open \"$file_name\": $!\n");
my %seen;
my #unique = grep !$seen{$_}++, <$fh>;
You need to open the file and read it.
"cat" is a shell command not perl
Try something like this
my $F;
die $! if(!open($F,"/tmp/myfile.$device"));
my #array = <$F>;
my %seen = (); my $file = grep { ! $seen{ $_ }++ } #array;
The die $! will stop the program with an error if the file doesn't open correctly;
#array=<$F> reads all the data from the file $F opened above into the array.
If you rig the argument list, you can make Perl open the file automatically, using:
perl -n -e 'BEGIN{#ARGV=("/tmp/myfile.device");} print if $count{$_}++ == 0;'

Grep to match all lines of patternfile (perl -e ok too)

I'm looking for a simple/elegant way to grep a file such that every returned line must match every line of a pattern file.
With input file
acb
bc
ca
bac
And pattern file
a
b
c
The command should return
acb
bac
I tried to do this with grep -f but that returns if it matches a single pattern in the file (and not all). I also tried something with a recursive call to perl -ne (foreach line of the pattern file, call perl -ne on the search file and try to grep in place) but I couldn't get the syntax parser to accept a call to perl from perl, so not sure if that's possible.
I thought there's probably a more elegant way to do this, so I thought I'd check. Thanks!
===UPDATE===
Thanks for your answers so far, sorry if I wasn't clear but I was hoping for just a one-line result (creating a script for this seems too heavy, just wanted something quick). I've been thinking about it some more and I came up with this so far:
perl -n -e 'chomp($_); print " | grep $_ "' pattern | xargs echo "cat input"
which prints
cat input | grep a | grep b | grep c
This string is what I want to execute, I just need to somehow execute it now. I tried an additional pipe to eval
perl -n -e 'chomp($_); print " | grep $_ "' pattern | xargs echo "cat input" | eval
Though that gives the message:
xargs: echo: terminated by signal 13
I'm not sure what that means?
One way using perl:
Content of input:
acb
bc
ca
bac
Content of pattern:
a
b
c
Content of script.pl:
use warnings;
use strict;
## Check arguments.
die qq[Usage: perl $0 <input-file> <pattern-file>\n] unless #ARGV == 2;
## Open files.
open my $pattern_fh, qq[<], pop #ARGV or die qq[ERROR: Cannot open pattern file: $!\n];
open my $input_fh, qq[<], pop #ARGV or die qq[ERROR: Cannot open input file: $!\n];
## Variable to save the regular expression.
my $str;
## Read patterns to match, and create a regex, with each string in a positive
## look-ahead.
while ( <$pattern_fh> ) {
chomp;
$str .= qq[(?=.*$_)];
}
my $regex = qr/$str/;
## Read each line of data and test if the regex matches.
while ( <$input_fh> ) {
chomp;
printf qq[%s\n], $_ if m/$regex/o;
}
Run it like:
perl script.pl input pattern
With following output:
acb
bac
Using Perl, I suggest you read all the patterns into an array and compile them. Then you can read through your input file using grep to make sure all of the regexes match.
The code looks like this
use strict;
use warnings;
open my $ptn, '<', 'pattern.txt' or die $!;
my #patterns = map { chomp(my $re = $_); qr/$re/; } grep /\S/, <$ptn>;
open my $in, '<', 'input.txt' or die $!;
while (my $line = <$in>) {
print $line unless grep { $line !~ $_ } #patterns;
}
output
acb
bac
Another way is to read all the input lines and then start filtering by each pattern:
#!/usr/bin/perl
use strict;
use warnings;
open my $in, '<', 'input.txt' or die $!;
my #matches = <$in>;
close $in;
open my $ptn, '<', 'pattern.txt' or die $!;
for my $pattern (<$ptn>) {
chomp($pattern);
#matches = grep(/$pattern/, #matches);
}
close $ptn;
print #matches;
output
acb
bac
Not grep and not a one liner...
MFILE=file.txt
PFILE=patterns
i=0
while read line; do
let i++
pattern=$(head -$i $PFILE | tail -1)
if [[ $line =~ $pattern ]]; then
echo $line
fi
# (or use sed instead of bash regex:
# echo $line | sed -n "/$pattern/p"
done < $MFILE
A bash(Linux) based solution
#!/bin/sh
INPUTFILE=input.txt #Your input file
PATTERNFILE=patterns.txt # file with patterns
# replace new line with '|' using awk
PATTERN=`awk 'NR==1{x=$0;next}NF{x=x"|"$0}END{print x}' "$PATTERNFILE"`
PATTERNCOUNT=`wc -l <"$PATTERNFILE"`
# build regex of style :(a|b|c){3,}
PATTERN="($PATTERN){$PATTERNCOUNT,}"
egrep "${PATTERN}" "${INPUTFILE}"
Here's a grep-only solution:
#!/bin/sh
foo ()
{
FIRST=1
cat pattern.txt | while read line; do
if [ $FIRST -eq 1 ]; then
FIRST=0
echo -n "grep \"$line\""
else
echo -n "$STRING | grep \"$line\""
fi
done
}
STRING=`foo`
eval "cat input.txt | $STRING"