Open file with or without extension - perl

This is how I open a file in Perl:
open FILE, "</file.ext";
How do I open the file file regardless of if it's called file or file.ext in Perl?

You can use grep:
use warnings;
use strict;
use Errno qw( ENOENT );
my ($file) = grep { -f $_ } qw(file file.ext)
or die $!=ENOENT;
open my $fh, '<', $file
or die "$file: $!";

The following will produce the most usable error message:
sub open_if_exists {
my ($qfn) = #_;
my $fh;
open($fh, '<', $qfn)
and return $fh;
$!{ENOENT}
and return undef;
die("Can't open \"$qfn\": $!\n");
}
my $qfn = "file";
my $fh = open_if_exists($qfn) || open_if_exists("$qfn.ext")
or die("Can't open \"$qfn\" or \"$qfn.ext\": $!\n");

open returns 0 on failure, so you can chain open calls together with the || or or operators.
my $fh;
open ($fh, '<', 'file') ||
open ($fh, '<', 'file.ext') ||
open ($fh, '<', $other_default_filename) ||
die "Couldn't find any acceptable file: $!";

The typical approach is to pass the filename to the piece of the code that needs to open the file:
sub f {
my ($filename) = #_;
open my $fh, '<', $filename or die "$!";
# do things with $fh
close $fh;
return;
}
now it doesn't matter what the name of the file is, function f will open it (assuming it exists and you have permissions to read it):
f('file');
f('file.ext');
You could also pass the filename as a command-line argument:
#!perl
# test-open.pl
use strict;
use warnings;
my $filename = shift #ARGV or die "Missing filename";
open my $fh, '<', $filename or die "$!";
now you call test-open.pl, passing it a filename:
perl test-open.pl file
perl test-open.pl file.ext

Related

how to change the contents in the file in perl?

