How can Perl's Getopt::Long discover arguments with mandatory parameter missing? - perl

In one of my scripts I use the Getopt::Long library. At the beginning of the program I make a call:
&GetOptions ('help', 'debug', 'user=s' => \$GetUser);
The first two arguments are simple: I discover their existance by checking $opt_help and $opt_debug respectively. However the third argument is tricky, because I need to distinguish between no option at all ($GetUser is undefined, which is ok for me), using "--user" alone ($GetUser is also undefined, but this time I want to display an error message) and "--user FooBar" (where the $GetUser receives 'FooBar', which I can use in further processing).
How can I distinguish between using no "--user" option and using it alone, without a username?

You are looking for : instead of =, so 'user:s' => \$GetUser. From Options with values
Using a colon : instead of the equals sign indicates that the option value is optional. In this case, if no suitable value is supplied, string valued options get an empty string '' assigned, while numeric options are set to 0
This allows you to legitimately call the program with --user and no value (with = it's an error). Then you only declare my $GetUser; and after the options are processed you can tell what happened. If it is undef it wasn't mentioned, if it is '' (empty string) it was invoked without a value and you can emit your message. This assumes that it being '' isn't of any other use in your program.
Otherwise, when you use 'user=s' and no value is given, the GetOptions reports an error by returning false and emits a descriptive message to STDERR. So you may well leave it and do
GetOptions( 'user=s' => ...) or die "Option error\n";
and rely on the module to catch and report wrong use. Our own message above isn't really needed as module's messages clearly describe the problem.
One other way of doing this would go along the lines of
usage(), exit if not GetOptions('user=s' => \$GetUser, ...);
sub usage {
# Your usage message, briefly listing options etc.
}
I'd like to add – you don't need & in front of a function call. It makes the caller's #_ visible, ignores function prototype, and does a few other similarly involved things. One common use is to get a coderef, $rc = \&fun, where it is needed. See for example this post

Related

How to check if Archive::Tar's write is successful?

I have a monthly Script running to archive files from past month. I'm using Archive::Tar to generate the archive. How can I check if calls to the ->write method are successful?
Does the following work? I didn't manage to fail $tar->write() yet.
unless ($tar->write( $name . '.tar.xz', COMPRESS_XZ )) {
die("cant write tar"); # or any other doings instead
}
Yes, the code in your question will catch any error within ->write.
The documentation of Archive::Tar does not specify what the return value of write is (except when no argument is provided, which isn't the case here). However, looking at the code of the module, write returns undef in case of an error and a true value in case of success:
1 if it was writing to a file (this is the case for the code in your question)
the written string if it was writing in a string.
Note that if something goes wrong and Archive::Tar returns undef, then it will also print an error message (unless you set $Archive::Tar::WARN to 0 by doing $Archive::Tar::WARN = 0). If you want to do something specific depending on the error, you can access the error message using the ->error method.

SVN::Client commit with comment/message option

I am trying to automate some svn tasks with perl SVN::Client module.
Unfortunately I couldn't find an option to commit a file with commit message.
Currenty I am using following method.
$client->commit($targets, $nonrecursive, $pool);
Does anyone know how can I add comment/message in svn commit with SVN::Client?
Is there any alternative options with perl to do this?
Thanks in advance.
The documentation of SVN::Client says you need to use the log_msg callback.
$client->commit($targets, $nonrecursive, $pool);
Commit files or directories referenced by target. Will use the log_msg callback to obtain the log message for the commit.
Here's what the doc says about log_msg.
$client->log_msg(\&log_msg)
Sets the log_msg callback for the client
context to a code reference that you pass. It always returns the
current codereference set.
The subroutine pointed to by this coderef will be called to get the
log message for any operation that will commit a revision to the repo.
It receives 4 parameters. The first parameter is a reference to a
scalar value in which the callback should place the log_msg. If you
wish to cancel the commit you can set this scalar to undef. The 2nd
value is a path to any temporary file which might be holding that log
message, or undef if no such file exists (though, if log_msg is undef,
this value is undefined). The log message MUST be a UTF8 string with
LF line separators. The 3rd parameter is a reference to an array of
svn_client_commit_item3_t objects, which may be fully or only
partially filled-in, depending on the type of commit operation. The
4th and last parameter will be a pool.
If the function wishes to return an error it should return a
svn_error_t object made with SVN::Error::create. Any other return
value will be interpreted as SVN_NO_ERROR.
According to this, probably the easiest way is to just call that every time you want to make a commit, and install a new message.
$client->log_msg( sub {
my ( $msg_ref, $path, $array_of_commit_obj, $pool ) = #_;
# set the message, beware the scalar reference
$$msg_ref = "Initial commit\n\nFollowed by a wall of text...";
return; # undef should be treated like SVN_NO_ERROR
});
$client->commit($targets, $nonrecursive, $pool);
# possibly call log_msg again to reset it.
If you want this to be easier, you can install that same handler once, but use a (possibly global or package) variable for the message.
our $commit_message;
$client->log_msg( sub {
my ( $msg_ref, $path, $array_of_commit_obj, $pool ) = #_;
# set the message, beware the scalar reference
$$msg_ref = $commit_message;
return; # undef should be treated like SVN_NO_ERROR
});
# ...
for my $targets ( #list_of_targets ) {
$commit_message = get_msg($targets); # or whatever
$client->commit($targets, $nonrecursive, $pool);
}
This way you are reusing the callback, but changing the message every time.
Please note that I have not tried this. All I've done is read the documentation and making some wild guesses.

Perl error: use of uninitialized value $DBI::err in concatenation

I wrote a procedure which imports data from an xml-file into a MariaDB using library DBI. The procedure works but I don't understand why the following code gives me the message:
use of uninitialized value $DBI::err in concatenation (.) or string at ...
Here the code (abbreviated):
my $insert_art = $dbh->prepare(
"INSERT INTO odbb_articles (creation_dt,ref_data,comp_no)".
"VALUES (?,?,?)"
);
....
my $comp_no = $xpc->findvalue('./sr:ARTCOMP/sr:COMPNO',$node1);
....
$insert_art->execute($creation_dt,$ref_data,$comp_no)
or die "Fehler bei der Ausfuehrung: ".
"$DBI::err -> $DBI::errstr (odbb_articles $DBI::state)\n";
If I insert the code
if ($comp_no eq "") { $comp_no = undef; }
just before $insert_art->execute the procedure works. This error happens when there is no entry in the xml-file for element COMPNO. I can avoid it if I define it as undef. I just wonder
why $comp_no cause this problem and
is there another solution than to control if $comp_no is "" and define it as undef?
The reason for the second question is to avoid the if statement if there are a lot of variables/columns which may have empty entries.
Thanks for help.
use of uninitialized value $DBI::err in concatenation (.) or string at ...
The error message you are seeing is Perl telling you that $DBI::err is undef. That is not because of the value of your $comp_no. It's just a result of what your program is doing.
So when you pass an empty string to the comp_no column, the database doesn't like that. It throws an error. DBI catches that error and passes it on. The $insert_art->execute returns a false value and the right-hand-side of the or gets called. That's your die.
Now in the string that you pass to die you put three variables:
$DBI::err
$DBI::errstr
$DBI::state
According to the DBI documentation, those are equivalent to the functions $h->err, $h->errstr and $h->state with $h being the last handle used. Let's look at the docs for those.
$h->err
Returns the native database engine error code from the last driver method called. The code is typically an integer but you should not assume that.
The DBI resets $h->err to undef before almost all DBI method calls, so the value only has a short lifespan. Also, for most drivers, the statement handles share the same error variable as the parent database handle, so calling a method on one handle may reset the error on the related handles. [...]
This does not explain when it can be undef.
$h->errstr
Returns the native database engine error message from the last DBI method called. This has the same lifespan issues as the "err" method described above.
The returned string may contain multiple messages separated by newline characters.
The errstr() method should not be used to test for errors, use err() for that, because drivers may return 'success with information' or warning messages via errstr() for methods that have not 'failed'.
Ok, so this is text. Don't use it to test for specific errors. You're not doing that. You just want to give debug output when the program fails.
$h->state
Returns a state code in the standard SQLSTATE five character format. Note that the specific success code 00000 is translated to any empty string (false). If the driver does not support SQLSTATE (and most don't), then state() will return S1000 (General Error) for all errors.
The driver is free to return any value via state, e.g., warning codes, even if it has not declared an error by returning a true value via the "err" method described above.
The state() method should not be used to test for errors, use err() for that, because drivers may return a 'success with information' or warning state code via state() for methods that have not 'failed'.
Again, this is not very clear about how useful it is.
My advice is to get rid of $DBI::err and $DBI::state. You don't need those to figure out what the problem is. Just output $DBI::errstr.
$insert_art->execute($creation_dt,$ref_data,$comp_no)
or die "Fehler bei der Ausfuehrung: " . $dbh->errstr;
Now your program will still fail, but at least you will have a meaningful error message that will explain what your database didn't like about the statement. That's better than being told how there is a bug in your error handling code.
Afterwards, the other answers will probably apply to fix the reason this is happening in the first case.
On another note, a word on die: If you provide a \n at the end of your arguments, it will not print your current script, line number and input handle line number. But those might be useful in your case. You can include them.
In a SQL database an empty string is very different to null.
If comp_no has a foreign key pointing to a record in another table, then the value "" is an accettable one only if there is a record with "" as primary key, very improbable.
Yu can fix this converting empty values to undef:
for ($creation_dt,$ref_data,$comp_no ){
defined $_ and $_ eq '' and $_ = undef;
}
$insert_art->execute($creation_dt,$ref_data,$comp_no);
or also
$insert_art->execute(map {defined($_) && length($_) ? $_ : undef} ($creation_dt,$ref_data,$comp_no));
This is a possible shortcut:
$comp_no ||= undef;
With the caveat that this will work in any case where $comp_no evaluates as false, meaning a value of 0 will actually cause the result to go undef also, which may or may not matter to you. If your field is numeric, I'd say it matters a lot.

Redis pipelining

I would like to take advantage of client pipelining when populating database. How can I achieve this using perl Redis client?
use Redis;
my $redis = Redis->new or die "No redis server";
$redis->multi;
for my $i (1 .. 20000) {
$redis->set("key.$i" => "foo" x500);
}
$redis->exec;
The documentation says you need to add a coderef to as the third argument to set.
To use pipelining, add a coderef argument as the last argument to a command method call
That would turn your example into:
for my $i (1 .. 20000) {
$redis->set("key.$i" => "foo" x500, sub {});
}
Instead of the empty sub, you can actually do stuff to the reply:
The coderef you supply to a pipelined command method is invoked once
the response is available. It takes two arguments, $reply and $error.
If $error is defined, it contains the text of an error reply sent by
the Redis server. Otherwise, $reply is the non-error reply. For almost
all commands, that means it's undef, or a defined but non-reference
scalar, or an array ref of any of those; but see "keys", "info", and
"exec".
It also says in the transaction handling part of the doc:
Warning: the behaviour of these commands when combined with pipelining is still under discussion, and you should NOT use them at the same time just now.

How can I get Perl's Getopt::Long to tell if arguments are missing?

I'm using Perl's Getopt::Long module to parse command line arguments. However, it seems that it returns a true value even if some of the arguments are missing. Is there a way to tell if this is the case?
In plain old Getopt::Long, you can't do this directly -- as Jonathan said, you need to check your requirements for undef. However, IMHO this is a good thing -- what is a "required" parameter? Often one has parameters that are required in one case and not another -- the most common example here being the sore thumb of the --help option. It's not required, and if the user uses it, he probably doesn't know to or won't pass any of the other "required" parameters.
I use this idiom in some of my code (well, I used to, until I switched to using MooseX::Getopt):
use List:MoreUtils 'all';
Getopt::Long::GetOptions(\%options, #opt_spec);
print usage(), exit if $options{help};
die usage() unless all { defined $options{$_} } #required_options;
Even with MooseX::Getopt I don't set my attributes to required => 1, again because of the --help option. Instead I check for the presence of all attributes I need before moving into the main body of program execution.
package MyApp::Prog;
use Moose;
with 'MooseX::Getopt';
has foo => (
is => 'ro', isa => 'Str',
documentation => 'Provides the foo for the frobnitz',
);
has bar => (
is => 'ro', isa => 'Int',
documentation => 'Quantity of bar furbles to use when creating the frobnitz',
);
# run just after startup; use to verify system, initialize DB etc.
sub setup
{
my $this = shift;
die "Required option foo!\n" unless $this->foo;
die "Required option bar!\n" unless $this->bar;
# ...
}
Options are optional, hence the name 'Getopt'.
You check the option values that are set by Getopt::Long; if one of the crucial ones is 'undef', it was missed and you can identify it.
The return value tells you that there were no horrible blunders in the command line. What constitutes a blunder depends on how you use Getopt::Long, but a classic one would be that the command line contains -o output but the command does not recognize a -o option.