Is this snippet creating an anonymous Perl hash? - perl

While reading the snippets provided by FormFiller ( where I kinda got by accident ) , I noticed this line:
$f->add_filler( password => Interactive => []);
Is this password => Interactive => [] equivalent to {"password" => {"Interactive"=>[]}}? If not, what does it become?

=> is semantically (almost) identical to , (see "Comma operator" at perldoc perlop), so you're doing this:
$f->add_filler( 'password', 'Interactive', [] );
If this calling style is supported by the method (which it doesn't), then it itself would have to convert these arguments into
{ password => { Interactive => [] } }
However more typically, hash-style arguments would be passed as a legal hash to begin with:
$f->add_filler( password => { Interactive => 1 } );
This would be received by the function like this:
sub add_filler
{
my $this = shift;
my %configs = #_;
# ...
}

The Data::Dumper module is great for answering questions like this. Use the following mock:
package Foo;
use Data::Dumper;
sub new { bless {} => shift }
sub add_filler {
my $self = shift;
print Dumper \#_;
}
Then call it
package main;
my $f = Foo->new;
$f->add_filler( password => Interactive => []);
and see when you get:
$VAR1 = [
'password',
'Interactive',
[]
];
This shows that add_filler receives a flat list of three arguments: two strings and a reference to an anonymous array.

No, it's exactly the same as
$f->add_filler( "password", "Interactive", []);

Related

How to return the correct object attribute in perl?

I have a package I created that is meant to return the object's specified attribute (shortened code)
package vendor_info;
my $vars;
sub new{
my $class = shift;
$vars = {
_servers => shift,
_locations => shift,
_favorite => shift,
_default_selection => shift,
_database => shift,
_DB => shift};
bless $vars, $class;
return $vars;
}
sub get_locations{
return $vars->{_locations};
}
sub get_database{
return $vars->{_database};
}
sub get_DB{
return $vars->{_DB};
}
My perl file receives an input parsed from the terminal but in this case, the variable $vendor is hard coded for testing. I have a list of objects in a hash, and I want to return the correct attribute according to the object. Some of the variables have been removed with placeholders.
$vendor = "atrena";
my %vendor_hash = (
"atrena" => new vendor_info("Variable_server","Variable_location","Advanced_CDC|CDC dftso|DFT|gui|GUI|adv_checker|Lint|spl-view-only|view-only-GUI","adv_checker","database","DB"),
"ansys" => new vendor_info("Variable","Location","agppi|agppi|ane3fl|ane3fl|ansys|ansys|ensemble_gui|ensemble_gui|hfss_desktop|hfss_desktop|hfss_gui|hfss_gui|hfss_solve|hfss_solve|hfsshpc_pack|hfsshpc_pack|optimetrics|optimetrics|q3d_desktop|q3d_desktop|rdacis|rdacis|struct|struct","ane3fl","database", "db"),
"coventor" => new vendor_info("var","location","COV_ZsplatViewer|Viewer|COV_VoxelModeler|Voxel-Modeler|MEMSp_Import_Package|Import-Package|MEMSp_Innovator_Plugin|Innovator-Plugin|MEMSp_MATLAB_Simulation|MATLAB-Simulation|MEMSp_Platform|Platform|MTI_AutoBuilder|Auto-Builder|MTI_Catapult|Catapult|MTI_CoventorWare|Coventor-Ware|MTI_Memcap|Memcap|MTI_PreProcessor|PreProcessor","database","db","db")
);
$vendor_object = $vendor_hash{$vendor};
print Dumper( $vendor_object);
$foodb = $vendor_object -> get_database();
The dumper is printing the correct information, however, when I call get_database(), the database called is always the attribute from the last object in the list, which in this case is coventor. The same could be said for any of the sub routine getters.
How do I call the correct attribute for the correct object?
You have $vars as a lexical variable which is scoped to the file which contains your package. So there is only one instance of this variable and it will always contain the data for the last object that was set up.
I'm not sure where you picked up that approach, but it's not how Perl objects work at all. $vars should be scoped to only exist within your constructor and your accessors should be using the object that is passed to them as their first argument (traditionally called $self).
# Only pragmas should start with lower-case letters
package VendorInfo;
sub new{
my $class = shift;
my $vars = {
_servers => shift,
_locations => shift,
_favorite => shift,
_default_selection => shift,
_database => shift,
_DB => shift
};
return bless $vars, $class;
}
# Just one example accessor...
sub get_database{
my $self = shift;
return $self->{_database};
}
One more point, please use Class->new() instead of the potentially problematic new Class syntax that you are using in your code.
Dave Cross already answered your immediate question.
This is an example of a more idiomatic version of your code:
{
package VendorInfo;
use Moo;
for my $attr (qw(
servers
locations
favorite
default_selection
database
DB
)) {
has $attr => (
is => 'ro',
required => 1,
);
}
}
# main program
use strict;
use warnings;
use Data::Dumper;
my %vendor_hash = (
"atrena" => VendorInfo->new(
servers => "Variable_server",
locations => "Variable_location",
favorite => "Advanced_CDC|CDC dftso|DFT|gui|GUI|adv_checker|Lint|spl-view-only|view-only-GUI",
default_selection => "adv_checker",
database => "database",
DB => "DB",
),
"ansys" => VendorInfo->new(
servers => "Variable",
locations => "Location",
favorite => "agppi|agppi|ane3fl|ane3fl|ansys|ansys|ensemble_gui|ensemble_gui|hfss_desktop|hfss_desktop|hfss_gui|hfss_gui|hfss_solve|hfss_solve|hfsshpc_pack|hfsshpc_pack|optimetrics|optimetrics|q3d_desktop|q3d_desktop|rdacis|rdacis|struct|struct",
default_selection => "ane3fl",
database => "database",
DB => "db",
),
"coventor" => VendorInfo->new(
servers => "var",
locations => "location",
favorite => "COV_ZsplatViewer|Viewer|COV_VoxelModeler|Voxel-Modeler|MEMSp_Import_Package|Import-Package|MEMSp_Innovator_Plugin|Innovator-Plugin|MEMSp_MATLAB_Simulation|MATLAB-Simulation|MEMSp_Platform|Platform|MTI_AutoBuilder|Auto-Builder|MTI_Catapult|Catapult|MTI_CoventorWare|Coventor-Ware|MTI_Memcap|Memcap|MTI_PreProcessor|PreProcessor",
default_selection => "database",
database => "db",
DB => "db",
),
);
my $vendor = "atrena";
my $vendor_object = $vendor_hash{$vendor};
print Dumper($vendor_object);
print "The database is: ", $vendor_object->database, "\n";
Things of note:
I renamed vendor_info to VendorInfo. Lowercase module names are (informally) reserved for pragmata.
I used Moo as a helper module for writing classes.
Moo provides a has helper function for declaring attributes. It also generates a constructor for me, so I don't have to write any boilerplate myself.
Moo automatically enables warnings/strict, so I don't have to do that either.
Indirect object syntax (method $object or method class, in your case new vendor_info) is a bad idea because of its syntactic ambiguity. class->method (here: VendorInfo->new) is much better.
The constructor created by Moo takes its arguments in the form of key-value pairs, not a long list (which is a good idea anyway if your sub takes more than 3 arguments).
Every attribute I declared gets a (read-only (because I used 'ro')) accessor, so client code can simply use $object->database.
In addition to other people's points, you will need to add a true statement at the end of your .pm file
This is how I would write your application
VendorInfo.pm
package VendorInfo;
use strict;
use warnings 'all';
sub new {
my $class = shift;
my $self;
#{$self}{qw/
_servers
_locations
_favorite
_default_selection
_database _DB
/} = #_;
return bless $self, $class;
}
sub get_locations {
my $self = shift;
return $self->{_locations};
}
sub get_database {
my $self = shift;
return $self->{_database};
}
sub get_DB {
my $self = shift;
return $self->{_DB};
}
1;
main.pl
use strict;
use warnings 'all';
use VendorInfo;
use Data::Dumper;
my $vendor = 'atrena';
my %vendor_hash = (
atrena => VendorInfo->new(
'Variable_server',
'Variable_location',
'Advanced_CDC|CDC dftso|DFT|gui|GUI|adv_checker|Lint|spl-view-only|view-only-GUI',
'adv_checker',
'database',
'DB',
),
ansys => VendorInfo->new(
'Variable',
'Location',
'agppi|agppi|ane3fl|ane3fl|ansys|ansys|ensemble_gui|ensemble_gui|hfss_desktop|hfss_desktop|hfss_gui|hfss_gui|hfss_solve|hfss_solve|hfsshpc_pack|hfsshpc_pack|optimetrics|optimetrics|q3d_desktop|q3d_desktop|rdacis|rdacis|struct|struct',
'ane3fl',
'database',
'db',
),
coventor => VendorInfo->new(
'var',
'location',
'COV_ZsplatViewer|Viewer|COV_VoxelModeler|Voxel-Modeler|MEMSp_Import_Package|Import-Package|MEMSp_Innovator_Plugin|Innovator-Plugin|MEMSp_MATLAB_Simulation|MATLAB-Simulation|MEMSp_Platform|Platform|MTI_AutoBuilder|Auto-Builder|MTI_Catapult|Catapult|MTI_CoventorWare|Coventor-Ware|MTI_Memcap|Memcap|MTI_PreProcessor|PreProcessor',
'database',
'db',
'db',
),
);
my $vendor_object = $vendor_hash{$vendor};
print Dumper $vendor_object;
my $foodb = $vendor_object->get_database;
print $foodb, "\n";
output
$VAR1 = bless( {
'_servers' => 'Variable_server',
'_default_selection' => 'adv_checker',
'_locations' => 'Variable_location',
'_database' => 'database',
'_DB' => 'DB',
'_favorite' => 'Advanced_CDC|CDC dftso|DFT|gui|GUI|adv_checker|Lint|spl-view-only|view-only-GUI'
}, 'VendorInfo' );
database

