Perl Getopt::Long Related Question - Mutually Exclusive Command-Line Arguments - perl

I have the following code in my perl script:
my $directory;
my #files;
my $help;
my $man;
my $verbose;
undef $directory;
undef #files;
undef $help;
undef $man;
undef $verbose;
GetOptions(
"dir=s" => \$directory, # optional variable with default value (false)
"files=s" => \#files, # optional variable that allows comma-separated
# list of file names as well as multiple
# occurrenceces of this option.
"help|?" => \$help, # optional variable with default value (false)
"man" => \$man, # optional variable with default value (false)
"verbose" => \$verbose # optional variable with default value (false)
);
if (#files) {
#files = split(/,/,join(',', #files));
}
What is the best way to handle mutually exclusive command line arguments? In my script I only want the user to enter only the "--dir" or "--files" command line argument but not both. Is there anyway to configure Getopt to do this?
Thanks.

I don't think there is a way in Getopt::Long to do that, but it is easy enough to implement on your own (I am assuming there is a usage function that returns a string that tells the user how to call the program):
die usage() if defined $directory and #files;

Why not just this:
if ($directory && #files) {
die "dir and files options are mutually exclusive\n";
}

You can simply check for the existence of values in both variables.
if(#files && defined $directory) {
print STDERR "You must use either --dir or --files, but not both.\n";
exit 1;
}
Or, if you would like to simply ignore any options specified after the first --dir or --files, you can point both at a function.
#!/usr/bin/perl
use Getopt::Long;
my $directory;
my #files;
my $mode;
my $help;
my $man;
my $verbose;
GetOptions(
"dir=s" => \&entries, # optional variable with default value (false)
"files=s" => \&entries, # optional variable that allows comma-separated
# list of file names as well as multiple
# occurrences of this option.
"help|?" => \$help, # optional variable with default value (false)
"man" => \$man, # optional variable with default value (false)
"verbose" => \$verbose # optional variable with default value (false)
);
sub entries {
my($option, $value) = #_;
if(defined $mode && $mode ne $option) {
print STDERR "Ignoring \"--$option $value\" because --$mode already specified...\n";
}
else {
$mode = $option unless(defined $mode);
if($mode eq "dir") {
$directory = $value;
}
elsif($mode eq "files") {
push #files, split(/,/, $value);
}
}
return;
}
print "Working on directory $directory...\n" if($mode eq "dir");
print "Working on files:\n" . join("\n", #files) . "\n" if($mode eq "files");

You can do this with Getopt::Long::Descriptive. It's a bit different from Getopt::Long, but if you're printing a usage summary, it helps to reduce duplication by doing all that for you.
Here, I've added a hidden option called source, so $opt->source which will contain the value dir or files depending on which option was given, and it will enforce the one_of constraint for you. The values given will be in $opt->dir or $opt->files, whichever one was given.
my ( $opt, $usage ) = describe_options(
'%c %o',
[ "source" => hidden => {
'one_of' => [
[ "dir=s" => "Directory" ],
[ "files=s#" => "FilesComma-separated list of files" ],
]
} ],
[ "man" => "..." ], # optional variable with default value (false)
[ "verbose" => "Provide more output" ], # optional variable with default value (false)
[],
[ 'help|?' => "Print usage message and exit" ],
);
print( $usage->text ), exit if ( $opt->help );
if ($opt->files) {
#files = split(/,/,join(',', #{$opt->files}));
}
The main difference for the rest of your script is that all the options are contained as methods of the $opt variable, rather than each one having its own variable like with Getopt::Long.

use strict;
use warnings;
use Getopt::Long;
my($directory,#files,$help,$man,$verbose);
GetOptions(
'dir=s' => sub {
my($sub_name,$str) = #_;
$directory = $str;
die "Specify only --dir or --files" if #files;
},
# optional variable that allows comma-separated
# list of file names as well as multiple
# occurrences of this option.
'files=s' => sub {
my($sub_name,$str) = #_;
my #s = split ',', $str;
push #files, #s;
die "Specify only --dir or --files" if $directory;
},
"help|?" => \$help,
"man" => \$man,
"verbose" => \$verbose,
);
use Pod::Usage;
pod2usage(1) if $help;
pod2usage(-exitstatus => 0, -verbose => 2) if $man;
=head1 NAME
sample - Using Getopt::Long and Pod::Usage
=head1 SYNOPSIS
sample [options] [file ...]
Options:
-help brief help message
-man full documentation
=head1 OPTIONS
=over 8
=item B
Print a brief help message and exits.
=item B
Prints the manual page and exits.
=back
=head1 DESCRIPTION
B will read the given input file(s) and do something
useful with the contents thereof.
=cut

Related

Getopts to flag bad options without dash

Getopt::Long::Configure("no_pass_through");
my %opts = ();
GetOptions(\%opts,
'opt1=s',
'opt2=s',
'opt3'
);
test.pl bad_option_without_dash
How do I make getopts flag an error when a bad option is passed without a dash? I was expecting that no_pass_through will take care of this. What am I missing?
Getopt::Long just extracts the options. It's up to you to validate the value of those options and the non-option arguments (which are left in #ARGV).
Specifically, if you want to make sure that only options have been passed, then you can use
#ARGV == 0
or die("usage\n");
What I use:
use Getopt::Long qw( );
my ( $opt_opt1, $opt_opt2, $opt_opt3 );
sub parse_args {
( $opt_opt1, $opt_opt2, $opt_opt3 ) = ();
Getopt::Long::Configure(qw( posix_default ));
Getopt::Long::GetOptions(
'help|h|?' => \&help,
'opt1=s' => \$opt_opt1,
'opt2=s' => \$opt_opt2,
'opt3' => \$opt_opt3,
)
or usage();
# Validate $opt_* here if necessary.
!#ARGV
or usage("Too many arguments.");
return #ARGV;
}
sub main {
# my () = #_; # This program doesn't accept non-option args.
...
}
main(parse_args());
Helpers:
use File::Basename qw( basename );
sub help {
my $prog = basename($0);
print
"Usage:
$prog [options]
$prog --help
Options:
--opt1 FOO
...
--opt2 BAR
...
--opt3
...
";
exit(0);
}
sub usage {
if (#_) {
my ($msg) = #_;
chomp($msg);
say STDERR $msg;
}
my $prog = basename($0);
say STDERR "Try '$prog --help' for more information.";
exit(1);
}
Getopt::Long operates only on options: arguments starting with hyphens. Without passthrough (no_pass_through is the default) it will remove them from #ARGV, leaving any non-option arguments for you to handle. If you expected no non-option arguments, you could determine that options were passed incorrectly if any arguments remain after calling GetOptions.
die "Usage: $0 [--opt1=string] [--opt2=string] [--opt3]\n" if #ARGV;
The return value of GetOptions is also useful, as it will indicate whether any unrecognized or invalid options were found.
GetOptions(...) or die "Usage: $0 ...\n";
Options are denoted with a leading dash (hyphen); arguments are not.
You might find Getopt::Long Argument-callback useful:
A special option 'name' <> can be used to designate a subroutine to handle non-option arguments. When GetOptions() encounters an argument that does not look like an option, it will immediately call this subroutine and passes it one parameter: the argument name.

perl - use command-line argument multiple times

I'm modifying a perl script in which the command line arguments are parsed like this:
if ($arg eq "-var1") {
$main::variable1 = shift(#arguments)
} elsif ($arg eq "-var2") {
$main::variable2 = shift(#arguments)
} elsif ($arg eq "var3") {
$main::variable3 = shift(#arguments)
} ...
So there is a whole bunch of elsif statements to cover all command-line arguments.
I'm now in a situaton where I want to use the argument '-var2' multiple times.
So my main::variable2 should maybe be an array that contains all values that are passed with "-var2".
I found that with Perl::getopt, this can be easily achieved (Perl Getopt Using Same Option Multiple Times).
However the way that my script parses its command-line arguments is different. So I was wondering if it could be achieved, without having to change the way the arguments are parsed.
That's not your actual code, is it? It won't even compile.
I'd be really surprised if Getopt::Long can't solve your problem and it's really a better idea to use a library rather than writing your own code.
But changing your code to store -var2 options in an array is simple enough.
my ($variable1, #variable2, $variable3);
if ($arg eq "-var1") {
$variable1 = shift(#arguments)
} elsif ($arg eq "-var2") {
push #variable2, shift(#arguments)
} elsif ($arg eq "-var3") {
$variable3 = shift(#arguments)
}
(I've also removed the main:: from your variables and added the, presumably missing, $s. It's really unlikely that you want to be using package variables rather than lexical variables.)
This particular wheel already exists. Please don't try to reinvent it. That just makes it a pain for the people trying to use your script. There's no reason to force people to learn a whole new set of rules in order to execute your program.
use File::Basename qw( basename );
use Getopt::Long qw( );
my $foo;
my #bars;
my $baz;
sub help {
my $prog = basename($0);
print
"Usage:
$prog [options]
$prog --help
Options:
--foo foo
...
--bar bar
May be used multiple times.
...
--baz baz
...
";
exit(0);
}
sub usage {
if (#_) {
my ($msg) = #_;
chomp($msg);
say STDERR $msg;
}
my $prog = basename($0);
say STDERR "Try '$prog --help' for more information.";
exit(1);
}
sub parse_args {
Getopt::Long::Configure(qw( posix_default ));
Getopt::Long::GetOptions(
"help" => \&help,
"foo=s" => \$foo,
"bar=s" => \#bars,
"baz=s" => \$baz,
)
or usage();
!#ARGV
or usage("Too many arguments");
return #ARGV;
}
main(parse_args());
Well, it is good practice to document your core -- you would appreciate it as soon as you return to make changes
NOTE: in Linux it requires perl-doc package to be installed to use --man option in full extent
#!/usr/bin/perl
#
# Description:
# Describe purpose of the program
#
# Parameters:
# Describe parameters purpose
#
# Date: Tue Nov 29 1:18:00 UTC 2019
#
use warnings;
use strict;
use Getopt::Long qw(GetOptions);
use Pod::Usage;
my %opt;
GetOptions(
'input|i=s' => \$opt{input},
'output|o=s' => \$opt{output},
'debug|d' => \$opt{debug},
'help|?' => \$opt{help},
'man' => \$opt{man}
) or pod2usage(2);
pod2usage(1) if $opt{help};
pod2usage(-exitval => 0, -verbose => 2) if $opt{man};
print Dumper(\%opt) if $opt{debug};
__END__
=head1 NAME
program - describe program's functionality
=head1 SYNOPSIS
program.pl [options]
Options:
-i,--input input filename
-o,--output output filename
-d,--debug output debug information
-?,--help brief help message
--man full documentation
=head1 OPTIONS
=over 4
=item B<-i,--input>
Input filename
=item B<-o,--output>
Output filename
=item B<-d,--debug>
Print debug information.
=item B<-?,--help>
Print a brief help message and exits.
=item B<--man>
Prints the manual page and exits.
=back
B<This program> accepts B<several parameters> and operates with B<them> to produce some B<result>
=cut

GetOptions Check Option Values

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)

Iterate directories in Perl, getting introspectable objects as result

I'm about to start a script that may have some file lookups and manipulation, so I thought I'd look into some packages that would assist me; mostly, I'd like the results of the iteration (or search) to be returned as objects, which would have (base)name, path, file size, uid, modification time, etc as some sort of properties.
The thing is, I don't do this all that often, and tend to forget APIs; when that happens, I'd rather let the code run on an example directory, and dump all of the properties in an object, so I can remind myself what is available where (obviously, I'd like to "dump", in order to avoid having to code custom printouts). However, I'm aware of the following:
list out all methods of object - perlmonks.org
"Out of the box Perl doesn't do object introspection. Class wrappers like Moose provide introspection as part of their implementation, but Perl's built in object support is much more primitive than that."
Anyways, I looked into:
"Files and Directories Handling in Perl - Perl Beginners' Site" http://perl-begin.org/topics/files-and-directories/
... and started looking into the libraries referred there (also related link: rjbs's rubric: the speed of Perl file finders).
So, for one, File::Find::Object seems to work for me; this snippet:
use Data::Dumper;
#targetDirsToScan = ("./");
use File::Find::Object;
my $tree = File::Find::Object->new({}, #targetDirsToScan);
while (my $robh = $tree->next_obj()) {
#print $robh ."\n"; # prints File::Find::Object::Result=HASH(0xa146a58)}
print Dumper($robh) ."\n";
}
... prints this:
# $VAR1 = bless( {
# 'stat_ret' => [
# 2054,
# 429937,
# 16877,
# 5,
# 1000,
# 1000,
# 0,
# '4096',
# 1405194147,
# 1405194139,
# 1405194139,
# 4096,
# 8
# ],
# 'base' => '.',
# 'is_link' => '',
# 'is_dir' => 1,
# 'path' => '.',
# 'dir_components' => [],
# 'is_file' => ''
# }, 'File::Find::Object::Result' );
# $VAR1 = bless( {
# 'base' => '.',
# 'is_link' => '',
# 'is_dir' => '',
# 'path' => './test.blg',
# 'is_file' => 1,
# 'stat_ret' => [
# 2054,
# 423870,
# 33188,
# 1,
# 1000,
# 1000,
# 0,
# '358',
# 1404972637,
# 1394828707,
# 1394828707,
# 4096,
# 8
# ],
# 'basename' => 'test.blg',
# 'dir_components' => []
... which is mostly what I wanted, except the stat results are an array, and I'd have to know its layout (($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks) stat - perldoc.perl.org) to make sense of the printout.
Then I looked into IO::All, which I like because of utf-8 handling (but also, say, socket functionality, which would be useful to me for an unrelated task in the same script); and I was thinking I'd use this package instead. The problem is, I have a very hard time discovering what the available fields in the object returned are; e.g. with this code:
use Data::Dumper;
#targetDirsToScan = ("./");
use IO::All -utf8;
$io = io(#targetDirsToScan);
#contents = $io->all(0);
for my $contentry ( #contents ) {
#print Dumper($contentry) ."\n";
# $VAR1 = bless( \*Symbol::GEN298, 'IO::All::File' );
# $VAR1 = bless( \*Symbol::GEN307, 'IO::All::Dir' ); ...
#print $contentry->uid . " -/- " . $contentry->mtime . "\n";
# https://stackoverflow.com/q/24717210/printing-ret-of-ioall-w-datadumper
print Dumper \%{*$contentry}; # doesn't list uid
}
... I get a printout like this:
# $VAR1 = {
# '_utf8' => 1,
# 'constructor' => sub { "DUMMY" },
# 'is_open' => 0,
# 'io_handle' => undef,
# 'name' => './test.blg',
# '_encoding' => 'utf8',
# 'package' => 'IO::All'
# };
# $VAR1 = {
# '_utf8' => 1,
# 'constructor' => sub { "DUMMY" },
# 'mode' => undef,
# 'name' => './testdir',
# 'package' => 'IO::All',
# 'is_absolute' => 0,
# 'io_handle' => undef,
# 'is_open' => 0,
# '_assert' => 0,
# '_encoding' => 'utf8'
... which clearly doesn't show attributes like mtime, etc. - even if they exist (which you can see if you uncomment the respective print line).
I've also tried Data::Printer's (How can I perform introspection in Perl?) p() function - it prints exactly the same fields as Dumper. I also tried to use print Dumper \%{ref ($contentry) . "::"}; (list out all methods of object - perlmonks.org), and this prints stuff like:
'O_SEQUENTIAL' => *IO::All::File::O_SEQUENTIAL,
'mtime' => *IO::All::File::mtime,
'DESTROY' => *IO::All::File::DESTROY,
...
'deep' => *IO::All::Dir::deep,
'uid' => *IO::All::Dir::uid,
'name' => *IO::All::Dir::name,
...
... but only if you use the print $contentry->uid ... line beforehand; else they are not listed! I guess that relates to this:
introspection - How do I list available methods on a given object or package in Perl? #911294
In general, you can't do this with a dynamic language like Perl. The package might define some methods that you can find, but it can also make up methods on the fly that don't have definitions until you use them. Additionally, even calling a method (that works) might not define it. That's the sort of things that make dynamic languages nice. :)
Still, that prints the name and type of the field - I'd want the name and value of the field instead.
So, I guess my main question is - how can I dump an IO::All result, so that all fields (including stat ones) are printed out with their names and values (as is mostly the case with File::Find::Object)?
(I noticed the IO::All results can be of type, say, IO::All::File, but its docs defer to "See IO::All", which doesn't discuss IO::All::File explicitly much at all. I thought, if I could "cast" \%{*$contentry} to a IO::All::File, maybe then mtime etc fields will be printed - but is such a "cast" possible at all?)
If that is problematic, are there other packages, that would allow introspective printout of directory iteration results - but with named fields for individual stat properties?
Perl does introspection in the fact that an object will tell you what type of object it is.
if ( $object->isa("Foo::Bar") ) {
say "Object is of a class of Foo::Bar, or is a subclass of Foo::Bar.";
}
if ( ref $object eq "Foo::Bar" ) {
say "Object is of the class Foo::Bar.";
}
else {
say "Object isn't a Foo::Bar object, but may be a subclass of Foo::Bar";
}
You can also see if an object can do something:
if ( $object->can("quack") ) {
say "Object looks like a duck!";
}
What Perl can't do directly is give you a list of all the methods that a particular object can do.
You might be able to munge some way.Perl objects are stored in package namespaces which are in the symbol table. Classes are implemented via Perl subroutines. It may be possible to go through the package namespace and then find all the subroutines.
However, I can see several issues. First private methods (the ones you're not suppose to use) and non-method subroutines would also be included. There's no way to know which is which. Also, parent methods won't be listed.
Many languages can generate such a list of methods for their objects (I believe both Python and Ruby can), but these usually give you a list without an explanation what these do. For example, File::Find::Object::Result (which is returned by the next_obj method of File::Find::Object) has a base method. What does it do? Maybe it's like basename and gives me the name of the file. Nope, it's like dirname and gives me the name of the directory.
Again, some languages could give a list of those methods for an object and a description. However, those descriptions depend upon the programmer to maintain and make sure they're correct. No guaranteed of that.
Perl doesn't have introspection, but all Perl modules stored in CPAN must be documented via POD embedded documentation, and this is printable from the command line:
$ perldoc File::Find::Object
This is the documentation you see in CPAN pages, in http://Perldoc.perl.org and in ActiveState's Perl documentation.
It's not bad. It's not true introspection, but the documentation is usually pretty good. After all, if the documentation stunk, I probably wouldn't have installed that module in the first place. I use perldoc all the time. I can barely remember my kids' names let alone the way to use Perl classes that I haven't used in a few months, but I find that using perldoc works pretty wall.
What you should not do is use Data::Dumper to dump out objects and try to figure out what they contain and possible methods. Some cleaver programmers are using Inside-Out Objects to thwart peeking toms.
So no, Perl doesn't list methods of a particular class like some languages can, but perldoc comes pretty close to doing what you need. I haven't use File::Find::Object in a long while, but going over the perldoc, I probably could write up such a program without much difficulty.
As I answered to your previous question, it is not a good idea to go relying on the guts of objects in Perl. Instead just call methods.
If IO::All doesn't offer a method that gives you the information that you need, you might be able to write your own method for it that assembles that information using just the documented methods provided by IO::All...
use IO::All;
# Define a new method for IO::All::Base to use, but
# define it in a lexical variable!
#
my $dump_info = sub {
use Data::Dumper ();
my $self = shift;
local $Data::Dumper::Terse = 1;
local $Data::Dumper::Sortkeys = 1;
return Data::Dumper::Dumper {
name => $self->name,
mtime => $self->mtime,
mode => $self->mode,
ctime => $self->ctime,
};
};
$io = io('/tmp');
for my $file ( $io->all(0) ) {
print $file->$dump_info();
}
Ok, this is more-less as an exercise (and reminder for me); below is some code, where I've tried to define a class (File::Find::Object::StatObj) with accessor fields for all of the stat fields. Then, I have the hack for IO::All::File from Replacing a class in Perl ("overriding"/"extending" a class with same name)?, where a mtimef field is added which corresponds to mtime, just as a reminder.
Then, just to see what sort of interface I could have between the two libraries, I have IO::All doing the iterating; and the current file path is passed to File::Find::Object, from which we obtain a File::Find::Object::Result - which has been "hacked" to also show the File::Find::Object::StatObj; but that one is only generated after a call to the hacked Result's full_components (that might as well have been a separate function). Notice that in this case, you won't get full_components/dir_components of File::Find::Object::Result -- because apparently it is not File::Find::Object doing the traversal here, but IO::All. Anyways, the result is something like this:
# $VAR1 = {
# '_utf8' => 1,
# 'mtimef' => 1403956165,
# 'constructor' => sub { "DUMMY" },
# 'is_open' => 0,
# 'io_handle' => undef,
# 'name' => 'img/test.png',
# '_encoding' => 'utf8',
# 'package' => 'IO::All'
# };
# img/test.png
# > - $VAR1 = bless( {
# 'base' => 'img/test.png',
# 'is_link' => '',
# 'is_dir' => '',
# 'path' => 'img/test.png',
# 'is_file' => 1,
# 'stat_ret' => [
# 2054,
# 426287,
# 33188,
# 1,
# 1000,
# 1000,
# 0,
# '37242',
# 1405023944,
# 1403956165,
# 1403956165,
# 4096,
# 80
# ],
# 'basename' => undef,
# 'stat_obj' => bless( {
# 'blksize' => 4096,
# 'ctime' => 1403956165,
# 'rdev' => 0,
# 'blocks' => 80,
# 'uid' => 1000,
# 'dev' => 2054,
# 'mtime' => 1403956165,
# 'mode' => 33188,
# 'size' => '37242',
# 'nlink' => 1,
# 'atime' => 1405023944,
# 'ino' => 426287,
# 'gid' => 1000
# }, 'File::Find::Object::StatObj' ),
# 'dir_components' => []
# }, 'File::Find::Object::Result' );
I'm not sure how correct this would be, but what I like about this is that I could forget where the fields are; then I could rerun the dumper, and see that I could get mtime via (*::Result)->stat_obj->size - and that seems to work (here I'd need just to read these, not to set them).
Anyways, here is the code:
use Data::Dumper;
my #targetDirsToScan = ("./");
use IO::All -utf8 ; # Turn on utf8 for all io
# try to "replace" the IO::All::File class
{ # https://stackoverflow.com/a/24726797/277826
package IO::All::File;
use IO::All::File; # -base; # just do not use `-base` here?!
# hacks work if directly in /usr/local/share/perl/5.10.1/IO/All/File.pm
# NB: field is a sub in /usr/local/share/perl/5.10.1/IO/All/Base.pm
field mtimef => undef; # hack
sub file {
my $self = shift;
bless $self, __PACKAGE__;
$self->name(shift) if #_;
$self->mtimef($self->mtime); # hack
#print("!! *haxx0rz'd* file() reporting in\n");
return $self->_init;
}
1;
}
use File::Find::Object;
# based on /usr/local/share/perl/5.10.1/File/Find/Object/Result.pm;
# but inst. from /usr/local/share/perl/5.10.1/File/Find/Object.pm
{
package File::Find::Object::StatObj;
use integer;
use Tie::IxHash;
#use Data::Dumper;
sub ordered_hash { # https://stackoverflow.com/a/3001400/277826
#my (#ar) = #_; #print("# ". join(",",#ar) . "\n");
tie my %hash => 'Tie::IxHash';
%hash = #_; #print Dumper(\%hash);
\%hash
}
my $fields = ordered_hash(
# from http://perldoc.perl.org/functions/stat.html
(map { $_ => $_ } (qw(
dev ino mode nlink uid gid rdev size
atime mtime ctime blksize blocks
)))
); #print Dumper(\%{$fields});
use Class::XSAccessor
#accessors => %{$fields}, # cannot - is seemingly late
# ordered_hash gets accepted, but doesn't matter in final dump;
#accessors => { (map { $_ => $_ } (qw(
accessors => ordered_hash( (map { $_ => $_ } (qw(
dev ino mode nlink uid gid rdev size
atime mtime ctime blksize blocks
))) ),
#))) },
;
use Fcntl qw(:mode);
sub new
{
#my $self = shift;
my $class = shift;
my #stat_arr = #_; # the rest
my $ic = 0;
my $self = {};
bless $self, $class;
for my $k (keys %{$fields}) {
$fld = $fields->{$k};
#print "$ic '$k' '$fld' ".join(", ",$stat_arr[$ic])." ; ";
$self->$fld($stat_arr[$ic]);
$ic++;
}
#print "\n";
return $self;
}
1;
}
# try to "replace" the File::Find::Object::Result
{
package File::Find::Object::Result;
use File::Find::Object::Result;
#use File::Find::Object::StatObj; # no, has no file!
use Class::XSAccessor replace => 1,
accessors => {
(map { $_ => $_ } (qw(
base
basename
is_dir
is_file
is_link
path
dir_components
stat_ret
stat_obj
)))
}
;
#use Fcntl qw(:mode);
#sub new # never gets called
sub full_components
{
my $self = shift; #print("NEWCOMP\n");
my $sobj = File::Find::Object::StatObj->new(#{$self->stat_ret()});
$self->stat_obj($sobj); # add stat_obj and its fields
return
[
#{$self->dir_components()},
($self->is_dir() ? () : $self->basename()),
];
}
1;
}
# main script start
my $io = io($targetDirsToScan[0]);
my #contents = $io->all(0); # Get all contents of dir
for my $contentry ( #contents ) {
print Dumper \%{*$contentry};
print $contentry->name . "\n"; # img/test.png
# get a File::Find::Object::Result - must instantiate
# a File::Find::Object; just item_obj() will return undef
# right after instantiation, so must give it "next";
# no instantition occurs for $tro, though!
#my $tffor = File::Find::Object->new({}, ($contentry->name))->next_obj();
my $tffo = File::Find::Object->new({}, ("./".$contentry->name));
my $tffos = $tffo->next(); # just a string!
$tffo->_calc_current_item_obj(); # unfortunately, this will not calculate dir_components ...
my $tffor = $tffo->item_obj();
# ->full_components doesn't call new, either!
# must call full_compoments, to generate the fields
# (assign to unused variable triggers it fine)
# however, $arrref_fullcomp will be empty, because
# File::Find::Object seemingly calcs dir_components only
# if it is traversing a tree...
$arrref_fullcomp = $tffor->full_components;
#print("# ".$tffor->stat_obj->size."\n"); # seems to work
print "> ". join(", ", #$arrref_fullcomp) ." - ". Dumper($tffor);
}

Perl Getopt::Long Assigning variable then going to subroutine

I have the following piece of code
my $use = "Use: " . basename($0) . " [options]";
my $version = "Version: 0.1 \n";
my $variableA;
my $variableB;
GetOptions(
'a=s' => \$variableA,
'help' => sub { print $use; exit 0 },
'version' => sub { print $version; exit 0 },
'b' => sub { \$variableB, &this_subroutine; goto NOWGOHERE; },
);
die "Incorrect use. \n" unless (defined $variableA || defined $variableB);
sub this_subroutine {
print "$variableB\n";
}
NOWGOHERE: print "HELLO I'M NOW HERE\n";
What I am trying to do is set $variableB and then do the &this_subroutine and the goto NOWGOHERE but I can only get it to do one or the other, not both, using either 'b=s' => \$variableB, or sub { &this_subroutine; goto NOWGOHERE;0 },
When trying to do both I cannot seem to print the $variableB, is there something obvious I am missing or doing wrong syntactically?
Using 'b=s' => \$variableB, sub { &this_subroutine; goto NOWGOHERE; }, does not seem to work either?
your help is much appreciated, many thanks
$variableB will never have a value because you never assign to it.
'a=s' => \$variableA,
gives $variableA a value because, when Getopt::Long is given a scalar ref, it assigns the option's value to that scalar.
On the other hand,
'b' => sub { \$variableB, &this_subroutine; goto NOWGOHERE; },
gives Getopt::Long a code reference, which it can't assign the option value to.
Based on the docs, it appears that it passes the option name and option value to the coderef as parameters, in which case
'b=s' => sub { $variableB = $_[1]; this_subroutine(); goto NOWGOHERE; },
should probably do what you want.