Double curly braces in perl - perl

I was looking at perl code online and came across something I hadn't seen before and can't find out what it's doing (if anything).
if($var) {{
...
}}
Does anyone know what the double curly braces mean?

There are two statements there. An "if" statement and a bare block. Bare blocks are loops that are executed exactly once.
say "a";
{
say "b";
}
say "c";
# Outputs a b c
But being loops, they do influence next, last and redo.
my $i = 0;
say "a";
LOOP: { # Purely descriptive (and thus optional) label.
++$i;
say "b";
redo if $i == 1;
say "c";
last if $i == 2;
say "d";
}
say "e";
# Outputs a b b c e
(next does the same as last since there is no next element.)
They are usually used to create a lexical scope.
my $file;
{
local $/;
open(my $fh, '<', $qfn) or die;
$file = <$fh>;
}
# At this point,
# - $fh is cleared,
# - $fh is no longer visible,
# - the file handle is closed, and
# - $/ is restored.
It's unclear why one was used here.
Alternatively, it could also be a hash constructor.
sub f {
...
if (#errors) {
{ status => 'error', errors => \#errors }
} else {
{ status => 'ok' }
}
}
is short for
sub f {
...
if (#errors) {
return { status => 'error', errors => \#errors };
} else {
return { status => 'ok' };
}
}
Perl peeks into the braces to guess if it's a bare loop or a hash constructor. Since you didn't provide the contents of the braces, we can't tell.

It's a trick usually employed with do, see chapter Statement Modifiers in perlsyn.
Probably the author wanted to jump out of the block with next or the like.

In case of if, they are probably equivalent to single braces (but it depends on what's inside the block and outside the if, cf.
perl -E ' say for map { if (1) {{ 1,2,3,4 }} } 1 .. 2'
). There are reasons to use double braces, though, with next or do, see perlsyn. For example, try running this several times:
perl -E 'if (1) {{ say $c++; redo if int rand 2 }}'
And try to replace double braces with single ones.

Without much more code, it's hard to say what they're being used for. It could be a typo, or it could be a naked block, see chapter 10.4 The Naked Block Control Structure in Learning Perl.
A naked block adds lexical scoping to variables within the block.

The {{ can be used to break out of an "if block". I have some code that contains:
if ($entry =~ m{\nuid: ([^\s]+)}) {{ # double brace so "last" will break out of "if"
my $uid = $1;
last if exists $special_case{$uid};
# ....
}}
# last breaks to here

Related

String can't find the value in a same line

use strict;
use warnings;
my $str = "This is the test and new paragraph...\n";
if($str=~m/paragraph/gi) # First Loop
{
if($str=~m/test/gi) # Second Loop
{
print "Ok...\n";
}
else
{
print "Not Ok...\n";
}
}
if($str=~m/test/i) #it doesn't prints the value
Output is: Not Ok...
if($str=~m/test/gi) #it prints the value
Output is: Ok...
In above case if the string found the paragraph value and the second loop couldn't find the test value. However in the second loop if we inserted the global g it can.
Could you please someone can explain me whats happening. Thanks in advance.
/g is used for finding all matches of a pattern. It doesn't make sense to alter the pattern between matches. Generally speaking, if (/.../g) makes no sense and should be replaced with if (/.../).
There are advanced uses for if (/\G.../gc), but that's different. if (/.../g) only makes sense if you're unrolling a while loop. (e.g. while (1) { ...; last if !/.../g; ... }).
Here's what's happening in this specific circumstance:
Because you signaled you wanted to find all matches (by using /g), the position at which to start matching is set to the end of the match (denoted by ^ below).
This is the test and new paragraph...
---------^
You can see this using pos.
$ perl -e'
my $str = "This is the test and new paragraph...";
if ($str =~ /paragraph/g) {
CORE::say pos($str) // 0;
if ($str =~ /test/g) {
CORE::say pos($str) // 0;
}
}
'
34
The subsequent m/test/gi doesn't match because test does not appear at or after the position at which the last match ended.
The solution is to simply remove the g modifier from you match operators.
$ perl -e'
my $str = "This is the test and new paragraph...";
if ($str =~ /paragraph/) {
CORE::say pos($str) // 0;
if ($str =~ /test/) {
CORE::say pos($str) // 0;
}
}
'
0
0
From perldoc perlretut:
Global matching
The final two modifiers we will discuss here, //g and //c , concern multiple matches. The modifier //g stands for global matching and allows the matching operator to match within a string as many times as possible. In scalar context, successive invocations against a string will have //g jump from match to match, keeping track of position in the string as it goes along. You can get or set the position with the pos() function.
In the first test, you're using the global flag, then the position of cursor is memorized, so the second match doesn't find test because it is before paragraph.
You have to remove the global flag from the first match.
my $str = "This is the test and new paragraph...\n";
if ($str =~ /paragraph/i) {
if ($str =~ /test/i) {
print "Ok...\n";
} else {
print "Not Ok...\n";
}
}

Perl - How to create commands that users can input in console?

I'm just starting in Perl and I'm quite enjoying it. I'm writing some basic functions, but what I really want to be able to do is to use those functions intelligently using console commands. For example, say I have a function adding two numbers. I'd want to be able to type in console "add 2, 4" and read the first word, then pass the two numbers as parameters in an "add" function. Essentially, I'm asking for help in creating some basic scripting using Perl ^^'.
I have some vague ideas about how I might do this in VB, but Perl, I have no idea where I'd start, or what functions would be useful to me. Is there something like VB.net's "Split" function where you can break down the contents of a scalar into an array? Is there a simple way to analyse one word at a time in a scalar, or iterate through a scalar until you hit a separator, for example?
I hope you can help, any suggestions are appreciated! Bear in mind, I'm no expert, I started Perl all of a few weeks ago, and I've only been doing VB.net half a year.
Thank you!
Edit: If you're not sure what to suggest and you know any simple/intuitive resources that might be of help, that would also be appreciated.
Its rather easy to make a script which dispatches to a command by name. Here is a simple example:
#!/usr/bin/env perl
use strict;
use warnings;
# take the command name off the #ARGV stack
my $command_name = shift;
# get a reference to the subroutine by name
my $command = __PACKAGE__->can($command_name) || die "Unknown command: $command_name\n";
# execute the command, using the rest of #ARGV as arguments
# and print the return with a trailing newline
print $command->(#ARGV);
print "\n";
sub add {
my ($x, $y) = #_;
return $x + $y;
}
sub subtract {
my ($x, $y) = #_;
return $x - $y;
}
This script (say its named myscript.pl) can be called like
$ ./myscript.pl add 2 3
or
$ ./myscript.pl subtract 2 3
Once you have played with that for a while, you might want to take it further and use a framework for this kind of thing. There are several available, like App::Cmd or you can take the logic shown above and modularize as you see fit.
You want to parse command line arguments. A space serves as the delimiter, so just do a ./add.pl 2 3 Something like this:
$num1=$ARGV[0];
$num2=$ARGV[1];
print $num1 + $num2;
will print 5
Here is a short implementation of a simple scripting language.
Each statement is exactly one line long, and has the following structure:
Statement = [<Var> =] <Command> [<Arg> ...]
# This is a regular grammar, so we don't need a complicated parser.
Tokens are seperated by whitespace. A command may take any number of arguments. These can either be the contents of variables $var, a string "foo", or a number (int or float).
As these are Perl scalars, there is no visible difference between strings and numbers.
Here is the preamble of the script:
#!/usr/bin/perl
use strict;
use warnings;
use 5.010;
strict and warnings are essential when learning Perl, else too much weird stuff would be possible. The use 5.010 is a minimum version, it also defines the say builtin (like a print but appends a newline).
Now we declare two global variables: The %env hash (table or dict) associates variable names with their values. %functions holds our builtin functions. The values are anonymous functions.
my %env;
my %functions = (
add => sub { $_[0] + $_[1] },
mul => sub { $_[0] * $_[1] },
say => sub { say $_[0] },
bye => sub { exit 0 },
);
Now comes our read-eval-loop (we don't print by default). The readline operator <> will read from the file specified as the first command line argument, or from STDIN if no filename is provided.
while (<>) {
next if /^\s*\#/; # jump comment lines
# parse the line. We get a destination $var, a $command, and any number of #args
my ($var, $command, #args) = parse($_);
# Execute the anonymous sub specified by $command with the #args
my $value = $functions{ $command }->(#args);
# Store the return value if a destination $var was specified
$env{ $var } = $value if defined $var;
}
That was fairly trivial. Now comes some parsing code. Perl “binds” regexes to strings with the =~ operator. Regexes may look like /foo/ or m/foo/. The /x flags allows us to include whitespace in our regex that doesn't match actual whitespace. The /g flag matches globally. This also enables the \G assertion. This is where the last successful match ended. The /c flag is important for this m//gc style parsing to consume one match at a time, and to prevent the position of the regex engine in out string to being reset.
sub parse {
my ($line) = #_; # get the $line, which is a argument
my ($var, $command, #args); # declare variables to be filled
# Test if this statement has a variable declaration
if ($line =~ m/\G\s* \$(\w+) \s*=\s* /xgc) {
$var = $1; # assign first capture if successful
}
# Parse the function of this statement.
if ($line =~ m/\G\s* (\w+) \s*/xgc) {
$command = $1;
# Test if the specified function exists in our %functions
if (not exists $functions{$command}) {
die "The command $command is not known\n";
}
} else {
die "Command required\n"; # Throw fatal exception on parse error.
}
# As long as our matches haven't consumed the whole string...
while (pos($line) < length($line)) {
# Try to match variables
if ($line =~ m/\G \$(\w+) \s*/xgc) {
die "The variable $1 does not exist\n" if not exists $env{$1};
push #args, $env{$1};
}
# Try to match strings
elsif ($line =~ m/\G "([^"]+)" \s*/xgc) {
push #args, $1;
}
# Try to match ints or floats
elsif ($line =~ m/\G (\d+ (?:\.\d+)? ) \s*/xgc) {
push #args, 0+$1;
}
# Throw error if nothing matched
else {
die "Didn't understand that line\n";
}
}
# return our -- now filled -- vars.
return $var, $command, #args;
}
Perl arrays can be handled like linked list: shift removes and returns the first element (pop does the same to the last element). push adds an element to the end, unshift to the beginning.
Out little programming language can execute simple programs like:
#!my_little_language
$a = mul 2 20
$b = add 0 2
$answer = add $a $b
say $answer
bye
If (1) our perl script is saved in my_little_language, set to be executable, and is in the system PATH, and (2) the above file in our little language saved as meaning_of_life.mll, and also set to be executable, then
$ ./meaning_of_life
should be able to run it.
Output is obviously 42. Note that our language doesn't yet have string manipulation or simple assignment to variables. Also, it would be nice to be able to call functions with the return value of other functions directly. This requires some sort of parens, or precedence mechanism. Also, the language requires better error reporting for batch processing (which it already supports).

Is for(1) always the same as do in perl?

for(1){
print 1;
}
do {
print 1;
}
Is it true?
Or is there any special case these two doesn't equal?
One difference is that for(1) sets $_ to the value of 1, as well:
for(1){
print $_; # prints 1
}
Also, do returns the value of the last command in the sequence:
my $x = do { 1 }; # $x = 1
my $y = for(1){ 1 }; # invalid
You might really be looking for just plain curlies.
{
print 1;
}
It has the following benefits:
Creates a lexical scope (like for (1) and do {}).
You can use next, last and redo in them (like for (1)).
It doesn't mask $_ (like do {}).
But
It can only used where a statement is expected (like for (1), but unlike do {}).
Therefore, { ... } makes more sense than for (1) { ... }, and do { ... } is useful when you want to return a value.
About the same.
You can next, last and redo a for loop, but a do is not a loop--including as part of a do-while "loop". So in a non-trivial block, you couldn't be sure. However, this will work:
do {{
...
}};
Also do will not automatically set $_ to each member of the list, the way a bare for loop will.
No. They have different compilation properties and have different effects. They are similar in only one dimension, that being that the code they introduce will not be looped over -- something they have in common with other constructs, including bare blocks and (sub {...})->().
Here's an obvious difference: for (LIST) BLOCK is a loop, whereas do BLOCK is an expression. This means that
for (1) {
say "Blurgh"
} unless 1;
doesn't compile, whereas
do {
say "Blurgh"
} unless 1;
does.

Is Perl's flip-flop operator bugged? It has global state, how can I reset it?

I'm dismayed. OK, so this was probably the most fun Perl bug I've ever found. Even today I'm learning new stuff about Perl. Essentially, the flip-flop operator .. which returns false until the left-hand-side returns true, and then true until the right-hand-side returns false keep global state (or that is what I assume.)
Can I reset it (perhaps this would be a good addition to Perl 4-esque hardly ever used reset())? Or, is there no way to use this operator safely?
I also don't see this (the global context bit) documented anywhere in perldoc perlop is this a mistake?
Code
use feature ':5.10';
use strict;
use warnings;
sub search {
my $arr = shift;
grep { !( /start/ .. /never_exist/ ) } #$arr;
}
my #foo = qw/foo bar start baz end quz quz/;
my #bar = qw/foo bar start baz end quz quz/;
say 'first shot - foo';
say for search \#foo;
say 'second shot - bar';
say for search \#bar;
Spoiler
$ perl test.pl
first shot
foo
bar
second shot
Can someone clarify what the issue with the documentation is? It clearly indicates:
Each ".." operator maintains its own boolean state.
There is some vagueness there about what "Each" means, but I don't think the documentation would be well served by a complex explanation.
Note that Perl's other iterators (each or scalar context glob) can lead to the same problems. Because the state for each is bound to a particular hash, not a particular bit of code,each can be reset by calling (even in void context) keys on the hash. But for glob or .., there is no reset mechanism available except by calling the iterator until it is reset. A sample glob bug:
sub globme {
print "globbing $_[0]:\n";
print "got: ".glob("{$_[0]}")."\n" for 1..2;
}
globme("a,b,c");
globme("d,e,f");
__END__
globbing a,b,c:
got: a
got: b
globbing d,e,f:
got: c
Use of uninitialized value in concatenation (.) or string at - line 3.
got:
For the overly curious, here are some examples where the same .. in the source is a different .. operator:
Separate closures:
sub make_closure {
my $x;
return sub {
$x if 0; # Look, ma, I'm a closure
scalar( $^O..!$^O ); # handy values of true..false that don't trigger ..'s implicit comparison to $.
}
}
print make_closure()->(), make_closure()->();
__END__
11
Comment out the $x if 0 line to see that non-closures have a single .. operation shared by all "copies", with the output being 12.
Threads:
use threads;
sub coderef { sub { scalar( $^O..!$^O ) } }
coderef()->();
print threads->create( coderef() )->join(), threads->create( coderef() )->join();
__END__
22
Threaded code starts with whatever the state of the .. had been before thread creation, but changes to its state in the thread are isolated from affecting anything else.
Recursion:
sub flopme {
my $recurse = $_[0];
flopme($recurse-1) if $recurse;
print " "x$recurse, scalar( $^O..!$^O ), "\n";
flopme($recurse-1) if $recurse;
}
flopme(2)
__END__
1
1
2
1
3
2
4
Each depth of recursion is a separate .. operator.
The trick is not use the same flip-flop so you have no state to worry about. Just make a generator function to give you a new subroutine with a new flip-flop that you only use once:
sub make_search {
my( $left, $right ) = #_;
sub {
grep { !( /\Q$left\E/ .. /\Q$right\E/ ) } #{$_[0]};
}
}
my $search_sub1 = make_search( 'start', 'never_existed' );
my $search_sub2 = make_search( 'start', 'never_existed' );
my #foo = qw/foo bar start baz end quz quz/;
my $count1 = $search_sub1->( \#foo );
my $count2 = $search_sub2->( \#foo );
print "count1 $count1 and count2 $count2\n";
I also write about this in Make exclusive flip-flop operators.
The "range operator" .. is documented in perlop under "Range Operators". Looking through the doucmentation, it appears that there isn't any way to reset the state of the .. operator. Each instance of the .. operator keeps its own state, which means there isn't any way to refer to the state of any particular .. operator.
It looks like it's designed for very small scripts such as:
if (101 .. 200) { print; }
The documentation states that this is short for
if ($. == 101 .. $. == 200) { print; }
Somehow the use of $. is implicit there (toolic points out in a comment that that's documented too). The idea seems to be that this loop runs once (until $. == 200) in a given instance of the Perl interpreter, and therefore you don't need to worry about resetting the state of the .. flip-flop.
This operator doesn't seem too useful in a more general reusable context, for the reasons you've identified.
A workaround/hack/cheat for your particular case is to append the end value to your array:
sub search {
my $arr = shift;
grep { !( /start/ .. /never_exist/ ) } #$arr, 'never_exist';
}
This will guarantee that the RHS of range operator will eventually be true.
Of course, this is in no way a general solution.
In my opinion, this behavior is not clearly documented. If you can construct a clear explanation, you could apply a patch to perlop.pod via perlbug.
I found this problem, and as far as I know there's no way to fix it. The upshot is - don't use the .. operator in functions, unless you are sure you are leaving it in the false state when you leave the function, otherwise the function may return different output for the same input (or exhibit different behaviour for the same input).
Each use of the .. operator maintains its own state. Like Alex Brown said, you need to leave it in the false state when you leave the function. Maybe you could do something like:
sub search {
my $arr = shift;
grep { !( /start/ || $_ eq "my magic reset string" ..
/never_exist/ || $_ eq "my magic reset string" ) }
(#$arr, "my magic reset string");
}

What are some elegant features or uses of Perl?

What? Perl Beautiful? Elegant? He must be joking!
It's true, there's some ugly Perl out there. And by some, I mean lots. We've all seen it.
Well duh, it's symbol soup. Isn't it?
Yes there are symbols. Just like 'math' has 'symbols'. It's just that we programmers are more familiar with the standard mathematical symbols. We grew to accept the symbols from our mother languages, whether that be ASM, C, or Pascal. Perl just decided to have a few more.
Well, I think we should get rid of all the unnecessary symbols. Makes the code look better.
The language for doing so already exists. It's called Lisp. (and soon, perl 6.)
Okay, smart guy. Truth is, I can already invent my own symbols. They're called functions and methods. Besides, we don't want to reinvent APL.
Oh, fake alter ego, you are so funny! It's really true, Perl can be quite beautiful. It can be quite ugly, as well. With Perl, TIMTOWTDI.
So, what are your favorite elegant bits of Perl code?
Perl facilitates the use of lists/hashes to implement named parameters, which I consider very elegant and a tremendous aid to self-documenting code.
my $result = $obj->method(
flux_capacitance => 23,
general_state => 'confusion',
attitude_flags => ATTITUDE_PLEASANT | ATTITUDE_HELPFUL,
);
My favourite pieces of elegant Perl code aren't necessarily elegant at all. They're meta-elegant, and allow you to get rid of all those bad habits that many Perl developers have slipped into. It would take me hours or days to show them all in the detail they deserve, but as a short list they include:
autobox, which turns Perl's primitives into first-class objects.
autodie, which causes built-ins to throw exceptions on failure (removing most needs for the or die... construct). See also my autodie blog and video).
Moose, which provide an elegant, extensible, and correct way of writing classes in Perl.
MooseX::Declare, which provides syntaxic aweseomeness when using Moose.
Perl::Critic, your personal, automatic, extensible and knowledgeable code reviewer. See also this Perl-tip.
Devel::NYTProf, which provides me the most detailed and usable profiling information I've seen in any programming language. See also Tim Bunce's Blog.
PAR, the Perl Archiver, for bundling distributions and even turning whole programs into stand-alone executable files. See also this Perl-tip.
Perl 5.10, which provides some stunning regexp improvements, smart-match, the switch statement, defined-or, and state variables.
Padre, the only Perl editor that integrates the best bits of the above, is cross-platform, and is completely free and open source.
If you're too lazy to follow links, I recently did a talk at Linux.conf.au about most of the above. If you missed it, there's a video of it on-line (ogg theora). If you're too lazy to watch videos, I'm doing a greatly expanded version of the talk as a tutorial at OSCON this year (entitled doing Perl right).
All the best,
Paul
I'm surprised no one mentioned the Schwartzian Transform.
my #sorted =
map { $_->[0] }
sort { $a->[1] <=> $b->[1] }
map { [ $_, expensive_func($_) ] }
#elements;
And in the absence of a slurp operator,
my $file = do { local $/; readline $fh };
Have a list of files the user wants your program to process? Don't want to accidentally process a program, folder, or nonexistent file? Try this:
#files = grep { -T } #files;
And, like magic, you've weeded out all the inappropriate entries. Don't want to ignore them silently? Add this line before the last one:
warn "Not a file: $_" foreach grep { !-T } #files;
Prints a nice warning message for every file that it can't process to standard error. The same thing without using grep would look like this:
my #good;
foreach(#files) {
if(-T) {
push #good, $_;
} else {
warn "Not a file: $_";
}
}
grep (and map) can be used to make code shorter while still keeping it very readable.
The "or die" construct:
open my $fh, "<", $filename
or die "could not open $filename: $!";
The use of qr// to create grammars:
#!/usr/local/ActivePerl-5.10/bin/perl
use strict;
use warnings;
use feature ':5.10';
my $non_zero = qr{[1-9]};
my $zero = qr{0};
my $decimal = qr{[.]};
my $digit = qr{$non_zero+ | $zero}x;
my $non_zero_natural = qr{$non_zero+ $digit*}x;
my $natural = qr{$non_zero_natural | $zero}x;
my $integer = qr{-? $non_zero_natural | $zero}x;
my $real = qr{$integer (?: $decimal $digit)?}x;
my %number_types = (
natural => qr/^$natural$/,
integer => qr/^$integer$/,
real => qr/^$real$/
);
for my $n (0, 3.14, -5, 300, "4ever", "-0", "1.2.3") {
my #types = grep { $n =~ $number_types{$_} } keys %number_types;
if (#types) {
say "$n is of type", #types == 1 ? " ": "s ", "#types";
} else {
say "$n is not a number";
}
}
Anonymous subroutines used to factor out duplicate code:
my $body = sub {
#some amount of work
};
$body->();
$body->() while $continue;
instead of
#some amount of work
while ($continue) {
#some amount of work again
}
Hash based dispatch tables:
my %dispatch = (
foo => \&foo,
bar => \&bar,
baz => \&baz
);
while (my $name = iterator()) {
die "$name not implemented" unless exists $dispatch{$name};
$dispatch{$name}->();
}
instead of
while (my $name = iterator()) {
if ($name eq "foo") {
foo();
} elsif ($name eq "bar") {
bar();
} elsif ($name eq "baz") {
baz();
} else {
die "$name not implemented";
}
}
Three-line classes with constructors, getter/setters and type validation:
{
package Point;
use Moose;
has ['x', 'y'] => (isa => 'Num', is => 'rw');
}
package main;
my $point = Point->new( x => '8', y => '9' );
$point->x(25);
A favorite example of mine is Perl's implementation of a factorial calculator. In Perl 5, it looks like so:
use List::Util qw/reduce/;
sub factorial {
reduce { $a * $b } 1 .. $_[0];
}
This returns false if the number is <= 1 or a string and a number if a number is passed in (rounding down if a fraction).
And looking forward to Perl 6, it looks like this:
sub factorial {
[*] 1..$^x
}
And also ( from the blog in the link above ) you can even implement this as an operator:
sub postfix:<!>(Int $x) {
[*] 1..($x || 1)
}
and then use it in your code like so:
my $fact5 = 5!;
If you have a comma separated list of flags, and want a lookup table for them, all you have to do is:
my %lookup = map { $_ => 1 } split /,/, $flags;
Now you can simply test for which flags you need like so:
if ( $lookup{FLAG} ) {
print "Ayup, got that flag!";
}
I am surprised no one has mentioned this. It's a masterpiece in my opinion:
#!/usr/bin/perl
$==$';
$;||$.| $|;$_
='*$ ( ^#(%_+&~~;# ~~/.~~
;_);;.);;#) ;~~~~;_,.~~,.* +,./|~
~;_);#-, .;.); ~ ~,./##-__);#-);~~,.*+,.
/|);;;~~#-~~~~;.~~,. /.);;.,./#~~#-;.;#~~#-;;
;;,.*+,./.);;#;./#,./ |~~~~;#-(#-__#-__&$#%^';$__
='`'&'&';$___="````" |"$[`$["|'`%",';$~=("$___$__-$[``$__"|
"$___"| ("$___$__-$[.%")).("'`"|"'$["|"'#").
'/.*?&([^&]*)&.*/$'.++$=.("/``"|"/$[`"|"/#'").(";`/[\\`\\`$__]//`;"
|";$[/[\\$[\\`$__]//`;"|";#/[\\\$\\.$__]//'").'#:=("#-","/.",
"~~",";#",";;",";.",",.",");","()","*+","__","-(","/#",".%","/|",
";_");#:{#:}=$%..$#:;'.('`'|"$["|'#')."/(..)(..)/".("```"|"``$["|
'#("').'(($:{$'.$=.'}<<'.(++$=+$=).')|($:{$'.$=.'}))/'.("```;"|
"``$[;"|"%'#;").("````'$__"|"%$[``"|"%&!,").${$[};`$~$__>&$=`;$_=
'*$(^#(%_+&#-__~~;#~~#-;.;;,.(),./.,./|,.-();;#~~#-);;;,.;_~~#-,./.,
./#,./#~~#-);;;,.(),.;.~~#-,.,.,.;_,./#,.-();;#~~#-,.;_,./|~~#-,.
,.);););#-#-__~~;#~~#-,.,.,.;_);~~~~#-);;;,.(),.*+);;# ~~#-,
./|,.*+,.,.);;;);*+~~#-,.*+,.;;,.;.,./.~~#-,.,.,.;_) ;~~~
~#-,.;;,.;.,./#,./.);*+,.;.,.;;#-__~~;#~~#-,.;;,.* +);;
#);#-,./#,./.);*+~~#-~~.%~~.%~~#-;;__,. /.);;##- __#-
__ ~~;;);/#;#.%;#/.;#-(#-__~~;;;.;_ ;#.%~~~~ ;;()
,.;.,./#,. /#,.;_~~#- ););,.;_ );~~,./ #,.
;;;./#,./| ~~~~;#-(#- __,.,.,. ;_);~~~ ~#
-~~());; #);#-,./#, .*+);;; ~~#-~~
);~~);~~ *+~~#-);-( ~~#-#-_ _~~#-
~~#-);; #,./#,.;., .;.);# -~~#-;
#/.;#-( ~~#-#-__ ~~#-~~ #-);#
-);~~, .*+,./ |);;;~ ~#-~~
;;;.; _~~#-# -__);. %;#-(
#-__# -__~~;# ~~#-;; ;#,.
;_,.. %);#-,./#, .*+,
..%, .;.,./|) ;;;)
;;#~ ~#-,.*+,. ,.~~
#-); *+,.;_);;.~ ~););
~~,.; .~~#-);~~,.;., ./.,.;
;,.*+ ,./|,.); ~~#- );;;,.(
),.*+); ;#~~/|#-
__~~;#~~ $';$;;
I absolutely love Black Perl (link to version rewritten to compile under Perl 5). It compiles, but as far as I can tell it doesn't actually do anything.
That's what you get for a language written by a linguist from a pragmatic perspective rather than from a theoretical perspective.
Moving on from that, you can think about the Perl that people complain about as pidgin Perl (perfectly useful, but not expressive, and beware of trying to express anything complex in it), and the stuff that #pjf is talking about as "proper" Perl, the language of Shakespeare, Hemingway, Hume and so on. [edit: err, though easier to read than Hume and less dated than Shakespeare.] [re-edit and hopefully less alcoholic than Hemingway]
Adding to the love of map and grep, we can write a simple command-line parser.
my %opts = map { $_ => 1 } grep { /^-/ } #ARGV;
If we want, we can set each flag to it's index in #ARGV:
my %opts = map { $ARGV[$_] => $_ } grep { $ARGV[$_] =~ /^-/ } 0 .. $#ARGV;
That way, if a flag has an argument, we can get the argument like this:
if( defined( $opts{-e} ) ) {
my $arg = $ARGV[ $opts{-e} ];
# do -e stuff for $arg
}
Of course, some people will cry that we're reinventing the wheel and we should use getopt or some variant thereof, but honestly, this was a fairly easy wheel to reinvent. Plus, I don't like getopt.
If you don't like how long some of those lines are, you can always use intermediate variables or just convenient line breaks (hey, Python fanatics? You hear that? We can put one line of code across two lines and it still works!) to make it look better:
my %opts = map { $ARGV[$_] => $_ }
grep { $ARGV[$_] =~ /^-/ } 0 .. $#ARGV;
This file parsing mechanism is compact and easy to customize (skip blank lines, skip lines starting with X, etc..).
open(H_CONFIG, "< $file_name") or die("Error opening file: $file_name! ($!)");
while (<H_CONFIG>)
{
chomp; # remove the trailing newline
next if $_ =~ /^\s*$/; # skip lines that are blank
next if $_ =~ /^\s*#/; # skip lines starting with comments
# do something with the line
}
I use this type of construct in diverse build situations - where I need to either pre or post process payload files (S-records, etc..) or C-files or gather directory information for a 'smart build'.
My favourite elegant Perl feature is that it uses different operators for numerical values and string values.
my $string = 1 . 2;
my $number = "1" + "2";
my $unambiguous = 1 . "2";
Compare this to other dynamic languages such as JavaScript, where "+" is used for concatenation and addition.
var string = "1" + "2";
var number = 1 + 2;
var ambiguous = 1 + "2";
Or to dynamic languages such as Python and Ruby that require type coercion between strings and numberical values.
string = "1" + "2"
number = 1 + 2
throws_exception = 1 + "2"
In my opinion Perl gets this so right and the other languages get it so wrong.
Poorer typists like me who get cramps hitting the shift key too often and have an almost irrational fear of using a semicolon started writing our Perl code in python formatted files. :)
e.g.
>>> k = 5
>>> reduce(lambda i,j: i*j, range(1,k+1),1)
120
>>> k = 0
>>> reduce(lambda i,j: i*j, range(1,k+1),1)
1