I'm trying to make a script that communicates with mplayer using open3, but the mplayer process is showing up as defunct and I am unable to send standard input into mplayer.
Here's the code:
#!/usr/bin/env perl
{
package mplayer::test;
use IPC::Open3;
sub new {
my $class = shift;
my $self = bless { #_ }, $class;
$self->start_mplayer();
$self;
}
sub start_mplayer{
my $self = shift;
local *DEVNULL;
open DEVNULL, ">/dev/null" or die "/dev/null: $!";
open OUTPUT, ">out.log" or die "out.log: $!";
$self->{r} = local *MPLAYER_READ;
$self->{w} = local *MPLAYER_WRITE;
$self->{pid} = open3($self->{w},$self->{r},">&DEVNULL",'mplayer -slave -idle -v');
die "Error opening mplayer!\n" unless $self->{pid};
}
sub do{
my ($self, $command) = #_;
print {$self->{w}} $command, "\n";
}
}
mplayer::test->new;
mplayer::test->do(qq~loadfile test.mp3~);
sleep(5);
I must be missing something obvious, I'm learning open3 from examples from other modules.
First off, switch to lexical filehandles. Typeglobs are package global and difficult to work with.
One problem is with local *DEVNULL. You've made *DEVNULL local to start_mplayer (and whatever it calls, including open3), but then used the associated filehandles outside start_mplayer. By that time, *DEVNULL has reverted back to its global state (ie. empty) and open3 tries to write to an empty filehandle. You should have gotten a print() on unopened filehandle DEVNULL warning, but you don't have warnings on...
Solution: don't localize it. Unfortunately this means you can't have multiple mplayer instances running at once. Normally you'd solve this by using a lexical filehandle, but unfortunately the special >& syntax only works with glob handles. The solution is to only open DEVNULL once.
Alternatively you can let open3 write to an error filehandle and just ignore them. Wastes a miniscule amount of memory.
Other changes...
Turn on strict and warnings
OUTPUT is never used.
Breaking up the command into multiple args avoids possible shell interference.
Putting localized filehandles into the object beforehand is unnecessary.
autodie is easier than typing "or die ..." all the time.
Here's your reworked start_mplayer routine. I don't have a copy of mplayer to try it with, but it works fine with cat.
use strict;
use warnings;
use autodie;
sub start_mplayer{
my $self = shift;
# Only open DEVNULL once, since its going to be shared.
open DEVNULL, ">", /dev/null" unless fileno DEVNULL;
$self->{pid} = open3($self->{r}, $self->{w}, ">&DEVNULL", 'mplayer', '-slave', '-idle', '-v');
die "Error opening mplayer!\n" unless $self->{pid};
}
To determine if its your program or something weird about mplayer, try a different command, like 'cat'. Often you have to close the input, or make sure it sees a newline, before a program will produce output.
For a more robust way to interact with programs, see IPC::Run.
Related
Is there a simple way in Perl to send STDOUT or STDERR to multiple places without forking, using File::Tee, or opening a pipe to /usr/bin/tee?
Surely there is a way to do this in pure perl without writing 20+ lines of code, right? What am I missing? Similar questions have been asked, both here on SO and elsewhere, but none of the answers satisfy the requirements that I not have to
fork
use File::Tee / IO::Tee / some other module+dependencies
whose code footprint is 1000x larger than my actual script
open a pipe to the actual tee command
I can see the use of a Core module as a tradeoff here, but really is that needed?
It looks like I can simply do this:
BEGIN {
open my $log, '>>', 'error.log' or die $!;
$SIG{__WARN__} = sub { print $log #_ and print STDERR #_ };
$SIG{__DIE__} = sub { warn #_ and exit 1 };
}
This simply and effectively sends most error messages both to the original STDERR and to a log file (apparently stuff trapped in an eval doesn't show up, I'm told). So there are downsides to this, mentioned in the comments. But as mentioned in the original question, the need was specific. This isn't meant for reuse. It's for a simple, small script that will never be more than 100 lines long.
If you are looking for a way to do this that isn't a "hack", the following was adapted from http://grokbase.com/t/perl/beginners/096pcz62bk/redirecting-stderr-with-io-tee
use IO::Tee;
open my $save_stderr, '>&STDERR' or die $!;
close STDERR;
open my $error_log, '>>', 'error.log' or die $!;
*STDERR = IO::Tee->new( $save_stderr, $error_log ) or die $!;
I simplified my program to the following trivial snippet and I'm still getting the message
Name "main::FILE" used only once: possible typo...
#!/usr/bin/perl -w
use strict;
use autodie qw(open close);
foreach my $f (#ARGV) {
local $/;
open FILE, "<", $f;
local $_ = <FILE>; # <--- HERE
close FILE;
print $_;
}
which obviously isn't true as it gets used three times. For whatever reason, only the marked occurrence counts.
I am aware about nicer ways to open a file (using a $filehandle), but it doesn't pay for short script, does it? So how can I get rid of the wrong warning?
According to the documentation for autodie:
BUGS
"Used only once" warnings can be generated when autodie or Fatal is used with package filehandles (eg, FILE ). Scalar filehandles are strongly recommended instead.
I get the warning on Perl 5.10.1, but not 5.16.3, so there may be something else going on as well.
I am new to perl scripting. I want to write subroutine test to log file.
for e.g.
my ($logfile, $logpath);
$logpath = '/usr/bin';
$logfile = "$logpath/log.txt";
open (LOG,">>","$logfile") || die ("Error : can't open log file");
sub test
{
print "Hi\n";
my $date = `date`;
}
sub logFunc
{
print LOG "Writing log files\n";
print LOG test(); # we cannot do like this :)
}
logFunc();
Say their are 15+ subroutines. So to write commands in each subroutine to log file I have to write print LOG "[Command]\n"; which works fine but script length is huge. So using common subroutine is their any way to achieve this?
There are several problems with your code.
Are you sure you have (and want) write-access to /usr/bin/?
You don't ever call your log() or your test() subroutines. No one will call any of them automatically.
The name log clashes with the built-in log function. So you will either have to call it with a prepended ampersand &log() which is ugly or rename it.
Your test() sub only has an implicit return value. Rather return the value of $date explicitly.
You are using the deprecated 2-argument version of open using a bare-word global file handle. Please use the 3-arg version with a lexical filehandle: open my $log_fh, '>>', $logfile.
A few hints:
Always add use strict; and use warnings; at the top of your script.
Since you're dealing with reading and writing files, you should also add use autodie;. This will automatically kill your program if you cannot open a file, or you cannot write to an open file.
Don't use OS commands when Perl probably can do exactly what you want without calling an OS command.
A Subroutine usually takes arguments and returns a value of some sort. In your case, have your test subroutine return something to write to the log. Or, create just a log subroutine that writes to a log, and have your test subroutine call it.
Here I'm reversing your subroutine calls. I create a write_to_log subroutine to handle my subroutine calls. My write_to_log adds the date/time stamp and writes that and my message. My various subroutines now just call write_to_log for me.
Notice all of my subroutines return some sort of value. The say command (as well as print) returns a non-zero value on success and a 0 on failure. I can use this to test whether my call to my subroutine worked or not.
use strict;
use warnings;
use autodie;
use features qw(say); #Allows you to use `say` instead of `print:
my $log_file = "/usr/bin/log.txt"; #You have write permission to this directory?
open my $log_fh, ">", $log_file;
my test ( $log_fh ) or die qq(Can't write to the log); #Pass the file handle to log
my test2 ( $log_fh ) or die qq(Can't write to the log);
close $log_fh;
sub test {
return write_to_log ( $log_fh, "Hello World!" );
}
sub test2 {
return write_to_log ( $log_fh, "Goodbye World!" );
}
sub write_to_log {
my $file_handle = shift;
my $message = shift;
use Time::Piece;
my $time = localtime->cdate;
return say {$file_handle} "$time: $message";
}
Here's a webpage that lists good books for learning modern Perl and what to look for in those books. If you're beginning to learn Perl, use one of these books.
I am compiling a Perl program, i am writing the output STDOUT to a file. In the same program , i want to run another small script using while function on the output of STDOUT. So, I need to save the output of first script in an array, then i can use in while<#array>. Like
open(File,"text.txt");
open(STDOUT,">output,txt");
#file_contents=<FILE>;
foreach (#file_contents){
//SCRIPT GOES HERE//
write;
}
format STDOUT =
VARIABLE #<<<<<< #<<<<<< #<<<<<<
$x $y $z
.
//Here I want to use output of above program in while loop //
while(<>){
}
How can i save the output of first program into array so that i can use in while loop, or how can i directly use STDOUT in while loop. I have to make sure that first part is completely executed. Thanks in advance.
Since you remapped STDOUT so it writes to a file, you could presumably close STDOUT, and then reopen the file for reading.
Quite where you're going to send any other output is a bit of a mystery, but presumably you can resolve that. Were it me, I'd not fiddle with STDOUT. I'd make the script write to a file handle:
use strict;
use warnings;
open my $input, "<", "text.txt" or die "A horrible death";
open my $output, ">", "output.txt" or die "A horrible death";
my #file_contents = <$input>;
close($input);
foreach (#file_contents)
{
# Script goes here
print $output "Any information that goes to output\n";
}
close $output;
open my $reread, "<", "output.txt" or die "A horrible death";
while (<$reread>)
{
# Process the previous output
}
Note the use of lexical file handles, the checking that the open worked, the close when finished with the input file, the use of use strict; and use warnings;. (I've only been working with Perl for 20 years and I know I don't trust my scripts until they run clean with those settings.)
I assume you want to reopen STDOUT in order to make the write function work. However, the correct solution for that is to either specify the file handle, or to a lesser extent, to use select.
write FILEHANDLE;
or
select FILEHANDLE;
write;
Unfortunately, it seems the IO of perlform is a bit arcane, and does not seem to allow for lexical file handles.
Your problem is you can't reuse the formatted text within the program, so a bit of trixy programming is required. What you can do is open a file handle that prints to a scalar. Which is another somewhat arcane perl functionality, but in this case, it might be the only way to do this directly.
# Using FOO as format to avoid destroying STDOUT
format FOO =
VARIABLE #<<<<<< #<<<<<< #<<<<<<
$x $y $z
.
my $foo;
use autodie; # save yourself some typing
open INPUT, '<', "text.txt"; # normally, we would add "or die $!" on these
open FOO, '>', \$foo; # but now autodie handles that for us
open my $output, '>', "output.txt";
while (<FILE>) {
$foo = ""; # we need to reset $foo each iteration
write FOO; # write to the file handle instead
print $output $foo; # this now prints $foo to output.txt
do_something($foo); # now you can also process the text at the same time
}
As you'll notice, we now first print the formatted line to the scalar $foo. While it is there, we can handle it as regular data, so there's no need to save to a file and reopening it to get to the data.
Each iteration, data is concatenated to the end of $foo, so to avoid accumulation, we need to reset $foo. The best way to handle this would be to make $foo lexical within the scope, but unfortunately we need $foo to be declared outside the while loop in order to be able to use it in the open statement.
It might be possible to use local $foo inside the while-loop, but I think that's adding yet more bad practice to this already very bad hack.
Conclusion:
With all this said and done, I suspect the best way to handle this is to not use perlform at all, and format your data in some other way. While perlform might be well suited to print to a file, it is not the best suited for what you have in mind. I recall this question from earlier, perhaps there was some other answer that would work better. Such as using sprintf, like Jonathan suggested
Assuming the output from your first program is tab-delimited:
while (<>) {
chomp $_;
my ($variable, $x, $y, $z) = split("\t", $_);
# do stuff with values
}
Yes, the problem is with a library I'm using, and no, I cannot modify it. I need a workaround.
Basically, I'm dealing with a badly written Perl library, that exits with 'die' when a certain error condition is encountered reading a file. I call this routine from a program which is looping through thousands of files, a handful of which are bad. Bad files happen; I just want my routine to log an error and move on.
IF I COULD modify the library, I would simply change the
die "error";
to a
print "error";return;
, but I cannot. Is there any way I can couch the routine so that the bad files won't crash the entire process?
FOLLOWUP QUESTION: Using an "eval" to couch the crash-prone call works nicely, but how do I set up handling for catch-able errors within that framework? To describe:
I have a subroutine that calls the library-which-crashes-sometimes many times. Rather than couch each call within this subroutine with an eval{}, I just allow it to die, and use an eval{} on the level that calls my subroutine:
my $status=eval{function($param);};
unless($status){print $#; next;}; # print error and go to next file if function() fails
However, there are error conditions that I can and do catch in function(). What is the most proper/elegant way to design the error-catching in the subroutine and the calling routine so that I get the correct behavior for both caught and uncaught errors?
You could wrap it in an eval. See:
perldoc -f eval
For instance, you could write:
# warn if routine calls die
eval { routine_might_die }; warn $# if $#;
This will turn the fatal error into a warning, which is more or less what you suggested. If die is called, $# contains the string passed to it.
Does it trap $SIG{__DIE__}? If it does, then it's more local than you are. But there are a couple strategies:
You can evoke its package and override die:
package Library::Dumb::Dyer;
use subs 'die';
sub die {
my ( $package, $file, $line ) = caller();
unless ( $decider->decide( $file, $package, $line ) eq 'DUMB' ) {
say "It's a good death.";
die #_;
}
}
If not, can trap it. (look for $SIG on the page, markdown is not handling the full link.)
my $old_die_handler = $SIG{__DIE__};
sub _death_handler {
my ( $package, $file, $line ) = caller();
unless ( $decider->decide( $file, $package, $line ) eq 'DUMB DIE' ) {
say "It's a good death.";
goto &$old_die_handler;
}
}
$SIG{__DIE__} = \&_death_handler;
You might have to scan the library, find a sub that it always calls, and use that to load your $SIG handler by overriding that.
my $dumb_package_do_something_dumb = \&Dumb::do_something_dumb;
*Dumb::do_something_dumb = sub {
$SIG{__DIE__} = ...
goto &$dumb_package_do_something_dumb;
};
Or override a builtin that it always calls...
package Dumb;
use subs 'chdir';
sub chdir {
$SIG{__DIE__} = ...
CORE::chdir #_;
};
If all else fails, you can whip the horse's eyes with this:
package CORE::GLOBAL;
use subs 'die';
sub die {
...
CORE::die #_;
}
This will override die globally, the only way you can get back die is to address it as CORE::die.
Some combination of this will work.
Although changing a die to not die has a specific solution as shown in the other answers, in general you can always override subroutines in other packages. You don't change the original source at all.
First, load the original package so you get all of the original definitions. Once the original is in place, you can redefine the troublesome subroutine:
BEGIN {
use Original::Lib;
no warnings 'redefine';
sub Original::Lib::some_sub { ... }
}
You can even cut and paste the original definition and tweak what you need. It's not a great solution, but if you can't change the original source (or want to try something before you change the original), it can work.
Besides that, you can copy the original source file into a separate directory for your application. Since you control that directory, you can edit the files in it. You modify that copy and load it by adding that directory to Perl's module search path:
use lib qw(/that/new/directory);
use Original::Lib; # should find the one in /that/new/directory
Your copy sticks around even if someone updates the original module (although you might have to merge changes).
I talk about this quite a bit in Mastering Perl, where I show some other techniques to do that sort of thing. The trick is to not break things even more. How you not break things depends on what you are doing.