Hash Constants in Perl - perl

I have a situation where I have an application and it maps to a directory I need to process in a zipfile. The mapping is quite simple:
CWA => "Financial",
PIP => "",
IFA => "IFA",
VDX => "Financial,
That is, if the name of the file begins with CWA, I know the directory I have to munge is under Financial. If the file name begins with a IFA, I know the directory name is IFA. I'd like to set this up as a hash (easy enough), but since these values don't really change, I'd like to setup this key => value mapping as a hash constant.
I don't believe this is possible, so I'd like to do the next best thing. What would that be? Or, can you setup a hash constant?
I'm thinking of writing a subroutine where you pass a parameter and it returns the correct value. After all, it's really the way constants themselves work, and it'd guarantee that the relationships between the keys and values don't change through out the program.
Or, I can simply declare the key => value relationship in the beginning of my program and hope that the key => value pairs aren't modified by something. This would be easier to read, and easier to modify if you have to since it's on the very top of my source code.
What's the best way to implement a key => value constant?

You can use Const::Fast.
use Const::Fast;
const my %hash = (
CWA => "Financial",
PIP => "",
IFA => "IFA",
VDX => "Financial",
);

Just use a named hash. Most likely, nothing will go wrong.
Use Readonly. This makes a hash that is accessed like any other hash, but can't be modified unless someone starts mucking around in the perl internals. As stated in its docs, it's slow compared to a regular variable access, but it's very unlikely to be slow enough to matter for you.
Hide the hash in a subroutine.
.
sub get_directory_for_prefix {
my ($prefix) = #_;
my %map = (
CWA => "Financial",
PIP => "",
IFA => "IFA",
VDX => "Financial",
);
return $map{$prefix};
}
or even
sub get_directory_for_prefix {
{CWA=>"Financial",PIP=>"",IFA=>"IFA",VOX=>"Financial"}->{shift()};
};

Alternativelly, if you don't want to use blocks you could still use constant:
use strict;
use warnings;
use constant CONSHASH => sub {{
foo1 => 'bar1',
foo2 => 'bar2',
foo3 => 'bar3',
}->{ +shift }};
print CONSHASH->('foo1') . "\n";
print CONSHASH->('foo2') . "\n";
print CONSHASH->('foo3') . "\n";

Here what I finally did following a few suggestions:
{
my %appHash = (
CWA => "Financial",
PIP => "",
FIA => "FIA",
VDX => "Financial",
);
sub appDir {
return $appHash{+shift};
}
}
By putting the %appHash in its own block, I can't reference that hash in the rest of my code. However, the appDir subroutine is in the same block and can reference it. And, because Subroutines are package wide, I can access that subroutine in my code. Therefore, I can access the values of %appHash, but I cannot change them.
use strict;
use warnings;
{
my %appHash = (
CWA => "Financial",
PIP => "",
FIA => "FIA",
VDX => "Financial",
);
sub appDir {
return $appHash{+shift};
}
}
{
### WARNING.
### this code is a counter example to show that %appHash
### is not available in this scope.
### Do not use this code.
### Disabling strictures and warnings in this block only.
no strict;
no warnings; # Danger Will Robinson!
# disable explicit package name error because %appHash is not defined in this scope.
# disable warnings related to 1) main::appHash and 2) uninitialized value of $appHash{"CWA"}
print "The directory for CWA is " . $appHash{CWA} . "\n"; #Prints nothing
}
print "The directory for CWA is " . appDir("CWA") . "\n"; #Prints Financial
my %appHash;
$appHash{CWA} = "FOO FOO FOO!";
print "The directory for CWA is " . $appHash{CWA} . "\n"; #Prints FOO FOO FOO!
print "The directory for CWA is " . appDir("CWA") . "\n"; #Still prints Financial
Neat!
Thanks iwj and hobbs

Related

Iterate directories in Perl, getting introspectable objects as result

