Is it possible with pert to achieve the following syntax?
sub a {
my ($first, $second) = #_;
print "$first $second";
}
sub b {
my ($param, $code) = #_;
my $res = $code->();
return "$param $res";
}
a 'param1' b 'param2' => sub { return "param3" };
#output would be "param1 param2 param3"
a is sub, which would get inside #_ 'param1' and whatever b (which would got 'param2' and a subref inside #_) returns. I like having no comma before 'b'. Is it possible?
I strongly recommend against this. What is your motivation to omit the comma?
Language X doesn't require a comma here.
Perl isn't X. There are a lot of features that X may have, but Perl doesn't. This also includes static typing, indentation-sensitive parsing, and Lisp-style macros. If you absolutely need X's features, maybe you should be using X.
I am writing a DSL in Perl where the comma would be annoying.
I am aware of this trend to write elaborate APIs that remotely look like ordinary text, and calling them a “DSL”. They are not; a DSL requires you to actually parse something. And if you're writing an API, it would better be idiomatic in the host language. Even if that involves stray commas and such.
I really want to do this for whatever reason, no matter how fragile the result.
In this specific case, I can write code to do as you wish. It uses the absurd and discouraged “dative“ form of method calls (also known as “indirect object notation”).
The param1 will be a class on which we call the a method. The argument list will be a call to b:
use feature 'say';
package param1 {
sub a {
my ($first, $second) = #_;
say "$first $second";
}
}
sub b {
my ($param, $code) = #_;
my $res = $code->();
return "$param $res";
}
a param1 b param2 => sub { "param3" }; # look, optional quotes for param1
Of course, that's merely syntactic sugar for 'param1'->a(b(param2 => sub { 'param3' })). And it requires you to know all values of param1 in advance – unless you create an object first that wraps the first arg:
use feature 'say';
package MyApi {
sub a {
my ($first, $second) = #_;
say "$$first $second";
}
}
sub b {
my ($param, $code) = #_;
my $res = $code->();
return "$param $res";
}
sub api($) { bless \shift() => 'MyApi' }
my $param1 = api 'param1';
a $param1 b param2 => sub { "param3" };
But that's silly.
I still want to do this, but without that fragile nonsense. I also do not care about how much effort I have to expend to make this work.
You can add keywords to the Perl parser that allow you to take over parsing. This requires you to have a certain amount of knowledge about Perl's parser API, and your code will not work on older Perls. Because you probably don't want to write your parser in C, you might want to look at something like Devel::Declare::Lexer, but these modules tend to be a bit iffy. Good luck to you!
Related
In Perl, I just got bitten by something that looked like the bug below:
package Foo;
sub method {
my $self = shift;
my #args = #_;
...
}
where I called it as a subroutine, not a method:
Foo::method( "arg1", "arg2" );
rather than calling it as a method - in this case, it was a "class method":
Foo->method( "arg1", "arg2" );
Calling Foo::method("arg1","arg2") resulted in "arg1" getting dropped.
Similar considerations can arise with an "object method":
my $object = Foo->new();
$obj->method( "arg1", "arg2" );
Is there a friendly, concise, Perl idiom for checking that the first argument, conventionally called $self, is in fact an object in the class (package), and/or the class/package name?
The best I have come up with is:
package Foo;
sub method {
my $self = ($_[0]->isa(__PACKAGE__) ? shift #_ : die "...error message...";
my #args = #_;
...
}
which is not much more concise than
package Foo;
sub method {
my $self = shift;
die "...error message..." if $self->isa(__PACKAGE__);
my #args = #_;
...
}
or
package Foo;
use Carp::Assert;
sub method {
my $self = shift;
assert($self->isa(__PACKAGE__));
my #args = #_;
...
}
Notes:
I know about Perl signatures, but dislike using experimental features.
I know about use attributes and :method. Is that the best way to go? Similar concerns about "evolving" features.
I know about Moose - but I don't think that Moose enforces this. (Did I miss anything.)
The problem with Perl is that there are so many ways to do something.
The best answer is to not mix functions and methods in a single package. "Hybrid modules", as they're known, are problematic. Everything which you might want to make a function should instead be a class method call.
There should be little need to fully qualify a function call in day-to-day programming.
The most concise way is to use Moops which is the new way to use Moose with syntax-sugar.
use Moops;
class Foo {
method something() {
print("something called\n");
}
}
Foo->new->something();
Foo::something();
# something called
# Invocant $self is required at /Users/schwern/tmp/test.plx line 10.
Moops is marked as unstable, but that's the interface, not the signatures themselves. Signatures have been around and usable in production for a long time, longer than they've been built in. More worrying is there hasn't been a release in over a year, however the author writes good stuff. Your call.
Otherwise, like with anything else, write a function.
use Carp;
use Scalar::Util qw(blessed);
sub check_invocant {
my $thing = shift;
my $caller = caller;
if( !defined $thing ) {
croak "The invocant is not defined";
}
elsif( !ref $thing ) {
croak "The invocant is not a reference";
}
elsif( !blessed $thing ) {
croak "The invocant is not an object";
}
elsif( !$thing->isa($caller) ) {
croak "The invocant is not a subclass of $caller";
}
return $thing;
}
Since this returns the invocant and handles the exception for you it can be used very concisely.
package Foo;
sub method {
my $self = ::check_invocant(shift);
...
}
I'll add to what Schwern has written to say that you could also take a look at Safe::Isa, which lets you safely call isa on something which you cannot be sure is an object.
I'm going to try to follow the advice of #Schwern and "not mix functions and methods in a single package". That said, here's an example using the fun method approach from Function::Parameters. The example is of course contrived and a bit awkward, but it illustrates the idea.
Function::Parameters requires a compiler version of at least perl5.14. It's still perl (and XS) so it will not magically make your code "strongly typed". But, with attributes and type constraints via Type::Tiny, you can separate your methods and functions by more than name only. Even just using different names for different types of subroutines - fun and method by default - can be really helpful.
Using the ':strict' keyword and/or default function/method "types" (fun => { ... } and method => { ... } below, as well as others such as method_lax) obviates the need for passing values to settings when the module is imported, so the code below can be made shorter.
use v5.22;
package My::Package {
use DDP;
use attributes 'get';
use Function::Parameters {
fun => { strict => 1, } ,
method => { strict => 1,
invocant => 1,
shift => '$class',
attributes => ':method',} ,
} ;
fun func_test ( # ) {
warn "must be called as a function"
if $_[0] eq __PACKAGE__ && get(__SUB__) ne "method";
print "args = ", np #_ ;
}
method meth_test ( # ) {
warn "must be called as a method"
unless $class eq __PACKAGE__ && get(__SUB__) eq "method";
say "\$class = $class" if length $class ;
say "args = ", np #_ ;
}
}
say "\nCalling meth_test as method:";
My::Package->meth_test( ["foo", "bar"] );
say "\nCalling meth_test as function:";
My::Package::meth_test( ["foo", "bar"] );
say "\nCalling func_test as a function:";
My::Package::func_test( qw/baz fuz/ );
say "\nCalling func_test as a method:";
My::Package->func_test( qw/baz fuz/ );
Output:
Calling meth_test as method:
$class = My::Package
args = [
[0] [
[0] "foo",
[1] "bar"
]
]
Calling meth_test as function:
must be called as a method at FunctionParameters-PackageCheck-SO.pl line 24.
$class = ARRAY(0x801cfa330)
args = []
Calling func_test as a function:
args = [
[0] "baz",
[1] "fuz"
]
Calling func_test as a method:
must be called as a function at FunctionParameters-PackageCheck-SO.pl line 17.
args = [
[0] "My::Package",
[1] "baz",
[2] "fuz"
]
I'm writing some code where I am using a subroutine as both an lvalue and an rvalue to read and write database values. The problem is, I want it to react differently based on whether it is being used as an lvalue or an rvalue.
I want the subroutine to write to the database when it is used as an lvalue, and read from the database when it is used as an rvalue.
Example:
# Write some data
$database->record_name($subscript) = $value;
# Read some data
my $value = $database->record_name($subscript);
The only way I can think of the make this work is to find a way for the subroutine to recognize whether it is being used as an lvalue or an rvalue and react differently for each case.
Is there a way to do this?
Deciding how to behave on whether it was called as an lvalue or not is a bad idea since foo(record_name(...)) would call it as an lvalue.
Instead, you should decide how to behave on whether it is used as an lvalue or not.
You can do that by returning a magical value.
use Variable::Magic qw( cast wizard );
my $wiz = wizard(
data => sub { shift; \#_ },
get => sub { my ($ref, $args) = #_; $$ref = get_record_name(#$args); },
set => sub { my ($ref, $args) = #_; set_record_name(#$args, $$ref); },
);
sub record_name :lvalue {
cast(my $rv, $wiz, #_);
return $rv;
}
A little test:
use Data::Dumper;
sub get_record_name { print("get: #_\n"); return "val"; }
sub set_record_name { print("set: #_\n"); }
my $x = record_name("abc", "def"); # Called as rvalue
record_name("abc", "def") = "xyz"; # Called as lvalue. Used as lvalue.
my $y_ref = \record_name("abc", "def"); # Called as lvalue.
my $y = $$y_ref; # Used as rvalue.
$$y_ref = "xyz"; # Used as lvalue.
Output:
get: abc def
set: abc def xyz
get: abc def
set: abc def xyz
After seeing this, you've surely learned that you should abandon the idea of using an lvalue sub. It's possible to hide all that complexity (such as by using sentinel), but the complexity remains. The fanciness is not worth all the complexity. Use separate setters and getters or use an accessor whose role is based on the number of parameters passed to it ($s=acc(); vs acc($s)) instead.
For this situation you might like to try my Sentinel module.
It provides a function you can use in the accessor, to turn it into a more get/set style approach. E.g. you could
use Sentinel qw( sentinel );
sub get_record_name { ... }
sub set_record_name { ... }
sub record_name
{
sentinel get => \&get_record_name,
set => \&set_record_name,
obj => shift;
}
At this point, the following pairs of lines of code are equivalent
$name = $record->record_name;
$name = $record->get_record_name;
$record->record_name = $new_name;
$record->set_record_name( $new_name );
Of course, if you're not needing to provide the specific get_ and set_ prefixed versions of the methods as well, you could inline them as closures.
See the module docs also for further ideas.
In my opinion, lvalue subroutines in Perl were a dumb idea. Just support ->record_name($subscript, $value) as a setter and ->record_name($subscript) as a getter.
That said, you can use the Want module, like this
use Want;
sub record_name:lvalue {
if ( want('LVALUE') ) {
...
}
else {
...
}
}
though that will also treat this as an LVALUE:
foo( $database->record_name($subscript) );
If you want only assignment statements to be treated specially, use want('ASSIGN') instead.
I need to transform data structures from a list of arrays into a tree-like one. I know the depth of the tree before I start processing the data, but I want to keep things flexible so I can re-use the code.
So I landed upon the idea of generating a subref on the fly (from within a Moose-based module) to go from array to tree. Like this (in a simplified way):
use Data::Dump qw/dump/;
sub create_tree_builder {
my $depth = shift;
return eval join '', 'sub { $_[0]->{$_[',
join(']}->{$_[', (1..$depth)),
']} = $_[', $depth + 1 , '] }';
}
my $s = create_tree_builder(5);
my $tree = {};
$s->($tree, qw/one two three four five/, 'a value');
print dump $tree;
# prints
# {
# one => { two => { three => { four => { five => "a value" } } } },
# }
This opened up worlds to me, and I'm finding cool uses for this process of eval-in a parametrically generated string into a function all over the place (clearly, a solution in search of problems).
However, it feels a little too good to be true, almost.
Any advice against this practice? Or suggestion for improvements?
I can see clearly that eval-ing arbitrary input might not be the safest thing, but what else?
Follow up
Thanks for all the answers. I used amon's code and benchmarked a bit, like this:
use Benchmark qw(:all) ;
$\ = "\n";
sub create_tree_builder {
my $depth = shift;
return eval join '', 'sub { $_[0]->{$_[',
join(']}->{$_[', (1..$depth)),
']} = $_[', $depth + 1 , '] }';
}
my $s = create_tree_builder(5);
$t = sub {
$_[0] //= {};
my ($tree, #keys) = #_;
my $value = pop #keys;
$tree = $tree->{shift #keys} //= {} while #keys > 1;
$tree->{$keys[0]} = $value;
};
cmpthese(900000, {
'eval' => sub { $s->($tree, qw/one two three four five/, 'a value') },
'build' => sub { $t->($tree, qw/one two three four five/, 'a value') },
});
The results are clearly in favour of building the tree, not of the eval'ed factory:
Rate build eval
build 326087/s -- -79%
eval 1525424/s 368% --
I'll admit I could have done that before. I'll try with more random trees (rather than assigning the same element over and over) but I see no reason that the results should be different.
Thanks a lot for the help.
It is very easy to write a generalized subroutine to build such a nested hash. It is much simpler that way than writing a factory that will produce such a subroutine for a specific number of hash levels.
use strict;
use warnings;
sub tree_assign {
# Create an empty tree if one was not given, using an alias to the original argument
$_[0] //= {};
my ($tree, #keys) = #_;
my $value = pop #keys;
$tree = $tree->{shift #keys} //= {} while #keys > 1;
$tree->{$keys[0]} = $value;
}
tree_assign(my $tree, qw/one two three four five/, 'a value');
use Data::Dump;
dd $tree;
output
{
one => { two => { three => { four => { five => "a value" } } } },
}
Why this might be a bad idea
Maintainability.
Code that is eval'd has to be eval'd inside the programmers head first– not always an easy task. Essentially, evaling is obfuscation.
Speed.
eval re-runs the perl parser and compiler, before normal execution resumes. However, the same technique can be used to gain start-up time by deferring compilation of subroutines until they are needed. This is not such a case.
There is more than one way to do it.
I like anonymous subroutines, but you don't have to use an eval to construct them. They are closures anyway. Something like
...;
return sub {
my ($tree, $keys, $value) = #_;
$#$keys >= $depth or die "need moar keys";
$tree = $tree->{$keys->[$_]} for 0 .. $depth - 1;
$tree->{$keys->[$depth]} = $value;
};
and
$s->($tree, [qw(one two three four five)], "a value");
would do something suprisingly similar. (Actually, using $depth now looks like a design error; the complete path is already specified by the keys. Therefore, creating a normal, named subroutine would probably be best.)
Understanding what the OP is doing a little better based on their comments, and riffing on Borodin's code, I'd suggest an interface change. Rather than writing a subroutine to apply a value deep in a tree, I'd write a subroutine to create an empty subtree and then work on that subtree. This allows you to work efficiently on the subtree without having to walk the tree on every operation.
package Root;
use Mouse;
has root =>
is => 'ro',
isa => 'HashRef',
default => sub { {} };
sub init_subtree {
my $self = shift;
my $tree = $self->root;
for my $key (#_) {
$tree = $tree->{$key} //= {};
}
return $tree;
}
my $root = Root->new;
my $subtree = $root->init_subtree(qw/one two three four/);
# Now you can quickly work with the subtree without having
# to walk down every time. This loop's performance is only
# dependent on the number of keys you're adding, rather than
# the number of keys TIMES the depth of the subtree.
my $val = 0;
for my $key ("a".."c") {
$subtree->{$key} = $val++;
}
use Data::Dump;
dd $root;
Data::Diver is your friend:
use Data::Diver 'DiveVal', 'DiveRef';
my $tree = {};
DiveVal( $tree, qw/one two three four five/ ) = 'a value';
# or if you hate lvalue subroutines:
${ DiveRef( $tree, qw/one two three four five/ ) } = 'a value';
use Data::Dump 'dump';
print dump $tree;
I have a number of higher order utility functions that take in a code reference and apply that code to some data. Some of these functions require localizing variables during the execution of the subroutines. At the beginning, I was using caller to determine which package to localize into, in a similar manner as shown in this example reduce function:
sub reduce (&#) {
my $code = shift;
my $caller = caller;
my ($ca, $cb) = do {
no strict 'refs';
map \*{$caller.'::'.$_} => qw(a b)
};
local (*a, *b) = local (*$ca, *$cb);
$a = shift;
while (#_) {
$b = shift;
$a = $code->()
}
$a
}
Initially this technique worked fine, however as soon as I tried writing a wrapper function around the higher order function, figuring out the correct caller becomes complicated.
sub reduce_ref (&$) {&reduce($_[0], #{$_[1]})}
Now in order for reduce to work, I would need something like:
my ($ca, $cb) = do {
my $caller = 0;
$caller++ while caller($caller) =~ /^This::Package/;
no strict 'refs';
map \*{caller($caller).'::'.$_} => qw(a b)
};
At this point it became a question of which packages to skip, combined with the discipline of never using the function from within those packages. There had to be a better way.
It turns out that the subroutine the higher order functions take as an argument contains enough meta-data to solve the problem. My current solution is using the B introspection module to determine the compiling stash of the passed in subroutine. That way, no-matter what happens between compilation of the code and its execution, the higher order function always knows the correct package to localize into.
my ($ca, $cb) = do {
require B;
my $caller = B::svref_2object($code)->STASH->NAME;
no strict 'refs';
map \*{$caller.'::'.$_} => qw(a b)
};
So my ultimate question is if this is the best way of determining the caller's package in this situation? Is there some other way that I have not thought of? Is there some bug waiting to happen with my current solution?
First, you can use the following and not need any changes:
sub reduce_ref (&$) { #_ = ( $_[0], #{$_[1]} ); goto &reduce; }
But generally speaking, the following is indeed exactly what you want:
B::svref_2object($code)->STASH->NAME
You want the $a and $b variables of the sub's __PACKAGE__, so you want to know the sub's __PACKAGE__, and that's exactly what that returns. It even fixes the following:
{
package Utils;
sub mk_some_reducer {
...
return sub { ... $a ... $b ... };
}
}
reduce(mk_some_reducer(...), ...)
It doesn't fix everything, but that's impossible without using arguments instead of $a and $b.
In case anyone needs them, here are the functions that I eventually decided to use:
require B;
use Scalar::Util 'reftype';
use Carp 'croak';
my $cv_caller = sub {
reftype($_[0]) eq 'CODE' or croak "not code: $_[0]";
B::svref_2object($_[0])->STASH->NAME
};
my $cv_local = sub {
my $caller = shift->$cv_caller;
no strict 'refs';
my #ret = map \*{$caller.'::'.$_} => #_;
wantarray ? #ret : pop #ret
};
Which would be used as:
my ($ca, $cb) = $code->$cv_local(qw(a b));
in the context of the original question.
I choose to use tie and find this:
package Galaxy::IO::INI;
sub new {
my $invocant = shift;
my $class = ref($invocant) || $invocant;
my $self = {']' => []}; # ini section can never be ']'
tie %{$self},'INIHash';
return bless $self, $class;
}
package INIHash;
use Carp;
require Tie::Hash;
#INIHash::ISA = qw(Tie::StdHash);
sub STORE {
#$_[0]->{$_[1]} = $_[2];
push #{$_[0]->{']'}},$_[1] unless exists $_[0]->{$_[1]};
for (keys %{$_[2]}) {
next if $_ eq '=';
push #{$_[0]->{$_[1]}->{'='}},$_ unless exists $_[0]->{$_[1]}->{$_};
$_[0]->{$_[1]}->{$_}=$_[2]->{$_};
}
$_[0]->{$_[1]}->{'='};
}
if I remove the last "$[0]->{$[1]}->{'='};", it does not work correctly.
Why ?
I know a return value is required. But "$[0]->{$[1]};" cannot work correctly either, and $[0]->{$[1]}->{'='} is not the whole thing.
Old post:
I am write a package in Perl for parsing INI files.
Just something based on Config::Tiny.
I want to keep the order of sections & keys, so I use extra array to store the order.
But when I use " $Config->{newsection} = { this => 'that' }; # Add a section ", I need to overload '=' so that "newsection" and "this" can be pushed in the array.
Is this possible to make "$Config->{newsection} = { this => 'that' };" work without influence other parts ?
Part of the code is:
sub new {
my $invocant = shift;
my $class = ref($invocant) || $invocant;
my $self = {']' => []}; # ini section can never be ']'
return bless $self, $class;
}
sub read_string {
if ( /^\s*\[\s*(.+?)\s*\]\s*$/ ) {
$self->{$ns = $1} ||= {'=' => []}; # ini key can never be '='
push #{$$self{']'}},$ns;
next;
}
if ( /^\s*([^=]+?)\s*=\s*(.*?)\s*$/ ) {
push #{$$self{$ns}{'='}},$1 unless defined $$self{$ns}{$1};
$self->{$ns}->{$1} = $2;
next;
}
}
sub write_string {
my $self = shift;
my $contents = '';
foreach my $section (#{$$self{']'}}) {
}}
Special Symbols for Overload
lists the behaviour of Perl overloading for '='.
The value for "=" is a reference to a function with three arguments, i.e., it looks like the other values in use overload. However, it does not overload the Perl assignment operator. This would go against Camel hair.
So you will probably need to rethink your approach.
This is not exactly JUST operator overloading, but if you absolutely need this functionality, you can try a perl tie:
http://perldoc.perl.org/functions/tie.html
Do you know about Config::IniFiles? You might consider that before you go off and reinvent it. With some proper subclassing, you can add ordering to it.
Also, I think you have the wrong interface. You're exposing the internal structure of your object and modifying it through magical assignments. Using methods would make your life much easier.