How to verify which flags were read using Getopt::Long in Perl? - perl

myscript.pl
my $R;
my $f1 = "f1.log";
my $f2 = "f2.log";
my $f3 = "f3.log";
sub checkflags {
GetOptions('a=s' => \$f1,
'b=s' => \$f2,
'c=s' => \$f3,
);
open $R, '>', $f1 or die "Cannot open file\n"; # Line a
}
All the flags are optional.
If I call the script as
perl myscript.pl -a=filename
I need to append a .log to the filename before opening it at Line a.
For that I need to know whether GetOptions read something into $f1 or not.
How can this be done?

The simplest solution is to look for /[.]log$/ in $f1 and add it if it isn't present. Unfortunately that means that when the user passes in "foo.log" and wanted it to become "foo.log.log" it won't, but I think we can agree that user is a jerk.
A better option, that will make the jerk happy, is:
#!/usr/bin/perl
use strict;
use warnings;
use Getopt::Long;
GetOptions(
'a=s' => \my $f1,
'b=s' => \my $f2,
'c=s' => \my $f3,
);
if (defined $f1) {
$f1 .= ".log";
} else {
$f1 = "f1.log";
}
print "$f1\n";
If you want to define all of default names at the top, use a different variable to do that (it is probably better reading code anyway):
#!/usr/bin/perl
use strict;
use warnings;
use Getopt::Long;
my $default_f1 = "f1.log";
my $default_f2 = "f2.log";
my $default_f3 = "f3.log";
GetOptions(
'a=s' => \my $f1,
'b=s' => \my $f2,
'c=s' => \my $f3,
);
if (defined $f1) {
$f1 .= ".log";
} else {
$f1 = $default_f1;
}
print "$f1\n";

if (defined $f1) {
# You got a -a option
}
But personally I'd prefer to read the options into a hash and then use exists().

$f1 = "$f1.log" unless $f1 =~ m/\.log$/i;
Appends the log extension if the file name does not already have one. Since the default value ends in log, nothing happens. And it works if the user types the log on the command line.

One way to achieve this is to use Moose and MooseX::Getopt:
package MyApp;
use strict;
use warnings;
use Moose;
with 'MooseX::Getopt';
has f1 => (
is => 'ro', isa => 'Str',
cmd_aliases => 'a',
default => 'f1.log',
predicate => 'has_a',
);
has f2 => (
is => 'ro', isa => 'Str',
cmd_aliases => 'b',
default => 'f2.log',
predicate => 'has_b',
);
has f3 => (
is => 'ro', isa => 'Str',
cmd_aliases => 'c',
default => 'f3.log',
predicate => 'has_c',
);
# this is run immediately after construction
sub BUILD
{
my $this = shift;
print "a was provided\n" if $this->has_a;
print "b was provided\n" if $this->has_b;
print "c was provided\n" if $this->has_c;
}
1;

Related

Perl script error Can't use an undefined value as a symbol reference at ./sendEvent.pl line 66

