Perl catch runtime error - perl

I am writing a perl script to open a textfile and perform some transformations on it. script is throwing an error saying "No such file or directory exists" whenever text file is unavailable.
I want to catch that error and create textfile then.
while (<>) { #i am passing filename from the batch file
#some task
}
# if the above while loop fails it throws no such file or directory exists error. I want to catch it and do some other task.

Those particular errors are warnings sent to STDERR by the "magic" behind ARGV. Why don't you just redirect STDERR?
perl script.pl foo bar 2>error.log
If that's not good enough, you'll have to start using $SIG{__WARN__} (yuck) or stop using ARGV (<> with no file handle defaults to using ARGV).
for my $argv (#ARGV ? #ARGV : '-') {
open(my $argv_fh, $argv)
or do {
... print message to log file ...
next;
};
while (<$argv_fh>) {
...
}
}

Instead of trying to catch the warning that the file doesn't exist, why not try passing the file path via getopt and test for file existence/readability before opening using file test operators.
edit: updated with example
#!/usr/bin/perl
use strict;
use warnings;
use Getopt::Std;
my %opts;
getopt('f', \%opts);
die "use -f to specify the file" unless defined $opts{f};
if(! -e $opts{f} ){
print "file doesn't exist\n";
}
elsif(! -r $opts{f} ){
print "file isn't readable\n";
}
elsif(! -f $opts{f} ){
print "file is not a normal file\n";
}
else{
open( my $fh, '<', $opts{f} ) or print "whatever error handling logic\n";
}

Related

file handler in perl not working in subroutine

#!/bin/perl
open( $WP, ">/home/Octa.txt" );
# Subroutine test
sub test {
$var1 = shift;
print $WP "TESTING\n";
}
# Subroutine func
sub func {
$var = shift;
if ( $var eq "Ocat" ) {
print $WP "String found\n";
test($var);
}
else {
print $WP "String not found\n";
}
}
$var3 = "Octa";
func($var3);
The issue is that the code is not able to write anything within the test subroutine or within the if condition of the 'funcsubroutine, but it prints in theelse` part of the 'func' subroutine.
First off, there is a typo -- you test $var against "Ocat", while Octa is intended.
So the test subroutine never gets called and only String not found is printed.
With that corrected and with the output file in a user writeable location, your program works.
However, some improvements are necessary.
use warnings;
use strict;
my $file = 'Octa.txt';
open my $WP, '>', $file or die "Can't open $file: $!";
my $var3 = "Octa";
func($WP, $var3);
#Subroutine test
sub test{
my ($fh, $var1) = #_;
print $fh "TESTING\n";
}
#Subroutine func
sub func{
my ($fh, $var) = #_;
if ($var eq "Octa"){
print $fh "String found\n";
test($fh, $var);
}
else {
print $fh "String not found\n";
}
}
I've changed the output file name since a user normally may not write to /home directory.
Comments
It is much better to use the three-argument form of open, in which case you get a lexical file handle which can be passed around nicely and is scoped. This question is a good example of how a global file handle can make things confusing, to say the least.
Always check the open call. For one thing, can you really write to /home directory?
Please always start programs with use warnings; and use strict;
There is another possibility for failure, which brings together practices in the comments above.
A file in /home normally isn't writeable by a user, in which case the posted program cannot work.
But without a check of open (which will fail) and without use warnings (which would be printed every time we touch the invalid $WH filehandle) we will not see any of these errors; instead, the program will quietly run and complete but it won't write the output file.

Perl Catch Variable in Error

