i need your help.
use Getopt::Long;
my $inputFile = "";
my $outputFile = "";
my $input_mm = "";
my $result;
$result = GetOptions (
"fromFile=s" => \$inputFile, # string
"toFile=s" => \$outputFile,
"mm=i" => \$input_mm);
in this case if in command line i give value to $input_mm 07 - perl sees it as 7. how do i fix it?
=i will read the value as a number. If you want to preserve formatting, use =s.
After you read the value, if you want to make sure it's numeric, you can use Scalar::Util's looks_like_number subroutine:
use Scalar::Util qw/looks_like_number/;
# ...
$result = GetOptions (
"fromFile=s" => \$inputFile, # string
"toFile=s" => \$outputFile,
"mm=s" => \$input_mm)
or die("Error in command line arguments\n");
die "mm wasn't a number!"
unless defined $input_mm && looks_like_number($input_mm);
Also, don't forget to check the return code of GetOptions (per the Getopt:::Long docs); a false value means there were errors in reading the arguments.
Use =s if you want to preserve the input value. You can check the validity of the value later e.g.
use Scalar::Util qw(looks_like_number);
$result = GetOptions(...);
if (defined $input_mm) {
looks_like_number($input_mm) or die "Invalid mm value '$input_mm'";
}
In the GetOptions method, it take the parameter =i as a number, if you want to make it as the number, you should use the function
use Scalar::Util qw(looks_like_number)
Related
I have a simple higher-order function that builds a message formatter.
use strict;
use warnings;
sub make_formatter {
my $level = shift;
return sub {
my $message = shift;
return "[$level] $message";
}
}
I use it from Perl like that:
my $component_formatter = make_formatter('ComponentError');
print $component_formatter->('Hello') . "\n";
I want to use make_formatter from a Template Toolkit template. I have tried to do the following:
use Template;
use Template::Constants;
my $template = Template->new({
# DEBUG => Template::Constants::DEBUG_ALL,
VARIABLES => {
make_formatter => make_formatter,
}
});
my $template_str = "
[% my_formatter = make_formatter('MyFormatter') %]
<h1>[% my_formatter('Sample message') %]</h1>
";
$template->process(\$template_str);
The output of this script is:
$ perl test.pl
Use of uninitialized value $level in concatenation (.) or string at test.pl line 10.
<h1>[] MyFormatter</h1>
Is it possible to call my_formatter using only Template Toolkit syntax ? Calling external Perl code that is not callable by default from Template Toolkit is not an option.
First let me please point out that putting use strict; use warnings; at the beginning of your script is strongly advised.
If you do that for your snippet generating the $template,
you will get a Bareword "make_formatter" not allowed while "strict subs" in use error, which should help you determine this is not a useful notation.
Now if you call make_formatter() instead, this will output <h1>[] MyFormatter</h1>. This makes sense: your function returned the sub, which is called with 'MyFormatter' in your template ( and $level is undef, as you called make_formatter with no input ).
As Mr. Haegland pointed out,
my $template = Template->new({
VARIABLES => {
make_formatter => \&make_formatter,
}
});
leads to the output I understand you want:
<h1>[MyFormatter] Sample message</h1>
\&make_formatter gives you a subroutine reference,
which in perl normally you could call using:
my $ref = \&make_formatter; $ref->( 'Input' );
This can then be called in the first line of your template,
returning another code ref, which is then called in your second line.
Hope this helps!
I have the following lines in my script:
my $spec = shift;
if (!defined $spec) {
return ("Invalid specification", undef);
}
$spec = "$spec" // '';
I would naturally expect this to, when passed undef, return the warning Invalid specification in the array, with the second item being undef. Instead, the check is passed, and I get a console message warning me about Use of uninitialized value $spec in string on the next line.
$spec is an object with string and number overloading, and is unfortunately written such that attempting to test for truthiness in this particular subroutine (by way of if ($spec) for instance) results in deep recursion and a segfault.
While I am interested in why, exactly, this is happening, I'm more interested in how to make it stop happening. I want to eliminate the console warning, preferable without no warnings qw/uninitialized/. Is this possible, and if so, how do I do it?
You say that $spec is an object with string overloading.
If that's the case then you need to coerce it into String form before checking for it being defined:
if (! defined overload::StrVal($spec)) {
Correction per ysth
As ysth pointed out in the StrVal does not coerce the overloaded stringification:
overload::StrVal(arg)
Gives the string value of arg as in the absence of stringify overloading. If you are using this to get the address of a reference (useful for checking if two references point to the same thing) then you may be better off using Scalar::Util::refaddr() , which is faster.
Therefore to accomplish this, try his other suggestion of:
"$spec" trapping warnings and detecting the uninitialized var warning. Better to add a method to the class to test for whatever case returns undef.
The following demonstrates this approach:
#!/usr/bin/env perl
use strict;
use warnings;
use Test::More tests => 2;
my $obj_str_defined = StringOverloaded->new("has value");
my $obj_str_undef = StringOverloaded->new(undef);
ok( is_overloaded_string_defined($obj_str_defined), qq{\$obj_str_defined is defined} );
ok( !is_overloaded_string_defined($obj_str_undef), qq{\$obj_str_undef is undef} );
sub is_overloaded_string_defined {
my $obj = shift;
my $is_str_defined = 1;
local $SIG{__WARN__} = sub {
$is_str_defined = 0 if $_[0] =~ /Use of uninitialized value \$obj in string/;
};
my $throwaway_var = "$obj";
return $is_str_defined;
}
{
# Object with string overloading
package StringOverloaded;
use strict;
use warnings;
use overload (
'""' => sub {
my $self = shift;
return $$self; # Dereference
},
fallback => 1
);
sub new {
my $pkg = shift;
my $val = shift;
my $self = bless \$val, $pkg;
return $self;
}
}
Output:
1..2
ok 1 - $obj_str_defined is defined
ok 2 - $obj_str_undef is undef
I am updating an existing Perl script that uses GetOptions from Getopt::Long. I want to add an option that takes a string as its parameter and can only have one of 3 values: small, medium, or large. Is there any way to make Perl throw an error or kill the script if any other string value is specified? So far I have:
my $value = 'small';
GetOptions('size=s' => \$value);
You could use a subroutine to handle the processing of that option.
User-defined subroutines to handle options
my $size = 'small'; # default
GetOptions('size=s' => \&size);
print "$size\n";
sub size {
my %sizes = (
small => 1,
medium => 1,
large => 1
);
if (! exists $sizes{$_[1]}) {
# die "$_[1] is not a valid size\n";
# Changing it to use an exit statement works as expected
print "$_[1] is not a valid size\n";
exit;
}
$size = $_[1];
}
I put the sizes into a hash, but you could use an array and grep as toolic showed.
One way is to use grep to check if the value is legal:
use warnings;
use strict;
use Getopt::Long;
my $value = 'small';
GetOptions('size=s' => \$value);
my #legals = qw(small medium large);
die "Error: must specify one of #legals" unless grep { $_ eq $value } #legals;
print "$value\n";
It's just one of a few checks you need to perform after GetOptions returned.
You need to check if GetOptions succeeded.
You may need to check the value provided for each optional argument.
You may need to check the number of arguments in #ARGV.
You may need to check the arguments in #ARGV.
Here's how I perform those checks:
use Getopt::Long qw( );
my %sizes = map { $_ => 1 } qw( small medium large );
my $opt_size;
sub parse_args {
Getopt::Long::Configure(qw( :posix_default ));
$opt_size = undef;
Getopt::Long::GetOptions(
'help|h|?' => \&exit_with_usage,
'size=s' => \$opt_size,
)
or exit_bad_usage();
exit_bad_usage("Invalid size.\n")
if defined($size) && !$sizes{$size};
exit_bad_usage("Invalid number of arguments.\n")
if #ARGV;
}
Here's how I handle failures:
use File::Basename qw( basename );
sub exit_with_usage {
my $prog = basename($0);
print("usage: $prog [options]\n");
print(" $prog --help\n");
print("\n");
print("Options:");
print(" --size {small|medium|large}\n");
print(" Controls the size of ...\n"
exit(0);
}
sub exit_bad_usage {
my $prog = basename($0);
warn(#_) if #_;
die("Use $prog --help for help\n");
exit(1);
}
This might be overkill, but also take a look Getopt::Again, which implements validation through its process configuration value per command line argument.
use strict;
use warnings;
use Getopt::Again;
opt_add my_opt => (
type => 'string',
default => 'small',
process => qr/^(?:small|medium|large)$/,
description => "My option ...",
);
my (%opts, #args) = opt_parse(#ARGV);
An alternative to Getopt::Long is Getopt::Declare which has built in pattern support, but is slightly more verbose:
use strict;
use warnings;
use feature qw/say/;
use Getopt::Declare;
my $args = Getopt::Declare->new(
join "\n",
'[strict]',
"-size <s:/small|medium|large/>\t small, medium, or large [required]"
) or exit(1);
say $args->{-size};
Test runs:
[hmcmillen]$ perl test.pl -size small
small
[hmcmillen]$ perl test.pl -size medium
medium
[hmcmillen]$ perl test.pl -size large
large
[hmcmillen]$ perl test.pl -size extra-large
Error: incorrect specification of '-size' parameter
Error: required parameter -size not found.
Error: unrecognizable argument ('extra-large')
(try 'test.pl -help' for more information)
Say, I have a sub that receives two arguments: An encoding specification, and a file path. The sub then uses that information to open a file for reading as shown below, stripped down to its essentials:
run({
encoding => 'UTF-16---LE',
input_filename => 'test_file.txt',
});
sub run {
my $args = shift;
my ($enc, $fn) = #{ $args }{qw(encoding input_filename)};
my $is_ok = open my $in,
sprintf('<:encoding(%s)', $args->{encoding}),
$args->{input_filename}
;
}
Now, this croaks with:
Cannot find encoding "UTF-16---LE" at E:\Home\...
What is the right way to ensure that $args->{encoding} holds a valid encoding specification before interpolating into the second argument to open?
Update
The information below is provided in the hope that it will be useful to someone at some point. I am also going to file a bug report.
The documents for Encode::Alias do not mention find_alias at all. A casual look at the Encode/Alias.pm on my Windows system reveals:
# Public, encouraged API is exported by default
our #EXPORT =
qw (
define_alias
find_alias
);
However, note:
#!/usr/bin/env perl
use 5.014;
use Encode::Alias;
say find_alias('UTF-8')->name;
yields:
Use of uninitialized value $find in exists at C:/opt/Perl/lib/Encode/Alias.pm line 25.
Use of uninitialized value $find in hash element at C:/opt/Perl/lib/Encode/Alias.pm line 26.
Use of uninitialized value $find in pattern match (m//) at C:/opt/Perl/lib/Encode/Alias.pm line 31.
Use of uninitialized value $find in lc at C:/opt/Perl/lib/Encode/Alias.pm line 40.
Use of uninitialized value $find in pattern match (m//) at C:/opt/Perl/lib/Encode/Alias.pm line 31.
Use of uninitialized value $find in lc at C:/opt/Perl/lib/Encode/Alias.pm line 40.
Being 1) lazy, and 2) first to assume I am doing something wrong, I decided to seek others' wisdom.
In any case, the bug is due to find_alias being exported as a function without checking for that in the code:
sub find_alias {
require Encode;
my $class = shift;
my $find = shift;
unless ( exists $Alias{$find} ) {
If find_alias is not invoked as a method, the argument is now in $class and $find is undefined.
HTH.
Encode::Alias->find_alias($encoding_name) returns an object whose name attribute is the canonical encoding name on success, and false on failure.
$ Encode::Alias->find_alias('UTF-16---LE')
$ Encode::Alias->find_alias('UTF-16 LE')
Encode::Unicode {
Parents Encode::Encoding
Linear #ISA Encode::Unicode, Encode::Encoding
public methods (6) : bootstrap, decode, decode_xs, encode, encode_xs, renew
private methods (0)
internals: {
endian "v",
Name "UTF-16LE",
size 2,
ucs2 ""
}
}
$ Encode::Alias->find_alias('Latin9')
Encode::XS {
public methods (9) : cat_decode, decode, encode, mime_name, name, needs_lines, perlio_ok, renew, renewed
private methods (0)
internals: 140076283926592
}
$ Encode::Alias->find_alias('UTF-16 LE')->name
UTF-16LE
$ Encode::Alias->find_alias('Latin9')->name
iso-8859-15
You can use the find_encoding function in Encode. Although, if you want to use it as an :encoding layer, you should also check perlio_ok. It's possible (but rare) for an encoding to exist but not support use with :encoding:
use Carp qw(croak);
use Encode qw(find_encoding);
sub run {
my $args = shift;
my $enc = find_encoding($args->{encoding})
or croak "$args->{encoding} is not a valid encoding";
$enc->perlio_ok or croak "$args->{encoding} does not support PerlIO";
my $is_ok = open my $in,
sprintf('<:encoding(%s)', $enc->name),
$args->{input_filename}
;
}
Note: find_encoding does handle aliases defined by Encode::Alias.
If you don't care about distinguishing between nonexistent encodings and those that don't support :encoding, you can just use the perlio_ok function:
Encode::perlio_ok($args->{encoding}) or croak "$args->{encoding} not supported";
Try to debug this script. I think it maybe an issue of variable interpolation? I'm not sure.
It works using options if I pass the values like so:
perl test-file-exists.pl --file /proj/Output/20111126/_GOOD
I am trying to remove the option of passing in --file since I need to generate the date
dynamically.
perl test-file-exists.pl
Given the code changes below (I commented out the options piece). I am trying to create the string (see $chkfil). I am getting errors passing in $dt4. Somehow, its not passing in the file string that I am creating into this other module.
use strict;
use warnings;
use lib '/home/test/lib';
use ProxyCmd;
use Getopt::Long;
#
### Set up for Getopt
#
#my $chkfil;
#my $help;
#usage() if ( #ARGV < 1 or
# ! GetOptions('help|?' => \$help,
# 'file=s' => \$chkfil)
# or defined $help );
my $cmd = ProxyCmd->new( User=>"test_acct",
AuthToken=>"YToken",
loginServer=>"host.com");
# Get previous day
my $dt4 = qx {date --date='-1day' +'%Y%m%d'};
# Check file
my $chkfil = qq{/proj/Output/$dt4/_GOOD};
# Now test the fileExists function
print "Checking 'fileExists':\n";
my $feResults = $cmd->fileExists("$chkfil");
if ($feResults == 0) {
print "File Exists!\n";
} else {
print "File Does Not Exist\n";
}
sub usage
{
print "Unknown option: #_\n" if ( #_ );
print "usage: program [--file /proj/Output/20111126/_GOOD] [--help|-?]\n";
exit;
}
When you use backticks or qx, you get the trailing newline included so chomp it off:
my $dt4 = qx {date --date='-1day' +'%Y%m%d'};
chomp $dt4;
and you'll get a sensible filename.
You could also use DateTime and friends to avoid shelling out entirely.