How can I get user input without waiting for enter in Perl? - perl

I am trying to make an interactive shell script in Perl.
The only user input I can find is the following:
$name = <STDIN>;
print STDOUT "Hello $name\n";
But in this the user must always press enter for the changes to take effect.
How can I get the program to proceed immediately after a button has been pressed?

From perlfaq8's answer to How do I read just one key without waiting for a return key?
:
Controlling input buffering is a remarkably system-dependent matter. On many systems, you can just use the stty command as shown in getc in perlfunc, but as you see, that's already getting you into portability snags.
open(TTY, "+</dev/tty") or die "no tty: $!";
system "stty cbreak </dev/tty >/dev/tty 2>&1";
$key = getc(TTY); # perhaps this works
# OR ELSE
sysread(TTY, $key, 1); # probably this does
system "stty -cbreak </dev/tty >/dev/tty 2>&1";
The Term::ReadKey module from CPAN offers an easy-to-use interface that should be more efficient than shelling out to stty for each key. It even includes limited support for Windows.
use Term::ReadKey;
ReadMode('cbreak');
$key = ReadKey(0);
ReadMode('normal');
However, using the code requires that you have a working C compiler and can use it to build and install a CPAN module. Here's a solution using the standard POSIX module, which is already on your system (assuming your system supports POSIX).
use HotKey;
$key = readkey();
And here's the HotKey module, which hides the somewhat mystifying calls to manipulate the POSIX termios structures.
# HotKey.pm
package HotKey;
#ISA = qw(Exporter);
#EXPORT = qw(cbreak cooked readkey);
use strict;
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); # ok, so i don't want echo either
$term->setcc(VTIME, 1);
$term->setattr($fd_stdin, TCSANOW);
}
sub cooked {
$term->setlflag($oterm);
$term->setcc(VTIME, 0);
$term->setattr($fd_stdin, TCSANOW);
}
sub readkey {
my $key = '';
cbreak();
sysread(STDIN, $key, 1);
cooked();
return $key;
}
END { cooked() }
1;

You can use the Term::ReadKey module to check for a keypress.

Related

Manipulating a Word doc with PERL and Win32::OLE works on command line, but not from a BuildForge Step

