I'm using the following perl code on windows environment:
use Time::HiRes qw(usleep);
#(some code here)
$self->{GLOBAL_OBJ}->xsleep($delay) if($delay);
sub xsleep {
my $seconds = shift;
#print "will sleep:$seconds seconds\n";
$seconds = $seconds * 1000000;
usleep($seconds);
#print "slept:$seconds micro seconds\n";
return 0;
}
When I call xsleep like that (from another module) the system is stuck and I can only stop it by ctrl+c, however when I call it from the current module it works fine.
Can anyone tell me why this is and how can I fix it?
Thanks
xsleep is being called as a method, which means the invocant (the result of the left side of ->) is passed as the first argument. This is currently ending up in $seconds. References numify to their address, so you get an extremely large numbers in $seconds. For example,
$ perl -e'CORE::say(0+{})'
9304720
Either adjust xsleep so it can be called as a method,
$self->{GLOBAL_OBJ}->xsleep($delay) if $delay;
sub xsleep {
my $self = shift;
my $seconds = shift;
...
}
or call xsleep as a sub
The::Package::xsleep($delay) if $delay;
sub xsleep {
my $seconds = shift;
...
}
Related
I'm trying to write a trait to threadsafe a sub automagically. This is what I've got:
#| A trait to ensure that a sub is not run on multiple threads simultaneously.
multi sub trait_mod:<is> (Sub \code, :$protected!) {
# If :!protected, do nothing.
if $protected {
# Create a new lock outside the multithreaded area
my $lock = Lock.new;
# Wrap the sub with a routine that hides callsame in a lock
code.wrap: sub (|) {
$lock.protect: {callsame}
}
}
}
#| Should print "Start X and finish X" if properly protected
sub needs-protection($x) is protected {
print "Start $x and ";
sleep 1;
say "finish $x";
}
# Test it out.
# If not protected, completes in 1 second with malformed output
(1..4).hyper(:1batch, :4degree) {
needs-protection $_
}
However, AFAICT, it seems that the callsame isn't doing anything (it returns Nil but that's it). My guess is that it's somehow attempting to call a different candidate for .protect, but I don't see a way to ensure that the callsame is linked to the wrapped sub, rather than some other method.
I was able to get it to work by doing
multi sub trait_mod:<is> (Sub \code, :$protected!) {
if $protected {
my $lock = Lock.new;
code.wrap: sub (|c) {
if CALLERS::<$*PROTECTED> {
$*PROTECTED = False;
return callsame;
}
$lock.protect: {
my $*PROTECTED = True;
code.CALL-ME(|c);
}
}
}
}
But that feels cludgy and I'm probably missing something that allows a True value for $*PROTECTED to slip out when things aren't safe. Is there a way to make a direct callsame while inside of a protect-ed block?
Deferral routines like callsame look for the nearest dynamically scoped dispatch to resume. A block {callsame} passed to the method protect will be called by the protect method, and the nearest dispatch in dynamic scope will be the method dispatch to protect. Therefore, it will attempt to defer to a protect method in a base class of Lock. There aren't any, thus the Nil result.
To solve this, we need to obtain the wrapped target in the correct dynamic scope, and make it available lexically. This can be achieved using nextcallee:
#| A trait to ensure that a sub is not run on multiple threads simultaneously.
multi sub trait_mod:<is> (Sub \code, :$protected!) {
# If :!protected, do nothing.
if $protected {
# Create a new lock outside the multithreaded area
my $lock = Lock.new;
# Wrap the sub with a routine that hides callsame in a lock
code.wrap: sub (|c) {
my &target = nextcallee;
$lock.protect: { target(|c) }
}
}
}
#| Should print "Start X and finish X" if properly protected
sub needs-protection($x) is protected {
print "Start $x and ";
sleep 1;
say "finish $x";
}
# Test it out.
# If not protected, completes in 1 second with malformed output
for (1..4).hyper(:1batch, :4degree) {
needs-protection $_
}
This gives the output that I expect you are expecting.
I am not being able to read the contents of the file tutc.txt. I want to write a subroutine to read the contents of a file which will be called from the perl script.
My module is named Module.pm
package Module;
use warnings;
use strict;
use Carp;
use feature "switch";
no warnings 'experimental::smartmatch';
# Constructor and initialisation
sub new { #class method
my $class = shift; #shift without arguments is shift #_ , takes 1st element of argument array
my $self = {#_}; #created a Hash reference with #_ helping to store values in a hash
bless ($self, $class); #turning self into an object by telling which class it belongs to without hardcode name in
$self->{_created} = 1; #syntax for accessing the contemts of a hash: refrence $object_name->{property_name}.
return $self;
}
#reading from config file
sub read {
my ($self, $file) = shift;
my $self = #_;
open my $config_fh, $file or return 0;
$self->{_filename} = $file; # Store a special property containing the name of the file
my $section;
my $config_name;
my $config_val;
while (my $line = <$config_fh>)
{
chomp $line;
given ($line) {
when (/^\[(.*)\]/)
{
$section = $1;
}
when (/^(?<key>[^=]+)=(?<value>.*)/)
{
$section //= '';
$self->{"$section.$config_name"} = $config_val;
}
}
}
close $config_fh;
return $self;
}
sub fetch {
my ($self, $key) = shift;
return $self->{$key};
}
My perl file looks like the following:
#!/usr/bin/perl
use Module;
use strict;
use warnings;
my $value = Module->new();
$value->read('/Users/hhansraj/git/edgegrid-curl/tutc.txt') or die "Couldn't read config file: $!";
print "The author's first name is ",$value->fetch('author.firstname'),"\n";
My text file looks like the following:
[author]
firstname=Doug
lastname=Sheppard
[site]
name=Perl.com
url=http://www.perl.com/
In your "read" subroutine, it looks like the first two lines of code (listed below) may be the source of your problem.
my ($self, $file) = shift;
my $self = #_;
In the first line, you're removing the first element of the #_ array (arguments to the subroutine) and putting that into the $self variable. And nothing is being entered into the $file variable. In the second line, you are redeclaring the $self variable and are assigning to it the size of what's left of the #_ array. I suspect that you're code is assigning the value/data to the $self variable that you are wanting.
Since the $file variable is not getting assigned any value, that is probably creating an issue with the open function. Also, you did not specify the file mode in your attempt to open the file. To just fix the missing mode specification to specify read only mode, you can change the following line:
open my $config_fh, $file or return 0;
to be
open (my $config_fh, "<", $file) or return 0;
Is there something like nodemon, that monitors file changes and restarts a perl script?
My perl script is just a while loop.
I tried to google for it, but results are either about mod_perl or irrelevant.
Any ideas?
I'm using Mac OS
I don't know of a tool like nodemon for Perl, unless there's one for generically restarting any program when it changes. Here's one I knocked together.
#!/usr/bin/env perl
use strict;
use warnings;
use v5.10;
use File::Monitor;
use Child qw(child);
sub start_program {
my $program = shift;
return child {
exec $^X, $program, #ARGV;
};
}
sub restart_program {
my($program, $child) = #_;
$child->kill("TERM");
return start_program($program);
}
sub monitor_program {
my $program = shift;
my $monitor = File::Monitor->new;
my $child = start_program($program);
say "PID: ".$child->pid;
$monitor->watch($program, sub {
$child = restart_program($program, $child);
});
while(1) {
sleep 1;
$monitor->scan;
}
}
monitor_program(shift);
This could be made more efficient by replacing File::Monitor with something hooking into the OS X filesystem event service.
Please see below function fnWaitCheckFinalStatus if Else part is executed in below code then value return by Function fnWaitCheckFinalStatus is coming blank because function this is called recursively fnWaitCheckFinalStatus.
Is there way to get return value of fnWaitCheckFinalStatus After exit function function should exit all its state.
How can I make it possible , any pointers on this.
Function fnWaitCheckFinalStatus(objStatusBar)
Dim blnRetValue : blnRetValue = True
Dim i : i=0
If objStatusBar.Exist Then
strValue=ObjStatusBar.GetROProperty("text")
Do
wait 10
strValue=ObjStatusBar.GetROProperty("text")
Loop While strValue = "Task Started"
End If
strValue1=ObjStatusBar.GetROProperty("text")
If strValue1="Task executed successfully" Then
blnRetValue1=True
fnWaitCheckFinalStatus = blnRetValue1
Exit Function
ElseIf strValue1="Task execution failed" Then
blnRetValue1=False
fnWaitCheckFinalStatus = blnRetValue1
Exit Function
Else
Call fnWaitCheckFinalStatus(objStatusBar)
End If
End Function
Consider "pass-through"ing the function result if you return from the recursion, like in this code (note the line with the !!! comment):
Function fnWaitCheckFinalStatus(objStatusBar)
Dim i : i=0
If objStatusBar.Exist Then
strValue=ObjStatusBar.GetROProperty("text")
Do
wait 10
strValue=ObjStatusBar.GetROProperty("text")
Loop While strValue = "Task Started"
End If
strValue1=ObjStatusBar.GetROProperty("text")
If strValue1="Task executed successfully" Then
fnWaitCheckFinalStatus = true
ElseIf strValue1="Task execution failed" Then
fnWaitCheckFinalStatus = false
Else
fnWaitCheckFinalStatus=fnWaitCheckFinalStatus(objStatusBar) ' !!!
End If
End Function
Also, I eliminated the result buffer variable. You don´t need it, so you can scratch it.
Also, I'd avoid exit function in this case to keep the code simpler (one entry point, one exit point), so I eliminated that, too.
Generally speaking, there is no obvious reason for using recursion here since you pass exactly the same argument as you receive, so the recursive call will do exactly the same as its caller scope. Use a loop instead.
I want to do the following -
#starting code
sleep(1000);
#remaining code
The starting code would run and get stuck at 'sleep'. After some time (<<1000), some other process would wake up this process by breaking this sleep(probably by sending a signal) and the rest of the program would run.
I have to use perl 5.6.1 on Windows, and it doesn't support alarm. I tried some signals like SIGINT, SIGFPE etc. but failed. Please suggest some alternative.
Are you using a signal handler? If not, SIGINT and its ilk will terminate your program.
my $parent_pid = $$;
# schedule interruption
if (fork() == 0) {
sleep 5;
kill 'INT', $parent_pid;
exit;
}
# trivial signal handler so SIGINT doesn't terminate the program
$SIG{INT} = sub { };
my $n = sleep 1_000_000;
print "Slept for $n seconds.\n";
On Linux, perl 5.6.2, this gives the output:
Slept for 5 seconds
For that matter, I don't know why you say alarm isn't supported on Perl 5.6 (unless you're on Windows maybe?) Again, set a signal handler or your program will terminate.
$SIG{ALRM} = sub {};
alarm 5;
$n = sleep 1_000_000;
print "slept for $n seconds\n";
works fine on my Perl 5.6.2.
Well, if I wanted to emulate
$SIG{ALRM} = \&handle_alarm;
alarm(5);
...
sleep(10);
I'd start with
use Time::HiRes qw( time sleep ); # Optional
my $alarm = time + 5;
...
my $timeout = $alarm - time;
if ($timeout <= 0) {
handle_alarm();
} else {
my $to_sleep = 10;
$to_sleep = $timeout if $timeout < $to_sleep;
sleep($to_sleep);
}