Converting code to perl sub, but not sure I'm doing it right - perl

I'm working from a question I posted earlier (here), and trying to convert the answer to a sub so I can use it multiple times. Not sure that it's done right though. Can anyone provide a better or cleaner sub?
I have a good deal of experience programming, but my primary language is PHP. It's frustrating to know how to execute in one language, but not be able to do it in another.
sub search_for_key
{
my ($args) = #_;
foreach $row(#{$args->{search_ary}}){
print "#$row[0] : #$row[1]\n";
}
my $thiskey = NULL;
my #result = map { $args->{search_ary}[$_][0] } # Get the 0th column...
grep { #$args->{search_in} =~ /$args->{search_ary}[$_][1]/ } # ... of rows where the
0 .. $#array; # first row matches
$thiskey = #result;
print "\nReturning: " . $thiskey . "\n";
return $thiskey;
}
search_for_key({
'search_ary' => $ref_cam_make,
'search_in' => 'Canon EOS Rebel XSi'
});
---Edit---
From the answers so far, I've cobbled together the function below. I'm new to Perl, so I don't really understand much of the syntax. All I know is that it throws an error (Not an ARRAY reference at line 26.) about that grep line.
Since I seem to not have given enough info, I will also mention that:
I am calling this function like this (which may or may not be correct):
search_for_key({
'search_ary' => $ref_cam_make,
'search_in' => 'Canon EOS Rebel XSi'
});
And $ref_cam_make is an array I collect from a database table like this:
$ref_cam_make = $sth->fetchall_arrayref;
And it is in the structure like this (if I understood how to make the associative fetch work properly, I would like to use it like that instead of by numeric keys):
Reference Array
Associative
row[1][cam_make_id]: 13, row[1][name]: Sony
Numeric
row[1][0]: 13, row[1][1]: Sony
row[0][0]: 19, row[0][1]: Canon
row[2][0]: 25, row[2][1]: HP
sub search_for_key
{
my ($args) = #_;
foreach my $row(#{$args->{search_ary}}){
print "#$row[0] : #$row[1]\n";
}
print grep { $args->{search_in} =~ #$args->{search_ary}[$_][1] } #$args->{search_ary};
}

You are moving in the direction of a 2D array, where the [0] element is some sort of ID number and the [1] element is the camera make. Although reasonable in a quick-and-dirty way, such approaches quickly lead to unreadable code. Your project will be easier to maintain and evolve if you work with richer, more declarative data structures.
The example below uses hash references to represent the camera brands. An even nicer approach is to use objects. When you're ready to take that step, look into Moose.
use strict;
use warnings;
demo_search_feature();
sub demo_search_feature {
my #camera_brands = (
{ make => 'Canon', id => 19 },
{ make => 'Sony', id => 13 },
{ make => 'HP', id => 25 },
);
my #test_searches = (
"Sony's Cyber-shot DSC-S600",
"Canon cameras",
"Sony HPX-32",
);
for my $ts (#test_searches){
print $ts, "\n";
my #hits = find_hits($ts, \#camera_brands);
print ' => ', cb_stringify($_), "\n" for #hits;
}
}
sub cb_stringify {
my $cb = shift;
return sprintf 'id=%d make=%s', $cb->{id}, $cb->{make};
}
sub find_hits {
my ($search, $camera_brands) = #_;
return grep { $search =~ $_->{make} } #$camera_brands;
}

This whole sub is really confusing, and I'm a fairly regular perl user. Here are some blanket suggestions.
Do not create your own undef ever -- use undef then return at the bottom return $var // 'NULL'.
Do not ever do this: foreach $row, because foreach my $row is less prone to create problems. Localizing variables is good.
Do not needlessly concatenate, for it offends the style god: not this, print "\nReturning: " . $thiskey . "\n";, but print "\nReturning: $thiskey\n";, or if you don't need the first \n: say "Returning: $thiskey;" (5.10 only)
greping over 0 .. $#array; is categorically lame, just grep over the array: grep {} #{$foo[0]}, and with that code being so complex you almost certainly don't want grep (though I don't understand what you're doing to be honest.). Check out perldoc -q first -- in short grep doesn't stop until the end.
Lastly, do not assign an array to a scalar: $thiskey = #result; is an implicit $thiskey = scalar #result; (see perldoc -q scalar) for more info. What you probably want is to return the array reference. Something like this (which eliminates $thiskey)
printf "\nReturning: %s\n", join ', ', #result;
#result ? \#result : 'NULL';

If you're intending to return whether a match is found, this code should work (inefficiently). If you're intending to return the key, though, it won't -- the scalar value of #result (which is what you're getting when you say $thiskey = #result;) is the number of items in the list, not the first entry.
$thiskey = #result; should probably be changed to $thiskey = $result[0];, if you want mostly-equivalent functionality to the code you based this off of. Note that it won't account for multiple matches anymore, though, unless you return #result in its entirety, which kinda makes more sense anyway.

