How to get a POD section into a variable:
pod2usage(-verbose => 99, -sections => "DESCRIPTION"); # Goes on STDOUT
=head1 DESCRIPTION
A description
=cut
I just want to assign DESCRIPTION to a variable instead displaying it on STDOUT.
I am currently investigating this way. It is complicated and it doesn't work:
sub pod2scalar {
use File::Temp 'tempfile';
my ($fh, $filename) = tempfile(UNLINK => 1);
open OLDOUT, '>&STDOUT';
{
local *STDOUT;
open STDOUT, ">", $filename or warn "Can't open $filename: $!";
#pod2usage(#_); # Doesn't work... I don't know why...
print STDOUT "This is captured in \$str";
close STDOUT;
}
open STDOUT, '>&OLDOUT' or die "Can't restore stdout: $!";
close OLDOUT or die "Can't close OLDOUT: $!";
open $fh, "<", $filename or warn "Can't open $filename: $!";
my $str = do { local $/, <$fh> };
close $fh;
$str;
}
You can open a scalar variable for output by passing a reference to open in place of a file name
Then you can provide the file handle as the value of the -output option of pod2usage to get the data sent to your scalar variable
You will also want to set an -exitval of 'NOEXIT' so that you get a chance to use what you have captured
It would look like this
use Pod::Usage 'pod2usage';
sub pod2scalar {
open my $fh, '>', \my $text;
pod2usage(#_, -output => $fh, -exitval => 'NOEXIT');
$text;
}
There is an excellent perl library Capture::Tiny that simplifies saving stdout/stderr.
By default pod2usage exits the program, so you must specify -exitval => "noexit".
Here is a full working example:
#!/usr/bin/perl
use strict;
use warnings;
use feature 'say';
use Pod::Usage;
use Capture::Tiny ':all';
=head1 DESCRIPTION
A description
=cut
my $stdout = capture_merged {
pod2usage(-verbose => 99, -sections => "DESCRIPTION", -exitval => "noexit");
};
say "## Captured";
say $stdout;
__END__
This will output:
## Captured
Description:
A description
Related
I have the following:
#! /usr/bin/perl
use Fcntl ':flock';
use strict;
...
my (#list, $fh);
open $fh, "<:encoding(utf8)", $file or die "$file: $!";
flock $fh, LOCK_EX;
use sigtrap 'handler' => sub {flock($fh, LOCK_UN);}, 'normal-signals'; # line 72
It runs but gives an error when I press ^C:
$ verify.pl
...
Can't use an undefined value as a symbol reference at ./verify.pl line 72.
The docs says it's OK
$ perldoc sigtrap
...
use sigtrap 'handler' => \&my_handler, 'normal-signals';
I can't figure out what's wrong.
I'm going to suggest that $fh is the undefined symbol reference. The use is run during the compilation phase (as if in a BEGIN {...} block), and, depending on where you think you're calling it, the $fh may never have been opened, or its scope may not be what you think.
Add some debugging to your handler to show, for example, the value of $fh and the refaddr of $fh. Also add to your open/flock code the same. I bet the refaddr isn't the same.
Since the sigtrap is registered globally, you may be best off with a global, e.g.:
my #handlers;
use sigtrap handler => sub { $_->() for grep defined, #handlers }, 'normal-signals';
{
my ($fh, #list);
open my $fh, ...
flock $fh, LOCK_EX;
my $handler = sub { flock $fh, LOCK_UN };
#handlers = map { weaken $_ } grep defined, #handlers, $handler;
# ... do stuff. When $handler goes out of scope, it'll go undef in #handlers
}
I need to work with some libraries that unfortunately log diagnostic
messages to STDOUT and STDERR. By using tie, I can redirect those
writes to a function that captures those. Since I don't want all
STDOUT and STDERR output of my programs to be captured thtough the
tied handle, I'd like to do this only for certain packages.
I have come up with a solution where the actual behavior is determined
by looking at caller() as can be seen below, but I have the feeling
that there has to be a better way... Is there a more elegant solution?
package My::Log::Capture;
use strict;
use warnings;
use 5.010;
sub TIEHANDLE {
my ($class, $channel, $fh, $packages) = #_;
bless {
channel => lc $channel,
fh => $fh,
packages => $packages,
}, $class;
}
sub PRINT {
my $self = shift;
my $caller = (caller)[0];
if ($caller ~~ $self->{packages}) {
local *STDOUT = *STDOUT;
local *STDERR = *STDERR;
given ($self->{channel}) {
when ('stdout') {
*STDOUT = $self->{fh};
}
when ('stderr') {
*STDERR = $self->{fh};
}
}
# Capturing/Logging code goes here...
} else {
$self->{fh}->print(#_);
}
}
1;
package main;
use My::Foo;
# [...]
use My::Log::Capture;
open my $stderr, '>&', *STDERR;
tie *STDERR, 'My::Log::Capture', (stderr => $stderr, [qw< My::Foo >]);
# My::Foo's STDERR output will be captured, everyone else's STDERR
# output will just be relayed.
Aside from fixing the libraries, I can think of only one solution that might be better.
You can re-open STDOUT and STDERR file handles into your own file handles. Then, re-open STDOUT and STDERR with your tied handles.
For example, here's how you do it for STDOUT:
open my $fh, ">&", \*STDOUT or die "cannot reopen STDOUT: $!";
close STDOUT;
open STDOUT, ">", "/tmp/test.txt";
say $fh "foo"; # goes to real STDOUT
say "bar"; # goes to /tmp/test.txt
You can read perldoc -f open for all the gory details on what ">&" and such does.
Anyway, instead of "/tmp/test.txt" you can replace that open call with the setup for your tied file handle.
Your code will have to always use an explicit file handle to write or use select to switch file handles:
select $fh;
say "foo"; # goes to real STDOUT
select STDOUT;
say "bar"; # goes to /tmp/test.txt
I have the following code:
use strict;
my $org_file_hash = {
'S6' => '/path/to/file/filename.txt_S6',
'S8' => '/path/to/file/filename.txt_S8',
'S2' => '/path/to/file/filename.txt_S2',
'S0' => '/path/to/file/filename.txt_S0',
'S00' => '/path/to/file/filename.txt_S00'
};
my $filehandles;
for(keys %{$org_file_hash})
{
my $key=$_;
open(my $key,">",$org_file_hash->{$key}) || die "Cannot open ".$org_file_hash->{$key}." for writing: $!";
push(#{$filehandles},$key);
}
In the latter part of the code, I get $org as "S2".
my $org="S2";
Based on $org I will decide the file I need to print to and in this case it is /path/to/file/filename.txt_S2.
To achieve this, I am doing following, but it does not work:
my $org="S2";
print {$org} "hello world\n";
I get the following error:
Can't use string ("S2") as a symbol ref while "strict refs" in use at new_t.pl line 22.
Please help.
Use $filehandles as a hash (or hashref) instead of an arrayref, as such:
my $filehandles = {};
for my $key (keys %{$org_file_hash})
{
# my $key=$_; # redundant
open( my $fh, '>', $org_file_hash->{$key} )
or die "Cannot open ".$org_file_hash->{$key}." for writing: $!";
$filehandles->{$key} = $fh;
}
# later...
my $org = 'S2';
print { $filehandles->{$org} } "Hello, world.\n";
At the end, don't forget to iterate over keys %{$filehandles} and close your opened files, too.
Use a hash:
my $filehandles = {};
for my $key (keys %{$org_file_hash}) {
open my $fh, ">", $org_file_hash->{$key} or die $!;
$filehandles->{$key} = $fh;
}
my $org="S2";
print {$filehandles->{$org}} "hello world\n";
BTW, if you use the open my $fh, ... form of open, $fh should be undefined. Otherwise, its value is used as the name of the real filehandle wanted. This is considered a symbolic reference, so the script won't compile under "use strict 'refs'".
How exactly would I check to see if a file is locked exclusively? I have this function but it is returning 1 no matter what I do:
sub is_file_locked
{
my $theFile;
my $theRC;
($theFile) = #_;
$theRC = open(HANDLE, $theFile);
$theRC = flock(HANDLE, LOCK_EX|LOCK_NB);
close(HANDLE);
return !$theRC;
}
You have opened $theFile in read mode and LOCK_EX isn't meant to be used that way.
Note that the fcntl(2) emulation of flock(3) requires that
FILEHANDLE be open with read intent to use LOCK_SH and requires
that it be open with write intent to use LOCK_EX.
First off, you should check if open succeeded.
Also, you should check if you can get a shared lock. flock with LOCK_EX would (I think) fail, if there is a shared lock on the file.
However, the file can become locked between the check and the return, creating a race condition, so such a function is of dubious value.
#!/usr/bin/perl
use strict; use warnings;
use Fcntl qw( :flock );
print is_locked_ex($0)
? "$0 : locked exclusively\n"
: "$0 : not locked exclusively\n";
my $test_file = 'test.txt';
open my $fh, '>', $test_file
or die "Cannot open '$test_file' for writing: $!";
if ( flock $fh, LOCK_EX|LOCK_NB ) {
print is_locked_ex($test_file)
? "$test_file : locked exclusively\n"
: "$test_file : not locked exclusively\n";
}
close $fh or die "Cannot close '$test_file': $!";
sub is_locked_ex {
my ($path) = #_;
die "Not a plain file: '$path'" unless -f $path;
return 1 unless open my $fh, '<', $path;
my $ret = not flock $fh, LOCK_SH | LOCK_NB;
close $fh
or die "Cannot close '$path': $!";
return $ret;
}
The final solution:
flock($fh, LOCK_EX) or die "Cannot lock file - $!\n";
if ( is_file_locked($gTestQueuePath) ){ print "locked";} else { print "not locked";}
#1 = locked 0 = not locked
sub is_file_locked
{
my $theFile;
my $theRC;
($theFile) = #_;
$theRC = open(my $HANDLE, ">>", $theFile);
$theRC = flock($HANDLE, LOCK_EX|LOCK_NB);
close($HANDLE);
return !$theRC;
}
close $fh or die "Cannot close";
I want to redirect STDERR and STDOUT to a variable. I did this.
close(STDOUT);
close(STDERR);
my $out;
open(STDOUT, ">>", \$out);
open(STDERR, ">>", \$out);
for(1..10)
{
print "print\n"; # this is ok.
warn "warn\n"; # same
system("make"); # this is lost. neither in screen nor in variable.
}
The problem with system. I want the output of this call to be captured too.
use Capture::Tiny!
Are you seeking to capture the output in a variable? If so, you have use backticks or qx{} with appropriate redirection. For example, you could use:
#/usr/bin/env perl
use strict;
use warnings;
# Ensure we have a way to write messages
open my $fh, '>', "output" or die;
close(STDOUT);
close(STDERR);
my $out;
open(STDOUT, ">>", \$out) or do { print $fh, "failed to open STDOUT ($!)\n"; die };
open(STDERR, ">>", \$out) or do { print $fh, "failed to open STDERR ($!)\n"; die };
foreach my $i (1..10)
{
print "print $i\n";
warn "warn $i\n";
my $extra = qx{make pth$i 2>&1};
print $fh "<<$i>><<$out>><<$extra>>\n";
}
(I happen to have programs pth1, pth2 and pth3 in the directory - they were made OK; pth4 and above write errors to stderr; the redirection was necessary.)
You should always check the success of operations such as open().
Why is this necessary? Because writing to a variable requires the cooperation of the process doing the writing - and make doesn't know how to cooperate.
There are several ways to redirect and restore STDOUT. Some of them work with STDERR too. Here are my two favorites:
Using select:
my $out;
open my $fh, ">>", \$out;
select $fh;
print "written to the variable\n";
select STDOUT;
print "written to original STDOUT\n";
Using local:
my $out
do {
local *STDOUT;
open STDOUT, ">>", \$out;
print "written to the variable\n";
};
print "written to original STDOUT\n";
Enjoy.
The reason this is happening is that the STDOUT and STDERR "filehandles" are not equivalent to stderr and stdout handles provided by the shell to the perl binary. In order to achieve what you want, you should use open instead of system
Why not use IPC::Open3?
TLDR Answer
use Capture::Tiny;
Merged STDOUT and STDERR
If you want STDOUT (from print()s) and STDERR (from warn()s) to be merged, then use...
my ($merged, #result) = capture_merged { print "Hello, world!" }; # static code
my ($merged, #result) = capture_merged { eval $codetoeval }; # code in variable
Separated STDOUT and STDERR
If you want them separated...
my ($stdout, $stderr, #result) = capture { print "Hello, world!" }; # static code
my ($stdout, $stderr, #result) = capture { eval $codetoeval }; # code in variable
Results of Eval
#result indicates the success, with success being [1], and failure being []. Tiny has a ton of other functions that you can look through for other cases, like code references, etc.. But I think the code above should cover most of any Perl developer's needs.