I am dealing with the following problem. I am newbie in Perl.
The idea is that I have a class, it has array as member/field (in hash).
Let's name this class ProductContainer.
I have another class Product. These Classes are in separate files (separate modules). So I need to just add a Product object into ProductContainer object (internal array).
Simple example what I need in Java.
public class ProductContainer {
private List<Product> mProductsList;
public addProduct(Product product) {
this.mProductList.add(product);
}
}
It's not clear what exactly you are asking, as you haven't shown any Perl code.
If you are using bless for your objects, the following shows you how to do that. I put all the packages in the same file. Also, note that the add method checks the type of its argument.
#!/usr/bin/perl
use warnings;
use strict;
{ package ProductContainer;
use Carp;
sub new { bless {}, shift }
sub add {
my $self = shift;
my $product = shift;
croak "Invalid member" unless UNIVERSAL::DOES($product, 'Product');
push #{ $self->{mProductsList} }, $product;
}
}
{ package Product;
sub new {
my $class = shift;
bless { name => shift }, $class
}
}
my $p = 'Product'->new('Product 1');
my $pc = 'ProductContainer'->new;
$pc->add($p);
$pc->add('Product 2'); # Exception!
Related
In Python you can do:
class Binance(Exchange):
name = "Binance"
code = "binance"
and in the parent class have
class Exchange:
#classmethod
def get_name(cls):
return cls.name
Now Perl!
This is lovely. I want the same for my Perl objects.
package DWDESReader;
use base qw(DWConfigFileReader);
our $type = "DES";
and in the base class:
package DWConfigFileReader;
our $type = "";
sub new {
my ($class, %args) = #_;
$args{type} = $type;
return bless {%args}, $class;
}
sub getType {
my ($self) = #_;
return $self->{type};
}
But this doesn't work, i.e. only returns the empty string assigned in the base class. I didn't expect it to work but am unsure how it should be done.
I don't see why one should need it, but it's possible, if you turn off strict refs:
#!/usr/bin/perl
use warnings;
use strict;
{ package My::Base;
sub new { bless {}, shift }
our $name = 'Base';
sub get_name {
my ($self) = #_;
my $class = ref $self || $self;
do { no strict 'refs';
${ $class . '::name' }
}
}
}
{ package My::Child;
use parent -norequire => 'My::Base';
our $name = 'Child';
}
my $ch = 'My::Child'->new;
print $ch->get_name, ' ', 'My::Child'->get_name;
But usually, you would just define a class method holding the name:
{ package My::Base;
sub new { bless {}, shift }
sub name { 'Base' }
sub get_name { shift->name }
}
{ package My::Child;
use parent -norequire => 'My::Base';
sub name { 'Child' }
}
Classes don't have attributes (variables) in Perl, only methods (subs).
I recommend creating an abstract virtual class method.
package DWConfigFileReader;
use Carp qw( croak );
sub new {
my ($class, %args) = #_;
my $self = bless(\%args, $class);
return $self;
}
sub type { croak("Subclass must override \"type\"."); }
1;
package DWDESReader;
use parent 'DWConfigFileReader';
sub type { "DES" }
1;
You don't even need $self->{type} = $class->type;; just use $self->type instead of $self->{type}.
As has been suggested, Perl inherits methods (subs), not variables, but constants are actually subs, so you can do something similar like this.
package DWDESReader;
use base qw(DWConfigFileReader);
use constant TYPE => "DES";
Then, if you call $self->TYPE somewhere in the base class, you'll get "DES" if the object is actually a DWDESReader object.
i'am trying to pass imported functions to another created package.
Maybe someone could help me :)
package Person;
use JSON; # i want to pass functions from this module to the package 'Employee'
sub new {
my $class = shift;
my $self = {
_name => "No Name",
};
bless $self, $class;
return $self;
}
sub setName {
my ($self, $name) = #_;
$self->{_name} = $name;
}
sub getName {
my $self = shift;
return $self->{_name};
}
1;
Now i want to use functions from the JSON Package inside this module.
package Employee;
use JSON qw( encode_json ); # This works, thx to everybody
our #ISA = qw(Person);
sub new {
my $class = shift;
my $self = Person->new();
encode_json({a=>1}); # this works now
bless $self, $class;
return $self;
}
1;
I would be nice, if someone could give me some hints.
Thanks to everybody
You're asking how to place encode_json in the Employee namespace. To do that, add the following after package Employee;:
use JSON qw( encode_json );
I'm also not sure why in the comment the OP said that he/she cannot (or does not want) put "use JSON" in the Employee package. Maybe because the Employee package file (Employee.pm) is written by someone else and cannot be modified.
Note that in Perl you can "open the Employee" package from any other code written in any file. So in your main script or the Person package file or wherever, you can do:
{ package Employee; use JSON; }
If you absolutely could not add use JSON to the Employee class because you were not sure what encoding you'd need to use, then you could pass a code reference into new:
# in Person.pm
my $e = Employee->new(\&JSON::encode_json);
# in Employee.pm
sub new {
my($class, $encoder) = #_;
...
$self->{_encoded} = $encoder->($value_to_encode);
...
return $self;
}
Again, the only reason you'd want to do this is if you dynamically needed to change which encoder you wanted to use. The solution you've adopted -- use JSON qw(encode_json) -- is the right one if you want that one function and won't need to change it.
I'm creating a user module to extract user information and currently I have:
sub new
{
my $class = shift;
my ( $id ) = #_;
my $self = getUserInfo ($id);
bless $self, $class;
return $self;
}
sub getUserInfo
{
...
}
However, I would like to achieve something to the effect of:
my $self = (getFirstName($id), getLastName($id), getEmpNum($id));
...
sub getFirstName{ return { firstname => $firstname }; }
sub getLastName{ return { lastname => $lastname }; }
sub getEmpNum{ return { empnum => $empnum }; }
How do I go about distributing a parameter to multiple subroutines?
I think your general code architecture has a few problems, but the snippets so far don't offer enough context to suggest an alternative solution – consider posting your complete code on Code Review for a more complete criticism.
Regarding your immediate problem: You could write a function to combine the hash references:
use Carp ();
sub combine_hashrefs {
my %combined;
for my $hashref (#_) {
if (my #conflicts = grep { exists $combined{$_} } keys %$hashref) {
Carp::confess "The keys [#conflicts] are conflicting";
}
#combined{keys %$hashref} = values %$hashref;
}
return \%combined;
}
...
my $self = combine_hashrefs($hashref_a, $hashref_b, $hashref_c, ...);
Do I understand correctly that you want to avoid the repetition of $id in the following line?
my $self = (getFirstName($id), getLastName($id), getEmpNum($id));
$self is a scalar, so you should rather use the anonymous array [...]. To specify $id only once, you can use
my $self = [ map $_->($id), \&getFirstName, \&getLastName, \&getEmpNum ];
I am starting to learn about objects in Perl using Moose.
I am not sure if I understand the purpose of MooseX::Privacy. Consider:
use v5.14;
package PA {
use Moose;
my $var='private?';
1;
sub getVar {
return $var;
}
}
package PB {
use Moose;
use MooseX::Privacy;
has 'var' => (
is => 'rw',
isa => 'Str',
default => 'private?',
traits => [qw/Private/],
);
1;
sub getVar {
my $self = shift;
return $self->var;
}
}
my $o1= PA->new();
my $o2= PB->new();
say $o1->getVar();
say $o2->getVar();
In both class PA and PB I have a private variable var. Only in class PB I use MooseX::Privacy. What is the difference between these two approaches? And why should I use MooseX::Privacy?
If you're looking for Java-style method privacy, then MooseX::Privacy is going to be a big disappointment. Here's what happens with Java style method privacy:
/* This file is called Main.java */
public class Main
{
public class MyParent
{
private String message_string ()
{
return "Message from %s\n";
}
public void print_message ()
{
System.out.printf( this.message_string(), "MyParent" );
}
}
public class MyChild extends MyParent
{
public String message_string ()
{
return "Another message from %s\n";
}
}
public static void main (String[] args)
{
Main o = new Main();
o.run();
}
public void run ()
{
MyParent c = new MyChild();
c.print_message();
}
}
You can compile and run this example like this:
$ javac Main.java
$ java Main
Message from MyParent
Note what's happened. The parent class (MyParent) declares message_string() to be a private method. The child class attempts to override the method but is roundly rebuffed - no soup for you child class!
Now let's try the equivalent with Perl and MooseX::Privacy...
# This file is called Main.pl
use v5.14;
use strict;
use warnings;
package MyParent {
use Moose;
use MooseX::Privacy;
private_method message_string => sub {
my $self = shift;
return "Message from %s\n";
};
sub print_message {
my $self = shift;
printf($self->message_string(), __PACKAGE__);
}
}
package MyChild {
use Moose; extends qw(MyParent);
use MooseX::Privacy;
sub message_string {
my $self = shift;
return "Another message from %s\n";
}
}
my $c = new MyChild();
$c->print_message();
We can run that like this:
$ perl Main.pl
Another message from MyParent
Say, WHA?!?!?! Ain't message_string supposed to be private?! How the hell did MyChild override the method in MyParent?!
The fact of the matter is, MooseX::Privacy doesn't give you anything close to method privacy as implemented in most OO languages. MooseX::Privacy is simply akin to doing this in your method:
die "GO AWAY!!" unless caller eq __PACKAGE__;
Except that MooseX::Privacy adds massive runtime expense to all your method calls.
Really, there's little reason to use MooseX::Privacy. If you want private methods, put them in lexical variables. Like this:
use v5.14;
use strict;
use warnings;
package MyParent {
use Moose;
my $message_string = sub {
my $self = shift;
return "Message from %s\n";
};
sub print_message {
my $self = shift;
printf($self->$message_string(), __PACKAGE__);
}
}
package MyChild {
use Moose; extends qw(MyParent);
sub message_string {
my $self = shift;
return "Another message from %s\n";
}
}
my $c = new MyChild();
$c->print_message();
Now run it:
$ perl Main2.pl
Message from MyParent
Hallelujah!! We have a true private method!
OK, so you can have private methods without MooseX::Privacy, and they work better (and faster) than MooseX::Privacy.
But what about private attributes? Well, I have a little module on CPAN that can help you: Lexical::Accessor. This is a little tool that creates an attribute for you, with "inside out" storage (i.e. the attribute value doesn't get stored in the object's blessed hashref), and installs the accessors for it in lexical variables (just like the private $get_message method above).
Anyway, that's my opinion on MooseX::Privacy.
I need to define multiple modules in the same file. I would like to do something like the following:
package FooObj {
sub new { ... }
sub add_data { ... }
}
package BarObj {
use FooObj;
sub new {
...
# BarObj "has a" FooObj
my $self = ( myFoo => FooObj->new() );
...
}
sub some_method { ... }
}
my $bar = BarObj->new();
However, this results in the message:
Can't locate FooObj.pm in #INC ...
BEGIN failed...
How do I get this to work?
Drop the use. Seriously.
use tells perl to read in the code from another file, which you don't need to do because the code is in the same file.
Unless I'm trying to create a private package that no one should know about, I put one package per file. That solves the problem. But, let's put them in the same file.
The use loads a file and calls the import method in that package. It's really only incidently that its argument looks like a module name. It's looking for the file. If the file is not there, it barfs.
You can do this, where BarObj assumes that FooObj is already there:
{
package FooObj;
sub new { bless { _count => 0 }, $_[0] }
sub add_data { $_[0]->{_count}++ }
}
{
package BarObj;
use Data::Dumper;
sub new {
bless { myFoo => FooObj->new }, $_[0];
}
sub foo { $_[0]->{myFoo} }
sub some_method { print Dumper( $_[0] ) }
}
my $bar = BarObj->new;
$bar->some_method;
If you need to interact with a package (and that's all it is: not a module or an object), you just need to have it defined before you want to use it. If you need to import something, you can call the import directly:
FooObj->import( ... );
Suppose there's something from FooObj that you want to import (but not inherit!), you call import directly with no loading;
{
package FooObj;
use Data::Dumper;
sub new { bless { _count => 0 }, $_[0] }
sub add_data { $_[0]->{_count}++ }
use Exporter qw(import);
our #EXPORT = qw(dumper);
sub dumper { print Dumper( $_[0] ) }
}
{
package BarObj;
FooObj->import;
sub new {
bless { myFoo => FooObj->new }, $_[0];
}
sub foo { $_[0]->{myFoo} }
# dumper mixin, not inherited.
sub some_method { dumper( $_[0] ) }
}
my $bar = BarObj->new;
$bar->some_method;
By convention we put one package in one file and name them the same thing, but that is just for convenience. You can put multiple packages in a single file. Since they are already loaded, you do not need to use use.
You also do not need to create special scoping for the packages, as the package keyword takes care of that. Using the braces does help with scoping of our variables. So you don't strictly need those brace blocks, but they're a good idea.
use uses a package naming convention to find the appropriate file to load. The package keyword inside the module defines the namespace. And the import functions handle the package loading (generally inherited from Exporter).
#!/usr/bin/perl
use strict;
use warnings;
package FooObj;
sub new
{
my $this = shift;
my $class = ref($this) || $this;
my $self = {};
bless $self, $class;
$self->initialize();
return $self;
}
sub initialize { }
sub add_data { }
package BarObj;
#use FooObj; <-- not needed.
sub new
{
my $this = shift;
my $class = ref($this) || $this;
my $self = { myFoo => FooObj->new() };
bless $self, $class;
$self->initialize();
return $self;
}
sub initialize { }
sub some_method { }
sub myFoo { return $_[0]->{myFoo} }
package main;
use Test::More;
my $bar = BarObj->new();
isa_ok( $bar, 'BarObj', "bar is a BarObj" );
isa_ok( $bar->myFoo, 'FooObj', "bar->myFoo is a FooObj" );
done_testing();
__DATA__
ok 1 - bar is a BarObj isa BarObj
ok 2 - bar->myFoo is a FooObj isa FooObj
1..2