Perl array attribute inside an object

Tried to write a perl module with OOP, but it can add an object to an array, when I use Dump method, it will output wrong data like this. Where is my error ?
Thanks
bless( {
'_name' => 'CUSIP',
'_validation_array' => [],
'_seq' => '1'
}, 'Field' );
source code:
package Field;
sub new {
my $class = shift;
my $self = {
_name => shift,
_seq => shift,
_validation_array => [ #_ ],
};
bless($self, $class);
return $self;
};
sub pushValidation(){
my $validation = shift;
push(#{$self->{_validation_array}}, $validation);
};
sub dump(){
foreach my $validation (#{$self->{_validation_array} }) {
#print Dumper($validation);#will work,
print $validation->{name}; #error, Use of uninitialized value
}
}
1;
This is the way I call this method :
my $validationObj = new Validation($validation->{name}, $validation->{seq});
$field->pushValidation($validationObj);
I see several problems here, but the most serious one is here:
sub pushValidation() {
my $validation = shift;
push(#{$self->{_validation_array}}, $validation);
};
This function is expecting a $self argument, but isn't shifting it from the arguments. You need to add use strict; at the top of your Perl file. If it had been enabled, the issue would have been immediately obvious:
Global symbol "$self" requires explicit package name at <filename> line <line>.
Same thing goes for the dump() function. (By the way, dump is a bad method name, as there is an (obscure) Perl builtin function with the same name. But that's not a huge issue.)

Turn data structures into perl objects (module recommendation)

I have an arbitrary data structure and I'd like to treat it as an object. I get this as a response from a REST app. Example below. There are some modules on CPAN which promise to do this. Data::Object looks best to me, but it's last updated 2011. Am I missing something? Is there perhaps an easy Moose way to do this? Thanks!
$o=$class->new($response);
$s=$o->success;
#i=$o->items;
{
'success' => bless( do{\(my $o = 1)}, 'JSON::XS::Boolean' ),
'requestNumber' => 5,
'itemsCount' => 1,
'action' => 'search.json',
'totalResults' => 161,
'items' => [
{
'link' => 'http://europeana.eu/api//v2/record/15503/E627F23EF13FA8E6584AF8706A95DB85908413BE.json?wskey=NpXXXX',
'provider' => [
'Kulturpool'
],
'europeanaCollectionName' => [
'15503_Ag_AT_Kulturpool_khm_fs'
],
# more fields omitted
}
],
'apikey' => 'Npxxxx'
};
Although I don't like using it, defining an AUTOLOAD subroutine is a way to create arbitrary classes on the fly. It's been a while since I used it, but it should look something like this:
package Local::Foo;
sub new {
my $class = shift;
my $self = {};
bless $self, $class;
return $self;
}
sub AUTOLOAD {
my $self = shift;
my $value = shift;
our $AUTOLOAD;
(my $method = $AUTOLOAD) = s/.*:://;
if ( defined $value ) {
$self->{$method} = $value;
}
return $self->{$method};
}
This class Local::Foo has an infinite amount of methods. For example, if I said
$foo->bar("fubar");
This would be the same as:
$foo->{bar} = "foobar";
If i called $foo->bar;, it will return the value of $foo->{bar};.
You probably want something to limit your method's style, and their values. For example, with this:
$foo->BAR;
$foo->Bar;
$foo->bar;
are all three valid and completely different methods. You probably want something to make sure your methods match a particular pattern (i.e., they're all lowercase, or the first letter is uppercase and the rest are lowercase. You probably want to make sure they start with a letter so, $foo->23diba; isn't a valid method.
One little problem: Once you define an AUTOLOAD subroutine, you also define DESTROY subroutine too. Perl calls the DESTROY subroutine before an object is destroyed. You need to handle the issue if $AUTOLOAD =~ /.*::DESTROY$/ too. You may need to add:
return if $AUTOLOAD =~ /.*::DESTROY$/;
somewhere in the AUTOLOAD subroutine, so you don't accidentally do something when DESTROY is called. Remember, it's automatically called whenever a class object falls out of scope if one exists, and with AUTOLOAD, you've defined one anyway.
This is an example:
use strict;
package Foo;
#define a simple Foo class with 3 properties
use base qw(Class::Accessor);
Foo->mk_accessors(qw(name role salary));
package main;
#define a perl hash with the same keys
my $hr = {'name'=>'john doe', 'role'=>'admin', 'salary'=>2500 };
#bless the object
my $obj = bless $hr, 'Foo';
print $obj->name, "\n"; #<-- prints: john doe
I am not saying this is necessarily a good idea, the best way to do the idea, or gotcha-free. I never tried it till 15 minutes ago. But it is fun and it is terse, so–
#!/usr/bin/env perl
BEGIN {
package Role::AutoVacca;
use Moo::Role;
use Scalar::Util "blessed";
sub BUILD {
my $self = shift;
for my $attr ( grep /\A[^_]/, keys %{$self} )
{
Method::Generate::Accessor
->generate_method( blessed($self),
$attr,
{ is => "rw" } );
}
}
package Fakey;
use Moo;
with "Role::AutoVacca";
}
my $fake = Fakey->new({
success => bless( do{\(my $o = 1)}, "JSON::XS::Boolean" ),
items => [ { link => "http://europeana.eu/o/haipi",
provider => [ "mememememe" ] } ],
apikey => "3k437" });
print "I CAN HAZ KEE? ", $fake->apikey, $/;
print "IZ GUD? ", $fake->success ? "YAH" : "ONOES", $/;
print "WUT DIZZYING? ", $fake->items, $/;

Params::Validate, how to require one of two parameters?

If I have a method that takes either one or the other of two named parameters, exactly one of which must be present, is there a way to handle that with Params::Validate?
$store->put( content_ref => $stringref );
or
$store->put( path => $path_to_file );
I'm not seeing it in the docs, but it seems like an obvious use case, so I thought I should ask.
You can use callbacks to achieve something along those lines:
#!/usr/bin/env perl
use strict;
use warnings;
package My::Class;
use Params::Validate;
use YAML;
sub new { bless {} => shift }
sub _xor_param {
my $param = shift;
return sub { defined($_[0]) and not defined($_[1]->{$param}) }
}
my %validation_spec = (
content_ref => {
'default' => undef,
callbacks => {
"Provided only if no 'path' is given"
=> _xor_param('path')
},
},
path => {
'default' => undef,
callbacks => {
"Provided only if no 'content_ref' is given"
=> _xor_param('content_ref')
},
},
);
sub put {
my $self = shift;
validate(#_, \%validation_spec);
print Dump \#_;
}
package main;
my $x = My::Class->new;
$x->put(path => 'some path');
$x->put(content_ref => \'some content');
$x->put(path => 'another_path', content_ref => \'some other content');
Output:
---
- path
- some path
---
- content_ref
- !!perl/ref
=: some content
The 'content_ref' parameter ("SCALAR(0xab83cc)") to My::Class::put did not pass
the 'Provided only if no 'path' is given' callback
at C:\temp\v.pl line 37
My::Class::put(undef, 'path', 'another_path', 'content_ref',
'SCALAR(0xab83cc)') called at C:\temp\v.pl line 47

Perl: do and eval result in different answers?

I have a file with the following statements in it:
{
%{do '/tmp/personcontact.pl'},
%{do '/tmp/address.pl'}
}
Now, the temp files are as follows:
Personcontact.pl :
{
'firstname' => {
'__type' => 'String'
},
'lastname' => {
'__type' => 'String'
}
}
Address.pl:
{
'address' => {
'street' => {
'__type' => 'String'
},
'unit' => {
'__type' => 'String',
},
'suburb' => {
'__type' => 'String'
},
'__type' => 'HASH'
}
}
Now, when I do :
open(SCHEMAFILE, "<", $schema) or return undef;
my $schemafile;
while(my $line = <SCHEMAFILE>) { $schemafile .= $line;}
my $tempref = eval $schemafile;
print Dumper $tempref;
The result is $VAR1 = '1/8'
And when I do :
print Dumper do "/tmp/schemawithinschema.pl";
The result is
$VAR1 = 'firstname';
$VAR2 = {
'__type' => 'String'
};
$VAR3 = 'address';
$VAR4 = {
'suburb' => {
'__type' => 'String'
},
'unit' => {
'__type' => 'String'
},
'street' => {
'__type' => 'String'
},
'__type' => 'ARRAY'
};
$VAR5 = 'lastname';
$VAR6 = {
'__type' => 'String'
};
What's wrong here? Thanks!
Alright, to keep this from perpetuating forever, here is a module-based solution for you:
Foo.pm:
package Foo;
use strict;
use warnings;
BEGIN {
require Exporter;
our #ISA = qw( Exporter );
our #EXPORT_OK = qw( get_person get_address get_all );
our $VERSION = '0.01';
}
my %person = (
firstname => {
__type => 'String',
},
lastname => {
__type => 'String',
},
);
my %address = (
address => {
street => {
__type => 'String',
},
unit => {
__type => 'String',
},
suburb => {
__type => 'String',
},
__type => 'HASH',
},
);
sub get_person
{
return \%person;
}
sub get_address
{
return \%address;
}
sub get_all
{
return( { %person, %address } );
}
1;
__END__
bar.pl:
#!/usr/bin/perl
use Data::Dumper;
use strict;
use warnings;
use lib '.';
use Foo qw( get_person get_address get_all );
my $junk = get_all();
print Dumper $junk;
But really, for the sake of your maintenance programmer (often yourself in 6 months), use JSON or YAML (or the faster YAML::XS), so that the data can be maintained as a simple-ish text file, instead of a series of nested data-disguised-as-code references.
To quote Perl Best Practices (not sure if it was Damian originally):
Always code as if the guy who ends up maintaining your code will be a violent psychopath who knows where you live.
EDIT: For completeness, here is the equivalent solution using YAML (from CPAN):
data.yml:
---
firstname:
__type: String
lastname:
__type: String
address:
__type: HASH
street:
__type: String
suburb:
__type: String
unit:
__type: String
baz.pl:
#!/usr/bin/perl
use YAML qw( Load Dump LoadFile DumpFile );
use Data::Dumper;
use strict;
use warnings;
my $data = LoadFile( 'data.yml' );
print Dumper $data;
One small pointer. That '1/8' is what you get when you evaluate a hash in a scalar context. The 8 is the number of buckets assigned to the hash and the 1 is the number of buckets that are in use.
It's generally useless, other than as a flag that you're doing something wrong.
While the intent of the question makes me cry, the difference between your two code snippets has nothing to do with do or eval and everything to do with context. And since that is a legitimate Perl topic, I'll briefly answer it.
In
my $tempref = eval $schemafile;
, the eval takes place in scalar context (imposed by the assignment to $tempref). $schemafile, however, contains a hash, created by the hash reference dereference operator %{}. When that hash is evaluated as a scalar it produces 1/8, normal behavior for a hash.
In
print Dumper do "/tmp/schemawithinschema.pl";
, the do takes place in the list context imposed by the Dumper call (which in turn is in the list context of the print). do creates the same hash that the eval did, but now it's being evaluated in list context, in fact as a list of arguments to Dumper. The top-level hash gets flattened into a list of Label => HashRef pairs, but that's not enough to stop Dumper from being able to show you something that looks a lot like the hash you were trying to create.
For future reference, it is helpful when trying to pinpoint a strange difference of behavior to present exactly the same call in both cases. The more variables between two test cases, the more things that you weren't expecting to matter will wind up mattering and confuse you.
All of that said, the real answer to "What's wrong here?" remains "Trying to do this at all.".