I'm using full text search with user generated input on a PostgreSQL table, "the a" in this example.
my $dbh = DBI->connect("...", { RaiseError => 0, AutoCommit => 1 });
my $sth = $dbh->prepare("SELECT name from mytable WHERE tsv ## plainto_tsquery('the a')");
my $rv = $sth->execute();
If the user input only contains stop words, I get a NOTICE on STDERR and the query returns no results, but produces no error.
I would like to capture that NOTICE in Perl to possibly alert the user to rephrase the search, but I can't seem to access it.
Setting RaiseError to 1 doesn't change anything and $dbh->pg_notifies returns undef.
Any ideas ?
I presume that the mention of "NOTICE" means that something does a RAISE. How that behaves is configurable but delving into that would require far more detail.
At perl level, there are various ways to get to the STDERR stream and capture what's sent to it.
If these are warn-ings then setting a hook for $SIG{__WARN__} runs that subroutine whenever a warning is to be printed
{
local $SIG{__WARN__} = sub { say "Got warning: $_[0]"; };
warn "a warning";
}
So you can capture it this way, do what you wish with it, and then perhaps reemit. The $_[0] in the example has the string a warning, and after the anonymous sub runs the control is back at the next line after a warning is issued (the warn statement in this snippet). See %SIG.
I put this in a block only to be able to local-ize the change to SIG{__WARN__}, what is practically compulsory (if this global isn't local-ized its change affects all code). So if this code is in a suitable lexical scope anyway then that block isn't needed.
But this won't catch things printed directly to STDERR. For that the most practical way is to use libraries, and a simple and convenient one for this purpose is Capture::Tiny
use Capture::Tiny qw(capture);
my ($stdout, $stderr, $exit) = capture {
say "to STDOUT";
say STDERR "to STDERR";
warn "a warn-ing";
# ...
};
Now $stdout has text to STDOUT while $stderr has to STDERR followed by a warn-ing. So your database code would go in such a block and the NOTICE should wind up in that $stderr variable. There is also a capture_stderr function if you prefer to capture only that this way.
That doesn't seem to work as it should, and it is recognized as an unsolved bug.
Related
I have the following error message (with Perl 5):
Tools.pm: Filehandle STDOUT reopened as FH only for input at /usr/local/lib/perl5/site_perl/mach/5.20/Template/Provider.pm line 967.
I understand its cause: It is that STDOUT was closed and later the same FD was used for something unrelated to STDOUT.
The code does the right thing. The only problem is that this error message should not to be logged.
How to stop printing this error message into our log file?
Detailed handling of errors is outlined in Template::Manual::Config::ERROR.
It can be categorized in the constructor by specifying templates for exception types
my $template = Template->new({
ERRORS => {
user => 'user/index.html',
dbi => 'error/database',
default => 'error/default',
},
});
which can be raised using the THROW directive
[% THROW user.login 'no user id: please login' %]
or by calling throw method
$context->throw('user.passwd', 'Incorrect Password');
$context->throw('Incorrect Password'); # type 'undef'
or by Perl code by calling die, perhaps with a Template::Exception object.
How to use this to solve the problem is a matter of details, of which none are provided.
But you really want to find (user) code that triggers this and clean it up. For one, as noted by ikegami in a comment, don't close STDOUT but reopen it to /dev/null. (I'd say, never simply close standard streams.) For instance, if you just don't want to see STDOUT any more
open STDOUT, '>', '/dev/null';
or first copy it (uses dup2) before reopening so that you can restore it later
open my $SAVEOUT, '>&', 'STDOUT';
open STDOUT, '>', '/dev/null';
...
open STDOUT, '>', $SAVEOUT; # restore STDOUT
close $SAVEOUT; # if unneeded
(see open), or if feasible create a local *FOO and use that to save STDOUT.
The warning comes about since the lowest unused file descriptor is always used, and here fd 1 was vacated by closing STDOUT; but it is attempted to be used for input what isn't OK. As for why it's not OK and why emit a warning, this thread and an old bug report are useful. This goes beyond Perl.
One generic way is to use the __WARN__ hook
BEGIN {
$SIG{__WARN__} = sub {
warn #_
unless $_[0] ~= /Filehandle STDOUT reopened as FH only for input/
}
};
where the warning is emitted unless it matches the one you want to suppress.
This BEGIN block need be before the use statements for modules it is expected to affect. If you know the scope at which this is needed it is better to localize it, local $SIG{__WARN__} = sub {...};
See this post and its links, to other posts and relevant documentation, for more details.
I'm using Term::ReadLine::Gnu and have run into a problem with signal handling. Given the script below and a TERM signal sent to the script, the handler for the TERM signal is not triggered until after the enter key is pressed. Using Term::ReadLine:Perl this does not occur.
I've read that Term::ReadLine::Gnu has its own internal signal handlers, but frankly I'm at a loss as to how to work with them.
I've reviewed http://search.cpan.org/~hayashi/Term-ReadLine-Gnu-1.20/Gnu.pm#Term::ReadLine::Gnu_Variables tried setting the rl_catch_signals variable to 0, but that didn't help. Ideally, I'd like to work with the Gnu signal handlers, but I'll settle for disabling them too.
To be absolutely specific, I need the TERM handler to trigger after the signal is received instead of waiting for the enter key to be pressed.
Any help or advice is certainly appreciated!
#!/usr/bin/perl
use strict;
use warnings;
use Term::ReadLine;
$SIG{TERM} = sub { print "I got a TERM\n"; exit; };
my $term = Term::ReadLine->new('Term1');
$term->ornaments(0);
my $prompt = 'cmd> ';
while ( defined (my $cmd = $term->readline($prompt)) ) {
$term->addhistory($cmd) if $cmd !~ /\S||\n/;
chomp($cmd);
if ($cmd =~ /^help$/) {
print "Help Menu\n";
}
else {
print "Nothing\n";
}
}
This is due to perl's default paranoid handling of signals - behind the scenes, perl blocks SIGTERM before starting the readline call and restores it when it's finished. See Deferred Signals in perlipc for the details.
Term::ReadLine::Perl uses perl's IO, which knows about these issues and deals with them, so you don't see this bug with it. Term::ReadLine::Gnu uses the C library, which doesn't, so you do.
You can work around this with one of two methods:
set the environment variable PERL_SIGNALS to unsafe before running the script, as in:
bash$ PERL_SIGNALS=unsafe perl readline-test.pl
Note, BEGIN { $ENV{PERL_SIGNALS} = "unsafe"; } isn't enough, it needs to be set before perl itself starts.
Use POSIX signal functions:
#~ $SIG{TERM} = sub { print "I got a TERM\n"; exit; };
use POSIX;
sigaction SIGTERM, new POSIX::SigAction sub { print "I got a TERM\n"; exit; };
Both the above seem to work in Linux; can't speak for Windows or other unices. Also, both of the above come with risks - see perlipc for the details.
I have the following Perl code and would like it to display exactly as invoking /bin/ls in the terminal would display. For example on a terminal sized to 100 columns, it would print up to 100 characters worth of output before inserting a newline. Instead this code prints 1 file per line of output. I feel like it involves assigning some terminal settings to the IO::Pty instance, but I've tried variations of that without luck.
UPDATE: I replaced the <$READER> with a call to sysread hoping the original code might just have a buffering issue, but the output received from sysread is still one file per line.
UPDATE: I added code showing my attempt at changing the IO::Pty's size via the clone_winsize_from method. This didn't result in the output being any different.
UPDATE: As best I can tell (from reading IPC::open3 code for version 1.12) it seems you cannot pass a variable of type IO::Handle without open3 creating a pipe rather than dup'ing the filehandle. This means isatty doesn't return a true value when ls invokes it and ls then forces itself into "one file per line" mode.
I think I just need to do a fork/exec and handle the I/O redirection myself.
#!/usr/bin/env perl
use IPC::Open3;
use IO::Pty;
use strict;
my $READER = IO::Pty->new();
$READER->slave->clone_winsize_from(\*STDIN);
my $pid = open3(undef, $READER, undef, "/bin/ls");
while(my $line = <$READER>)
{
print $line;
}
waitpid($pid, 0) or die "Error waiting for pid: $!\n";
$READER->close();
I think $READER is getting overwritten with a pipe created by open3, which can be avoided by changing
my $READER = ...;
my $pid = open3(undef, $READER, undef, "/bin/ls");
to
local *READER = ...;
my $pid = open3(undef, '>&READER', undef, "/bin/ls");
See the docs.
You can pass the -C option to ls to force it to use columnar output (without getting IO::Pty involved).
The IO::Pty docs describe a clone_winsize_from(\*FH) method. You might try cloning your actual pty's dimensions.
I see that you're setting up the pty only as stdout of the child process. You might need to set it up also as its stdin — when the child process sends the "query terminal size" escape sequence to its stdout, it would need to receive the response on its stdin.
I am a newb to Perl. I am writing some scripts and want to define my own print called myprint() which will print the stuff passed to it based on some flags (verbose/debug flag)
open(FD, "> /tmp/abc.txt") or die "Cannot create abc.txt file";
print FD "---Production Data---\n";
myprint "Hello - This is only a comment - debug data";
Can someone please help me with some sample code to for myprint() function?
Do you care more about writing your own logging system, or do you want to know how to put logging statements in appropriate parts of your program which you can turn off (and, incur little performance penalty when they are turned off)?
If you want a logging system that is easy to start using, but also offers a world of features which you can incrementally discover and use, Log::Log4perl is a good option. It has an easy mode, which allows you to specify the desired logging level, and emits only those logging messages that are above the desired level.
#!/usr/bin/env perl
use strict; use warnings;
use File::Temp qw(tempfile);
use Log::Log4perl qw(:easy);
Log::Log4perl->easy_init({level => $INFO});
my ($fh, $filename) = tempfile;
print $fh "---Production Data---\n";
WARN 'Wrote something somewhere somehow';
The snippet also shows a better way of opening a temporary file using File::Temp.
As for overriding the built-in print … It really isn't a good idea to fiddle with built-ins except in very specific circumstances. perldoc perlsub has a section on Overriding Built-in Functions. The accepted answer to this question lists the Perl built-ins that cannot be overridden. print is one of those.
But, then, one really does not need to override a built-in to write a logging system.
So, if an already-written logging system does not do it for you, you really seem to be asking "how do I write a function that prints stuff conditionally depending on the value of a flag?"
Here is one way:
#!/usr/bin/env perl
package My::Logger;
{
use strict; use warnings;
use Sub::Exporter -setup => {
exports => [
DEBUG => sub {
return sub {} unless $ENV{MYDEBUG};
return sub { print 'DEBUG: ' => #_ };
},
]
};
}
package main;
use strict; use warnings;
# You'd replace this with use My::Logger qw(DEBUG) if you put My::Logger
# in My/Logger.pm somewhere in your #INC
BEGIN {
My::Logger->import('DEBUG');
}
sub nicefunc {
print "Hello World!\n";
DEBUG("Isn't this a nice function?\n");
return;
}
nicefunc();
Sample usage:
$ ./yy.pl
Hello World!
$ MYDEBUG=1 ./yy.pl
Hello World!
DEBUG: Isn't this a nice function?
I wasn't going to answer this because Sinan already has the answer I'd recommend, but tonight I also happened to be working on the "Filehandle References" chapter to the upcoming Intermediate Perl. That are a couple of relevant paragraphs which I'll just copy directly without adapting them to your question:
IO::Null and IO::Interactive
Sometimes we don't want to send our output anywhere, but we are forced
to send it somewhere. In that case, we can use IO::Null to create
a filehandle that simply discards anything that we give it. It looks
and acts just like a filehandle, but does nothing:
use IO::Null;
my $null_fh = IO::Null->new;
some_printing_thing( $null_fh, #args );
Other times, we want output in some cases but not in others. If we are
logged in and running our program in our terminal, we probably want to
see lots of output. However, if we schedule the job through cron, we
probably don't care so much about the output as long as it does the job.
The IO::Interactive module is smart enough to tell the difference:
use IO::Interactive;
print { is_interactive } 'Bamboo car frame';
The is_interactive subroutine returns a filehandle. Since the
call to the subroutine is not a simple scalar variable, we surround
it with braces to tell Perl that it's the filehandle.
Now that you know about "do nothing" filehandles, you can replace some
ugly code that everyone tends to write. In some cases you want output
and in some cases you don't, so many people use a post-expression
conditional to turn off a statement in some cases:
print STDOUT "Hey, the radio's not working!" if $Debug;
Instead of that, you can assign different values to $debug_fh based
on whatever condition you want, then leave off the ugly if $Debug
at the end of every print:
use IO::Null;
my $debug_fh = $Debug ? *STDOUT : IO::Null->new;
$debug_fh->print( "Hey, the radio's not working!" );
The magic behind IO::Null might give a warning about "print() on
unopened filehandle GLOB" with the indirect object notation (e.g.
print $debug_fh) even though it works just fine. We don't get that
warning with the direct form.
Here's a scenario. You have a large amount of legacy scripts, all using a common library. Said scripts use the 'print' statement for diagnostic output. No changes are allowed to the scripts - they range far and wide, have their approvals, and have long since left the fruitful valleys of oversight and control.
Now a new need has arrived: logging must now be added to the library. This must be done automatically and transparently, without users of the standard library needing to change their scripts. Common library methods can simply have logging calls added to them; that's the easy part. The hard part lies in the fact that diagnostic output from these scripts were always displayed using the 'print' statement. This diagnostic output must be stored, but just as importantly, processed.
As an example of this processing, the library should only record the printed lines that contain the words 'warning', 'error', 'notice', or 'attention'. The below Extremely Trivial and Contrived Example Code (tm) would record some of said output:
sub CheckPrintOutput
{
my #output = #_; # args passed to print eventually find their way here.
foreach my $value (#output) {
Log->log($value) if $value =~ /warning|error|notice|attention/i;
}
}
(I'd like to avoid such issues as 'what should actually be logged', 'print shouldn't be used for diagnostics', 'perl sucks', or 'this example has the flaws x y and z'...this is greatly simplified for brevity and clarity. )
The basic problem comes down to capturing and processing data passed to print (or any perl builtin, along those lines of reasoning). Is it possible? Is there any way to do it cleanly? Are there any logging modules that have hooks to let you do it? Or is it something that should be avoided like the plague, and I should give up on ever capturing and processing the printed output?
Additional: This must run cross-platform - windows and *nix alike. The process of running the scripts must remain the same, as must the output from the script.
Additional additional: An interesting suggestion made in the comments of codelogic's answer:
You can subclass http://perldoc.perl.org/IO/Handle.html and create your
own file handle which will do the logging work. – Kamil Kisiel
This might do it, with two caveats:
1) I'd need a way to export this functionality to anyone who uses the common library. It would have to apply automatically to STDOUT and probably STDERR too.
2) the IO::Handle documentation says that you can't subclass it, and my attempts so far have been fruitless. Is there anything special needed to make sublclassing IO::Handle work? The standard 'use base 'IO::Handle' and then overriding the new/print methods seem to do nothing.
Final edit: Looks like IO::Handle is a dead end, but Tie::Handle may do it. Thanks for all the suggestions; they're all really good. I'm going to give the Tie::Handle route a try. If it causes problems I'll be back!
Addendum: Note that after working with this a bit, I found that Tie::Handle will work, if you don't do anything tricky. If you use any of the features of IO::Handle with your tied STDOUT or STDERR, it's basically a crapshoot to get them working reliably - I could not find a way to get the autoflush method of IO::Handle to work on my tied handle. If I enabled autoflush before I tied the handle it would work. If that works for you, the Tie::Handle route may be acceptable.
There are a number of built-ins that you can override (see perlsub). However, print is one of the built-ins that doesn't work this way. The difficulties of overriding print are detailed at this perlmonk's thread.
However, you can
Create a package
Tie a handle
Select this handle.
Now, a couple of people have given the basic framework, but it works out kind of like this:
package IO::Override;
use base qw<Tie::Handle>;
use Symbol qw<geniosym>;
sub TIEHANDLE { return bless geniosym, __PACKAGE__ }
sub PRINT {
shift;
# You can do pretty much anything you want here.
# And it's printing to what was STDOUT at the start.
#
print $OLD_STDOUT join( '', 'NOTICE: ', #_ );
}
tie *PRINTOUT, 'IO::Override';
our $OLD_STDOUT = select( *PRINTOUT );
You can override printf in the same manner:
sub PRINTF {
shift;
# You can do pretty much anything you want here.
# And it's printing to what was STDOUT at the start.
#
my $format = shift;
print $OLD_STDOUT join( '', 'NOTICE: ', sprintf( $format, #_ ));
}
See Tie::Handle for what all you can override of STDOUT's behavior.
You can use Perl's select to redirect STDOUT.
open my $fh, ">log.txt";
print "test1\n";
my $current_fh = select $fh;
print "test2\n";
select $current_fh;
print "test3\n";
The file handle could be anything, even a pipe to another process that post processes your log messages.
PerlIO::tee in the PerlIO::Util module seems to allows you to 'tee' the output of a file handle to multiple destinations (e.g. log processor and STDOUT).
Lots of choices. Use select() to change the filehandle that print defaults to. Or tie STDOUT. Or reopen it. Or apply an IO layer to it.
This isn't the answer to your issue but you should be able to adopt the logic for your own use. If not, maybe someone else will find it useful.
Catching malformed headers before they happen...
package PsychicSTDOUT;
use strict;
my $c = 0;
my $malformed_header = 0;
open(TRUE_STDOUT, '>', '/dev/stdout');
tie *STDOUT, __PACKAGE__, (*STDOUT);
sub TIEHANDLE {
my $class = shift;
my $handles = [#_];
bless $handles, $class;
return $handles;
}
sub PRINT {
my $class = shift;
if (!$c++ && #_[0] !~ /^content-type/i) {
my (undef, $file, $line) = caller;
print STDERR "Missing content-type in $file at line $line!!\n";
$malformed_header = 1;
}
return 0 if ($malformed_header);
return print TRUE_STDOUT #_;
}
1;
usage:
use PsychicSTDOUT;
print "content-type: text/html\n\n"; #try commenting out this line
print "<html>\n";
print "</html>\n";
You could run the script from a wrapper script that captures the original script's stdout and writes the output somewhere sensible.