I have functioning PERL scripts which are used to update Word documents.
The PERL scripts are coded to work with MS Office 2003 or 2007.
The machine I'm trying to do the updates via BF on has Office 2003 on, the appropriate template is installed, the Macro Security settings have been updated.
When I run the exact command I want BF to use on the command line, it works as expected.
When I run it via a BF step I get "*** Unable to open doc at \servername\projectname\bin\updateVer.pl line 94" (the line number is the croak in the Perl script).
The script looks like this up to the croak:
# enable Sanity checking and make the variable names meaningful
use strict;
use warnings;
use English;
use Win32::OLE;
# Gain access to MS Word 'wd' constants
use Win32::OLE::Const ('Microsoft Word');
use FindBin qw($RealDir);
use lib ($RealDir, "$RealDir/..", "$RealDir/../lib");
# include the common and log utilities
use SCCM::Common;
use SCCM::Logs;
# use command line inputs
use Getopt::Long qw(:config auto_abbrev permute ignore_case pass_through);
# set up logs and process logfile options
logOptions(qw(-log now));
my $bookmark_update_result = "";
my $update_ref_result = "";
# Get input from user
my $path;
my $bookmarkName;
my $bookmarkValue;
my $Word;
my $newWord = 0;
GetOptions("path=s" => \$path,
"bookmarkName=s" => \$bookmarkName,
"bookmarkValue=s" => \$bookmarkValue);
unless ( defined($path) )
{ croakf "%[Fail] Path and filename of SVD are required\n"; }
unless ( defined($bookmarkName) && defined($bookmarkValue) )
{ croakf "%[Fail] bookmarkName and bookmarkValue parameters are both required.\n"; }
# Start Word in a safer way, checking to see if user has it open first.
eval
{
$Word = Win32::OLE->GetActiveObject('Word.Application');
if (! $Word)
{
$newWord = 1;
$Word = Win32::OLE->new('Word.Application', 'Quit');
}
};
croakf "%[Fail] -- unable to start Word Engine: $#\n", Win32::OLE->LastError() if ($# || ! $Word);
my $dispAlerts = $Word->{'DisplayAlerts'};
$Word->{'DisplayAlerts'} = wdAlertsNone;
if ($newWord)
{
$Word->{'Visible'} = 0;
}
my $doc = $Word->Documents->Open($path) or
croakf ("%[Fail] Unable to open doc ", Win32::OLE->LastError() );
The script is being called like this:
ccperl \servername\projectname\bin\updateVer.pl -path "C:\BuildForgeBuilds\BFProjectName\BFProjectName_0177\MyDocument.doc" -bookmarkName REV_Baseline -bookmarkValue My_Baseline_10.20.30
Can I get some direction to convince BF that it's OK to open my work doc?
Thank you!
Turns out after I removed the 'Archive' bit from the template on the machine the job was running on, BF was able to successfully run its job.
Funny I could run it directly on the server with the 'Archive' bit set on the template. But hey, I'm no longer stuck on this one.
Thanks to anybody who read my question and even considered what might have been the problem.

How to read the properties file from perl script

I have written a perl script where I will be connecting to database, for which I'm using this statement
my $dbh = DBI->connect(
"DBI:mysql:database=test;host=localhost;mysql_socket=/var/run/mysqld/mysqld.sock",
"root", "password", {'RaiseError' => 1});
As I don't want any information to be hardcoded, I want to use properties file where I can list the above details (e.g., database, host, mysql_socket) and read the details of properties file from the script. How can I write the properties file and read the details from perl script?
There are a lot of CPAN modules that helps you to achieve this task.
I like Config::Simple, for example:
#!/usr/bin/perl
use strict;
use warnings;
use Config::Simple;
...
my $cfg = new Config::Simple('myapp.ini');
my $user = $cfg->param('database.user');
my $connection_str = $cfg->param('database.connection');
#...
and the file myapp.ini:
[database]
connection="DBI:mysql:database=test;host=localhost;mysql_socket=/var/run/mysqld/mysqld.sock"
user=root
;...
You can install the module from the terminal/command prompt using:
cpan install Config::Simple
or
yum install perl-Config-Simple
I had issues using perl-Config-Simple and decided to use Config::Properties instead. If you are experiencing the same, then you can try the following.
Make sure you have the Config::Properties installed. The following are several examples of how to install from command line, depending on the OS you are using, you'll want to use the appropriate choice:
cpan Config::Properties
cpan install Config::Properties
yum install perl-Config-Properties
The code:
#!/usr/bin/perl
use strict;
use warnings;
use Config::Properties;
open my $cfh, '<', './foo.properties' or die "unable to open property file";
my $properties = Config::Properties->new();
$properties->load($cfh);
my $dbName = $properties->getProperty('database.name');
my $dbUser = $properties->getProperty('database.user');
The property file:
database.name=somedb
database.user=someuser
Once you have the values in the variables, put them into your connection string and you should be good to go.
var temp;
if($ENV eq "Prod"){
#Prod Configurations
temp = "Prod";
}
else{
# Stage and Test Confgurations
temp = "Stage";
}
My brick and mortar solution, exports one value from a properties file:
#!/usr/bin/perl
use strict;
use warnings;
my $line;
foreach $line (<STDIN>) {
chomp($line);
if(my $match = $line =~ /^(.*)=(.*)$/){
my $key = $1;
my $value = $2;
if ($ARGV[0] eq $key) {
print "$value\n";
exit 0;
}
}
}
Usage: perl script.pl mykey < file.properties

Windows running processes list perl

I’m looking for the most standard way to get a list of running processes (and services) on a Windows machine. It’s important not to use « modern » stuff because I’ll deploy that program on old servers.
Any idea?
As skp mentioned, the tasklist command can do it (tested on Windows XP).
Here is a small script that creates a hash of processes by PID:
use warnings;
use strict;
my #procs = `tasklist`;
#Find position of PID based on the ===== ====== line in the header
my $pid_pos;
if ($procs[2] =~ /^=+/)
{
$pid_pos = $+[0]+1;
}
else
{
die "Unexpected format!";
}
my %pids;
for (#procs[3 .. $#procs])
{
#Get process name and strip whitespace
my $name = substr $_,0,$pid_pos;
$name =~s/^\s+|\s+$//g;
#Get PID
if (substr($_,$pid_pos) =~ /^\s*(\d+)/)
{
$pids{$1} = $name;
}
}
use Data::Dumper;
print Dumper %pids;
Another approach that might be useful is Win32::Process::List. It gets the process list using core Windows C functions. It appears to work with old versions of Perl.

Controlling arguments in perl with Getopt::Long

I am trying to use Getopt::Long add command line arguments to my script (seen below). The problem I am running into is related to multiple commands that do different things. For example I have an option flag that sets the configuration file to use with the script the option is -c [config_path] and I also have -h for help.
The problem I am running into is I need to have a condition that states whether or not the config option has been used AND a config file has been specified. I tried counting the options in #ARGV but found if -h and -c are specifed it causes the script to move on the to the subroutine load_config anyway. Because as seen in the code below when 2 arguments are found in #ARGV it fires the subroutine.
In what way could I fix this? At least in my head specifying -h and -c at the same time sorta contradicts each other. Is there a way to make it so only "informational commands" like help cannot be executed with "operational commands" like -c? Heck is there a way where I get a list of the commands that have been passed? I tried printing the contents of #ARGV but nothing was in it even though I had specified command arguments.
#!/usr/bin/perl
use strict;
use warnings;
use Getopt::Long;
use Term::ANSIColor;
use XML::Simple;
use Net::Ping;
use Net::OpenSSH;
use Data::Dumper;
# Create a new hash to copy XML::Simple configuration file data into
my %config_file;
# Clear the screen and diplay version information
system ("clear");
print "Solignis's Backup script v0.8 for ESX\\ESX(i) 4.0+\n";
print "Type -h or --help for options\n\n";
# Create a new XML::Simple object
my $xml_obj = XML::Simple->new();
# Create a new Net::Ping object
my $ping_obj = Net::Ping->new();
my $config_file;
my $argcnt = $#ARGV + 1;
GetOptions('h|help' => \&help,
'c|config=s' => \$config_file
);
if ($argcnt == 0) {
print "You must supply a config to be used\n";
} elsif ($argcnt == 2) {
if (! -e $config_file) {
print color 'red';
print "Configuration file not found!\n";
print color 'reset';
print "\n";
die "Script Halted\n";
} else {
load_config();
}
}
sub load_config {
print color 'green';
print "$config_file loaded\n";
print color 'reset';
my $xml_file = $xml_obj->XMLin("$config_file",
SuppressEmpty => 1);
foreach my $key (keys %$xml_file) {
$config_file{$key} = $xml_file->{$key};
}
print Dumper (\%config_file);
}
sub help {
print "Usage: backup.pl -c [config file]\n";
}
#ARGV is altered by GetOptions, that is why it seems empty. Rather than counting arguments, just directly check if $config_file is defined.
BTW, IMO there is no need to try to exclude -c from being used with -h. Normally a "help" just prints the help text and exits without taking any other action, check that first and it shouldn't matter whether -c is supplied or not.
Something like
my $help;
my $config_file;
GetOptions('h|help' => \$help,
'c|config=s' => \$config_file
);
if ( defined $help ) {
help();
} elsif ( defined $config_file ) {
...;
} else {
die "No arguments!";
}
You might also want to check out Getopt::Euclid which presents some expanded ways to provide options and a cool way of using the programs documentation as the spec for the command-line arguments.
You can always set a default value for the options eg my $help = 0; my $config_file = ""; and then test for those values.

Calling a function in Perl with different properties

I have written a Perl script that would start a SNMP session and extracting the data/counters and it's value to a csv file. There are 7 perl scripts; different properties/definition/variables on the top.. but the engine is the same.
At this point, those 7 perl scripts are redundant except for the defined variables. Is there a way to keep the execution perl script as a properties/execution file and keep the engine in a another file? This properties/execution perl script will call the engine (using the properties defined in it's own script).
So in short, I want to use the variables in their own script (as an execution as well), but calls a specific function from a unified "engine".
i.e.
retrieve_mibs1.pl retrieve_mibs2.pl
retrieve_mibs3.pl
retrieve_mibs4.pl
retrieve_mibs5.pl
retrieve_mibs6.pl
retrieve_mibs7.pl
retrieve_mibs1.pl
#!/usr/local/bin/perl
use Net::SNMP;
##DEFINITION START
my #Servers = (
'server1',
'server2',
);
my $PORT = 161;
my $COMMUNITY = 'secret';
my $BASEOID = '1.2.3.4.5.6.7.8';
my $COUNTERS = [
[11,'TotalIncomingFromPPH'],
[12,'TotalFailedIncomingFromPPH'],
];
##ENGINE START
sub main {
my $stamp = gmtime();
my #oids = ();
foreach my $counter (#$COUNTERS) {
push #oids,("$BASEOID.$$counter[0].0");
}
foreach my $server (#Servers) {
print "$stamp$SEPARATOR$server";
my ($session,$error) = Net::SNMP->session(-version => 1,-hostname => $server,-port => $PORT,-community => $COMMUNITY);
if ($session) {
my $result = $session->get_request(-varbindlist => \#oids);
if (defined $result) {
foreach my $oid (#oids) {
print $SEPARATOR,$result->{$oid};
}
} else {
print STDERR "$stamp Request error: ",$session->error,"\n";
print "$SEPARATOR-1" x scalar(#oids);
}
} else {
print STDERR "$stamp Session error: $error\n";
print "$SEPARATOR-1" x scalar(#oids);
}
print "\n";
}
}
main();
You could do it using eval: set up the variables in one file, then open the engine and eval it's content.
variables.pl (set up your variables and call the engine):
use warnings;
use strict;
use Carp;
use English '-no_match_vars';
require "engine.pl"; # so that we can call it's subs
# DEFINITION START
our $VAR1 = "Hello";
our $VAR2 = "World";
# CALL THE ENGINE
print "START ENGINE:\n";
engine(); # call engine
print "DONE\n";
engine.pl (the actual working stuff):
sub engine{
print "INSIDE ENGINE\n";
print "Var1: $VAR1\n";
print "Var2: $VAR2\n";
}
1; # return a true value
Other alternatives would be:
pass the definitions as command line parameters directly to engine.pl and evaluate the contents of #ARGV
write a perl module containing the engine and use this module
store the parameters in a config file and read it in from your engine (e.g. using Config::IniFiles)
Two thoughts come to mind immediately:
Build a Perl module for your common code, and then require or use the module as your needs dictate. (The difference is mostly whether you want to run LynxLee::run_servers() or run_servers() -- do you want the module to influence your current scope or not.)
Use symbolic links: create these symlinks: retrieve_mibs1.pl -> retrieve_mibs.pl retrieve_mibs2.pl -> retrieve_mibs.pl, and so on, then set the variables based on the program name:
#!/usr/bin/perl -w
use File::Basename;
my $name = basename($0);
my #Servers, $PORT, $COMMUNITY, $BASEOID, $COUNTERS;
if($name ~= /retrieve_mibs1\.pl/) {
#Servers = (
'server1',
'server2',
);
# ...
} elsif ($name ~= /retrieve_mibs2\.pl/) {
#Servers = (
'server3',
'server4',
);
# ...
}
Indexing into a hash with the name of the program to retrieve the parameters would be much cleaner, but I'm not so good at Perl references. :)
I'm not sure what the problem is so I'm guessing a little. You have code in various places that is the same each time save for some variables. This is the very definition of a subroutine.
Maybe the problem is that you don't know how to include the common code in those various scripts. This is fairly easy: You write that code in a perl module. This is basically a file ending in pm instead of pl. Of course you have to take care of a bunch of things such as exporting your functions. Perldoc should be of great help.