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.
Related
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;
...
}
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;
The following piece of code is supposed to read a few, undetermined in number, lines from a socket.
use warnings;
use strict;
use IO::Socket::INET;
my $server = shift;
my $port = shift;
my $sock = new IO::Socket::INET (
PeerAddr => $server,
PeerPort => $port,
Proto => 'tcp',
Timeout => 1,
Blocking => 0
)
or die "Could not connect";
while (my $in = <$sock>) {
print "$in";
}
print "Received last line\n";
Unfortunately, the $in = <$sock> part is blocking although I have set Blocking => 0 and the server does not send any more text. Hence, Received last line won't be printed.
So, I tried to improve the behavior with use IO::Select:
use warnings;
use strict;
use IO::Socket::INET;
use IO::Select;
my $server = shift;
my $port = shift;
my $sock = new IO::Socket::INET (
PeerAddr => $server,
PeerPort => $port,
Proto => 'tcp',
Timeout => 1,
Blocking => 1
)
or die "Could not connect";
my $select = new IO::Select;
$select -> add($sock);
sleep 1;
while ($select -> can_read) {
my $in = <$sock>;
print $in;
}
This second approach only prints the first sent line, then seems to block for ever.
Since I have seen such examples working, I believe the problem is Windows, on which I am trying to run these scripts.
Is there a way how I can achieve a non blocking read?
When using select (used by can_read), it defies the purpose to follow up with blocking IO. You must also avoid buffering IO because the system (i.e. select) doesn't know about any data in your library's buffers. This means you can't mix select with read, readline (aka <> and <$fh>) and eof. You must use sysread.
my %clients;
for my $fh ($select->can_read()) {
my $client = $clients{$fh} //= {};
our $buf; local *buf = $client->{buf} //= ''; # alias my $buf = $client->{buf};
my $rv = sysread($sock, $buf, 64*1024, length($buf));
if (!defined($rv)) {
my $error = $!;
$select->remove($fh);
delete($clients{$fh});
# ... Handle error ...
next;
}
if (!$rv) {
$select->remove($fh);
delete($clients{$fh});
# ... Handle EOF ... # Don't forget to check if there's anything in $buf.
next;
}
... remove any complete messages from $buf and handle them ...
}
If you want to read a line at a time, you'd use
while ($buf =~ s/^([^\n]*)\n//) {
process_msg($client, $1);
}
I want to be able to set a system environment variable in Perl and I wrote the following script (inspired from this idea) to accomplish this:
use Win32;
use Win32::API;
use Win32::OLE qw( in );
my $machine = ".";
my $WMIServices = Win32::OLE->GetObject ( "winmgmts:{impersonationLevel=impersonate,(security)}//$machine/root/cimv2" ) || die;
my $objVariable = $WMIServices->Get("Win32_Environment")->SpawnInstance_;
$objVariable->{Name}="NewOSType";
$objVariable->{UserName} = "<System>";
$objVariable->{VariableValue} = "LAMBDA";
$objVariable->Put_;
However, I am not an expert in Perl and I would like to know what the experts think about this code. Is this the best way to accomplish this?
Another possible approach:
use strict;
use warnings;
use Win32::TieRegistry qw[:KEY_];
use Win32::API;
use constant HWND_BROADCAST => -1;
use constant WM_SETTINGCHANGE => 0x1a;
my $hklm_env = Win32::TieRegistry->new(
'HKEY_LOCAL_MACHINE/SYSTEM/CurrentControlSet/Control/Session Manager/Environment',
{ Access => KEY_READ() | KEY_WRITE(), Delimiter => '/' }
); # returns undef if SYSTEM ENV not writable
my $hkcu_env = Win32::TieRegistry->new(
'HKEY_CURRENT_USER/Environment',
{ Access => KEY_READ() | KEY_WRITE(), Delimiter => '/' }
);
# if SYSTEM ENV not writable try USER ENV
my $e = defined($hklm_env) ? $hklm_env : $hkcu_env;
if(defined $e) {
$e->SetValue('Variable', 'Value');
}
else {
warn "Cannot open neither SYSTEM ENV nor USER ENV registry for Read+Write";
}
my $SendMessage = new Win32::API("user32", "SendMessage", 'NNNP', 'N') or die "Couldn't create SendMessage: $!\n";
my $RetVal = $SendMessage->Call(HWND_BROADCAST,WM_SETTINGCHANGE,0,'Environment');
Using Perl, how do I capture a single character from STDIN without needing the user to hit enter (similar to C's getch() function)?
Perl has a getc() function, but according to the perlfunc:
However, it cannot be used by itself to fetch
single characters without waiting for
the user to hit enter.
The perlfunc docs do provides a way to read a single character using getc() but it requires manipulating the terminal settings using stty. The script I'm writing needs to work on Windows (without cygwin, msys, etc.) - so that's not an option.
From perlfaq5's answer to How can I read a single character from a file? From the keyboard?
You can use the builtin getc() function for most filehandles, but it won't (easily) work on a terminal device. For STDIN, either use the Term::ReadKey module from CPAN or use the sample code in getc in perlfunc.
If your system supports the portable operating system programming interface (POSIX), you can use the following code, which you'll note turns off echo processing as well.
#!/usr/bin/perl -w
use strict;
$| = 1;
for (1..4) {
my $got;
print "gimme: ";
$got = getone();
print "--> $got\n";
}
exit;
BEGIN {
use POSIX qw(:termios_h);
my ($term, $oterm, $echo, $noecho, $fd_stdin);
$fd_stdin = fileno(STDIN);
$term = POSIX::Termios->new();
$term->getattr($fd_stdin);
$oterm = $term->getlflag();
$echo = ECHO | ECHOK | ICANON;
$noecho = $oterm & ~$echo;
sub cbreak {
$term->setlflag($noecho);
$term->setcc(VTIME, 1);
$term->setattr($fd_stdin, TCSANOW);
}
sub cooked {
$term->setlflag($oterm);
$term->setcc(VTIME, 0);
$term->setattr($fd_stdin, TCSANOW);
}
sub getone {
my $key = '';
cbreak();
sysread(STDIN, $key, 1);
cooked();
return $key;
}
}
END { cooked() }
The Term::ReadKey module from CPAN may be easier to use. Recent versions include also support for non-portable systems as well.
use Term::ReadKey;
open(TTY, "</dev/tty");
print "Gimme a char: ";
ReadMode "raw";
$key = ReadKey 0, *TTY;
ReadMode "normal";
printf "\nYou said %s, char number %03d\n",
$key, ord $key;
You want this module: Term::ReadKey.