I am trying to open one file read oneline in it at a time then open the another file and try to search for some part of the line read from the first file in the second file and try to replace all instances with the other part of the line read from the first file.When i am executing it its getting executed and i am able to see the result on the console but the files are not getting modified. What could be the mistake. Can some one please suggest this.
use strict;
use warnings;
use autodie; # die if problem reading or writing a file
my $filename = 'compare.txt';
open(my $fh, '+<', $filename) or die "Could not open file '$filename' $!";
while(<$fh>){
my $readline= "$_";
print("\n");
my #arr=split(',',$readline);
print($arr[0]."\n".$arr[1]);
replace($arr[0],$arr[1]);
}
close $fh;
sub replace
{
my $search=shift(#_);
my $replace=shift(#_);
my $filename2 = 'replace.txt';
open(my $fh1, '+<', $filename2) or die "Could not open file '$filename' $!";
while(<$fh1>)
{
my $readline2= "$_";
$readline2=~s/$search/$replace/g;
print($readline2);
print("\n");
}
close $fh1;
}
As a huge fan of the Path::Tiny module, I would do the above as:
use 5.014;
use warnings;
use Path::Tiny;
my %rep = map { split /,/ } path('compare.txt')->lines({chomp => 1});
path("replace.txt")->edit_lines( sub {
while(my($key,$val) = each(%rep)) {
s/$key/$val/g;
}
});
In your sub, when you are iterating the lines in your file, you should write it back to a file. The regex substitute doesn't automatically write it back to file.
use strict;
use warnings;
use autodie; # die if problem reading or writing a file
use File::Copy;
my $filename = 'compare.txt';
open(my $fh, '+<', $filename) or die "Could not open file '$filename' $!";
while(<$fh>){
my $readline= "$_";
print("\n");
my #arr=split(',',$readline);
print($arr[0]."\n".$arr[1]);
replace($arr[0],$arr[1]);
}
close $fh;
sub replace
{
my $search=shift(#_);
my $replace=shift(#_);
my $filename2 = 'replace.txt';
open(my $fh1, '+<', $filename2) or die "Could not open file '$filename' $!";
#open file to write to
open $newfile, '>', 'replace_tmp.txt';
while(<$fh1>)
{
chomp;
my $readline2= "$_";
$readline2=~s/$search/$replace/g;
print( $newfile, $readline2);
print($newfile, "\n");
}
close($fh1);
close($newfile);
move ('replaced.txt', 'replace.txt');
}
This is simple way of doing it. You can use File::Tie to write back to the same file and avoid renaming it, or refer to perldoc

Remove the first line from my directory

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 to catch errors with IO::File perl

Normally you'd do:
open( my $fh, "+<", "$thefile.txt") or die "Could not open $thefile.txt $!\n";
but with IO::File you do (from docs):
$fh = new IO::File;
if ($fh->open("< file")) {
print <$fh>;
$fh->close;
}
Does IO::File automatically throw errors/die if there was a problem opening the file? How would one go about it when using this module?
Mostly concerned with logging, how would you log out a 'good' error message like 'No such file or directory'
From the docs for IO::File:
CONSTRUCTOR
new ( FILENAME [,MODE [,PERMS]] )
Creates an IO::File. If it receives any parameters, they are passed to the method open; if the open fails, the object is destroyed. Otherwise, it is returned to the caller.
Therefore, you can use or die statements just like you normally do:
use IO::File;
my $fh = IO::File->new('notfound.txt') or die "Can't open: $!";
Outputs:
Can't open: No such file or directory at script.pl line 5.
open( my $fh, "+<", "thefile.txt") or die "Could not open thefile.txt $!\n";
Remove $ sign from thefile.txt. You are not storing your file name in a variable.
you can use
$file = 'thefile.txt';
open( my $fh, "<", "$file") or die "Could not open $file $!\n"
In die the "$!" would show the error message as "No such file or directory"
$fh->open("< file") will be false if it cannot open the file. So just add an else:
$fh = new IO::File;
if ($fh->open("< file")) {
print <$fh>;
$fh->close;
}
else {
die("Cannot open file. Reason: $!");
}

read input file, match and remove data and write remaining lines to a new file

I am stuck trying to get this to write out the contents of the file. What I am trying to do is open an input file, filter out/remove the matched line and write to a new file. Can someone show me how to do this properly? Thanks.
use strict;
use warnings;
use Text::CSV_XS;
my $csv = Text::CSV_XS->new ({ binary => 1 }) or
die "Cannot use CSV: ".Text::CSV_XS->error_diag ();
open my $fh, "<:encoding(UTF-16LE)", "InputFile.txt" or die "cannot open file: $!";
my #rows;
while (my $row = $csv->getline ($fh)) {
my #lines;
shift #lines if $row->[0] =~ m/Global/;
my $newfile = "NewFile.txt";
open(my $newfh, '>', $newfile) or die "Can't open";
print $newfh #lines;
}
$csv->eof or $csv->error_diag ();
close $fh;
Open the output file outside of the loop. As you read each line, decide if you want to keep it. If yes, write to output file. If not, don't do anything.
Something like the following (untested):
use strict;
use warnings;
use Text::CSV_XS;
my ($input_file, $output_file) = qw(InputFile.txt NewFile.txt);
my $csv = Text::CSV_XS->new ({ binary => 1 })
or die sprintf("Cannot use CSV: %s\n", Text::CSV_XS->error_diag);
open my $infh, "<:encoding(UTF-16LE)", $input_file
or die "Cannot open '$input_file': $!";
open my $outfh, '>', $output_file
or die "Cannot open '$output_file': $!";
while (my $row = $csv->getline($infh)) {
next if $row->[0] =~ m/Global/;
unless ( $csv->print($outfh, $row) ) {
die sprintf("Error writing to '%s': %s",
$output_file,
$csv->error_diag
);
}
}
close $outfh
or die "Cannot close '$output_file': $!";
close $infh
or die "Cannot close '$input_file': $!";
$csv->eof
or die "Processing of '$input_file' terminated prematurely";

using perl tie::file with utf encoded file

Can I use Tie::File with an output file of utf encoding? I can't get this to work right.
What I am trying to do is open this utf encoded file, remove the match string from the file and rename the file.
Code:
use strict;
use warnings;
use Tie::File;
use File::Copy;
my ($input_file) = qw (test.txt);
open my $infh, "<:encoding(UTF-16LE)", $input_file or die "cannot open '$input_file': $!";
for (<$infh>) {
tie my #lines, "Tie::File", $_;
shift #lines if $lines[0] =~ m/MyHeader/;
untie #lines;
my ($name) = /^(.*).csv/i;
move($_, $name . ".dat");
}
close $infh
or die "Cannot close '$input_file': $!";
Code: (updated)
my ($input_file) = qw (test.txt);
my $qfn_in = $input_file;
my $qfn_out = $qfn_in . ".dat";
open(my $fh_in, "<:raw:perlio:encoding(UTF-16le):crlf:utf8", $qfn_in)
or die("Can't open \"$qfn_in\": $!\n");
open(my $fh_out, ">:raw:perlio:encoding(UTF-16le):crlf:utf8", $qfn_out)
or die("Can't open \"$qfn_out\": $!\n");
while (<$fh_in>) {
next if $. == 1 && /MyHeader/;
print($fh_out $_)
or die("Can't write to \"$qfn_out\": $!");
}
close($fh_in);
close($fh_out) or die("Can't write to \"$qfn_out\": $!");
rename($qfn_out, $qfn_in)
or die("Can't rename: $!\n");
This is underdocumented in the Tie::File perldoc, but you want to pass the discipline => ':encoding(UTF-16LE)' option when you tie the file:
tie my #lines, 'Tie::File', $input_file, discipline => ':encoding(UTF-16LE)'
Note that the third argument is the name of the file to associate with the tied array. Tie::File will automatically open and manage the filehandle for you; there is no need to call open on the file yourself.
#lines now contains the contents of the file, so the next thing to do is check the first line:
if ($lines[0] =~ m/pattern/) {
my $line = shift #lines;
untie #lines; # rewrites, closes the file, w/o first line
my ($name) = $line =~ /^(.*).csv/i;
rename $input_file, "$name.dat";
}
But I concur with TLP that Tie::File is overkill for this job.
(My previous answer about opening a filehandle with the correct encoding and passing the glob as the third arg to Tie::File won't work, as (1) it didn't open the file in read/write mode and (2) even if it did, Tie::File can't or doesn't apply the encoding on both the reading from and writing to the file handle)
my $qfn_in = ...;
my $qfn_out = $qfn_in . ".tmp";
open(my $fh_in, "<:raw:perlio:encoding(UTF-16le):crlf:utf8", $qfn_in)
or die("Can't open \"$qfn_in\": $!\n");
open(my $fh_out, ">:raw:perlio:encoding(UTF-16le):crlf:utf8", $qfn_out)
or die("Can't open \"$qfn_out\": $!\n");
while (<$fh_in>) {
next if $. == 1 && /MyHeader/;
print($fh_out $_)
or die("Can't write to \"$qfn_out\": $!");
}
close($fh_in);
close($fh_out) or die("Can't write to \"$qfn_out\": $!");
rename($qfn_out, $qfn_in)
or die("Can't rename: $!\n");
(:perlio and :utf8 are workarounds for bugs that existed back then.)
The line:
tie my #lines, "Tie::File", $_;
Tries to tie #lines to a file with the name of each line of test.txt. Since it does not seem to be a file with filenames in it, I suspect that that tie fails.
What you are probably after is using Tie::File on test.txt. If you only want to check the first line of that file, you do not need a loop.
So you'd need something like:
use autodie; #handy to check for fatal errors
tie my #lines, "Tie::File", $input_file;
shift #lines if $lines[0] =~ /MyHeader/;
untie #lines;
if ($input_file =~ /(.+).csv/i) {
move($input_file, $1);
}
But there are simpler ways to check the first line of a file. This will check one file:
perl -we '$_=<>; print if /MyHeader/; print <>;' test.txt > test.dat