STDOUT from Pidgin plugin script - perl

Yesterday, I wrote a perl plugin script for Pidgin 2.10.9, running on Windows 7, and using Strawberry Perl 5.10.1.5
Basically, on the receipt of an IM, it uses backticks to call a console application (written in .NET) and returns the console output to the sender as an IM.
I had to reboot this morning, but ever since I rebooted, it has stopped working.
So, I changed the backticks to use "capture". That didn't work either, but it at least gave me this error:
(15:00:33) Plugin: Error: Error in IPC::System::Simple plumbing: "Can't dup STDOUT" - "Bad file descriptor" at (eval 12) line 53
I have no idea what's changed from yesterday to today, and wondered if anybody knew what might be causing the error?
Thanks
Edit: Thought I'd add my code
use Purple;
#use IPC::System::Simple qw(system systemx capture capturex);
use IPC::System::Simple qw(capture capturex);
%PLUGIN_INFO = (
perl_api_version => 2,
name => "PlugIn",
version => "0.1",
summary => "AutoResp",
description => "PlugIn",
author => "Mark Watkin",
url => "http://",
load => "plugin_load",
unload => "plugin_unload"
);
sub plugin_init {
return %PLUGIN_INFO;
}
sub plugin_load {
my $plugin = shift;
Purple::Debug::info("PlugIn", "plugin_load()\n");
$data = "";
$conversation_handle = Purple::Conversations::get_handle();
Purple::Signal::connect($conversation_handle, "received-im-msg", $plugin, \&signal_chat_callback, $data);
}
sub plugin_unload {
my $plugin = shift;
Purple::Debug::info("PlugIn", "plugin_unload()\n");
}
sub signal_chat_callback {
# The signal data and the user data come in as arguments
my ($account, $sender, $message, $conv, $flags) = #_;
Purple::Debug::info("PlugIn", "Account Alias \"" . $account->get_alias() . "\"\n");
if( $account->get_alias() eq "PlugIn" )
{
Purple::Debug::info("PlugIn", "Request: \"" . $message . "\"\n");
if(!$conv)
{
Purple::Debug::info("PlugIn", "No conversation\n");
$conv = Purple::Conversation->new(1, $account, $sender);
}
$im = $conv->get_im_data();
$im->send( "One moment please..." );
my $query = "";
# eval {
# $query = capture("\"D:\\SourceCode\\PlugInNET\\bin\\Debug\\PlugInNET.exe\" \"" . $message . "\"");
# #$query = capture("\"D:\\SourceCode\\PlugInNET\\bin\\Debug\\PlugInNET.exe\"", "\"" . $message . "\"");
# #my $query = capture("D:\\SourceCode\\PlugInNET\\bin\\Debug\\PlugInNET.exe");
# #my $query = `\"D:\\SourceCode\\PlugInNET\\bin\\Debug\\PlugInNET.exe\" \"$message\"`;
# #my $query = `dir /b`;
# };
# if( $# )
# {
# Purple::Debug::info("PlugIn", "Error: " . $# . "\n");
# }
Purple::Debug::info("PlugIn", "Query: " . $query . "\n");
open ( my $fh, "-|", "D:\\SourceCode\\PlugInNET\\bin\\Debug\\PlugInNET.exe \"$message\"" ) or die "Cannot run free, $ERRNO";
while (<$fh>)
{
Purple::Debug::info("PlugIn", "Read: Line " . $_ . "\n");
$query = $query . $_ . "\n";
}
close $fh;
Purple::Debug::info("PlugIn", "Query: " . $query . "\n");
if( $query eq "" )
{
$im->send( "I'm sorry, my brain doesn't seem to be functioning at the moment" );
} else {
#msgs = split(/-----------\n/, $query);
foreach( #msgs )
{
Purple::Debug::info("PlugIn", "Result Msg: \"" . $_ . "\"\n");
$im->send( "<BODY>" . $_ . "</BODY>" );
}
}
}
}
The plan was to fix up the paths once I had it working properly

Please consider using file handles instead of backticks to capture stdout from another source. You'll be able collect errors.
#!/usr/bin/perl
use strict;
use warnings;
use English;
# No taint protection in this example
open ( my $fh, '-|', '/usr/bin/free' ) or die "Cannot run free, $ERRNO";
while (<$fh>)
{
print;
}
close $fh;

Related

Perl Script is giving error uninialized varilable access

Code runs sometimes, sometimes gives error on linux host.
Need to check why has is not printing,
Error, messages: Use of uninitialized value in sprintf at ./fa_list.pl line 139, line
Can someone check, why I'm getting error?
use Getopt::Long;
my $sid = '9999';
my $Fa_VSan_Map = 'Fa_VSan_Map';
sub usage {
my $message = $_[0];
if (defined $message && length $message) {
$message .= "\n"
unless $message =~ /\n$/;
}
my $command = $0;
$command =~ s#^.*/##;
print STDERR (
$message,
"usage: $command -sid xxx -outf FA_Mapping\n" .
"Where -sid: is primary SID to show mappings.\n" .
" -outf: Output File prefix.\n" .
" -Reserved...\n"
);
die("\n")
}
GetOptions( 'sid=i' => \$sid, 'outf=s' => \$Fa_VSan_Map) or
usage("Invalid commmand line options.");
print($sid);
my $outf = "$Fa_VSan_Map$sid.csv";
my $outf1 = "Fa_VSan_Map1$sid.csv";
my ($mydir,$dir_port,$dir_port_wwpn,$FaWWPN);
my (%FA,%FAH,%FAC,%VSAN);
my ($wwpn,$host,$port,$fcid,$logged,$fab);
# 50:00:09:72:08:4b:05:89, => cdc02-core1-1.yyyyy.xxxx.com,CISCO,fc3/12,VS251,50:00:09:72:08:4b:05:89,,8,Active
# cdc02-core-1-2.yyyyy.xxxx.com,CISCO,fc1/29,VS251,50:00:09:73:00:1c:e1:1c,,8,Active
sub LoadVSAN()
{
my $vsanf = "VSAN$sid.csv";
print ($vsanf);
open (VSAN, "<", $vsanf) or die "Could not open $!";
while (<VSAN>) {
if (/Active/) {
my #array = split /,/;
print (#array);
my $key = $array[4];
$key =~ s/://g;
my #line_arranged = ($array[3],$array[2],$array[0],$array[6],$array[7]);
$VSAN{$key} = \#line_arranged;
print($key, ": ", #{$VSAN{$key}}, "\n");
}
}
close VSAN;
}
LoadVSAN;
# foreach my $key (%VSAN) {
# print(${VSAN{$key}}[0]); print("\n");
# ${$VSAN{$FaWwpn}}[0]
# }
open (OUT, ">", $outf) or die "Could not open $outf $!";
open( OUT1, ">",$outf1) or die "Could not open $outf1 $!";
my $sidtxt = "sidcfg.fa$sid.txt";
my $cmd = 'symcfg -sid ' . $sid . ' list -fa all -v > ' . $sidtxt;
system($cmd);
open ( SYM, "<" , $sidtxt ) or die "Could not open $sidtxt $!";
while ( <SYM>) {
chomp ;
if (/Director Identification:/) {
$mydir = $_;
$mydir =~ s/\s+Director Identification: //;
$mydir =~ s/FA-//;
}
elsif (/Director Port:/) {
$port = $_;
$port =~ s/\s+Director Port: //;
$dir_port = sprintf '%04d_%03s_%03d', int($sid), $mydir, int($port);
}
elsif (/WWN Port Name/) {
$wwpn = $_;
$wwpn =~ s/\s+WWN Port Name\s+: //;
$dir_port_wwpn = sprintf '%s,%s', $dir_port, $wwpn;
$FA{$dir_port} = $wwpn;
}
}
close(SYM);
$sidtxt = 'symaccess.ll.' . $sid . '.txt';
$cmd = 'symaccess -sid ' . $sid . ' list logins > ' . $sidtxt;
#print($cmd);
system($cmd );
open ( SYM, "<" , $sidtxt ) or die "Could not open $sidtxt $!";
while ( <SYM>) {
chomp ;
if (/Director Identification/) {
$mydir = $_;
$mydir =~ s/Director Identification\s+:\s+//;
$mydir =~ s/FA-//;
}
elsif (/Director Port/) {
$port = $_;
$port =~ s/Director Port\s+:\s+//;
$dir_port = sprintf '%04d_%03s_%03d', int($sid),$mydir, int($port);
}
elsif (/Fibre/) {
($wwpn,undef, $host,$port,$fcid,$logged,$fab) = split;
my $host_port;
if( lc($host) eq 'null') {
$host_port = substr($wwpn,10,6);
}
else {
$host_port = $host . '_' . $port . '_' . substr($wwpn,12,4);
}
if (exists $FAH{$dir_port}) {
$FAH{$dir_port} .= ':' . $host_port;
$FAC{$dir_port} += 1;
} else {
$FAH{$dir_port} = $host_port;
$FAC{$dir_port} = 1;
}
if ( $logged eq "Yes") {
my $line = sprintf ( '%s,%s,%s,%s', $dir_port, $FA{$dir_port}, $host_port, $fcid);
print (OUT1 $line . "\n");
}
}
}
print OUT "Fa,FaWWPN,VSan,HostCount,PERCENT_BUSY,HostNames\n";
my $PERCENT_BUSY=10.0;
foreach my $fa ( keys %FAC) {
my $formula = '=VLOOKUP(B2,Sheet1!A$2:F$600,6,FALSE)';
my $FaWwpn = lc($FA{$fa});
#print($FaWwpn . ": " . $VSAN{$FaWwpn}->[0] . "\n" );
## Below is line 139
my $line = sprintf ('%s,%s,%s,%s,%3.2f,%s', $fa, $FaWwpn, ${$VSAN{$FaWwpn}}[0], $FAC{$fa}, $PERCENT_BUSY, lc($FAH{$fa}));
print OUT $line . "\n";
#print $line . "\n";
}
close(SYM);
I believe there is problem with lc($FAH{$fa}).
have you checked you initialized $FAH in your code ?

Moving gmail messages with Net::IMAP::Simple

I am trying to use Net::IMAP::Simple to move mail to an old_messages folder after I have read and stripped the attachments from them, but when I do it all of the moved messages are blank and from "unknown sender", and the inbox is unchanged. I've checked around and nobody seems to have had this problem before.
I have also tried this using both Email::Simple and Email::MIME as the $es object passed as an argument in the statement
$imap->put( 'OLD_MESSAGES', $es, "") or warn $imap->errstr
but neither worked.
Here's my code using Email::MIME
use strict;
use warnings;
# required modules
use Net::IMAP::Simple;
use Email::MIME;
use IO::Socket::SSL;
use Email::MIME::Attachment::Stripper;
# fill in your details here
my $username = 'usersite.com';
my $password = 'password';
my $mailhost = 'imap.gmail.com';
# Connect
my $imap = Net::IMAP::Simple->new( $mailhost, port => 993, use_ssl => 1, )
|| die "Unable to connect to IMAP: $Net::IMAP::Simple::errstr\n";
# Log in
if ( !$imap->login( $username, $password ) ) {
print STDERR "Login failed: " . $imap->errstr . "\n";
exit( 64 );
}
# Look in the the INBOX
my $nm = $imap->select( 'INBOX' );
# How many messages are there?
my ( $unseen, $recent, $num_messages ) = $imap->status();
print "unseen: $unseen, recent: $recent, total: $num_messages\n\n";
my $filepath = "C:/Users/doug/Desktop/gmail/";
## Iterate through unseen messages
for ( my $i = 1 ; $i <= $nm ; $i++ ) {
if ( !$imap->seen( $i ) ) {
next;
}
else {
my $es = Email::MIME->new( join '', #{ $imap->get( $i ) } );
#my $es = Email::MIME->new( join '', #{ $imap->top($i) } );
my $text = $es->body;
my $stripper = Email::MIME::Attachment::Stripper->new( $es );
my #attachments = $stripper->attachments;
printf(
"[%03d] %s\n\t%s\n%s",
$i,
$es->header( 'From' ),
$es->header( 'Subject' ), $text
);
my $l = 0;
foreach $_ ( #attachments ) {
my $fh = IO::File->new();
binmode( $fh );
open( $fh, '>', "$filepath" . "$_->{filename}" );
print $fh "$_->{payload}\n";
$fh->close;
}
$imap->put( 'OLD_MESSAGES', $es, "" ) or warn $imap->errstr;
}
}
# Disconnect
$imap->quit;
exit;
I had to strip down my code, but below is the gist of it. Works for me before I cut it out and pasted here, lemme know if it works else i'll edit it
use Mail::IMAPClient;
use Email::MIME::Attachment::Stripper;
use other stuff as needed....
# login
my $sock = IO::Socket::SSL->new(PeerAddr=>'imap.gmail.com',PeerPort=>993);
my $imap = Mail::IMAPClient->new(Socket => $sock, User => $user, Password => $pass, Ignoresizeerrors => 1);
die $imap->LastError() unless $imap->IsAuthenticated();
# decoding mime (you can probably skip)
my $message = $imap->message_string(123);
my $decoded_mime = "";
my #decoded_list = MIME::Words::decode_mimewords($message);
for(my $i=0; $i<scalar(#decoded_list); ++$i) {
my #set = #{$decoded_list[$i]};
if(scalar(#set) == 1) {
$decoded_mime .= $set[0];
}
else {
eval {
Encode::from_to($set[0],$set[1],'utf-8');
};
if($#) { eval {}; }
$decoded_mime .= $set[0];
}
}
$message = $decoded_mime;
# Strip attachments
$mime = Email::MIME::Attachment::Stripper->new($message);
$mime = $mime->message; # convert to regular Email::MIME

Sendmail with time and pause using Perl

I have the following code e works perfectly, however, I want to set a time to send each email.
Example: 100 e-mail is sent, the PAUSE script for 1 hour, and sends back another 100 emails.
This code here it sends direct. I need to make the 2 work, and send emails slowly according to the txt list.
#!/usr/local/bin/perl
## use: perl send.pl list-email.txt "noreply#mail.com" "subject" html.html
$ARGC = #ARGV;
if ( $ARGC != 4 ) {
printf "$0 <mailist> <tes#test.com> <HELLO friend> <html.htm>\n\n";
#printf "Script for sending emails";
exit(1);
}
$mailtype = "content-type: text/html";
$sendmail = '/usr/sbin/sendmail';
$sender = $ARGV[1];
$subject = $ARGV[2];
$efile = $ARGV[0];
$emar = $ARGV[0];
$count = 1;
open( FOO, $ARGV[3] );
#foo = <FOO>;
$corpo = join( "\n", #foo );
open( BANDFIT, "$emar" ) || die "Can't Open $emar";
while (<BANDFIT>) {
( $ID, $options ) = split( /\|/, $_ );
chop($options);
foreach ($ID) {
$recipient = $ID;
open( SENDMAIL, "| $sendmail -t" );
print SENDMAIL "$mailtype\n";
print SENDMAIL "Subject: $subject\n";
print SENDMAIL "From: $sender\n";
print SENDMAIL "To: $recipient\n\n";
print SENDMAIL "$corpo\n\n";
close(SENDMAIL);
printf "Enviado para $recipient [ OK $count ]";
$count++;
}
}
close(BANDFIT);
=============== other code / time pause===============
#!/usr/bin/env perl
sub mostraMensagem() {
while (1) {
sleep(1);
print("Hello World!\n");
$count++;
if ( $count == 5 ) {
print("PAUSE!\n");
$count = 0;
sleep(5);
print("CONTINUE..\n");
mostraMensagem;
}
}
}
mostraMensagem;
I got friends !! but still need you ...
it sends 5 emails and pause for 5 seconds, however, the count does not continue, it returns to zero. what can we do?
the counter back to zero after 5 ..
The new CODE:
#!/usr/local/bin/perl
## use: perl enviar.pl list-mail.txt "my#mail.com" "subject" html.html
$ARGC=#ARGV;
if ($ARGC !=4) {
printf "$0 <mailist> <my#myemail.com> <subject> <msg.htm>\n\n";
#printf "Script sending emails";
exit(1);
}
$mailtype = "content-type: text/html";
$sendmail = '/usr/sbin/sendmail';
$sender = $ARGV[1];
$subject = $ARGV[2];
$efile = $ARGV[0];
$emar = $ARGV[0];
$count=1;
open(FOO, $ARGV[3]);
#foo = <FOO>;
$corpo = join("\n", #foo);
open (BANDFIT, "$emar") || die "Can't Open $emar";
while(<BANDFIT>) {
($ID,
$options) = split(/\|/,$_);
chop($options);
foreach ($ID) {
$recipient = $ID;
## this changes =>>> ###
### send 5 email of list.txt, and pause 5 seconds, continue.. ###
if ( $count == 5 ) {
print("PAUSE!\n");
$count = 0;
sleep(5);
print("CONTINUE..\n");
}
open (SENDMAIL, "| $sendmail -t");
print SENDMAIL "$mailtype\n";
print SENDMAIL "Subject: $subject\n";
print SENDMAIL "From: $sender\n";
print SENDMAIL "To: $recipient\n\n";
print SENDMAIL "$corpo\n\n";
close (SENDMAIL);
printf "sending for $recipient [ Ok Send; $count ]";
$count++;
}
}
close(BANDFIT);
#### end #####
Essentially you would count the amount of emails sent, when you reach the 100 mark, pause for 3600 seconds and then continue.
** UDPATE - Full Code **
Tested (smaller numbers) on RHEL 5
Assuming email-list.txt looks like:
user_1_#company.com
user_2_#company.com
user_99_#company.com
user_100_#company.com
Code:
#!/usr/bin/perl
# =========================
# Assign $ARGV[x] -> var
# =========================
if (#ARGV < 4){ usage() }
my $sendAs = $ARGV[1];
my $subject = $ARGV[2];
my $htmlFile = $ARGV[3];
my $sendList = $ARGV[0];
# =========================
# Get Send List -> var
# =========================
open(LIST, $sendList) || die "Could not open $sendList: $!\n";
my #recipients = <LIST>;
close(LIST);
# =========================
# Iterate / Send Email
# =========================
my $count = 1;
foreach my $recipient (#recipients)
{
chomp($recipient);
if ( $count < 100 )
{
my $cmd = 'cat ' . $htmlFile . ' | /usr/sbin/sendmail -s "$(echo -e "' . $subject . '\nContent-Type: text/html")" ' . $recipient . ' -v -- -F ' . $sendAs;
my $results = `$cmd`;
}
elsif ( $count == 100 )
{
my $cmd = 'cat ' . $htmlFile . ' | /usr/sbin/sendmail -s "$(echo -e "' . $subject . '\nContent-Type: text/html")" ' . $recipient . ' -- -F ' . $sendAs;
my $results = `$cmd`;
sleep(3600);
$count = 0;
}
$count++;
}
# =========================
# Essential Subroutines
# =========================
sub usage()
{
print "\nUsage:\n\t$0 <mailist.txt> <test\#mail.com> <\"Hello friend\"> <test.html>\n\n";
exit;
}
P.S. LEARN PERL

Can not send data to IO::Socket::INET in conditional statement

I have an issue communicating with a external system via IO::Socket::Inet.
I try to login and send multiple commands to the system but unfortunately this does'n work if the command print in line 58 is under conditional statement.
The conditional statements in this case is required to handle response data.
package Net::Cli::Cisco;
use 5.006;
use strict;
use warnings FATAL => qw(all);
use IO::Socket::INET;
use Carp;
use Data::Dumper;
$| = 1;
sub new {
my $class = shift;
my %args = #_;
my $self = bless {
_host => $args{host} || carp('No hostname defined'),
_username => $args{username} || carp('No username defined'),
_password => $args{password} || carp('No password defined'),
_logged_in => 0,
}, $class;
return $self;
}
sub connect {
my $self = shift;
my $host = $self->{_host};
my $port = 23;
my $handle = IO::Socket::INET->new(
Proto => "tcp",
PeerAddr => $host,
PeerPort => $port,
Type => SOCK_STREAM,
Timeout => 3
) or die "can't connect to port $port on $host: $!";
my $shc = "\r\n";
$self->{shc} = $shc;
$self->{handle} = $handle;
}
sub getInterface {
my ($self) = #_;
$self->connect;
my #cmd_list = ( "sh clock", "sh ip int brief" );
$self->send_cmd(#cmd_list);
}
sub send_cmd {
my ( $self, #cmd_list ) = #_;
my $handle = $self->{handle};
my $response;
while ( $response = <$handle> ) {
if ( $response =~ m/^Username:/ ) {
print "Conditional statements exec done!\n";
print $handle $self->{_username} . $self->{shc};
}
#print $handle $self->{_username} . $self->{shc};
print $response;
print $handle $self->{_password} . $self->{shc};
print $handle "enable" . $self->{shc};
print $handle $self->{_password} . $self->{shc};
print $handle "term leng 0" . $self->{shc};
foreach my $cmd (#cmd_list) {
print $handle "$cmd" . $self->{shc};
}
print $handle "exit" . $self->{shc};
}
close($handle);
}
1;
my $x = __PACKAGE__->new(
"host" => "1.1.1.1",
"username" => "user",
"password" => "pw"
);
$x->getInterface;
Well, I can't see why my code is wrong.
Note: If I recommend line 61 everything working fine.
Any ideas?
After comment from ikegami please find working subroutine below:
sub send_cmd {
my ( $self, #cmd_list ) = #_;
my $handle = $self->{handle};
my $response;
START: while ( $response = <$handle> ) {
print $response;
if ( $response =~ m/[^Username:|^Password:|\$%#:>]/ ) {
print $handle $self->{_username} . $self->{shc};
print $handle $self->{_password} . $self->{shc};
print $handle "enable" . $self->{shc};
print $handle $self->{_password} . $self->{shc};
print $handle "term leng 0" . $self->{shc};
foreach my $cmd (#cmd_list) {
print $handle "$cmd" . $self->{shc};
}
print $handle "exit" . $self->{shc};
} else {
goto START;
}
}
close($handle);

How can I capture the complete commandline in Perl?

Suppose the call was
/usr/local/bin/perl verify.pl 1 3 de# > result.log
Inside verify.pl I want to capture the whole call above and append it to a log file for tracking purposes.
How can I capture the whole call as it is?
$0 has the script name and #ARGV has the arguments, so the whole commandline is:
$commandline = $0 . " ". (join " ", #ARGV);
or, more elegantly (thanks FMc):
$commandline = join " ", $0, #ARGV;
I don't however, know how to capture the redirection (> result.log)
There is way (at least on unix-systems) to get whole command line:
my $cmdline = `ps -o args -C perl | grep verify.pl`;
print $cmdline, "\n";
e: Cleaner way using PID (courtesy of Nathan Fellman):
print qx/ps -o args $$/;
$commandline = join " ", $0, #ARGV; does not handle the case that command line has quotes such as ./xxx.pl --love "dad and mom"
A Quick Solution:
my $script_command = $0;
foreach (#ARGV) {
$script_command .= /\s/ ? " \'" . $_ . "\'"
: " " . $_;
}
Try to save the following code as xxx.pl and run ./xxx.pl --love "dad and mom":
#!/usr/bin/env perl -w
use strict;
use feature qw ( say );
say "A: " . join( " ", $0, #ARGV );
my $script_command = $0;
foreach (#ARGV) {
$script_command .= /\s/ ? " \'" . $_ . "\'"
: " " . $_;
}
say "B: " . $script_command;
Here virtually same Linux-only variants (of course, after shell intervention):
pure perl
BEGIN {
my #cmd = ( );
if (open(my $h, "<:raw", "/proc/$$/cmdline")) {
# precisely, buffer size must be at least `getconf ARG_MAX`
read($h, my $buf, 1048576); close($h);
#cmd = split(/\0/s, $buf);
};
print join("\n\t", #cmd), "\n";
};
using File::Slurp:
BEGIN {
use File::Slurp;
my #cmd = split(/\0/s, File::Slurp::read_file("/proc/$$/cmdline", {binmode => ":raw"}));
print join("\n\t", #cmd), "\n";
};
See In Perl, how do I get the directory or path of the current executing code?
Example which handles more special cases (and without adding own name) and with processing the line with GetOpt:
#!perl
use strict;
use warnings;
use Getopt::Long qw(GetOptionsFromString);
use feature qw ( say );
# Note: $0 is own name
my $sScriptCommandLine;
my #asArgs = ();
my $iRet;
my $sFile = '';
my $iN = -1;
my $iVerbose = 0;
# ============================================================================
my %OptionsHash = (
"f=s" => \$sFile,
"n=i" => \$iN,
"v:+" => \$iVerbose);
$sScriptCommandLine = join( ' ', #ARGV ); # useless for argument with spaces
say 'A: ' . $sScriptCommandLine;
$sScriptCommandLine = '"' . join( '" "', #ARGV ) . '"'; # all arguments in "", but not suitable for arguments with '"' (given as '\"')
say 'B: ' . $sScriptCommandLine;
$sScriptCommandLine = '';
foreach (#ARGV) {
$sScriptCommandLine .= ' ' if ($sScriptCommandLine);
$_ =~ s/\\/\\\\/g; # needed for GetOptionsFromString
$_ =~ s/\"/\\\"/g;
if (/\s/) {
$sScriptCommandLine .= '"'.$_.'"';
}
else {
$sScriptCommandLine .= $_;
}
}
say 'C: ' . $sScriptCommandLine;
my ($iRet,$paArgs);
($iRet,$paArgs) = GetOptionsFromString($sScriptCommandLine,%OptionsHash);
# remaining parameters in $$paArgs[0] etc.
if (!$iRet) {
# error message already printed from GetOptionsFromString
print "Invalid parameter(s) in: \"$sScriptCommandLine\"\n";
}
say 'D: ' . '<<' . join( '>> <<', #{$paArgs} ) . '>>';
say 'f=s: "'.$sFile.'"';
say 'n=i: '.$iN;
say 'v:+: '.$iVerbose;
# eof