Is there a way to suppress warnings & error messages in PDF::Reuse?
(I don't need the warnings...if this part of the script fails for any particular pdf then its ok.)
I've tried the following but it doesn't seem to work:
eval {
local $SIG{ALRM} = sub {die "alarm\n"};
alarm 10;
{
local $SIG{__WARN__}=sub{};
use PDF::Reuse;
prFile( $copyPdf );
prDoc( $file ) ;
prEnd() or next;
}
alarm 0;
};
if ($#) {
die unless $# eq "alarm\n";
print "timed out\n";
}
What warnings are you seeing?
I tried the above script with a PDF I had lying around and got no errors or warnings. perl 5.8.8, PDF::Reuse 0.35.
Is the problem that one of your PDFs is badly formed?
Related
I'm writing Perl for the first time and Internet tells me i can use alarm if i have a long running sql query.
I need to run a SP which will run for hours in a Perl, and i would like to set a time limit.
Below is the last step of my codes but i'm getting segmentation fault when the process runs longer that my timeout, in this occasion sleep(20). Logs shows it finished printing ---1---- and then segmentation fault.
How can I fix this?
I tried taking sub DelRef{} out into a seperate .pl and comment the $db part in the third line to test if alarm is working fine, and it worked all right. I'm confused which part went wrong and caused the segmentation fault.
sub DelRef {
print "starting defRefData\n";
$db = new Sybapi($user, $password, $server, $margin_database);
print "entering eval\n";
my $timeout = 10;
eval {
local $SIG{ALRM} = sub { die "timeout\n" };
print "inside eval now\n";
alarm($timeout);
print "---1----\n";
#sleep(5); --working fine
sleep(20); #not working,
#$db->exec_sql("exec CPN_Margins..clean_up_refData_db '$XrefCode'");
print "----2----\n";
alarm(0);
};
#alarm(0);
print "out of eval\n";
if($#)
{
#die unless $# eq "timeout\n";
if($# =~ "timeout\n")
{
warn "Timed out!\n";
#exit 0;
}
else{
print $#;
}
}
}
&DelRef();
print "process is done\n";
$db->close();
From perldoc (https://perldoc.perl.org/functions/alarm.html)-
It is usually a mistake to intermix alarm and sleep calls, because
sleep may be internally implemented on your system with alarm.
If you want to implement timeout, it can be achieved without sleep. Just follow the example mentioned in the link.
EDIT:
I have added it here -How to set timeout for a long running Sybase sp in Perl
I'm having a really weird problem with this perl script. The basic point is that sometimes a file write/append doesn't happen. On a run of the program, either all of the writes will happen or none of them will. Here is the subroutine, with some comments:
sub process_svs {
my $F;
open($F, '<', $_[0]);
if($log_dups==1) {
open($dfh, '>>',"./duplicates.txt");
}
while (my $line = <$F>) {
chomp $line;
if($line =~ /somepattern/) {
if (! -e "somefile") {
copy("source","dest") or warn ("couldn't copy");
} elsif($log_dups==1) {
system("touch ./duplicates.txt"); # ghetto workaround
print $dfh "./".$_[0]."_files/".$1.",v already exists\n" or die("Couldn't write duplicate"); # problem line
}
}
}
close $F;
}
The print statements to stdout always work, but if I remove the touch ./duplicates.txt crap, nothing is written to duplicates.txt.
The other "weird" thing, is that earlier in the program, I create a directory with perl mkdir, and if the directory exists when the program is run, I don't need the workaround, the duplicates.txt writing works just fine. If I delete the directory, and let the program mkdir it, it doesn't work. Seems relevant, but I can't figure out how since the directory and the text file are not in the same location, or related in any way, that I can think of.
Additionally, I have run it through the debugger, and can see the write call being executed, but inspecting duplicates.txt immediately after the write shows nothing written.
Any possible reasons for this would be greatly appreciated.
If you want to see a modified, but more complete, version of the script, it is here:
use strict;
use warnings;
use File::Copy;
my $svs = $ARGV[0];
my $rhis_str = system("rhis $svs > ./tmp_history");
my $fh;
my $dfh;
my #versions;
my $all_revs = 0;
my $current_rev = "";
my $log_dups = 0;
sub process_svs {
my $F;
open($F, '<', $_[0]);
if($log_dups==1) {
open($dfh, '>>',"./duplicates.txt");
}
while (my $line = <$F>) {
chomp $line;
if($line =~ /something/) {
if (! -e "something") {
copy("source","dest") or warn ("couldn't copy ");
} elsif($log_dups==1) {
system("touch ./duplicates.txt"); # ghetto workaround
print $dfh "something already exists\n" or die("Couldn't write duplicate");
}
}
}
close $F;
}
for(my $i = 0; $i <= scalar #ARGV; $i++) {
my $arg = $ARGV[$i];
if($arg eq "-a") {
$all_revs = 1;
} elsif($arg eq "-r") {
$all_revs = 0;
$current_rev = $ARGV[$i+1];
} elsif($arg eq "--log-dups") {
$log_dups = 1;
}
}
open($fh, '<','./tmp_history') or die(">>> Failed to open ./tmp_history");;
mkdir "./".$svs."_files";
if($all_revs == 1) {
print ">>> Processing all revisions of ".$svs;
if($log_dups==1) {
print" (and logging duplicates)\n";
}
while(my $line = <$fh>) {
chomp $line;
if ($line =~ /something/) {
push #versions, $1;
}
}
}
system("some_cmd &>/dev/null");
process_svs($svs);
}
You're not checking to see if your files opened. This is a very, very basic mistake and you should fix this immediately. Either add or die $! after each open or, better yet, use autodie and it will take care of catching all IO exceptions for you and give you good, consistent error messages.
Most importantly, this will tell you why it failed to open. $! tells you why it failed. You don't have that in your check on print.
print $dfh "./".$_[0]."_files/".$1.",v already exists\n" or die("Couldn't write duplicate"); # problem line
You're checking if print failed, but you're not including $!. Either add $! like die "Couldn't write to duplicate: $!" or use autodie, remove the or die clause, and let autodie take care of it. I recommend the second.
I suspect you'll find that something else is deleting duplicates.txt between the open and the print.
The second thing that grabs my attention is here.
if($log_dups==1) {
open($dfh, '>>',"./duplicates.txt");
}
You're using a global variable $log_dups to decide whether or not to open the file for writing (and not checking if it succeeded). This should be a variable that gets passed into the function, it's just good programming practice. Later you decide whether to print to $dfh based on that global variable.
if (! -e "something") {
copy("source","dest") or warn ("couldn't copy ");
} elsif($log_dups==1) {
system("touch ./duplicates.txt"); # ghetto workaround
print $dfh "something already exists\n" or die("Couldn't write duplicate");
}
Because $log_dups is global it's possible something else is changing $log_dups between deciding to open duplicates.txt and writing to it. To avoid all these problems, and to make the code simpler, $log_dups should be an argument passed into the function.
Furthermore, the filehandle $dfh is inexplicably a global. Same problem, something else could be closing it. It will also not be automatically closed at the end of the function which might leave writes to duplicates.txt buffered until the program exits. $dfh should be a lexical.
Other problems...
my $rhis_str = system("rhis $svs > ./tmp_history");
$rhis_str will contain the exit status of the rhis program. I don't think that's what you want. You don't use this variable anyway.
There's no need to pass ./file to open, it's safe and easier to read to use just pass file. That it's in the current working directory is implied.
If you fix these basic problems and still have trouble, then edit your question with the revised code and we can look again.
I'm writing a wrapper to an external command ("sox", if this can help) with Perl "Tk".
I need to run it asynchronously, of course, to avoid blocking tk's MainLoop().
But, I need to read it's output to notify user about command's progress.
I am testing a solution like this one, using IPC::Open3:
{
$| = 1;
$pid = open3(gensym, ">&STDERR", \*FH, $cmd) or error("Errore running command \"$cmd\"");
}
while (defined($ch = FH->getc)) {
notifyUser($ch) if ($ch =~ /$re/);
}
waitpid $pid, 0;
$retval = $? >> 8;
POSIX::close($_) for 3 .. 1024; # close all open handles (arbitrary upper bound)
But of course the while loop blocks MainLoop until $cmd does terminate.
Is there some way to read output handle asynchronously?
Or should I go with standard fork stuff?
The solution should work under win32, too.
For non-blocking read of a filehandle, take a look at Tk::fileevent.
Here's an example script how one can use a pipe, a forked process, and fileevent together:
use strict;
use IO::Pipe;
use Tk;
my $pipe = IO::Pipe->new;
if (!fork) { # Child XXX check for failed forks missing
$pipe->writer;
$pipe->autoflush(1);
for (1..10) {
print $pipe "something $_\n";
select undef, undef, undef, 0.2;
}
exit;
}
$pipe->reader;
my $mw = tkinit;
my $text;
$mw->Label(-textvariable => \$text)->pack;
$mw->Button(-text => "Button", -command => sub { warn "Still working!" })->pack;
$mw->fileevent($pipe, 'readable', sub {
if ($pipe->eof) {
warn "EOF reached, closing pipe...";
$mw->fileevent($pipe, 'readable', '');
return;
}
warn "pipe is readable...\n";
chomp(my $line = <$pipe>);
$text = $line;
});
MainLoop;
Forking may or may not work under Windows. Also one needs to be cautious when forking within Tk; you must make sure that only one of the two processes is doing X11/GUI stuff, otherwise bad things will happen (X11 errors, crashes...). A good approach is to fork before creating the Tk MainWindow.
I am using Module::Pluggable to load modules from a given directory:
for my $module ( plugins() ) {
eval "use $module";
if ($#) {
my $error = (split(/\n/, $#))[0];
push #rplugin_errors, $error;
print STDOUT "Failed to load $module: $error\n";
} else {
print STDOUT "Loaded: $module\n";
my $mod = $module->new();
my $module_name = $mod->{name};
$classes{$module_name} = $mod;
}
}
This function can be called via a reload method elsewhere. But if a one of the modules I am trying to "use" throws an errors it's not loaded and the script is somewhat crippled.
I'd like to validate each module in plugins() before executing use. So Ideally I could do something like:
$error = 0;
for my $module ( plugins() ) {
eval TEST $module;
if ($#) {
print STDERR "$module failed. Will not continue";
$error = 1;
last;
}
}
if ($error == 0) {
for my $module ( plugins() ) {
use $module;
}
}
Change
eval TEST $module;
back to
eval "use $module";
Well, importing probably doesn't make sense here (or in your original code), so the following would be better:
eval "require $module";
I think you're overcomplicating this. Your code already includes a clause to test for errors in the use and report on them if any occur. (if ($#)... print STDOUT "Failed to load $module: $error\n";) According to your comment on ikegami's answer, your goal is that "If one fails, we halt and send a message stating the reload could not take place because of a module error." (Yes, I know you said your goal is to validate the modules before loading them. It isn't. Your goal is to halt if there's an error; you've just decided that pre-validation is the way to accomplish that. This is what we call an X-Y Problem.)
You're already detecting and reporting any errors that occur... You want to halt on error... So, when you detect an error, halt after reporting it.
if ($#) {
my $error = (split(/\n/, $#))[0];
push #rplugin_errors, $error;
die "Failed to load $module: $error\n";
} else {
I need to know how to customize my own errors in Perl. For instance, here's some code:
my $filename = 'filaname1.exe';
print "Copying $filename";
copy("$dir_root\\$filename", "$spcl_dir\\$filename");
if ($? == "0") {
print " - Success!\n";
}
else { print " - Failure!\n"; }
I tried to write this and "catch" the error and print "Failure" when I don't get an exit code of 0, and print "Success" when I do. I need to know how I can customize this; I don't really want to use die or anything like that where it will give a somewhat cryptic error (to the end user).
Thanks!
You need to read the documentation on $? in perlvar. This value is:
The status returned by the last pipe
close, backtick ("``") command,
successful call to wait() or
waitpid(), or from the system()
operator.
Your call to copy (presumably from File::Copy) doesn't far into any of those categories, so $? isn't set.
However, if you read the documentation for File::Copy, you'll see that its function all "return 1 on success, 0 on failure". So you can simplify your code a lot.
#!/usr/bin/perl
use strict; use warnings;
use File::Copy;
if (copy('notthere', 'somewhere else')) {
warn "success\n";
} else {
warn "failure: $!\n";
}
Note that I've used "warn" rather than "print" so that the errors go to STDERR. Note, also, the use of $! to display the operating system error. This can, of course, be omitted if it's not user-friendly enough.
Are you using File::Copy? You must be using something, because copy() isn't a perl keyword or built-in function.
The documentation of File::Copy doesn't refer to $? at all, so that's probably your mistake. You want to check the return value, and only if it's zero, refer to $!.
use strict;
use File::Copy qw(copy);
my ($from, $to) = #ARGV;
my $res = copy ($from, $to);
if( $res ){
print "Okay\n";
}
else{
print "Not Okay: $!\n";
}