I have a Perl script and I am trying to make it print out the value for $article when it errors. The script looks like:
eval{
for my $article($output =~ m/<value lang_id="">(.*?)<\/value>/g)
{
$article =~ s/ /+/g;
$agent->get("someurl");
$agent->follow_link(url_regex => qr/(?i:pdf)/ );
my $pdf_data = $agent->content;
open my $ofh, '>:raw', "$article.pdf"
or die "Could not write: $!";
print {$ofh} $pdf_data;
close $ofh;
sleep 10;
}
};
if($#){
print "error: ...: $#\n";
}
So if there is no .pdf file the code sends an error which is what I want. But what I need to know is it somehow possible to get the name of the $article that caused the error? I was trying to use some kind of global variable with no luck.
Why don't you put the eval inside the for loop? Something like this:
for my $article($output =~ m/<value lang_id="">(.*?)<\/value>/g)
{
$article =~ s/ /+/g;
eval{
# ...
}
if ($#) {
print STDERR "Error handling article: ", $article, " ", $!, "\n";
}
}
If that's your only problem, just declare my $article; before the eval, and remove the my from the for loop. But from your reply to Cornel Ghiban, I suspect it isn't.
Include the file name in the die>/ string:
open my $ofh, '>:raw', "$article.pdf" or die "Could not write '$article': $!";
I assume that you want to write and not read. Unless you have a permission issue or a full file system, a write is likely to succeed and you will never see an error.
Your script does not need to die, you can just set a flag or save message to the log or store error for late handling.
my #errors=();
................
open my $ofh, '>:raw', "$article.pdf" or do { push #errors,"$article: $!" };
if(-e $ofh) {
# work with the file
}
................
if(#errors) {
# do something
}

Open filehandle or assign stdout

I'm working in a program where the user can pass a -o file option, and output should be then directed to that file. Otherwise, it should go to stdout.
To retrieve the option I'm using the module getopt long, and that's not the problem. The problem is that I want to create a file handle with that file or assign stdout to it if the option was not set.
if ($opt) {
open OUTPUT, ">", $file;
} else {
open OUTPUT, # ???
}
That's because this way, later in my code I can just:
print OUTPUT "...";
Without worrying if OUTPUT is stdout or a file the user specified. Is this possible? If I'm doing a bad design here, please let me know.
This would be a good example on how to use select.
use strict;
use warnings;
use autodie;
my $fh;
if ($opt) {
open $fh, '>', $file;
select $fh;
}
print "This goes to the file if $opt is defined, otherwise to STDOUT."
Look at the open documentation. The easiest is to reopen STDOUT itself and not use a filehandle in your code.
if ($opt) {
open(STDOUT, ">", $file);
}
...
print "this goes to $file or STDOUT\n";
(Add some error checking of course.)
A constant item such as OUTPUT cannot be assigned. Using a variable such as $output works better. For example:
my ($output, $display_filename);
if ($opt)
{
if ($opt eq '-')
{
$display_filename = 'stdout';
$output = *STDOUT;
}
else
{
$display_filename = $opt;
open($output, '>', $opt) or
die("Cannot open $opt for writing: $!\n");
}
}
That way the program can print to standard output and/or to an output file:
print $output "This might go to a file\n";
print "Data written to $display_filename\n" if ($verbose);

How can I get rid of the STDERR in Perl

I'm using some system commands in Perl.
In the below case I was getting output as follows:
ls: import-log.*: No such file or directory
ls: error-log.*: No such file or directory
No specified files found for deletion
My code:
sub monthoryear()
{
#importlog = `ls -al import-log.*`;
#errorlog = `ls -al error-log.*`;
}
I don't want to see the following in the output even if there are no files.
ls: import-log.*: No such file or directory &
ls: error-log.*: No such file or directory
While the other answers are correct about the exact technical question you asked, you should also consider not writing what is effectively a shell script in Perl.
You should use Perl native methods of getting file list (e.g. glob() or File::Find) instead of calling a backticked ls.
Redirect STDERR to the null device:
use File::Spec;
open STDERR, '>', File::Spec->devnull() or die "could not open STDERR: $!\n";
You can add stderr redirection in your subshell commands:
#importlog = `ls -al import-log.* 2>/dev/null`;
#errorlog = `ls -al error-log.* 2>/dev/null`;
Check out perlfaq8. If you don't care if it's STDOUT or STDERR, you can get both redirected to STDOUT.
$output = `$cmd 2>&1`;
In your case, you probably just want to get rid of STDERR:
$output = `$cmd 2>/dev/null`;
However, I agree with DVK's answer. Using an external command to get a list of files just seems silly. You should use File::Find. This way you can use Perl's normal error handling in case something fails.
#!/usr/bin/perl
use strict;
use warnings;
use File::Find;
my #importlog;
my #errorlog;
find(sub {
push #importlog, $File::Find::name if /^import-log\.*/;
push #errorlog, $File::Find::name if /^error-log\.*/;
}, '.');
print "Import log:\n", join("\n", #importlog), "\n";
print "Error log:\n", join("\n", #errorlog), "\n";
Create a new warn hook, then do something with the message, store it, ignore it etc...
local $SIG{__WARN__} = sub {
my $message = shift;
## do nothing to ignore all together
## ignore specific message
# warn $message unless $message =~ /No such file or directory/;
## or do something else
# die $message ## make fatal
# open my $fh, '>', 'file.log'; print $fh $message;
};
You can redirect the stderr to /dev/null as:
#importlog = `ls -al import-log.* 2> /dev/null`;
#errorlog = `ls -al error-log.* 2> /dev/null`;
Subshells will inherit the parent's STDERR, so if you want to do it on a global level, you can do this:
open(STDERR,'>/dev/null');
`ls non-existent-file`;
`ls non-existent-file2`;
`ls non-existent-file3`;
`ls non-existent-file4`;
`ls non-existent-file5`;
Often you also want to restore STDERR later. I do this like this:
#!/usr/bin/perl
print STDERR "This will be send to the old (readable) STDERR\n";
my $oldstderr = readlink "/proc/self/fd/2"; #Remember the location of the old STDERR
open(STDERR, ">/dev/null"); #Ignore STDERR now
print STDERR "This will be send to a STDERR that is 'gone'\n";
open(STDERR, ">$oldstderr"); #restores STDERR to the old state
print STDERR "This will be send to the old (readable) STDERR again\n";
OR
You can use the Capture::Tiny module which makes it easier to read and more portable.
#!/usr/bin/perl
use Capture::Tiny qw/capture_stderr/;
print STDERR "This will be send to the old (readable) STDERR\n";
capture_stderr sub {
print STDERR "This will be send to a STDERR that is 'gone'\n";
};
print STDERR "This will be send to the old (readable) STDERR again\n";
Here's how you can suppress STDERR, capture error messages that occur while turned off, restore STDERR, and report back any captured error messages.
#!/usr/bin/perl
use warnings;
use strict;
print STDERR "STDERR is on.\n";
my ($stderr_fh, $err_msg_ref) = suppress_std_err();
print "STDERR is now off and error messages are being suppressed and saved.\n";
print STDERR "I'm an error message.\n";
restore_std_err($stderr_fh);
print STDERR "STDERR is back on\n";
print "Errors reported while STDERR was off: $$err_msg_ref\n";
#Saves STDERR in filehandle then turns it off.
#Any error messages that occur while STDERR is off are stored for safekeeping.
sub suppress_std_err {
my $suppressed_std_error_messages;
open (my $saved_std_err_fh, ">&", STDERR);
close STDERR;
open (STDERR, ">", \$suppressed_std_error_messages);
return ($saved_std_err_fh, \$suppressed_std_error_messages);
}
#Restores STDERR from saved filehandle.
sub restore_std_err {
my $old_std_err_fh = shift;
close STDERR;
open (STDERR, ">&", $old_std_err_fh);
}

How do I determine whether a Perl file handle is a read or write handle?

You are given either an IO::File object or a typeglob (\*STDOUT or Symbol::symbol_to_ref("main::FH")); how would you go about determining if it is a read or write handle? The interface cannot be extended to pass this information (I am overriding close to add calls to flush and sync before the actual close).
Currently I am attempting to flush and sync the filehandle and ignoring the error "Invalid argument" (which is what I get when I attempt to flush or sync a read filehandle):
eval { $fh->flush; 1 } or do {
#this seems to exclude flushes on read handles
unless ($! =~ /Invalid argument/) {
croak "could not flush $fh: $!";
}
};
eval { $fh->sync; 1 } or do {
#this seems to exclude syncs on read handles
unless ($! =~ /Invalid argument/) {
croak "could not sync $fh: $!";
}
};
Have a look at the fcntl options. Maybe F_GETFL with O_ACCMODE.
Edit: I did a little googling and playing over lunch and here is some probably non-portable code but it works for my Linux box, and probably any Posix system (perhaps even Cygwin, who knows?).
use strict;
use Fcntl;
use IO::File;
my $file;
my %modes = ( 0 => 'Read only', 1 => 'Write only', 2 => 'Read / Write' );
sub open_type {
my $fh = shift;
my $mode = fcntl($fh, F_GETFL, 0);
print "File is: " . $modes{$mode & 3} . "\n";
}
print "out\n";
$file = new IO::File();
$file->open('> /tmp/out');
open_type($file);
print "\n";
print "in\n";
$file = new IO::File();
$file->open('< /etc/passwd');
open_type($file);
print "\n";
print "both\n";
$file = new IO::File();
$file->open('+< /tmp/out');
open_type($file);
Example output:
$ perl test.pl
out
File is: Write only
in
File is: Read only
both
File is: Read / Write