It sounds like you are trying to reinvent exception handling. Don't do that. There are lots of potential errors besides being handed a write-only handle. How about being handed a closed handle? A handle with an existing error?
mobrule's method with use Fcntl; correctly determines the flags on a filehandle, but this does not generally handle errors and warnings.
If you want to delegate to the caller the responsibility of opening the file, delegate to the caller the appropriate handling of exceptions. This allows the caller to choose the appropriate response. The vast majority of times, it will be either to die or warn or fix the offending code that handed you a bad handle.
There are two way to handle exceptions on a file handle passed to you.
First, if you can look at TryCatch or Try::Tiny on CPAN and use that method of exception handling. I use TryCatch and it is great.
A second method is use eval and catch the appropriate error or warning after the eval is finished.
If you attempt to write to a read-only file handle, it is a warning that is generated. Catch the warning that is generated from your attempted write and you can then return success or failure to the caller.
Here is an example:
use strict; use warnings;
sub perr {
my $fh=shift;
my $text=shift;
my ($package, $file, $line, $sub)=caller(0);
my $oldwarn=$SIG{__WARN__};
my $perr_error;
{
local $SIG{__WARN__} = sub {
my $dad=(caller(1))[3];
if ($dad eq "(eval)" ) {
$perr_error=$_[0];
return ;
}
oldwarn->(@_);
};
eval { print $fh $text };
}
if(defined $perr_error) {
my $s="$sub, line: $line";
$perr_error=~s/line \d+\./$s/ ;
warn "$sub called in void context with warning:\n" .
$perr_error
if(!defined wantarray);
return wantarray ? (0,$perr_error) : 0;
}
return wantarray ? (1,"") : 1;
}
my $fh;
my @result;
my $res;
my $fname="blah blah file";
open $fh, '>', $fname;
print "\n\n","Successful write\n\n"
if perr $fh, "opened by Perl and writen to...\n";
close $fh;
open $fh, '<', $fname;
# void context:
perr $fh, "try writing to a read-only handle";
# scalar context:
$res=perr $fh, "try writing to a read-only handle";
@result=perr $fh, "try writing to a read-only handle";
if ($result[0]) {
print "SUCCESS!!\n\n";
} else {
print "\n","I dunno -- should I die or warn this:\n";
print $result[1];
}
close $fh;
@result=perr $fh, "try writing to a closed handle";
if ($result[0]) {
print "SUCCESS!!\n\n";
} else {
print "\n","I dunno -- should I die or warn this:\n";
print $result[1];
}
The output:
Successful write
main::perr called in void context with warning:
Filehandle $fh opened only for input at ./perr.pl main::perr, line: 49
I dunno -- should I die or warn this:
Filehandle $fh opened only for input at ./perr.pl main::perr, line: 55
I dunno -- should I die or warn this:
print() on closed filehandle $fh at ./perr.pl main::perr, line: 64