Related

Perl need the right grep operator to match value of variable

I want to see if I have repeated items in my array, there are over 16.000 so will automate it
There may be other ways but I started with this and, well, would like to finish it unless there is a straightforward command. What I am doing is shifting and pushing from one array into another and this way, check the destination array to see if it is "in array" (like there is such a command in PHP).
So, I got this sub routine and it works with literals, but it doesn't with variables. It is because of the 'eq' or whatever I should need. The 'sourcefile' will contain one or more of the words of the destination array.
// Here I just fetch my file
$listamails = <STDIN>;
# Remove the newlines filename
chomp $listamails;
# open the file, or exit
unless ( open(MAILS, $listamails) ) {
print "Cannot open file \"$listamails\"\n\n";
exit;
}
# Read the list of mails from the file, and store it
# into the array variable #sourcefile
#sourcefile = <MAILS>;
# Close the handle - we've read all the data into #sourcefile now.
close MAILS;
my #destination = ('hi', 'bye');
sub in_array
{
my ($destination,$search_for) = #_;
return grep {$search_for eq $_} #$destination;
}
for($i = 0; $i <=100; $i ++)
{
$elemento = shift #sourcefile;
if(in_array(\#destination, $elemento))
{
print "it is";
}
else
{
print "it aint there";
}
}
Well, if instead of including the $elemento in there I put a 'hi' it does work and also I have printed the value of $elemento which is also 'hi', but when I put the variable, it does not work, and that is because of the 'eq', but I don't know what else to put. If I put == it complains that 'hi' is not a numeric value.
When you want distinct values think hash.
my %seen;
#seen{ #array } = ();
if (keys %seen == #array) {
print "\#array has no duplicate values\n";
}
It's not clear what you want. If your first sentence is the only one that matters ("I want to see if I have repeated items in my array"), then you could use:
my %seen;
if (grep ++$seen{$_} >= 2, #array) {
say "Has duplicates";
}
You said you have a large array, so it might be faster to stop as soon as you find a duplicate.
my %seen;
for (#array) {
if (++$seen{$_} == 2) {
say "Has duplicates";
last;
}
}
By the way, when looking for duplicates in a large number of items, it's much faster to use a strategy based on sorting. After sorting the items, all duplicates will be right next to each other, so to tell if something is a duplicate, all you have to do is compare it with the previous one:
#sorted = sort #sourcefile;
for (my $i = 1; $i < #sorted; ++$i) { # Start at 1 because we'll check the previous one
print "$sorted[$i] is a duplicate!\n" if $sorted[$i] eq $sorted[$i - 1];
}
This will print multiple dupe messages if there are multiple dupes, but you can clean it up.
As eugene y said, hashes are definitely the way to go here. Here's a direct translation of the code you posted to a hash-based method (with a little more Perlishness added along the way):
my #destination = ('hi', 'bye');
my %in_array = map { $_ => 1 } #destination;
for my $i (0 .. 100) {
$elemento = shift #sourcefile;
if(exists $in_array{$elemento})
{
print "it is";
}
else
{
print "it aint there";
}
}
Also, if you mean to check all elements of #sourcefile (as opposed to testing the first 101 elements) against #destination, you should replace the for line with
while (#sourcefile) {
Also also, don't forget to chomp any values read from a file! Lines read from a file have a linebreak at the end of them (the \r\n or \n mentioned in comments on the initial question), which will cause both eq and hash lookups to report that otherwise-matching values are different. This is, most likely, the reason why your code is failing to work correctly in the first place and changing to use sort or hashes won't fix that. First chomp your input to make it work, then use sort or hashes to make it efficient.

Perl throws an error message about syntax

So, building off a question about string matching (this thread), I am working on implementing that info in solution 3 into a working solution to the problem I am working on.
However, I am getting errors, specifically about this line of the below function:
next if #$args->{search_in} !~ /#$cur[1]/;
syntax error at ./db_index.pl line 16, near "next "
My question as a perl newbie is what am I doing wrong here?
sub search_for_key
{
my ($args) = #_;
foreach $row(#{$args->{search_ary}}){
print "#$row[0] : #$row[1]\n";
}
my $thiskey = NULL;
foreach $cur (#{$args->{search_ary}}){
print "\n" . #$cur[1] . "\n"
next if #$args->{search_in} !~ /#$cur[1]/;
$thiskey = #$cur[0];
last;
}
return $thiskey;
}
You left off the semicolon at the end of the previous line. That's what caused the syntax error, anyway. I think you're also misusing $args, but it's hard to be sure about that without knowing how you're calling this function.
There are several issues here.
Are you adding use strict; and use warnings; at the top of your script before you do anything else? You only posted the sub, but it is clear that you are not using these.
What is NULL? (strict will not let you use bare-words...) Be sure to read What is Truth in Perl? The more Perly way is to deal with "truth" or "false" is defined / undef or exists or specifically test for a value chosen as a convention.
Missing ; after print "\n" . #$cur[1] . "\n"
Your data structures seem way too complicated. From what I can tell, you are passing a reference to a hash of arrays, true? Why your data structures get really obscure, back up and look at what you are trying to do...
Perl gives you plenty of way to shoot yourself in the foot. It is not strictly typed and you will do yourself (and your readers) a favor by naming references as a derivative of what they refer to. So instead of $args use $ref2HoArefs for example.
Side note, are you sure you can't just use a hash for what you're doing? It seems awfully complicated do do something so simple:
my %hash = (
key1 => 'value1',
key2 => 'value2',
);
exists $hash{$search_in}; # true/false.
my $result = $hash{$search_in}; # returns 'value1' when $search_in is 'key1'
Or if you need to search by value:
my %flip = reverse %hash;
$result = $flip{$search_in};
And if you really need a regex key ( or value ) lookup:
sub string_match {
my ($lookup_hash, $key ) = #_;
for my $hash_key ( %{ $lookup_hash } ){
return $hash_key if $key =~ $lookup_hash->{$hash_key};
}
return; # not found.
}
my $k = string_match({
'whitespace at end' => qr/\s+$/,
'whitespace at start' => qr/^\s+/,
}, "Some Garbage string "); # k == whitespace at end

Perl Array Question

Never done much programming -- been charged at work with manipulating the data from comment cards. Using perl so far I've got the database to correctly put its daily comments into an array. Comments are each one LINE of text within the database, so I just split the array on the line-break.
my #comments = split("\n", $c_data);
And yes, this being my first time programming, that took me wayyy too long to figure out.
At this point I now need to organize these array elements (is that what I should call them?) into their own separate scalars based on capitalized words (this is a behavior of the database, which was at one point corrupt).
Example of what two elements of the array look like:
print "$comments[0]\n";
This dining experience was GOOD blah blah blah.
or
print "$comments[1]\n";
Overall this was a BAD time and me and my blah blah.
These "good" or "bad" or "best" are already capitalized by the database the data came from.
What's the easiest way in Perl to get these lines into scalars from an array based on these capitalized words?
If I understand you correctly, you want to merge array elements that match a certain word. You can do it like this:
my #bad_comments = grep { /\bBAD\b/ } #comments;
my #good_comments = grep { /\bGOOD\b/ } #comments;
That way all 'good' and 'bad' comments go to each own array.
Now if you need to merge them into a scalar you'd want to join them (opposite of split):
my $bad_comments = join "\n", grep { /\bBAD\b/ } #comments;
my $good_comments = join "\n", grep { /\bGOOD\b/ } #comments;
Think hash table when you want to group data by arbitrary string keys. In this case, you have an array of GOOD comments and an array of BAD comments. What if you had an array of SO-SO comments? A strategy based on having array variables #good, #bad, #soso breaks down fast.
You have some ways to go before you can fully understand the code below:
#!/usr/bin/perl
use strict; use warnings;
use Regex::PreSuf;
my %comments;
my #types = qw( GOOD BAD ); # DRY
my $types_re = presuf #types;
while ( my $comment = <DATA> ) {
chomp $comment;
last unless $comment =~ /\S/;
# capturing match in list context returns captured strings
my ($type) = ( $comment =~ /($types_re)/ );
push #{ $comments{$type} }, $comment;
}
for my $type ( #types ) {
print "$type comments:\n";
for my $comment ( #{ $comments{$type} } ) {
print $comment, "\n";
}
}
__DATA__
This dining experience was GOOD blah blah blah.
Overall this was a BAD time and me and my blah blah.
You could use regular expressons, eg:
if ($comments[$i] =~ /GOOD/) {
# good comment
}
or more generally
if ($comments[$i] =~ /\b([A-Z]{2,})\b/) {
print "Comment: $1\n";
}
Here, \b means word boundary, () are used to extract captured text, [A-Z] represent a group of capital characters - capital letters, {2,} means that there have to be 2 or more characters defined by previous class.
I would store all your comments into a hash-of-arrays data structure, with the key being your capitalized word.
Here is a general solution to grab any capitalized word (assuming only one per comment), not just GOOD and BAD:
use strict;
use warnings;
my #comments = <DATA>;
chomp #comments;
my %data;
for (#comments) {
my $cap;
for (split) {
$cap = $_ if /^[A-Z]+$/;
}
if ($cap) { push #{ $data{$cap} }, $_ }
}
use Data::Dumper; print Dumper(\%data);
__DATA__
This is GOOD stuff
Here's some BAD stuff.
More of the GOOD junk.
Nothing here.
Here is the output:
$VAR1 = {
'BAD' => [
'Here\'s some BAD stuff.'
],
'GOOD' => [
'This is GOOD stuff',
'More of the GOOD junk.'
]
};
In my opinion, your best bet would be to create a disk-based database of some sort (SQLite?) that stores the comments and type as separate data.
Then use one of the other posted solutions to import your existing data into it.
The only problem here is that you need to learn Perl's DBI layer and a bit of SQL to use SQLite with Perl.
Not sure what you mean by "organize" and "based on".
If you mean produce a list of any capitalized words, each with a list of the lines containing that word (similar to toolic's solution, you could do this:
my %CAPS = ();
map {
my ($word) = /(\b[A-Z]+\b)/;
push( #{ $CAPS{$word} }, $_)
} #comments;
This will build a mapping of WORDS to things, and the things in this case are going to be lists of lines.
And you can refer to these lists as $CAPS{'GOOD'} or $CAPS{'BAD'}, or $CAPS{whatever}.

How do I do a simple Perl hash equivalence comparison?

I'm wondering if there's an idiomatic one-liner or a standard-distribution package/function that I can use to compare two Perl hashes with only builtin, non-blessed types. The hashes are not identical (they don't have equivalent memory addresses).
I'd like to know the answer for both for shallow hashes and hashes with nested collections, but I understand that shallow hashes may have a much simpler solution.
TIA!
Something like cmp_deeply available in Test::Deep ?
[This was a response to an answer by someone who deleted their answer.]
Uh oh!
%a ~~ %b && [sort values %a] ~~ [sort values %b]
doesn't check whether the values belong to the same keys.
#! perl
use warnings;
use strict;
my %a = (eat => "banana", say => "whu whu"); # monkey
my %b = (eat => "whu whu", say => "banana"); # gorilla
print "Magilla Gorilla is always right\n"
if %a ~~ %b && [sort values %a] ~~ [sort values %b];
I don't know if there's an easy way or a built-in package, and I don't know what happens when you just do %hash1 == %hash2 (but that's probably not it), but it's not terribly hard to roll your own:
sub hash_comp (\%\%) {
my %hash1 = %{ shift };
my %hash2 = %{ shift };
foreach (keys %hash1) {
return 1 unless defined $hash2{$_} and $hash1{$_} == $hash2{$_};
delete $hash1{$_};
delete $hash2{$_};
}
return 1 if keys $hash2;
return 0;
}
Untested, but should return 0 if the hashes have all the same elements and all the same values. This function will have to be modified to account for multidimensional hashes.
If you want something from a standard distribution, you could use Data::Dumper; and just dump the two hashes into two scalar variables, then compare the strings for equality. That might work.
There's also a package on CPAN called FreezeThaw that looks like it does what you want.
Note that to use the smart match (not repeated here because it's already posted), you will have to use feature; and it's only available for Perl 5.10. But who's still using Perl 5.8.8, right?
Thanks for your question.
I used Test::More::eq_hash as result.
hashes can be casted into arrays, where every value follows its key (but you won't know the order of the keys). So:
( join("",sort(%hash1)) eq join("",sort(%hash2)) )
Oh, wait, that won't work because there are some edge cases, like:
%hash1 = { 'aaa' => 'aa' };
%hash2 = { 'aa' => 'aaa' };
So it's best to use a character in the join() that you KNOW will never appear in any key or value. If the values are BLOBs, that will be a big problem, but for anything else you could use the NULL char "\0".
( join("\0",sort(%hash1)) eq join("\0",sort(%hash2)) )
Looks kinda ugly, I know, but it will do for checking if two hashes are equal in a shallow way, which is what most people are looking for.
For shallow hashes:
(grep {exists %hash2{$_}} keys %hash1) > 0
You can use eq_deeply in Test::Deep::NoTest. It just returns a boolean that you can check, without the extra overhead of the testing capabilities of the main module.
convert hashes to xml files and compare, and yes you could use multilevel.
sub isEqualHash
{
my ($self,$hash1, $hash2) = #_;
my $file1 = "c:/neo-file1.txt";
my $file2 = "c:/neo-file2.txt";
my $xmlObj = XML::Simple->new();
my $dummy_file = $xmlObj->XMLout($hash1,OutputFile => $file1);
my $dummy_file = $xmlObj->XMLout($hash2,OutputFile => $file2);
open FILE, "<".$file1;
my $file_contents1 = do { local $/; <FILE> };
close(FILE);
open FILE, "<".$file2;
my $file_contents2 = do { local $/; <FILE> };
close(FILE);
if($file_contents1 eq $file_contents2)
{
return "Passed";
}
else
{
return "Failed";
}
}

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