Can I define a block of code in Perl? - perl

Just like a #define (preprocessor directive) in C, is there any way to define a block of code in perl.
use constant PI=>3.14;
Like this I can define only variable.
Can I do the same with a block of code?
The following code part does not work. How can I achieve the same?
use constant FUN=>{
$i=3;
while($i)
{
print "$i\n";--$i;}
}


Perl doesn't have macros. (A sufficiently demented programmer could fake them using source filters but that sort of black magic is best avoided.) use constant doesn't trigger an inline replacement the way the C preprocessor does. Instead, it creates a subroutine that always returns the same value. When you write
use constant PI => 3.14;
what Perl does is (essentially)
sub PI() { 3.14 }
The constant pragma can only be used to define values, not code. To reuse code define a subroutine instead.


Most people would write that (give or take the positioning of braces) as:
sub FUN
{
my $i = 3;
while ($i)
{
print "$i\n";
--$i;
}
}
You could do:
my $FUN = sub { print "$_\n" foreach (qw(3 2 1)); };
&$FUN();


Use sub keyword to define a function.
Unlike C langage preprocessing is almost useless in scripting language such as perl.


This is a bit of a hack but you can use string eval to achieve runtime evaluation of code:
use strict;
use warnings;
my $code = "
my \$value = 17;
print \"\$value\n\";
" ;
eval $code ;
result:
[pt#localhost bin]$ perl testit2
17
[pt#localhost bin]$
You'll need mad escaping skills if you write anything complicated.
Update: if you use q() instead of " then much less escaping will be needed.


Try/catch in perl can be implemented this way:
eval {
# do something
die "Exception1\n" if $something_not_right;
};
if ($#) {
for ($#) {
/Exception1/ && do { handle_excp1(); last; };
/Exception2/ && do { handle_excp2(); last; };
die "Don't know how to handle $#\n";
};
};
Of course you don't have to use a string literal to throw an exception. Any object reference would do.

Related

Can I make a variable optional in a perl sub prototype?

I'd like to understand if it's possible to have a sub prototype and optional parameters in it. With prototypes I can do this:
sub some_sub (\#\#\#) {
...
}
my #foo = qw/a b c/;
my #bar = qw/1 2 3/;
my #baz = qw/X Y Z/;
some_sub(#foo, #bar, #baz);
which is nice and readable, but the minute I try to do
some_sub(#foo, #bar);
or even
some_sub(#foo, #bar, ());
I get errors:
Not enough arguments for main::some_sub at tablify.pl line 72, near "#bar)"
or
Type of arg 3 to main::some_sub must be array (not stub) at tablify.pl line 72, near "))"
Is it possible to have a prototype and a variable number of arguments? or is something similar achievable via signatures?
I know it could be done by always passing arrayrefs I was wondering if there was another way. After all, TMTOWTDI.

All arguments after a semi-colon are optional:
sub some_sub(\#\#;\#) {
}

Most people are going to expect your argument list to flatten, and you are reaching for an outdated tool to do what people don't expect.
Instead, pass data structures by reference:
some_sub( \#array1, \#array2 );
sub some_sub {
my #args = #_;
say "Array 1 has " . $args[0]->#* . " elements";
}
If you want to use those as named arrays within the sub, you can use ref aliasing
use v5.22;
use experimental qw(ref_aliasing);
sub some_sub {
\my( #array1 ) = $_[0];
...
}
With v5.26, you can move the reference operator inside the parens:
use v5.26;
use experimental qw(declared_refs);
sub some_sub {
my( \#array1 ) = $_[0];
...
}
And, remember that v5.20 introduced the :prototype attribute so you can distinguish between prototypes and signatures:
use v5.20;
sub some_sub :prototype(##;#) { ... }
I write about these things at The Effective Perler (which you already read, I see), in Perl New Features, a little bit in Preparing for Perl 7 (which is mostly about what you need to stop doing in Perl 5 to be future proof).

How do I pass in a variable from one function into another in perl

I am initializing a variable within one function and would like to pass this variable into another function. This variable holds a char value.
I have tried passing in the referencing and dereferencing, declaring the variables outside of the function, and using local.
I've also looked in perlmonks, perl by example, googled and looked through this site for a solution but to no avail. I'm just starting out with perl programming so any help will be appreciated!

Sounds to me like you need to read through some documentation, not just google around. I would suggest http://www.perl.org/books/beginning-perl/.
use strict;
use warnings;
sub foo {
my $char = 'A';
bar($char);
}
sub bar {
my ($bar_char) = #_;
print "bar got char $bar_char\n";
}
foo();

If you pass a parameter by reference (see below), it can be modified by the first function and you can then pass it to another function:
#!/usr/bin/perl
sub f {
$c = shift;
$$c='m';
}
$c='a';
f(\$c);
print $c;
This will print 'm'

Is there a reason who your first function cannot return this variable?
my $config_variable = function1( $param1 );
function2 ( $config_variable, $param2 );
You can also pass more than one variable back too:
my ( $config_variable, $value ) = function1( $param1 );
my $value2 = function2( $param1, $config_variable );
This would be the best way. However, you can use globally defined variables and they can be used from function to function:
#! /usr/bin/env perl
#
use strict;
use warnings;
my $value;
func1();
func2();
sub func1 {
$value = "foo";
}
sub func2 {
print "Value = $value\n";
}
Note that I declared $value outside of both functions, so it's global in the entire file - even in the subroutines. Now, func1 can set it, and func1 can print it.
The technical term for this is: A terrible, awful, evil idea and you should never, ever1 think of doing it.
This is because a particular variable you think is set to one value suddenly and mysteriously changes values without any reason. Do this for one variable is bad enough, but if you use this as a crutch, you'll end up with dozens of variables that are impossible to track through your program.
If you find yourself doing this quite a bit, you may need to rethink your code logic.

WriteOutput Perl?

I'm trying to make a perl subroutine similar to this php function.
private function writeOutput($msg, $type) {
echo date("H\:i\:s") . " - [$type] . > $msg\n";
}
I need a little help defining $msg and $type.
sub WriteOutput {
$sec = sprintf ("%02d", $sum%60);
$mins = sprintf("%02d", ($sum%3600)/60);
$hrs = int($sum/3600);
print "[$hrs:$mins:$sec]:[$type]>: $msg";
}

As I understand, your question is about passing arguments to Perl subroutine.
Perl stores arguments passed to subroutine in special variable #_. Add following line at the beginning of your subroutine.
my ($msg, $type) = #_;
And call this subroutine with
writeOutput("test", "type1");
Bdw, I hope you're not trying to use global variables here, since my is missing.
Apart from that it's not clear what is $sum

Let's take a look at your PHP subroutine:
private function writeOutput($msg, $type) {
echo date("H\:i\:s") . " - [$type] . > $msg\n";
}
First, Perl doesn't have a builtin date formatter. Instead, you have to use a module to handle dates.
Also, you're taking two parameters in your function called $msg and $type. Perl doesn't use function parameters in the function call. Instead, you use shift:
use Time::Piece; # A nice way to handle datetime. Included since Perl 5.10
use feature qw(say); # Better than `print`. Included since Perl 5.10
sub write_output {
my $msg = shift;
my $type = shift;
my $time = Time::Piece->new(localtime);
say $time->hms . " - [$type] . > $msg";
}
The shift command is the standard way of taking your function's input parameters. Time::Piece is the standard Perl module for handling time since Perl 5.10. This is an object oriented module. The -> is similar to the dot in most other languages. The my $time = Time::Piece->new(localtime); creates a new Time::Piece object based upon the current time. The $time->hms uses the hms method to print out the time in HH:MM:SS format.
Note the use of my which declares and localizes variables (something that PHP doesn't really have). You should always have use strict; and use warnings; on all of your Perl programs. Then, you have to declare all of your variables with my.
Note in Perl, the standard way for variables is to use all lowercase and use underscores as separators. This is taken from Perl Best Practices by Damian Conway. You may or may not agree with all of Conway's coding standards, but one of the nice things about standard is that everyone uses them which makes working with other's people code so much nicer -- whether you like them or not.

For this function in PHP:
private function writeOutput($msg, $type) {
echo date("H\:i\:s") . " - [$type] . > $msg\n";
}
Perl offers the possibility to do the same thing:
use POSIX qw(strftime);
sub WriteOutput {
my($msg, $type) = #_;
my $date = strftime("[%H:%M:%S]", localtime);
print "$date:[$type]>: $msg";
}
WriteOutput "Ok", "Not OK?";
Gives:
[19:12:01][Not Ok?]>: Ok

What's an easy way to print a multi-line string without variable substitution in Perl?

I have a Perl program that reads in a bunch of data, munges it, and then outputs several different file formats. I'd like to make Perl be one of those formats (in the form of a .pm package) and allow people to use the munged data within their own Perl scripts.
Printing out the data is easy using Data::Dump::pp.
I'd also like to print some helper functions to the resulting package.
What's an easy way to print a multi-line string without variable substitution?
I'd like to be able to do:
print <<EOL;
sub xyz {
my $var = shift;
}
EOL
But then I'd have to escape all of the $'s.
Is there a simple way to do this? Perhaps I can create an actual sub and have some magic pretty-printer print the contents? The printed code doesn't have to match the input or even be legible.

Enclose the name of the delimiter in single quotes and interpolation will not occur.
print <<'EOL';
sub xyz {
my $var = shift;
}
EOL

You could use a templating package like Template::Toolkit or Text::Template.
Or, you could roll your own primitive templating system that looks something like this:
my %vars = qw( foo 1 bar 2 );
Write_Code(\$vars);
sub Write_Code {
my $vars = shift;
my $code = <<'END';
sub baz {
my $foo = <%foo%>;
my $bar = <%bar%>;
return $foo + $bar;
}
END
while ( my ($key, $value) = each %$vars ) {
$code =~ s/<%$key%>/$value/g;
}
return $code;
}
This looks nice and simple, but there are various traps and tricks waiting for you if you DIY. Did you notice that I failed to use quotemeta on my key names in the substituion?
I recommend that you use a time-tested templating library, like the ones I mentioned above.

You can actually continue a string literal on the next line, like this:
my $mail = "Hello!
Blah blah.";
Personally, I find that more readable than heredocs (the <<<EOL thing mentioned elsewhere).
Double quote " interpolates variables, but you can use '. Note you'll need to escape any ' in your string for this to work.
Perl is actually quite rich in convenient things to make things more readable, e.g. other quote-operations. qq and q correspond to " and ' and you can use whatever delimiter makes sense:
my $greeting = qq/Hello there $name!
Nice to meet you/; # Interpolation
my $url = q|http://perlmonks.org/|; # No need to escape /
(note how the syntax coloring here didn't quite keep up)
Read perldoc perlop (find in page: "Quote and Quote-like Operators") for more information.

Use a data section to store the Perl code:
#!/usr/bin/perl
use strict;
use warnings;
print <DATA>;
#print munged data
__DATA__
package MungedData;
use strict;
use warnings;
sub foo {
print "foo\n";
}

Try writing your code as an actual perl subroutine, then using B::Deparse to get the source code at runtime.

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