I tried to store an array of Moose Objects to YAML or JSON.
The saving works very well, but when I try to restore my Objects, they're empty:
$VAR1 = bless({}, 'Note');
$VAR2 = bless({}, 'Note');
Here is my code:
Note.pm:
package Note;
use strict;
use warnings;
use Moose;
use MooseX::Storage;
with Storage('format' => 'JSON', 'io' => 'File');
has 'message' =>(is=> 'rw', isa =>'Str');
1;
testNote.pl:
use strict;
use warnings;
use utf8;
use feature 'say';
use Note;
use Storable;
use MooseX::Storage;
use Data::Dumper;
use JSON;
my #container=();
my $obj = Note->new;
$obj->message("firstmessage");
say $obj->message;
push(#container,$obj);
my $obj2 = Note->new;
$obj2->message("secondmessage");
push(#container,$obj2);
my #output=();
for my $counter (0 .. $#container){
push(#output,$container[$counter]->pack());
}
say "Output packed strings:" ;
for my $counter(0 .. $#output){
say $output[$counter];
}
store \#output, 'saveNotes';
my #Notes=();
my #fin=#{retrieve('saveNotes') };
say "After reading file:";
#Arr=();
for my $counter (0 .. $#fin){
push(#Arr,Note->unpack($fin[$counter]));
}
say Dumper(#Arr);
Hope someone could help :)
Related
How can I export a normal, non-OO subroutine from a Moose package? In a regular package, I'd do it with Exporter, #ISA and #EXPORT.
Moose is for building classes and roles. While you technically can also export functions, it's not necessarily the best idea.
Here's an example Moose class which also exports a function.
MyApp/Widget.pm
use v5.26;
use warnings;
package MyApp::Widget;
use Exporter qw( import );
our #EXPORT_OK = qw( is_widget );
use Moose;
use namespace::autoclean -except => 'import';
has name => ( is => 'ro', isa => 'Str', required => 1 );
sub is_widget {
my $object = shift;
blessed( $object ) and $object->isa( __PACKAGE__ );
}
__PACKAGE__->meta->make_immutable;
Here's how you might use it:
use v5.26;
use warnings;
use MyApp::Widget qw( is_widget );
my $w = 'MyApp::Widget'->new( name => 'Foo' );
say is_widget( $w );
say $w->is_widget;
Note that even though is_widget was intended an exportable function, it can also be called as a method! In this case, that's a feature rather than a bug, but often that will be an inconvenience.
A better idea might be to create two separate packages: one for your class and one for your exportable functions.
MyApp/Widget.pm
use v5.26;
use warnings;
package MyApp::Widget;
use Moose;
use namespace::autoclean;
has name => ( is => 'ro', isa => 'Str', required => 1 );
__PACKAGE__->meta->make_immutable;
MyApp/Util.pm
use v5.26;
use warnings;
package MyApp::Util;
use Exporter qw( import );
our #EXPORT_OK = qw( is_widget );
use Scalar::Util qw( blessed );
sub is_widget {
my $object = shift;
blessed( $object ) and $object->isa( 'MyApp::Widget' );
}
1;
And you'd call use your packages like this:
use v5.26;
use warnings;
use MyApp::Widget;
use MyApp::Util qw( is_widget );
my $w = 'MyApp::Widget'->new( name => 'Foo' );
say is_widget( $w );
Because the Moose class and the Exporter are now cleanly separated, you can no longer call $w->is_widget — it's entirely a function and no longer a method.
How do I increment a field in a Class::Struct object?
For now I am stuck with
use Class::Struct foo => [
counter => '$',
];
my $bar = foo->new(counter => 5);
$bar->counter($bar->counter()+1);
I wonder if there is something more expressive than the last line (the obvious $bar->counter++ results in Can't modify non-lvalue subroutine call).
EDIT: of course, I am not interested in $bar->[0]++ et al - what if I add a field before counter? I don't want to have to hunt my code for all such "bugs-in-waiting".
You can add an increment method to foo:
#!/usr/bin/env perl
package foo;
use strict; use warnings;
sub increment_counter {
my $self = shift;
my $val = $self->counter + 1;
$self->counter($val);
return $val;
}
package main;
use 5.012;
use strict;
use warnings;
use Class::Struct foo => [
counter => '$',
];
my $bar = foo->new(counter => 5);
$bar->increment_counter;
say $bar->counter;
__END__
Alternatively, try doing this :
use strict; use warnings;
use Class::Struct foo => [
counter => '$',
];
my $bar = foo->new(counter => 5);
print ++$bar->[0];
or using a SCALAR ref (no need to hard-code the "path" like the previous snippet) :
use strict; use warnings;
$\ = "\n";
use Class::Struct foo => [
counter => '*$',
];
my $bar = foo->new(counter => 5);
print ++${ $bar->counter };
I have two Perl packages: pack_hash and pack_run
package pack_hash;
$VERSION = '1.00';
#ISA = qw( Exporter );
#EXPORT_OK = qw( %hashInfo );
$hashInfo{abc} = ['a', 'b', 'c'];
1;
package pack_run;
use stricts;
use warnings;
use Data::Dumper;
use pack_hash qw( %hashInfo );
somethingDoing();
sub somethingDoing {
my $var1 = \%pack_hash::hashInfo; # getting the hash reference
print Dumper($var1);
...
...
}
1;
Can anyone please let me know, whether it is possible to replace the name of the hash-package (pack_hash), by using any variable, like:
my $pakVar = "pack_hash";
my $var1 = \%$pakVar::hashInfo;
I, know it is WRONG/NOT_CORRECT, but I want this kind of symbolic ref transformation, when I'm using strictures.
I also wanted to know, whether it is possible to do the thing with eval. But I want a final variable, here $var1, which will refer the particular hash (hashInfo);
No, that is not possible. But this is:
use strict;
use warnings;
use Symbol qw<qualify_to_ref>;
my $pakVar = 'pack_hash';
my $var1 = *{ qualify_to_ref( 'hashInfo', $pakVar ) }{HASH};
qualify_to_ref takes the name of a package variable and the package name and returns a GLOB reference pointer, then you just access the HASH slot of the GLOB. You can also do it this way:
my $var1 = \%{ qualify_to_ref( 'hashInfo', $pakVar ) };
But it is just as easy to turn off strict in a very tight do as well;
my $var1
= do {
no strict;
\%{ $pakVar . '::hashInfo' };
};
I understand that some coding cultures consider turning off strict or warnings as "cheating". I know that I've had code review questions about turning off one class of warning in a small block like this. I knew which warnings I was going to get, so I didn't need it. The reviewer didn't see it this way.
For this reason some veteran Perl-ers think nothing about turning off strict. But if you can't because it makes the natives restless--you can use Symbol. However, some shops have rules against package variables, so it never becomes an issue.
If you have a class method that returns a reference to the hash:
package pack_hash;
use strict;
use warnings;
our %hashInfo;
$hashInfo{abc} = ['a', 'b', 'c'];
sub hashInfo { \%hashInfo }
then you can easily get the reference:
use strict;
use warnings;
my $pakVar = 'pack_hash';
my $hashInfo = $pakVar->hashInfo();
print #{ $hashInfo->{'abc'} };
I have a Perl module (Module.pm) that initializes a number of variables, some of which I'd like to import ($VAR2, $VAR3) into additional submodules that it might load during execution.
The way I'm currently setting up Module.pm is as follows:
package Module;
use warnings;
use strict;
use vars qw($SUBMODULES $VAR1 $VAR2 $VAR3);
require Exporter;
our #ISA = qw(Exporter);
our #EXPORT = qw($VAR2 $VAR3);
sub new {
my ($package) = #_;
my $self = {};
bless ($self, $package);
return $self;
}
sub SubModules1 {
my $self = shift;
if($SUBMODULES->{'1'}) { return $SUBMODULES->{'1'}; }
# Load & cache submodule
require Module::SubModule1;
$SUBMODULES->{'1'} = Module::SubModule1->new(#_);
return $SUBMODULES->{'1'};
}
sub SubModules2 {
my $self = shift;
if($SUBMODULES->{'2'}) { return $SUBMODULES->{'2'}; }
# Load & cache submodule
require Module::SubModule2;
$SUBMODULES->{'2'} = Module::SubModule2->new(#_);
return $SUBMODULES->{'2'};
}
Each submodule is structured as follows:
package Module::SubModule1;
use warnings;
use strict;
use Carp;
use vars qw();
sub new {
my ($package) = #_;
my $self = {};
bless ($self, $package);
return $self;
}
I want to be able to import the $VAR2 and $VAR3 variables into each of the submodules without having to reference them as $Module::VAR2 and $Module::VAR3. I noticed that the calling script is able to access both the variables that I have exported in Module.pm in the desired fashion but SubModule1.pm and SubModule2.pm still have to reference the variables as being from Module.pm.
I tried updating each submodule as follows which unfortunately didn't work I was hoping:
package Module::SubModule1;
use warnings;
use strict;
use Carp;
use vars qw($VAR2 $VAR3);
sub new {
my ($package) = #_;
my $self = {};
bless ($self, $package);
$VAR2 = $Module::VAR2;
$VAR3 = $Module::VAR3;
return $self;
}
Please let me know how I can successfully export $VAR2 and $VAR3 from Module.pm into each Submodule. Thanks in advance for your help!
In your submodules, are you forgetting to say
use Module;
? Calling use Module from another package (say Module::Submodule9) will try to run the Module::import method. Since you don't have that method, it will call the Exporter::import method, and that is where the magic that exports Module's variables into the Module::Submodule9 namespace will happen.
In your program there is only one Module namespace and only one instance of the (global) variable $Module::VAR2. Exporting creates aliases to this variable in other namespaces, so the same variable can be accessed in different ways. Try this in a separate script:
package Whatever;
use Module;
use strict;
use vars qw($VAR2);
$Module::VAR2 = 5;
print $Whatever::VAR2; # should be 5.
$VAR2 = 14; # same as $Whatever::VAR2 = 14
print $Module::VAR2; # should be 14
Well there is the easy way:
In M.pm:
package M;
use strict;
use warnings;
#our is better than "use vars" for creating package variables
#it creates an alias to $M::foo named $foo in the current lexical scope
our $foo = 5;
sub inM { print "$foo\n" }
1;
In M/S.pm
package M;
#creates an alias to $M::foo that will last for the entire scope,
#in this case the entire file
our $foo;
package M::S;
use strict;
use warnings;
sub inMS { print "$foo\n" }
1;
In the script:
#!/usr/bin/perl
use strict;
use warnings;
use M;
use M::S;
M::inM();
M::S::inMS();
But I would advise against this. Global variables are not a good practice, and sharing global variables between modules is even worse.
Is it possible to dynamically specify a class in Perl and access a static method in that class? This does not work, but illustrates what I'd like to do:
use Test::Class1;
my $class = 'Test::Class1';
$class::static_method();
I know I can do this:
$class->static_method();
and ignore the class name passed to static_method, but I wonder if there's a better way.
Yup! The way to do it with strictures is to use can.
package Foo::Bar;
use strict;
use warnings;
sub baz
{
return "Passed in '#_' and ran baz!";
}
package main;
use strict;
use warnings;
my $class = 'Foo::Bar';
if (my $method = $class->can('baz'))
{
print "yup it can, and it ";
print $method->();
}
else
{
print "No it can't!";
}
can returns a reference to the method, undef / false. You then just have to call the method with the dereferene syntax.
It gives:
> perl foobar.pl
yup it can, and it Passed in '' and ran baz!
As always with Perl, there is more than one way to do it.
use strict;
use warnings;
{
package Test::Class;
sub static_method{ print join(' ', #_), "\n" }
}
You can use the special %:: variable to access the symbol table.
my $class = 'Test::Class';
my #depth = split '::', $class;
my $ref = \%::;
$ref = $glob->{$_.'::'} for #depth; # $::{'Test::'}{'Class::'}
$code = $glob->{'static_method'};
$code->('Hello','World');
You could just simply use a symbolic reference;
no strict 'refs';
my $code = &{"${class}::static_method"};
# or
my $code = *{"${class}::static_method"}{CODE};
$code->('Hello','World');
You could also use a string eval.
eval "${class}::static_method('Hello','World')";
The simplest in this case, would be to use UNIVERSAL::can.
$code = $class->can('static_method');
$code->('Hello','World');
I am unaware of a particularly nice way of doing this, but there are some less nice ways, such as this program:
#!/usr/bin/perl -w
use strict;
package Test::Class1;
sub static_method {
print join(", ", #_) . "\n";
}
package main;
my $class = "Test::Class1";
{
no strict "refs";
&{${class}. "::static_method"}(1, 2, 3);
}
I have included a $class variable, as that was how you asked the question, and it illustrates how the class name can be chosen at runtime, but if you know the class beforehand, you could just as easily call &{"Test::Class1::static_method"}(1, 2, 3);
Note that you have to switch off strict "refs" if you have it on.
There are three main ways to call a static function:
$object->static_method()
Classname->static_method()
Classname::static_method()
You could define your function like this:
# callable as $object->static_method() or Classname->static_method()
sub static_method
{
my $class = shift; # ignore; not needed
# ...
}
or like this, which works in all three calling scenarios, and doesn't incur any overhead on the caller's side like Robert P's solution does:
use UNIVERSAL qw(isa);
sub static_method
{
my $class = shift if $_[0] and isa($_[0], __PACKAGE__);
# ...
}
You can use string eval:
#!/usr/bin/perl
use strict; use warnings;
package Test::Class1;
sub static_method {
print join(", ", #_) . "\n";
}
package main;
my $class = 'Test::Class1';
my $static_method = 'static_method';
my $subref = eval q{ \&{ "${class}::${static_method}" } };
$subref->(1, 2, 3);
Output:
C:\Temp> z
1, 2, 3
Benchmarks:
#!/usr/bin/perl
use strict; use warnings;
package Test::Class1;
sub static_method { "#_" }
package main;
use strict; use warnings;
use Benchmark qw( cmpthese );
my $class = 'Test::Class1';
my $static_method = 'static_method';
cmpthese -1, {
'can' => sub { my $r = $class->can($static_method); $r->(1, 2, 3) },
'eval' => sub {
my $r = eval q/ \&{ "${class}::${static_method}" } /;
$r->(1, 2, 3);
},
'nostrict' => sub {
no strict "refs";
my $r = \&{ "${class}::static_method" };
$r->(1, 2, 3);
}
};
Output:
Rate eval can nostrict
eval 12775/s -- -94% -95%
can 206355/s 1515% -- -15%
nostrict 241889/s 1793% 17% --