How to check undefined key in perl OO code? - perl

I have use strict;use warnings; in my perl script;
But this error cannot be found:
sub new {
#....
my $self={};
$self->{databas}="..."; # 'e' is missing
#....
}
sub foo {
my $self=shift;
print $self->{database}; # undef
}
I have spend hours to found out that database in mispelled in sub new.
use strict;use warnings; didnt help.
How can I avoid this error?

Restrict/lock hashes with Hash::Util.
Alternatively, use Moose to describe your classes, making a misspelled attribute a run-time error.
package MyClass;
use Moose;
has 'database' => (isa => 'Str', is => 'rw', default => 'quux');
sub foo {
my ($self) = #_;
$self->database; # returns quux
$self->databas; # Can't locate object method "databas" via package…

use defined, or // operator (if you have perl 5.10/later)
print "not defined" if !defined $a; # check if $a is undef
print $a // 'undefed!'; # print a if availiable, "undefed!" otherwise
See http://perldoc.perl.org/functions/defined.html and http://perldoc.perl.org/perlop.html#C-style-Logical-Defined-Or

Use getters and setters instead of hash keys, or switch to Moose.

Do you think you would have spotted it if you saw the hash dumped out? Like this:
$self = bless( {
'anotherfield' => 'something else',
'databas' => '...',
'afield' => 'something'
}, 'MyClass' );
If you were wondering "How come 'database' isn't set?!?!" and you dumped this out, do you think that would help? "Oh it assigned 'databas' not 'database'!"
Then Data::Dumper is the minimal Perl debugging tool
use Data::Dumper;
...
# Why isn't database assigned?!?!
say Data::Dumper->Dump( [ $self ], [ '$self' ] );
Of course, the most convenient form of Data::Dumper tools is Smart:Comments.
use Smart::Comments;
...
### $self
Which outputs:
### $self: bless( {
### afield => 'something',
### anotherfield => 'something else',
### databas => '...'
### }, 'MyClass' )
It's not as preventative a tool as Moose but it will save hours, though. I think it even helps you learn Perl tricks and practices as you spill out the guts of CPAN objects. When you know the underlying structure, you have something to search for in CPAN modules.
Like I said, it solves the problem of hours tracking down bugs (often enough).

Another approach is to use the core module Class::Struct.
package MyObj;
use Class::Struct;
struct(
databas => '$',
# ...
);
1;
package main;
# create object
my $obj = MyObj->new(databas => 'MyDB');
# later
print $obj->database;
Running this results in the following error:
Can't locate object method "database" via package "MyObj" at ... .

Related

Using a Moose alias with MooseX::Constructor::AllErrors

I'm trying to use an alias with MooseX::Aliases and MooseX::Constructor::AllErrors
However, the two don't seem to play nicely together. Consider the following example:
package Alias
{
use Moose;
use MooseX::Aliases;
use MooseX::Constructor::AllErrors;
has foo => (
is => 'rw', isa => 'Str', required => 1, alias => 'bar'
);
}
use strict;
use warnings;
use Alias;
my $obj;
eval {
$obj = Alias->new( bar => 'alias_value' );
};
if ($#)
{
foreach my $error ( $#->errors )
{
print $error ."\n";
print $error->message ."\n";
}
exit 1;
}
print $obj->bar ."\n";
$obj->foo( 'new_alias_value' );
print $obj->foo."\n";
1;
This should allow me to create an Alias object using the 'bar' alias... shouldn't it? Does anyone know if MooseX::Constructor::AllErrors is supposed to support aliased attributes?
It's a bug, in that it violates expectations, but it's not easily resolvable -- the problem is that MooseX::Aliases modifies what arguments are allowed/accepted in the constructor, but MooseX::Constructor::AllErrors is not aware of this, so when it looks at the passed values at construction time, it errors out when there is no 'agency' field.
This gets around the situation by manually moving the aliased field before MooseX::Constructor::AllErrors sees it:
around BUILDARGS => sub {
my $orig = shift;
my $self = shift;
my %args = #_;
$args{agency} //= delete $args{company};
$self->$orig(%args);
};
The good news is that this has hope of working better in the future, because
there are plans for MooseX::Aliases to be cored, which would force all other
extensions (e.g. MXCAE) to support the alias feature properly.

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, $/;

Perl: cmpthese text vs anonymous sub problems with parameters passed

If you read about cmpthese in the Perl Benchmark module's documentation, it states that cmpthese or timethese can be used with code in either text or subroutine references. The documentation seems to imply these forms are completely interchangeable:
# Use Perl code in strings...
timethese($count, {
'Name1' => '...code1...',
'Name2' => '...code2...',
});
# ... or use subroutine references.
timethese($count, {
'Name1' => sub { ...code1... },
'Name2' => sub { ...code2... },
});
I am having difficulties with passed parameters with the string form versus subroutine references form with cmpthese. Either the values in #array do not get passed or I have a run-time error.
I have the following code:
#!/usr/bin/perl
use strict; use warnings;
use Benchmark qw(:all);
my #array = qw( first second third );
sub target {
my $str = $_[0];
print "str=$str\n";
}
sub control {
print "control: array[0]=$array[0]\n";
}
my $sub_ref=\&target;
my $control_ref=\&control;
print "\n\n\n";
# ERROR: array does not get passed...
cmpthese(1, {
'target text' => 'target(#array)',
'control 1' => 'control()',
});
# This is OK...
cmpthese(1, {
'sub code ref' => sub { target(#array) },
'control 2' => sub { control() },
});
# This is OK too...
cmpthese(1, {
'target sub' => sub { $sub_ref->(#array) },
'control 3' => sub { $control_ref->() },
});
# fixed paramenters work:
cmpthese(1, {
'target text fixed' => 'target("one", "two", "three")',
'control 4' => 'control()',
});
# Run time error...
cmpthese(1, {
'text code ref' => '$sub_ref->(#array)',
'control 5' => '$control_ref->()',
});
All the forms I have work correctly with eval so I think this may be an issue with Benchmark? I have used all my google foo to try and find some documented difference between the two forms but I cannot.
Does anyone know the reason that my simple examples above do not seem to work as expected? The comments in the code indicate the problems I am having on OS X, Perl 5.10.0.
The text passed to cmpthese and timethese gets propogated to an eval statement deep in the bowels of Benchmark. Unless the arguments in the text are literals or global variables, they won't be in scope by the time they are evaluated, and you get a run-time error.
Use the anonymous sub version of the arguments to provide lexical closure for your arguments and all will be well.
I haven't looked in too much detail at this, but my guess is that when Benchmark evals the strings into code, the lexical variable #array is not in scope. Things would probably work if you made #array an our variable.
But in general, I find it is easier just to use code refs.

OO-Perl Aliasing Class Attributes

I have a module that I'm working on. I am setting up a few attributes like this:
$self->{FOO};
$self->{BAR};
$self->{FOOBAR};
And, I want to use AUTOLOAD to help create methods for accessing these attributes. For example, $foo->Bar() returns the value of $self->{BAR}. No problem. Everything is standard.
Now, I want to create alias Methods. For example, if someone says $obj->Fu();, I'll return $self->{FOO}. What I'd like to do is create a $self->{FU} that points to the same memory location as $self->{FOO}. That way, when I set the value of $self->{FOO}, $self-{FU} is also set. This way, I don't have to make all sorts of changes in the way AUTOLOAD works or remember to set $self->{FU} whenever I set $self->{FOO}.
Any easy way of doing this?
Yes, use Moose, rather than attempting to make explicit mapping between hash
keys. Writing your own accessors, or using AUTOLOAD, is not necessary and has
a much higher chance of error:
package MyClass;
use Moose;
use MooseX::Aliases;
has foo => (
is => 'rw', isa => 'Str',
alias => 'fu',
);
has bar => (
is => 'rw', isa => 'Str',
);
__PACKAGE__->meta->make_immutable;
no Moose;
1;
package main;
use strict;
use warnings;
use MyClass;
my $obj = MyClass->new;
$obj->foo("value");
$obj->fu("a new value");
# prints "foo has the value 'a new value'"
print "foo has the value '", $obj->foo, "'\n";
I would recommend Moose over what you're doing, but the easiest way to accomplish what you're asking is probably this:
sub Fu { shift->Foo(#_) }
This way, it doesn't matter if Foo is autoloaded or not.
The non-Moose solution is to just create an alias in the symbol table. It's not a common thing to do, and I suspect that whatever you are trying to do has a better way, Moose or otherwise. Don't use any of this if you can avoid it with a better design or interface, which are often the superior solutions to things like this.
In this AUTOLOAD routine, I look at a %Aliases hash to figure out other methods else I have to define. When I have aliases, I make proper aliases in the symbol table. It's a bit ugly, but it avoids adding another actual method in the call stack:
#!perl
use 5.010;
{
package SomeClass;
use Carp;
use vars qw($AUTOLOAD);
sub new {
return bless {
map { $_, undef } qw(FOO BAR FOOBAR)
}, $_[0];
};
my %Aliases = (
FOO => [ qw(fu) ],
);
sub AUTOLOAD {
our $method = $AUTOLOAD;
$method =~ s/.*:://;
carp "Autoloading $method";
{
no strict 'refs';
*{"$method"} = sub {
#_ > 1
?
$_[0]->{"\U$method"} = $_[1]
:
$_[0]->{"\U$method"}
};
foreach my $alias ( #{ $Aliases{"\U$method"} } ) {
*{"$alias"} = *{"$method"};
}
goto &{"$method"};
}
}
sub DESTROY { 1 }
}
my $object = SomeClass->new;
$object->foo(5);
say "Foo is now ", $object->foo;
say "Foo is now ", $object->foo(9);
say "Fu is now ", $object->fu;
say "Fu is set to ", $object->fu(17);
say "Foo is now ", $object->foo;
Now foo and fu access the same thing:
Foo is now 5
Foo is now 9
Fu is now 9
Fu is set to 17
Foo is now 17

In Perl, how can I find out if my file is being used as a module or run as a script?

Let's say I have a Perl file in which there are parts I need to run only when I'm called as a script. I remember reading sometime back about including those parts in a main() method and doing a
main() unless(<some condition which tests if I'm being used as a module>);
But I forgot what the condition was. Searching Google hasn't turned out anything fruitful. Can someone point out the right place to look for this?
If the file is invoked as a script, there will be no caller so you can use:
main() unless caller;
See brian d foy's explanation.
#!/usr/bin/perl
use strict;
use warnings;
main() unless caller;
sub main {
my $obj = MyClass->new;
$obj->hello;
}
package MyClass;
use strict;
use warnings;
sub new { bless {} => shift };
sub hello { print "Hello World\n" }
no warnings 'void';
"MyClass"
Output:
C:\Temp> perl MyClass.pm
Hello World
Using from another script:
C:\Temp\> cat mytest.pl
#!/usr/bin/perl
use strict;
use warnings;
use MyClass;
my $obj = MyClass->new;
$obj->hello;
Output:
C:\Temp> mytest.pl
Hello World
I call these things "modulinos" originally in my Scripts as Modules article for The Perl Journal (now Dr. Dobbs). Google that term and you get the right resources. Sinan already linked to my development sources for one of my books where I talk about it. You might also like How a Script Becomes a Module.
Better to not do this, and instead take a structured approach like MooseX::Runnable.
Your class will look like:
class Get::Me::Data with (MooseX::Runnable, MooseX::Getopt) {
has 'dsn' => (
is => 'ro',
isa => 'Str',
documentation => 'Database to connect to',
);
has 'database' => (
is => 'ro',
traits => ['NoGetopt'],
lazy_build => 1,
);
method _build_database {
Database->connect($self->dsn);
}
method get_data(Str $for_person){
return $database->search({ person => $for_person });
}
method run(Str $for_person?) {
if(!$defined $for_person){
print "Type the person you are looking for: ";
$for_person = <>;
chomp $for_person;
}
my #data = $self->get_data($for_person);
if(!#data){
say "No data found for $for_person";
return 1;
}
for my $data (#data){
say $data->format;
}
return 0;
}
}
Now you have a class that can be used inside your program easily:
my $finder = Get::Me::Data->new( database => $dbh );
$finder->get_data('jrockway');
Inside an interactive script that is bigger than just the "run" method above:
...
my $finder = Get::Me::Data->new( dsn => 'person_database' );
$finder->run('jrockway') and die 'Failure'; # and because "0" is success
say "All done with Get::Me::Data.";
...
If you just want to do this standalone, you can say:
$ mx-run Get::Me::Data --help
Usage: mx-run ... [arguments]
--dsn Database to connect to
$ mx-run Get::Me::Data --dsn person_database
Type the person you are looking for: jrockway
<data>
$ mx-run Get::Me::Data --dsn person_database jrockway
<data>
Notice how little code you wrote, and how flexible the resulting class is. "main if !caller" is nice, but why bother when you can do better?
(BTW, MX::Runnable has plugins; so you can easily increase the amount of debugging output you see, restart your app when the code changes, make the app persistent, run it in the profiler, etc.)