I would need to automate some keyboard entries inside my perl script. For this, I use Win32::GuiTest module.
This works fine for all entries I need except for shift-end.
Here's what I send
Win32::GuiTest::SendKeys("+{END}");
but it seems that it only takes the {END}.
The weird thing is that
Win32::GuiTest::SendKeys("+(some text)");
works fine and sends SOME TEXT
In fact, I am unable to do +{} commands, it always take only the key inside the {}
On the other hand, commands with ^ (ctrl) or % (alt) work fine for example Win32::GuiTest::SendKeys("%{F4}") closes the window
does anybody would know why?
Thanks :)
Late answer, anyway, maybe it is of help to somebody...
Shift{foo} commands like Shift{End} need to be performed with low-level keybd_event via the SendRawKey wrapper. So this is what you are looking for:
SendRawKey(VK_LSHIFT, KEYEVENTF_EXTENDEDKEY);
SendKeys('{END}');
SendRawKey(VK_RSHIFT, KEYEVENTF_KEYUP);
SendRawKey(VK_LSHIFT, KEYEVENTF_KEYUP);
Full sample (copies a complete line into the clipboard):
use warnings;
use strict;
use Win32::Clipboard;
use Win32::GuiTest qw (:ALL); # Win32-GuiTest-1.63 used
print "place cursor now...\n"; sleep(5); print get_line();
sub get_line {
Win32::Clipboard()->Empty();
SendKeys('{HOME}');
SendRawKey(VK_LSHIFT, KEYEVENTF_EXTENDEDKEY);
SendKeys('{END}');
SendRawKey(VK_RSHIFT, KEYEVENTF_KEYUP);
SendRawKey(VK_LSHIFT, KEYEVENTF_KEYUP);
SendKeys('^c');
return Win32::Clipboard()->GetText();
}
Related
I’m trying to run this script to check genotyped data for imputation with HRC or 1000G using an imputation server, it can be found here. It is perl-based. It has these packages/libraries it is (trying) to load.
use strict;
use warnings;
use File::Basename;
use Getopt::Long;
use IO::Uncompress::Gunzip qw(gunzip $GunzipError);
use Term::ReadKey qw/ GetTerminalSize /;
However, it throws an error Unable to get Terminal Size. The TIOCGWINSZ ioctl didn't work. The COLUMNS and LINES environment variables didn't work. The resize program didn't work. at /usr/lib64/perl5/vendor_perl/Term/ReadKey.pm line 362.
How do I solve this?
Ah. So the question is sort of solved. It turns out the script in particular is expecting to be run in a terminal, which stays open. That is to say: it is not expecting to be run in a submission-system, which is what I was doing. In fact, I need to run it in a submission-system, because the computer cluster doesn't allow for big data to be run in a terminal, and because the data is just to big to keep waiting for the program to finish. Submitting it to a compute node with more power makes more sense.
The developer of the script, the HRC or 1000G Imputation preparation and checking tool, has kindly provided a non-terminal-requiring script. He will put it online, and/or provide it via email.
solved
I've been learning about filehandles in Perl, and I was curious to see if there's a way to alter the source code of a program as it's running. For example, I created a script named "dynamic.pl" which contained the following:
use strict;
use warnings;
open(my $append, ">>", "dynamic.pl");
print $append "print \"It works!!\\n\";\n";
This program adds the line
print "It works!!\n";
to the end of it's own source file, and I hoped that once that line was added, it would then execute and output "It works!!"
Well, it does correctly append the line to the source file, but it doesn't execute it then and there.
So I assume therefore that when perl executes a program that it loads it to memory and runs it from there, but my question is, is there a way to access this loaded version of the program so you can have a program that can alter itself as you run it?
The missing piece you need is eval EXPR. This compiles, "evaluates", any string as code.
my $string = q[print "Hello, world!";];
eval $string;
This string can come from any source, including a filehandle.
It also doesn't have to be a single statement. If you want to modify how a program runs, you can replace its subroutines.
use strict;
use warnings;
use v5.10;
sub speak { return "Woof!"; }
say speak();
eval q[sub speak { return "Meow!"; }];
say speak();
You'll get a Subroutine speak redefined warning from that. It can be supressed with no warnings "redefine".
{
# The block is so this "no warnings" only affects
# the eval and not the entire program.
no warnings "redefine";
eval q[sub speak { return "Shazoo!"; }];
}
say speak();
Obviously this is a major security hole. There is many, many, many things to consider here, too long for an answer, and I strongly recommend you not do this and find a better solution to whatever problem you're trying to solve this way.
One way to mitigate the potential for damage is to use the Safe module. This is like eval but limits what built in functions are available. It is by no means a panacea for the security issues.
With a warning about all kinds of issues, you can reload modules.
There are packages for that, for example, Module::Reload. Then you can write code that you intend to change in a module, change the source at runtime, and have it reloaded.
By hand you would delete that from %INC and then require, like
# ... change source code in the module ...
delete $INC{'ModuleWithCodeThatChages.pm'};
require ModuleWithCodeThatChanges;
The only reason I can think of for doing this is experimentation and play. Otherwise, there are all kinds of concerns with doing something like this, and whatever your goal may be there are other ways to accomplish it.
Note The question does specify a filehandle. However, I don't see that to be really related to what I see to be the heart of the question, of modifying code at runtime.
The source file isn't used after it's been compiled.
You could just eval it.
use strict;
use warnings;
my $code = <<'__EOS__'
print "It works!!\n";
__EOS__
open(my $append_fh, ">>", "dynamic.pl")
or die($!);
print($append_fh $code);
eval("$code; 1")
or die($#);
There's almost definitely a better way to achieve your end goal here. BUT, you could recursively make exec() or system() calls -- latter if you need a return value. Be sure to setup some condition or the dominoes will keep falling. Again, you should rethink this, unless it's just practice of some sort, or maybe I don't get it!
Each call should execute the latest state of the file; also be sure to close the file before each call.
i.e.,
exec("dynamic.pl"); or
my retval;
retval = system("perl dynamic.pl");
Don't use eval ever.
I need to read program output using Net::SSH2. My problem is some of that data hided under the bottom of program output. In ssh-mode I need to enter "Return" on my keyboard to look up next. This is awkward for using in a perl-script =).
I know that Net::OpenSSH does it well, but I really need to use Net::SSH2. Does anybody know, how can I get it?
Thnx!
UPD: Some code below
my $ch = $ssh2->channel();
$ch->blocking(0);
$ch->shell();
print $ch "dir\n";
print $_ while <$ch>;
In this code I print output of command with "--More--" prompt of the terminal at the bottom.
Simple Net::OpenSSH "capture" method returns a whole data at the same time:
my #dirlist = $ssh->capture('dir');
Is it possible to do same thing using Net::SSH2?
I can setup a telnet connection in Perl no problems, and have just discovered Curses, and am wondering if I can use the two together to scrape the output from the telnet session.
I can view on a row, column basis the contents of STDOUT using the simple script below:
use Curses;
my $win = new Curses;
$win->addstr(10, 10, 'foo');
$win->refresh;
my $thischar=$win->inch(10,10);
print "Char $thischar\n";
And using the below I can open a telnet connection and send \ receive commands with no problem:
use net::telnet;
my $telnet = new Net::Telnet (Timeout => 9999,);
$telnet->open($ipaddress) or die "telnet open failed\n";
$telnet->login($user,$pass);
my $output = $telnet->cmd("command string");
... But what I would really like to do is get the telnet response (which will include terminal control characters) and then search on a row \ column basis using curses. Does anyone know of a way I can connect the two together? It seems to me that curses can only operate on STDOUT
Curses does the opposite. It is a C library for optimising screen updates from a program writing to a terminal, originally designed to be used over a slow serial connection. It has no ability to scrape a layout from a sequence of control characters.
A better bet would be a terminal emulator that has an API with the ability to do this type of screen scraping. Off the top of my head I'm not sure if any Open-source terminal emulators do this, but there are certainly commercial ones available that can.
If you are interacting purely with plain-text commands and responses, you can use Expect to script that, otherwise, you can use Term::VT102, which lets you screen scrape (read specific parts of the screen, send text, handle events on scrolling, cursor movement, screen content changes, and others) applications using VT102 escape sequences for screen control (e.g., an application using the curses library).
You probably want something like Expect
use strict;
use warnings;
use Expect;
my $exp = Expect->spawn("telnet google.com 80");
$exp->expect(15, #timeout
[
qr/^Escape character.*$/,
sub {
$exp->send("GET / HTTP/1.0\n\n");
exp_continue;
}
]
);
You're looking for Term::VT102, which emulates a VT102 terminal (converting the terminal control characters back into a virtual screen state). There's an example showing how to use it with Net::Telnet in VT102/examples/telnet-usage.pl (the examples directory is inside the VT102 directory for some reason).
It's been about 7 years since I used this (the system I was automating switched to a web-based interface), but it used to work.
Or you could use the script command for this.
From the Solaris man-page:
DESCRIPTION
The script utility makes a record of everything printed
on your screen. The record is written to filename. If no file name
is given, the record is saved in the file typescript...
The script command forks and creates a
sub-shell, according to the value of
$SHELL, and records the text from this
session. The script ends when the
forked shell exits or when
Control-d is typed.
I would vote also for the Expect answer. I had to do something similar from a gui'ish application. The trick (albeit tedious) to get around the control characters was to strip all the misc characters from the returned strings. It kind of depends on how messy the screen scrape ends up being.
Here is my function from that script as an example:
# Trim out the curses crap
sub trim {
my #out = #_;
for (#out) {
s/\x1b7//g;
s/\x1b8//g;
s/\x1b//g; # remove escapes
s/\W\w\W//g;
s/\[\d\d\;\d\dH//g; #
s/\[\?25h//g;
s/\[\?25l//g;
s/\[\dm//g;
s/qq//g;
s/Recall//g;
s/\357//g;
s/[^0-9:a-zA-Z-\s,\"]/ /g;
s/\s+/ /g; # Extra spaces
}
return wantarray ? #out : $out[0];
}
I've tried searching CPAN. I found Mac::iTunes, but not a way to assign a rating to a particular track.
If you're not excited by Mac::AppleScript, which just takes a big blob of AppleScript text and runs it, you might prefer Mac::AppleScript::Glue, which provides a more object-oriented interface. Here's the equivalent to Iamamac's sample code:
#!/usr/bin/env perl
use Modern::Perl;
use Mac::AppleScript::Glue;
use Data::Dumper;
my $itunes = Mac::AppleScript::Glue::Application->new('iTunes');
# might crash if iTunes isn't playing anything yet
my $track = $itunes->current_track;
# for expository purposes, let's see what we're dealing with
say Dumper \$itunes, \$track;
say $track->rating; # initially undef
$track->set(rating => 100);
say $track->rating; # should print 100
All that module does is build a big blob of AppleScript, run it, and then break it all apart into another AppleScript expression that it can use on your next command. You can see that in the _ref value of the track object when you run the above script. Because al it's doing is pasting and parsing AppleScript, this module won't be any faster than any other AppleScript-based approach, but it does allow you to intersperse other Perl commands within your script, and it keeps your code looking a little more like Perl, for what that's worth.
You can write AppleScript to fully control iTunes, and there is a Perl binding Mac::AppleScript.
EDIT Code Sample:
use Mac::AppleScript qw(RunAppleScript);
RunAppleScript(qq(tell application "iTunes" \n set rating of current track to $r \n end tell));
Have a look at itunes-perl, it seems to be able to rate tracks.