I have some subroutines that I call like this myWrite($fileName, \@data). myWrite() opens the file and writes out the data in some way. I want to modify myWrite so that I can call it as above or with a filehandle as the first argument. (The main reason for this modification is to delegate the opening of the file to the calling script rather than the module. If there is a better solution for how to tell an IO subroutine where to write, i'd be glad to hear it.)
In order to do this, I must test whether the first input var is a filehandle. I figured out how to do that by reading this question.
Now here's my question: I also want to test whether I can write to this filehandle. I can't figure out how to do that.
Here's what I want to do:
sub myWrite {
my ($writeTo, $data) = @_;
my $fh;
if (isFilehandle($writeTo)) { # i can do this
die "you're an immoral person\n"
unless (canWriteTo($writeTo)); # but how do I do this?
$fh = $writeTo;
} else {
open $fh, ">", $writeTo;
}
...
}
All I need to know is if I can write to the filehandle, though it would be nice to see some general solution that tells you whether you're filehandle was opened with ">>" or "<", or if it isn't open, etc.
(Note that this question is related but doesn't seem to answer my question.)
dawg :
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? \n\nmobrule's method with use Fcntl; correctly determines the flags on a filehandle, but this does not generally handle errors and warnings. \n\nIf 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. \n\nThere are two way to handle exceptions on a file handle passed to you. \n\nFirst, 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. \n\nA second method is use eval and catch the appropriate error or warning after the eval is finished. \n\nIf 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.\n\nHere is an example:\n\nuse strict; use warnings;\n\nsub perr {\n my $fh=shift;\n my $text=shift;\n my ($package, $file, $line, $sub)=caller(0);\n my $oldwarn=$SIG{__WARN__};\n my $perr_error;\n\n {\n local $SIG{__WARN__} = sub { \n my $dad=(caller(1))[3];\n if ($dad eq \"(eval)\" ) {\n $perr_error=$_[0];\n return ;\n } \n oldwarn->(@_);\n };\n eval { print $fh $text }; \n } \n\n if(defined $perr_error) {\n my $s=\"$sub, line: $line\";\n $perr_error=~s/line \\d+\\./$s/ ;\n warn \"$sub called in void context with warning:\\n\" . \n $perr_error \n if(!defined wantarray);\n return wantarray ? (0,$perr_error) : 0;\n }\n return wantarray ? (1,\"\") : 1;\n}\n\nmy $fh;\nmy @result;\nmy $res;\nmy $fname=\"blah blah file\";\n\nopen $fh, '>', $fname;\n\nprint \"\\n\\n\",\"Successful write\\n\\n\" \n if perr $fh, \"opened by Perl and writen to...\\n\";\n\nclose $fh;\n\nopen $fh, '<', $fname;\n\n# void context:\nperr $fh, \"try writing to a read-only handle\";\n\n# scalar context:\n$res=perr $fh, \"try writing to a read-only handle\";\n\n\n@result=perr $fh, \"try writing to a read-only handle\";\nif ($result[0]) {\n print \"SUCCESS!!\\n\\n\";\n} else {\n print \"\\n\",\"I dunno -- should I die or warn this:\\n\";\n print $result[1];\n} \n\nclose $fh;\n@result=perr $fh, \"try writing to a closed handle\";\nif ($result[0]) {\n print \"SUCCESS!!\\n\\n\";\n} else {\n print \"\\n\",\"I dunno -- should I die or warn this:\\n\";\n print $result[1];\n}\n\n\nThe output:\n\nSuccessful write\n\nmain::perr called in void context with warning:\nFilehandle $fh opened only for input at ./perr.pl main::perr, line: 49\n\nI dunno -- should I die or warn this:\nFilehandle $fh opened only for input at ./perr.pl main::perr, line: 55\n\nI dunno -- should I die or warn this:\nprint() on closed filehandle $fh at ./perr.pl main::perr, line: 64\n",
2010-09-30T02:33:50
tchrist :
Detecting Openness of Handles\n\nAs Axeman points out, $handle->opened() tells you whether it is open.\n\nuse strict;\nuse autodie;\nuse warnings qw< FATAL all >;\nuse IO::Handle;\nuse Scalar::Util qw< openhandle >;\n\nour $NULL = \"/dev/null\";\nopen NULL;\nprintf \"NULL is %sopened.\\n\", NULL->opened() ? \"\" : \"not \";\nprintf \"NULL is %sopenhandled.\\n\", openhandle(\"NULL\") ? \"\" : \"not \";\nprintf \"NULL is fd %d.\\n\", fileno(NULL);\n\n\nproduces\n\nNULL is opened.\nNULL is not openhandled.\nNULL is fd 3.\n\n\nAs you see, you cannot use Scalar::Util::openhandle(), because it is just too stupid and buggy.\n\nOpen Handle Stress Test\n\nThe correct approach, if you were not using IO::Handle->opened, is demonstrated in the following simple little trilingual script:\n\neval 'exec perl $0 ${1+\"$@\"}'\n if 0;\n\nuse 5.010_000;\nuse strict;\nuse autodie;\nuse warnings qw[ FATAL all ];\n\nuse Symbol;\nuse IO::Handle;\n\n#define exec(arg)\nBEGIN { exec(\"cpp $0 | $^X\") } #!/usr/bin/perl -P\n#undef exec\n\n#define SAY(FN, ARG) printf(\"%6s %s => %s\\n\", short(\"FN\"), q(ARG), FN(ARG))\n#define STRING(ARG) SAY(qual_string, ARG)\n#define GLOB(ARG) SAY(qual_glob, ARG)\n#define NL say \"\"\n#define TOUGH \"hard!to!type\"\n\nsub comma(@);\nsub short($);\nsub qual($);\nsub qual_glob(*);\nsub qual_string($);\n\n$| = 1;\n\nmain();\nexit();\n\nsub main { \n\n our $GLOBAL = \"/dev/null\";\n open GLOBAL;\n\n my $new_fh = new IO::Handle;\n\n open(my $null, $GLOBAL);\n\n for my $str ($GLOBAL, TOUGH) {\n no strict \"refs\";\n *$str = *GLOBAL{IO};\n }\n\n STRING( *stderr );\n STRING( \"STDOUT\" );\n STRING( *STDOUT );\n STRING( *STDOUT{IO} );\n STRING( \\*STDOUT );\n STRING( \"sneezy\" );\n STRING( TOUGH );\n STRING( $new_fh );\n STRING( \"GLOBAL\" );\n STRING( *GLOBAL );\n STRING( $GLOBAL );\n STRING( $null );\n\n NL;\n\n GLOB( *stderr );\n GLOB( STDOUT );\n GLOB( \"STDOUT\" );\n GLOB( *STDOUT );\n GLOB( *STDOUT{IO} );\n GLOB( \\*STDOUT );\n GLOB( sneezy );\n GLOB( \"sneezy\" );\n GLOB( TOUGH );\n GLOB( $new_fh );\n GLOB( GLOBAL );\n GLOB( $GLOBAL );\n GLOB( *GLOBAL );\n GLOB( $null );\n\n NL;\n\n}\n\nsub comma(@) { join(\", \" => @_) }\n\nsub qual_string($) { \n my $string = shift();\n return qual($string);\n} \n\nsub qual_glob(*) { \n my $handle = shift();\n return qual($handle);\n} \n\nsub qual($) {\n my $thingie = shift();\n\n my $qname = qualify($thingie);\n my $qref = qualify_to_ref($thingie); \n my $fnum = do { no autodie; fileno($qref) };\n $fnum = \"undef\" unless defined $fnum;\n\n return comma($qname, $qref, \"fileno $fnum\");\n} \n\nsub short($) {\n my $name = shift();\n $name =~ s/.*_//;\n return $name;\n} \n\n\nWhich when run produces:\n\nstring *stderr => *main::stderr, GLOB(0x8368f7b0), fileno 2\nstring \"STDOUT\" => main::STDOUT, GLOB(0x8868ffd0), fileno 1\nstring *STDOUT => *main::STDOUT, GLOB(0x84ef4750), fileno 1\nstring *STDOUT{IO} => IO::Handle=IO(0x8868ffe0), GLOB(0x84ef4750), fileno 1\nstring \\*STDOUT => GLOB(0x8868ffd0), GLOB(0x8868ffd0), fileno 1\nstring \"sneezy\" => main::sneezy, GLOB(0x84169f10), fileno undef\nstring \"hard!to!type\" => main::hard!to!type, GLOB(0x8868f1d0), fileno 3\nstring $new_fh => IO::Handle=GLOB(0x8868f0b0), IO::Handle=GLOB(0x8868f0b0), fileno undef\nstring \"GLOBAL\" => main::GLOBAL, GLOB(0x899a4840), fileno 3\nstring *GLOBAL => *main::GLOBAL, GLOB(0x84ef4630), fileno 3\nstring $GLOBAL => main::/dev/null, GLOB(0x7f20ec00), fileno 3\nstring $null => GLOB(0x86f69bb0), GLOB(0x86f69bb0), fileno 4\n\n glob *stderr => GLOB(0x84ef4050), GLOB(0x84ef4050), fileno 2\n glob STDOUT => main::STDOUT, GLOB(0x8868ffd0), fileno 1\n glob \"STDOUT\" => main::STDOUT, GLOB(0x8868ffd0), fileno 1\n glob *STDOUT => GLOB(0x8868ffd0), GLOB(0x8868ffd0), fileno 1\n glob *STDOUT{IO} => IO::Handle=IO(0x8868ffe0), GLOB(0x84ef4630), fileno 1\n glob \\*STDOUT => GLOB(0x8868ffd0), GLOB(0x8868ffd0), fileno 1\n glob sneezy => main::sneezy, GLOB(0x84169f10), fileno undef\n glob \"sneezy\" => main::sneezy, GLOB(0x84169f10), fileno undef\n glob \"hard!to!type\" => main::hard!to!type, GLOB(0x8868f1d0), fileno 3\n glob $new_fh => IO::Handle=GLOB(0x8868f0b0), IO::Handle=GLOB(0x8868f0b0), fileno undef\n glob GLOBAL => main::GLOBAL, GLOB(0x899a4840), fileno 3\n glob $GLOBAL => main::/dev/null, GLOB(0x7f20ec00), fileno 3\n glob *GLOBAL => GLOB(0x899a4840), GLOB(0x899a4840), fileno 3\n glob $null => GLOB(0x86f69bb0), GLOB(0x86f69bb0), fileno 4\n\n\nThat is how you test for open file handles!\n\nBut that wasn’t even your question, I believe. \n\nStill, I felt it needed addressing, as there are too many incorrect solutions to that problem floating around here. People need to open their eyes to how these things actually work. Note that the two functions from Symbol use the caller’s package if necessary—which it certainly often is.\n\nDetermining Read/Write Mode of Open Handle\n\nThis is the answer to your question:\n\n#!/usr/bin/env perl\n\nuse 5.10.0;\nuse strict;\nuse autodie;\nuse warnings qw< FATAL all >;\n\nuse Fcntl;\n\nmy (%flags, @fh);\nmy $DEVICE = \"/dev/null\";\nmy @F_MODES = map { $_ => \"+$_\" } qw[ < > >> ];\nmy @O_MODES = map { $_ | O_WRONLY }\n O_SYNC ,\n O_NONBLOCK ,\n O_SYNC | O_APPEND ,\n O_NONBLOCK | O_APPEND ,\n O_SYNC | O_NONBLOCK | O_APPEND ,\n ;\n\n open($fh[++$#fh], $_, $DEVICE) for @F_MODES;\nsysopen($fh[++$#fh], $DEVICE, $_) for @O_MODES;\n\neval { $flags{$_} = main->$_ } for grep /^O_/, keys %::;\n\nfor my $fh (@fh) {\n printf(\"fd %2d: \" => fileno($fh));\n my ($flags => @flags) = 0+fcntl($fh, F_GETFL, my $junk);\n while (my($_, $flag) = each %flags) {\n next if $flag == O_ACCMODE;\n push @flags => /O_(.*)/ if $flags & $flag;\n }\n push @flags => \"RDONLY\" unless $flags & O_ACCMODE;\n printf(\"%s\\n\", join(\", \" => map{lc}@flags));\n}\n\nclose $_ for reverse STDOUT => @fh;\n\n\nWhich, when run, produces this output:\n\nfd 3: rdonly\nfd 4: rdwr\nfd 5: wronly\nfd 6: rdwr\nfd 7: wronly, append\nfd 8: rdwr, append\nfd 9: wronly, sync\nfd 10: ndelay, wronly, nonblock\nfd 11: wronly, sync, append\nfd 12: ndelay, wronly, nonblock, append\nfd 13: ndelay, wronly, nonblock, sync, append\n\n\nHappy now, Schwern? ☺ ",
2010-11-17T00:32:45
mob :
Still experimenting with this, but maybe you can try a zero-byte syswrite to a filehandle and check for errors:\n\nopen A, '<', '/some/file';\nopen B, '>', '/some/other-file';\n\n{\n local $! = 0;\n my $n = syswrite A, \"\";\n # result: $n is undef, $! is \"Bad file descriptor\"\n}\n{\n local $! = 0;\n my $n = syswrite B, \"\";\n # result: $n is 0, $! is \"\"\n}\n\n\nfcntl looks promising too. Your mileage may vary, but something like this could be on the right track:\n\nuse Fcntl;\n$flags = fcntl HANDLE, F_GETFL, 0; # \"GET FLags\"\nif ( ($flags & O_ACCMODE) & (O_WRONLY|O_RDWR) ) {\n print \"HANDLE is writeable ...\\n\"\n}\n",
2010-09-27T20:03:45
Axeman :
If you're using IO (and you should), then $handle->opened will tell you whether a handle is opened. Might have to delve deeper to tell its mode.",
2010-11-16T20:42:40