I'm about to start a script that may have some file lookups and manipulation, so I thought I'd look into some packages that would assist me; mostly, I'd like the results of the iteration (or search) to be returned as objects, which would have (base)name, path, file size, uid, modification time, etc as some sort of properties.
The thing is, I don't do this all that often, and tend to forget APIs; when that happens, I'd rather let the code run on an example directory, and dump all of the properties in an object, so I can remind myself what is available where (obviously, I'd like to "dump", in order to avoid having to code custom printouts). However, I'm aware of the following:
list out all methods of object - perlmonks.org
"Out of the box Perl doesn't do object introspection. Class wrappers like Moose provide introspection as part of their implementation, but Perl's built in object support is much more primitive than that."
Anyways, I looked into:
"Files and Directories Handling in Perl - Perl Beginners' Site" http://perl-begin.org/topics/files-and-directories/
... and started looking into the libraries referred there (also related link: rjbs's rubric: the speed of Perl file finders).
So, for one, File::Find::Object seems to work for me; this snippet:
use Data::Dumper;
#targetDirsToScan = ("./");
use File::Find::Object;
my $tree = File::Find::Object->new({}, #targetDirsToScan);
while (my $robh = $tree->next_obj()) {
#print $robh ."\n"; # prints File::Find::Object::Result=HASH(0xa146a58)}
print Dumper($robh) ."\n";
}
... prints this:
# $VAR1 = bless( {
# 'stat_ret' => [
# 2054,
# 429937,
# 16877,
# 5,
# 1000,
# 1000,
# 0,
# '4096',
# 1405194147,
# 1405194139,
# 1405194139,
# 4096,
# 8
# ],
# 'base' => '.',
# 'is_link' => '',
# 'is_dir' => 1,
# 'path' => '.',
# 'dir_components' => [],
# 'is_file' => ''
# }, 'File::Find::Object::Result' );
# $VAR1 = bless( {
# 'base' => '.',
# 'is_link' => '',
# 'is_dir' => '',
# 'path' => './test.blg',
# 'is_file' => 1,
# 'stat_ret' => [
# 2054,
# 423870,
# 33188,
# 1,
# 1000,
# 1000,
# 0,
# '358',
# 1404972637,
# 1394828707,
# 1394828707,
# 4096,
# 8
# ],
# 'basename' => 'test.blg',
# 'dir_components' => []
... which is mostly what I wanted, except the stat results are an array, and I'd have to know its layout (($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks) stat - perldoc.perl.org) to make sense of the printout.
Then I looked into IO::All, which I like because of utf-8 handling (but also, say, socket functionality, which would be useful to me for an unrelated task in the same script); and I was thinking I'd use this package instead. The problem is, I have a very hard time discovering what the available fields in the object returned are; e.g. with this code:
use Data::Dumper;
#targetDirsToScan = ("./");
use IO::All -utf8;
$io = io(#targetDirsToScan);
#contents = $io->all(0);
for my $contentry ( #contents ) {
#print Dumper($contentry) ."\n";
# $VAR1 = bless( \*Symbol::GEN298, 'IO::All::File' );
# $VAR1 = bless( \*Symbol::GEN307, 'IO::All::Dir' ); ...
#print $contentry->uid . " -/- " . $contentry->mtime . "\n";
# https://stackoverflow.com/q/24717210/printing-ret-of-ioall-w-datadumper
print Dumper \%{*$contentry}; # doesn't list uid
}
... I get a printout like this:
# $VAR1 = {
# '_utf8' => 1,
# 'constructor' => sub { "DUMMY" },
# 'is_open' => 0,
# 'io_handle' => undef,
# 'name' => './test.blg',
# '_encoding' => 'utf8',
# 'package' => 'IO::All'
# };
# $VAR1 = {
# '_utf8' => 1,
# 'constructor' => sub { "DUMMY" },
# 'mode' => undef,
# 'name' => './testdir',
# 'package' => 'IO::All',
# 'is_absolute' => 0,
# 'io_handle' => undef,
# 'is_open' => 0,
# '_assert' => 0,
# '_encoding' => 'utf8'
... which clearly doesn't show attributes like mtime, etc. - even if they exist (which you can see if you uncomment the respective print line).
I've also tried Data::Printer's (How can I perform introspection in Perl?) p() function - it prints exactly the same fields as Dumper. I also tried to use print Dumper \%{ref ($contentry) . "::"}; (list out all methods of object - perlmonks.org), and this prints stuff like:
'O_SEQUENTIAL' => *IO::All::File::O_SEQUENTIAL,
'mtime' => *IO::All::File::mtime,
'DESTROY' => *IO::All::File::DESTROY,
...
'deep' => *IO::All::Dir::deep,
'uid' => *IO::All::Dir::uid,
'name' => *IO::All::Dir::name,
...
... but only if you use the print $contentry->uid ... line beforehand; else they are not listed! I guess that relates to this:
introspection - How do I list available methods on a given object or package in Perl? #911294
In general, you can't do this with a dynamic language like Perl. The package might define some methods that you can find, but it can also make up methods on the fly that don't have definitions until you use them. Additionally, even calling a method (that works) might not define it. That's the sort of things that make dynamic languages nice. :)
Still, that prints the name and type of the field - I'd want the name and value of the field instead.
So, I guess my main question is - how can I dump an IO::All result, so that all fields (including stat ones) are printed out with their names and values (as is mostly the case with File::Find::Object)?
(I noticed the IO::All results can be of type, say, IO::All::File, but its docs defer to "See IO::All", which doesn't discuss IO::All::File explicitly much at all. I thought, if I could "cast" \%{*$contentry} to a IO::All::File, maybe then mtime etc fields will be printed - but is such a "cast" possible at all?)
If that is problematic, are there other packages, that would allow introspective printout of directory iteration results - but with named fields for individual stat properties?
Perl does introspection in the fact that an object will tell you what type of object it is.
if ( $object->isa("Foo::Bar") ) {
say "Object is of a class of Foo::Bar, or is a subclass of Foo::Bar.";
}
if ( ref $object eq "Foo::Bar" ) {
say "Object is of the class Foo::Bar.";
}
else {
say "Object isn't a Foo::Bar object, but may be a subclass of Foo::Bar";
}
You can also see if an object can do something:
if ( $object->can("quack") ) {
say "Object looks like a duck!";
}
What Perl can't do directly is give you a list of all the methods that a particular object can do.
You might be able to munge some way.Perl objects are stored in package namespaces which are in the symbol table. Classes are implemented via Perl subroutines. It may be possible to go through the package namespace and then find all the subroutines.
However, I can see several issues. First private methods (the ones you're not suppose to use) and non-method subroutines would also be included. There's no way to know which is which. Also, parent methods won't be listed.
Many languages can generate such a list of methods for their objects (I believe both Python and Ruby can), but these usually give you a list without an explanation what these do. For example, File::Find::Object::Result (which is returned by the next_obj method of File::Find::Object) has a base method. What does it do? Maybe it's like basename and gives me the name of the file. Nope, it's like dirname and gives me the name of the directory.
Again, some languages could give a list of those methods for an object and a description. However, those descriptions depend upon the programmer to maintain and make sure they're correct. No guaranteed of that.
Perl doesn't have introspection, but all Perl modules stored in CPAN must be documented via POD embedded documentation, and this is printable from the command line:
$ perldoc File::Find::Object
This is the documentation you see in CPAN pages, in http://Perldoc.perl.org and in ActiveState's Perl documentation.
It's not bad. It's not true introspection, but the documentation is usually pretty good. After all, if the documentation stunk, I probably wouldn't have installed that module in the first place. I use perldoc all the time. I can barely remember my kids' names let alone the way to use Perl classes that I haven't used in a few months, but I find that using perldoc works pretty wall.
What you should not do is use Data::Dumper to dump out objects and try to figure out what they contain and possible methods. Some cleaver programmers are using Inside-Out Objects to thwart peeking toms.
So no, Perl doesn't list methods of a particular class like some languages can, but perldoc comes pretty close to doing what you need. I haven't use File::Find::Object in a long while, but going over the perldoc, I probably could write up such a program without much difficulty.
As I answered to your previous question, it is not a good idea to go relying on the guts of objects in Perl. Instead just call methods.
If IO::All doesn't offer a method that gives you the information that you need, you might be able to write your own method for it that assembles that information using just the documented methods provided by IO::All...
use IO::All;
# Define a new method for IO::All::Base to use, but
# define it in a lexical variable!
#
my $dump_info = sub {
use Data::Dumper ();
my $self = shift;
local $Data::Dumper::Terse = 1;
local $Data::Dumper::Sortkeys = 1;
return Data::Dumper::Dumper {
name => $self->name,
mtime => $self->mtime,
mode => $self->mode,
ctime => $self->ctime,
};
};
$io = io('/tmp');
for my $file ( $io->all(0) ) {
print $file->$dump_info();
}
Ok, this is more-less as an exercise (and reminder for me); below is some code, where I've tried to define a class (File::Find::Object::StatObj) with accessor fields for all of the stat fields. Then, I have the hack for IO::All::File from Replacing a class in Perl ("overriding"/"extending" a class with same name)?, where a mtimef field is added which corresponds to mtime, just as a reminder.
Then, just to see what sort of interface I could have between the two libraries, I have IO::All doing the iterating; and the current file path is passed to File::Find::Object, from which we obtain a File::Find::Object::Result - which has been "hacked" to also show the File::Find::Object::StatObj; but that one is only generated after a call to the hacked Result's full_components (that might as well have been a separate function). Notice that in this case, you won't get full_components/dir_components of File::Find::Object::Result -- because apparently it is not File::Find::Object doing the traversal here, but IO::All. Anyways, the result is something like this:
# $VAR1 = {
# '_utf8' => 1,
# 'mtimef' => 1403956165,
# 'constructor' => sub { "DUMMY" },
# 'is_open' => 0,
# 'io_handle' => undef,
# 'name' => 'img/test.png',
# '_encoding' => 'utf8',
# 'package' => 'IO::All'
# };
# img/test.png
# > - $VAR1 = bless( {
# 'base' => 'img/test.png',
# 'is_link' => '',
# 'is_dir' => '',
# 'path' => 'img/test.png',
# 'is_file' => 1,
# 'stat_ret' => [
# 2054,
# 426287,
# 33188,
# 1,
# 1000,
# 1000,
# 0,
# '37242',
# 1405023944,
# 1403956165,
# 1403956165,
# 4096,
# 80
# ],
# 'basename' => undef,
# 'stat_obj' => bless( {
# 'blksize' => 4096,
# 'ctime' => 1403956165,
# 'rdev' => 0,
# 'blocks' => 80,
# 'uid' => 1000,
# 'dev' => 2054,
# 'mtime' => 1403956165,
# 'mode' => 33188,
# 'size' => '37242',
# 'nlink' => 1,
# 'atime' => 1405023944,
# 'ino' => 426287,
# 'gid' => 1000
# }, 'File::Find::Object::StatObj' ),
# 'dir_components' => []
# }, 'File::Find::Object::Result' );
I'm not sure how correct this would be, but what I like about this is that I could forget where the fields are; then I could rerun the dumper, and see that I could get mtime via (*::Result)->stat_obj->size - and that seems to work (here I'd need just to read these, not to set them).
Anyways, here is the code:
use Data::Dumper;
my #targetDirsToScan = ("./");
use IO::All -utf8 ; # Turn on utf8 for all io
# try to "replace" the IO::All::File class
{ # https://stackoverflow.com/a/24726797/277826
package IO::All::File;
use IO::All::File; # -base; # just do not use `-base` here?!
# hacks work if directly in /usr/local/share/perl/5.10.1/IO/All/File.pm
# NB: field is a sub in /usr/local/share/perl/5.10.1/IO/All/Base.pm
field mtimef => undef; # hack
sub file {
my $self = shift;
bless $self, __PACKAGE__;
$self->name(shift) if #_;
$self->mtimef($self->mtime); # hack
#print("!! *haxx0rz'd* file() reporting in\n");
return $self->_init;
}
1;
}
use File::Find::Object;
# based on /usr/local/share/perl/5.10.1/File/Find/Object/Result.pm;
# but inst. from /usr/local/share/perl/5.10.1/File/Find/Object.pm
{
package File::Find::Object::StatObj;
use integer;
use Tie::IxHash;
#use Data::Dumper;
sub ordered_hash { # https://stackoverflow.com/a/3001400/277826
#my (#ar) = #_; #print("# ". join(",",#ar) . "\n");
tie my %hash => 'Tie::IxHash';
%hash = #_; #print Dumper(\%hash);
\%hash
}
my $fields = ordered_hash(
# from http://perldoc.perl.org/functions/stat.html
(map { $_ => $_ } (qw(
dev ino mode nlink uid gid rdev size
atime mtime ctime blksize blocks
)))
); #print Dumper(\%{$fields});
use Class::XSAccessor
#accessors => %{$fields}, # cannot - is seemingly late
# ordered_hash gets accepted, but doesn't matter in final dump;
#accessors => { (map { $_ => $_ } (qw(
accessors => ordered_hash( (map { $_ => $_ } (qw(
dev ino mode nlink uid gid rdev size
atime mtime ctime blksize blocks
))) ),
#))) },
;
use Fcntl qw(:mode);
sub new
{
#my $self = shift;
my $class = shift;
my #stat_arr = #_; # the rest
my $ic = 0;
my $self = {};
bless $self, $class;
for my $k (keys %{$fields}) {
$fld = $fields->{$k};
#print "$ic '$k' '$fld' ".join(", ",$stat_arr[$ic])." ; ";
$self->$fld($stat_arr[$ic]);
$ic++;
}
#print "\n";
return $self;
}
1;
}
# try to "replace" the File::Find::Object::Result
{
package File::Find::Object::Result;
use File::Find::Object::Result;
#use File::Find::Object::StatObj; # no, has no file!
use Class::XSAccessor replace => 1,
accessors => {
(map { $_ => $_ } (qw(
base
basename
is_dir
is_file
is_link
path
dir_components
stat_ret
stat_obj
)))
}
;
#use Fcntl qw(:mode);
#sub new # never gets called
sub full_components
{
my $self = shift; #print("NEWCOMP\n");
my $sobj = File::Find::Object::StatObj->new(#{$self->stat_ret()});
$self->stat_obj($sobj); # add stat_obj and its fields
return
[
#{$self->dir_components()},
($self->is_dir() ? () : $self->basename()),
];
}
1;
}
# main script start
my $io = io($targetDirsToScan[0]);
my #contents = $io->all(0); # Get all contents of dir
for my $contentry ( #contents ) {
print Dumper \%{*$contentry};
print $contentry->name . "\n"; # img/test.png
# get a File::Find::Object::Result - must instantiate
# a File::Find::Object; just item_obj() will return undef
# right after instantiation, so must give it "next";
# no instantition occurs for $tro, though!
#my $tffor = File::Find::Object->new({}, ($contentry->name))->next_obj();
my $tffo = File::Find::Object->new({}, ("./".$contentry->name));
my $tffos = $tffo->next(); # just a string!
$tffo->_calc_current_item_obj(); # unfortunately, this will not calculate dir_components ...
my $tffor = $tffo->item_obj();
# ->full_components doesn't call new, either!
# must call full_compoments, to generate the fields
# (assign to unused variable triggers it fine)
# however, $arrref_fullcomp will be empty, because
# File::Find::Object seemingly calcs dir_components only
# if it is traversing a tree...
$arrref_fullcomp = $tffor->full_components;
#print("# ".$tffor->stat_obj->size."\n"); # seems to work
print "> ". join(", ", #$arrref_fullcomp) ." - ". Dumper($tffor);
}

Perl - Overloading package/class properties?

I am attempting to port some code from PHP that basically boils down to property overloading. That is, if you try to get or set a class property that is not actually defined as a part of the class, it will send that information to a function that will pretty much do anything I want with it. (In this case, I want to search an associative array within the class before giving up.)
However, Perl is... quite a bit different from PHP, given that classes are already hashes. Is there any way that I can apply some equivalent of __get() and __set() to a Perl "class" that will remain completely encapsulated in that package, transparent to anything trying to actually get or set properties?
EDIT: The best way to explain this may be to show you code, show the output, and then show what I want it to output.
package AccessTest;
my $test = new Sammich; #"improper" style, don't care, not part of the question.
say 'bacon is: ' . $test->{'bacon'};
say 'cheese is: ' . $test->{'cheese'};
for (keys $test->{'moreProperties'}) {
say "$_ => " . $test->{'moreProperties'}{$_};
}
say 'invalid is: ' . $test->{'invalid'};
say 'Setting invalid.';
$test->{'invalid'} = 'true';
say 'invalid is now: ' . $test->{'invalid'};
for (keys $test->{'moreProperties'}) {
say "$_ => " . $test->{'moreProperties'}{$_};
}
package Sammich;
sub new
{
my $className = shift;
my $this = {
'bacon' => 'yes',
'moreProperties' => {
'cheese' => 'maybe',
'ham' => 'no'
}
};
return bless($this, $className);
}
This currently outputs:
bacon is: yes
Use of uninitialized value in concatenation (.) or string at ./AccessTest.pl line 11.
cheese is:
cheese => maybe
ham => no
Use of uninitialized value in concatenation (.) or string at ./AccessTest.pl line 17.
invalid is:
Setting invalid.
invalid is now: true
cheese => maybe
ham => no
Now, I need to make modifications to Sammich only, without making any changes at all to the initial AccessTest package, that will result in this:
bacon is: yes
cheese is: maybe
cheese => maybe
ham => no
invalid is: 0
Setting invalid.
invalid is now: true
cheese => maybe
ham => no
invalid => true
As you can see, the desired effect is that the 'cheese' property, since it's not a part of the test object directly, would instead be grabbed from the 'moreProperties' hash. 'invalid' would attempt the same thing, but since it is neither a direct property nor in 'moreProperties', it would act in whatever way programmed - in this case, I would want it to simply return the value 0, without any errors or warnings. Upon attempting to set the 'invalid' property, it would not be added to the object directly, because it's not already there, but would instead be added to the 'moreProperties' hash.
I'm expecting this to take more than the six or so lines it would require in PHP, but as it is a very important concept of OOP, I fully expect Perl to handle it somehow.
As I have said in my comments, the reason this problem is hard is that you aren't following one of the golden rules of Object-Oriented Programming, namely encapsulation. How can you expect to intercept a call that isn't a method? If your exposed API consists of getter/setters then you can intercept an unknown method call with an AUTOLOAD method. If you don't you may use #pilcrow's noble suggestion of using a tied hash (Edit: or #tchrist's valiant use of the overload pragma); still this is more a tribute to Perl's flexibility than your API.
To do this more correctly (and yes I see you "require" that the API not be modified, if you choose to ignore this, then call this post a message to future readers).
#!/usr/bin/env perl
use v5.10; # say
use strict;
use warnings;
use MooseX::Declare;
use Method::Signatures::Modifiers;
class Sammich {
has 'bacon' => ( isa => 'Str', is => 'rw', default => 'yes' );
has 'more' => (
isa => 'HashRef',
is => 'rw',
default => sub{ {
cheese => 'maybe',
ham => 'no',
} },
);
our $AUTOLOAD;
method AUTOLOAD ($val?) {
# get unknown method name
my $attr = (split( /::/, $AUTOLOAD))[-1];
my $more = $self->more;
# see if that method name exists in "more"
if (exists $more->{$attr}) {
# if so, are there new values? then set
if (defined $val) {
$more->{$attr} = $val;
}
# ... and return
return $more->{$attr};
}
# attr does not exist, so set it or initialize it to 0
$more->{$attr} = defined $val ? $val : 0;
return $more->{$attr};
}
}
# I don't care that you don't care
my $test = Sammich->new();
say 'bacon is: ' . $test->bacon;
say 'cheese is: ' . $test->cheese;
for (keys %{ $test->more }) {
say "$_ => " . $test->more->{$_};
}
say 'invalid is: ' . $test->invalid;
say 'Setting invalid.';
$test->invalid( 'true' );
say 'invalid is now: ' . $test->invalid;
for (keys %{ $test->more }) {
say "$_ => " . $test->more->{$_};
}
Some may say that my wording here is harsh and perhaps it is. I try to help those who will be helped, therefore seeing a bolded message like
I need to make modifications to Sammich only, without making any changes at all to the initial AccessTest package
then demanding that Perl bow to your whim
I'm expecting this to take more than the six or so lines it would require in PHP, but as it is a very important concept of OOP, I fully expect Perl to handle it somehow.
is irksome. I hope that future readers will see this as a case example of why encapsulation helps in the long run.
Update to the update
(I am receiving anonymous downvotes, presumably for abetting your misguided approach. :) )
Just to be clear, the question you pose is an "XY Problem", specifically an artifact of the mistaken translation of OO technique from PHP to Perl. For example, as mentioned passim in this question, object properties in perl generally should not be implemented as directly accessed hash(ref) elements. That's the wrong "X".
Jumping from one language to another introduces more than merely syntactical differences.
Update
You can accomplish what you want with something like this:
package UnfortunateHack; {
use Tie::Hash;
our #ISA = qw(Tie::StdHash);
sub FETCH {
my ($self, $key) = #_;
return exists $self->{$key}
? $self->{$key}
: $self->{moreProperties}->{$key};
}
}
...
package Sammich;
sub new {
my $class = shift;
tie my %this, 'UnfortunateHack';
%this = ( bacon => 'yes',
moreProperties => { ... } );
bless \%this, $class;
}
Original Answer
If I understand your intent — to intercept $obj->property calls where TheClass::property isn't necessarily defined — then perl's AUTOLOAD in an OO context will do what you want.
From the linked docs (perlobj):
If you call a method that doesn't exist in a class, Perl will throw an error. However, if that class or any of its parent classes defines an AUTOLOAD method, that AUTOLOAD method is called instead.
You are completely violating encapsulation. To prove it to you, comment out the bless from &Sammich::new so that it returns a plain hash reference.
package Sammich;
sub new {
my $className = shift;
my $this = {
'bacon' => 'yes',
'moreProperties' => {
'cheese' => 'maybe',
'ham' => 'no'
}
};
# don't even bother blessing it
# return bless($this, $className);
}
The only way to get what you want it is to use magic.
In Perl classes are more than hashes, they are built on packages and you can define there whatever method you want and it remains encapsulated in that package/class.
You can see a code example in the Object-Oriented Programming in Perl Tutorial.

How to check undefined key in perl OO code?

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 ... .

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

How can I reduce duplication in constants?

I have this Perl script with many defined constants of configuration files. For example:
use constant {
LOG_DIR => "/var/log/",
LOG_FILENAME => "/var/log/file1.log",
LOG4PERL_CONF_FILE => "/etc/app1/log4perl.conf",
CONF_FILE1 => "/etc/app1/config1.xml",
CONF_FILE2 => "/etc/app1/config2.xml",
CONF_FILE3 => "/etc/app1/config3.xml",
CONF_FILE4 => "/etc/app1/config4.xml",
CONF_FILE5 => "/etc/app1/config5.xml",
};
I want to reduce duplication of "/etc/app1" and "/var/log" , but using variables does not work. Also using previously defined constants does not work in the same "use constant block". For example:
use constant {
LOG_DIR => "/var/log/",
FILE_FILENAME => LOG_DIR . "file1.log"
};
does not work.
Using separate "use constant" blocks does workaround this problem, but that adds a lot of unneeded code.
What is the correct way to do this?
Thank you.
Using separate "use constant" blocks
does workaround this problem, but that
adds a lot of unneeded code.
Does it really?
use constant BASE_PATH => "/etc/app1";
use constant {
LOG4PERL_CONF_FILE => BASE_PATH . "/log4perl.conf",
CONF_FILE1 => BASE_PATH . "/config1.xml",
CONF_FILE2 => BASE_PATH . "/config2.xml",
CONF_FILE3 => BASE_PATH . "/config3.xml",
CONF_FILE4 => BASE_PATH . "/config4.xml",
CONF_FILE5 => BASE_PATH . "/config5.xml",
};
I don't see a lot of problems with this. You have specified the base path in one point only, thereby respecting the DRY principle. If you assign BASE_PATH with an environment variable:
use constant BASE_PATH => $ENV{MY_BASE_PATH} || "/etc/app1";
... you then have a cheap way of reconfiguring your constant without having to edit your code. What's there to not like about this?
If you really want to cut down the repetitive "BASE_PATH . " concatenation, you could add a bit of machinery to install the constants yourself and factor that away:
use strict;
use warnings;
use constant BASE_PATH => $ENV{MY_PATH} || '/etc/apps';
BEGIN {
my %conf = (
FILE1 => "/config1.xml",
FILE2 => "/config2.xml",
);
for my $constant (keys %conf) {
no strict 'refs';
*{__PACKAGE__ . "::CONF_$constant"}
= sub () {BASE_PATH . "$conf{$constant}"};
}
}
print "Config is ", CONF_FILE1, ".\n";
But at this point I think the balance has swung away from Correct to Nasty :) For a start, you can no longer grep for CONF_FILE1 and see where it is defined.
I'd probably write it like this:
use Readonly;
Readonly my $LOG_DIR => "/var/log";
Readonly my $LOG_FILENAME => "$LOG_DIR/file1.log";
Readonly my $ETC => '/etc/app1';
Readonly my $LOG4PERL_CONF_FILE => "$ETC/log4perl.con";
# hash because we don't have an index '0'
Readonly my %CONF_FILES => map { $_ => "$ETC/config$_.xml" } 1 .. 5;
However, that's still a lot of code, but it does remove the duplication and that's a win.
Why are your logfiles numeric? If they start with 0, an array is a better choice than a hash. If they're named, they're more descriptive.
use constant +{
map { sprintf $_, '/var/log' } (
LOG_DIR => "%s/",
LOG_FILENAME => "%s/file1.log",
),
map { sprintf $_, '/etc/app1' } (
LOG4PERL_CONF_FILE => "%s/log4perl.conf",
CONF_FILE1 => "%s/config1.xml",
CONF_FILE2 => "%s/config2.xml",
CONF_FILE3 => "%s/config3.xml",
CONF_FILE4 => "%s/config4.xml",
CONF_FILE5 => "%s/config5.xml",
),
};
That's not going to work, sadly. The reason for this is that you are using functions ('constants') before they are defined. You evaluate them before the call to constant->import.
Using variables doesn't work because use statements are evaluated at compile time. Assigning to variables is only done at runtime, so they won't be defined yet.
The only solution I can give is to split it into multiple use constant statements. In this case, two statements will do (one for LOG_DIR and CONF_DIR, another for the rest).
Depending on what you are doing, you might not want constants at all. Mostly, I write stuff that other people use to get their stuff done, so I solve this problem in a way that gives other programmers flexibility. I make these things into methods:
sub base_log_dir { '...' }
sub get_log_file
{
my( $self, $number ) = #_;
my $log_file = catfile(
$self->base_log_dir,
sprintf "foo%03d", $number
);
}
By doing it this way, I can easily extend or override things.
Doing this loses the value of constant folding though, so you have to think about how important that is to you.