Hello everyone i am new to perl scripting and below is my perl script
#!/usr/bin/perl
#use strict;
use warnings;
use 5.010;
I am getting the error
Can't use an undefined value as a symbol reference at ./sendEvent.pl line 66.
can anyone please tell me what is the issue?
It seems as though your socket isn't connected, as that's where the undefined reference is being generated.
Try ensuring that your socket is opened with the IO::Socket call...
$sock = IO::Socket::INET->new(PeerAddr => "$hostname",
PeerPort => "$port",
Proto => 'tcp')
or die "can't connect to port $port on $hostname: $!";
or somesuch.
See where that gets you. At the very least you'll know whether the socket connects correctly.
Attn: OP
Suggestion: use of hash simplifies typing and make code more readable
#!/usr/bin/perl
use strict;
use warnings;
use 5.010;
use IO::Socket;
use Getopt::Long qw(GetOptions);
use Data::Dumper;
my %unit;
my #keys = qw(host port source name value part ptype module);
my #threshold = ("1000000");
# Defaults to avoid typing parameters
%unit = (
host => 'igloz118',
port => '2010',
source => 'APG_HEALTH',
name => 'RawValueCount',
value => '1000002',
part => 'APG',
ptype => 'APG-Frontend',
module => 'connecting',
devtype => 'Host',
group => 'group',
dname => '.lss.emc.com'
);
GetOptions(
'host|h=s' => \$unit{host},
'port|p=s' => \$unit{port},
'source|s=s' => \$unit{source},
'name|n=s' => \$unit{name},
'value|v=s' => \$unit{value},
'part|p=s' => \$unit{part},
'ptype|pt=s' => \$unit{ptype},
'module|m=s' => \$unit{module}
) or die "Usage: $0 --n NAME\n";
$unit{device} = $unit{host}.$unit{dname};
say '::: Parameters :::::';
printf "%-8s = %s\n", $_, $unit{$_} for #keys;
say '::::::::::::::::::::';
my $sock = IO::Socket::INET->new(
PeerAddr => $unit{hostname},
PeerPort => $unit{port},
Proto => 'tcp'
) or die "can't connect to port $unit{port} on $unit{host}: $!";;
#keys = qw/group variable value device devtype module part parttype name threshold source/;
for (my $i = 0; $i <=0 ; $i++) {
my($timestamp,$raw);
$timestamp = time;
$unit{threshold} = $threshold[$i];
$unit{variable} = join '.', #unit{qw/source device part name/};
$raw = join "\t", ( '+r', $timestamp, #unit{#keys} );
print "$raw";
print $sock "$raw";
}
close($sock);

Moose: builder requires a value that sometimes is not set (non deterministic)

I'm new to MOOSE and Perl OOP, and I'm struggling understanding the execution order of the code.
I want to create a class reading files, so an attribute of the object should be the filehandle and another the filename to be read.
My problem is that the attribute 'filehandle' has a builder that requires $self->filename, but sometimes at runtime 'filename' is not (yet) available when the builder is called.
Thanks for you help
My ideal object creation:
my $file = FASTQ::Reader->new(
filename => "$Bin/test.fastq",
);
Perl module:
has filename => (
is => 'ro', isa => 'Str', required => 1,
);
has fh => (
is => 'ro', isa => 'FileHandle', builder => '_build_file_handler',
);
sub _build_file_handler {
my ($self) = #_;
say Dumper $self;
open(my $fh, "<", $self->filename) or die ("cant open " . $self->filename . "\n");
return $fh;
}
See: https://gist.github.com/telatin/a81a4097913af55c5b86f9e01a2d89ae
If a value of one attribute depends on another attribute, make it lazy.
#!/usr/bin/perl
use warnings;
use strict;
{ package My::Class;
use Moose;
has filename => (is => 'ro', isa => 'Str', required => 1);
has fh => (is => 'rw', isa => 'FileHandle', lazy => 1, builder => '_build_fh');
# ~~~~~~~~~
sub _build_fh {
my ($self) = #_;
open my $fh, '<', $self->filename or die $!;
return $fh
}
}
my $o = 'My::Class'->new(filename => __FILE__);
print while readline $o->fh;
See Laziness in Moose::Manual::Attributes:
if the default value for this attribute depends on some other attributes, then the attribute must be lazy.

How do I set a default FileHandle attribute with moose

You may infer from the question that this is my first Moose class.
How do I set an attribute FileHandle to *STDOUT?
This doesn't work.
has 'output' => (
is => 'rw',
isa => 'FileHandle',
default => sub { openhandle(*STDOUT) }
);
The output when run is:
Attribute (output) does not pass the type constraint because: Validation failed for 'FileHandle' with value *main::STDOUT
The documentation claims:
FileHandle accepts either an IO::Handle object or a builtin perl
filehandle (see "openhandle" in Scalar::Util).
What am I missing?
Thanks.
-E
I don't know what else you may need there, but this works for starters
The WithFH.pm
package WithFH;
use feature 'say';
use Moose;
has 'fh' => (is => 'ro', isa => 'FileHandle', default => sub { \*STDOUT } );
sub say {
my $self = shift;
say { $self->{fh} } "#_";
}
__PACKAGE__->meta->make_immutable;
1;
and the main
use warnings;
use strict;
use feature 'say';
use WithFH;
my $wfh = WithFH->new;
$wfh->say("hi");
That prints hi to STDOUT.

Perl Moose: Attribute only getting set when mentioned in BUILD subroutine

I've building a script that recursively builds the names of a directory's subdirectories/files and the names of the files in those subdirectories as objects:
package Dir;
use Moose;
use Modern::Perl;
use File;
use strict;
use warnings;
has 'path' => (is => 'ro', isa => 'Str', required => 1);
has 'name' => (is => 'ro', isa => 'Str', lazy => 1, default => sub { my $self = shift; my ($name) = $self->path =~ /\/([^\/]*)$/; return $name; } );
has 'subdirs' => (is => 'rw', isa => 'ArrayRef[Dir]' );
has 'files' => (is => 'rw', isa => 'ArrayRef[File]' );
has 'num_dirs' => (is => 'ro', isa => 'Int', lazy => 1, default => sub { my $self = shift; scalar #{$self->subdirs}; } );
sub BUILD {
my $self = shift;
my $path = $self->path;
# run some tests
logf('Path to the directory does not exist.') if (!-e $path);
logf('The path should point to a directory, not a file.') if (!-d $path);
# populate subdirs attribute with Dir objects
opendir my $dh, $path or die "Can't opendir '$path': $!";
# Get files and dirs and separate them out into categories
my #dirs_and_files = grep { ! m{^\.$|^\.\.$} } readdir $dh;
closedir $dh or die "Can't closedir '$path': $!";
my #subdir_names = grep { -d "$path/$_" } grep { !m{^\.} } #dirs_and_files;
my #file_names = grep { -f "$path/$_" } grep { !m{^\.} } #dirs_and_files;
# Create objects
my #dir_objects = map { Dir->new ( path => $path . '/' . $_ ) } #subdir_names;
my #file_objects = map { File->new ( path => $path . '/' . $_ ) } #file_names;
# Populate this with file and directory objects
$self->subdirs ( \#dir_objects );
$self->files ( \#file_objects );
}
1;
Notice the code has a files attribute which holds an array of File objects. A File has the following attributes:
has 'path' => (is => 'ro', isa => 'Str', required => 1);
has 'name' => (is => 'ro', isa => 'Str', lazy => 1, default => sub { my $self = shift; my ($name) = $self->path =~ /\/([^\/]*)$/; return $name; } );
The problem is that the name attribute never gets set when a File object is created. I'm not sure why.
EDIT 1: Solution (sort of)
So, I slapped this into the File object to see if it triggered the creation of the attribute:
sub BUILD {
my $self = shift;
}
This did not solve the problem. However, this did:
sub BUILD {
my $self = shift;
$self->name;
}
The question I have, though, is why did I need to do this?
The problem is your pattern is failing if there's a trailing slash.
my ($name) = $self->path =~ /\/([^\/]*)$/;
If $self->path is /some/thing it works. If it's /some/thing/ it "works" but [^\/]* happily matches an empty string. So you get no warning.
You can put in an optional slash, and change it to match ONE or more non-slashes. Also by using alternative delimiters we can clean up all those leaning toothpicks.
my ($name) = $self->path =~ m{/ ([^/]+) /? $}x;
But really one shouldn't be parsing paths with regular expressions. Use one of the many built in modules like File::Basename or File::Spec
return basename($self->path);
Some side notes.
Moose is very slow to start up and is best suited for long running processes like web servers. For something as generic as a File and Dir class, consider using Moo. It's mostly compatible with Moose, much faster, and when used in conjunction with Types::Standard, does types better. It would be good, for example, to make a StrNotEmpty type to avoid this sort of problem.
Unless this is an exercise, Perl already has a great module to do this sort of thing. Look into Path::Tiny.
Attributes with lazy => 1 are only created when their accessor is called, not after construction.
Just a side note:
You incorrectly claim a path doesn't exist if you have no permission to its parent dir. Also, you incorrectly claim a path to a directory isn't one if you have no permission to its parent dir.
You also needlessly stat the file twice. In fact, you needn't stat the file at all since opendir is already making the checks you are making.
Simply replace
logf('Path to the directory does not exist.') if (!-e $path);
logf('The path should point to a directory, not a file.') if (!-d $path);
opendir my $dh, $path or die "Can't opendir '$path': $!";
with
opendir(my $dh, $path)
or do {
logf("Can't open directory \"$path\": $!");
die("Can't open directory \"$path\": $!");
};
This also avoids the race condition in your code, the possibility that the state of things might change between the checks and the opendir.

How to set ro attributes during build?

I'm writing a script to help me get proficient in Moose. I've got the following bit of code:
package Dir;
use Moose;
use Modern::Perl;
use File;
has 'dirs' => (is => 'ro', isa => 'HashRef[Dir]' );
has 'files' => (is => 'ro', isa => 'HashRef[File]');
has 'dir_class' => (is => 'ro', isa => 'ClassName', default => 'Dir');
has 'file_class' => (is => 'ro', isa => 'ClassName', default => 'File');
sub BUILD {
my $self = shift;
my $path = $self->path;
my $name = $self->name;
my (%dirs, %files);
# populate dirs attribute with LaborData::Data::Dir objects
opendir my $dh, $path or die "Can't opendir '$path': $!";
# Get files and dirs and separate them out
my #dirs_and_files = grep { ! m{^\.$|^\.\.$} } readdir $dh;
closedir $dh or die "Can't closedir '$path': $!";
my #dir_names = grep { -d "$path/$_" } grep { !m{^\.} } #dirs_and_files;
my #file_names = grep { -f "$path/$_" } grep { !m{^\.} } #dirs_and_files;
# Create objects
map { $dirs{$_} = $self->dir_class->new ( path => $path . '/' . $_ ) } #dir_names;
map { $files{$_} = $self->file_class->new ( path => $path . '/' . $_ ) } #file_names;
# Set attributes
$self->dirs ( \%dirs );
$self->files ( \%files );
}
The code results in the following error: died: Moose::Exception::CannotAssignValueToReadOnlyAccessor (Cannot assign a value to a read-only accessor at reader Dir::dirs
To get around this error, I could either make the attributes rw or use builder methods for the dirs and files attributes. The former solution is undesirable and the latter solution will require duplication of code (for example, the directory will need to be opened twice) and so is also undesirable.
What is the best solution to this problem?
You can assign a writer to your read-only attribute and use that internally from your BUILD. Name it with an _ to indicate it's internal.
package Foo;
use Moose;
has bar => ( is => 'ro', writer => '_set_bar' );
sub BUILD {
my $self = shift;
$self->_set_bar('foobar');
}
package main;
Foo->new;
This will not throw an exception.
It's essentially the same as making it rw, but now the writer is not the same accessor as the reader. The _ indicates that it's internal, so it's less undesirable than just using rw. Remember that you cannot really protect anything in Perl anyway. If your user wants to get to the internals they will.
I found one possible solution, though it's frowned upon:
# Set attributes
$self->{dirs} = \%dirs;
$self->{files} = \%files;