Perl notes

From raju

Contents

code snippets

modify array elements only if they match a regular expression

without any temp variable

    @$list_ref = map { $_ =~ m!ContainThis!
                       ? do { s!change_this!change_that!g; $_ }
                       : $_
                     } @$list_ref

With a temp variable.

Todo: Is there any need for this version? If not, delete it in a future revision?

    @$list_ref = map { my $tmp = $_; $tmp =~ m!ContainThis! 
                       ? do { $tmp =~ s!change_this!to_that!g; $tmp }
                       : $_
                     } @$list_ref


The return value of the substitution operator is the number of substitutions performed. That is why it is necessary to explicitly return the string in the if clause.

Ref:

using not defined in an if statement

    if (not defined $opts->{foo})
    {
        print $usage;
        die "\nError: option foo is not defined: $!";
    }

split on multiple delimiters

To get the first two fields from $_

($a,$b) = split /[:,\s\/]/, $_

To get all the fields from $string

my @flds = split /[:,\s\/]/, $string
  • The pair of slashes /.../ denote the regular expression or pattern to be matched.
  • The pair of square brackets [...] denotes the character class of the regex.
  • Inside is the set of possible characters that can be matched: colons :, commas ,, any type of space character \s, and forward slashes \/ (with the backslash as an escape character).

Ref: http://stackoverflow.com/questions/8252547/how-to-split-a-string-with-multiple-patterns-in-perl

take care of white spaces when using split

    my @res = split(/\s*=\s*/, $foo);
    print "first element = $res[0]\n";

does the file exist and readable?

unless (-f $foo and -r $foo)
{
    die "unable to read file $foo: $!";
}

write to file or to STDOUT

The idea here is to write to a file. However, if some reason file can't be opened, write the output to STDOUT instead.

    use strict;
    use warnings;

    my $file;
    my ($FH, $success);
    $success = open($FH, ">", $file);
    $FH = *STDOUT unless $success;
    ...
    print "output is written to $file\n" if $success;
    ...
    print $FH "My name is raju.\n";
    ...
    # Only close if the file handle points 
    # to an actual file. Do not close STDOUT.
    close $FH if $success;

Ref:

replace a string with first word

$tmp =~ s/(\S+).*/$1/;

combine two arrays

push(@$master, @$child)

where master and child are reference to arrays. The result will be stored in master, child is unaltered.

using defined in a while loop condition

while( defined(my $item = &get_item()) )
{
    ...
}

Ref:

number of elements in a hash

my $num = scalar keys %$href;

where $href is a reference to a hash.

number of elements in a array reference

my $num = scalar @$aref;

where $aref is a reference to an array.

In the for loops, we could use

foreach my $i (0..$#{ $aref })
{
    ...
}

create an array reference

my $greeks = [qw(gamma beta alpha)]

push one hash into another hash

To add one hash into another

use Data::Dumper;
my %x = ( a => 1, b => 2, );
my %y = ( a => 3, d => 4, );
%x = (%x, %y);
print Dumper(\%x);

For common keys, values in y overwrite the values in x so that the output is

$VAR1 = {
          'a' => 3,
          'b' => 2,
          'd' => 4
        };

The output could have also been assigned to %y or to a new hash %z.

Ref:- http://perlmaven.com/how-to-insert-a-hash-in-another-hash

To do the same but using hash references

use Data::Dumper;
my $x = { a => 1, b => 2 };
my $y = { a => 3, d => 4 };
$x = { %$x, %$y };
print Dumper($x);

Ref:- http://www.simon.me.uk/2007/209_merging-two-hashrefs-in-perl

using a custom module

Here is a simple way to create and use a custom module.

% cat JumbaDance.pm
package JumbaDance;
use strict;

use warnings;
no warnings;

use subs qw();
use vars qw( $VERSION );

$VERSION = '0.01';
...
<pre>

Using the module
<pre>
% cat usingJumbaDance.pl
use FindBin;
use lib "$FindBin::Bin";
use JumbaDance;
...

Place the modeule and the perl script in the same directory.

capture empty strings when using split

Set LIMIT=-1 in the call to split function so that even empty strings are captured.

my @fields = split(/\s*=\s*/, $str, -1);

Sample usage

% perl -e 'my $str="star="; my @fields = split(/\s*=\s*/, $str, -1); print "$#fields\n"'
1

 % perl -e 'my $str="star="; my @fields = split(/\s*=\s*/, $str); print "$#fields\n"'
0

which shows that the former is 2 element array and the latter is a one element array.

match first occurrence

Use the lazy operator "?" to match the first occurrence.

% perl -e 'my $a="1 = 2 = 3 =4"; if ($a =~ m/(.*?)\s*=\s*(.*)/) {$b = $1; $c = $2;} print "$a\n$b\n$c\n"'
1 = 2 = 3 =4
1
2 = 3 =4
% perl -e 'my $a="1 ="; if ($a =~ m/(.*?)\s*=\s*(.*)/) {$b = $1; $c = $2;} print "$a\n$b\n$c\n"'
1 =
1

% perl -e 'my $a="1"; if ($a =~ m/(.*?)\s*=\s*(.*)/) {$b = $1; $c = $2;} print "$a\n$b\n$c\n"'
1


In the second case, $b is 1 and $c is empty. In the third case, both $b and $c are empty.

Print the program names by searching for the first occurrence of '-' character.

% perl -e 'my @a=("prog1 -arg1 val1 -arg2 val2", "prog-2 -arg1 val1 -arg2 val2"); my @b = map { my $tmp=$_; $tmp =~ m/(.*?)\s+-/; $1 } @a; print(join("\n", @a) . "\n"); print(join("\n", @b) . "\n"); '
prog1 -arg1 val1 -arg2 val2
prog-2 -arg1 val1 -arg2 val2
prog1
prog-2

get base name and directory name from a file name

use File::Basename; # for fileparse
use File::Spec; # for rel2abs

# By default, the filename is not converted to absolute path.
# It has to be done manually if necessary.
#
# Note that the directory name contains '/' at the end. 
my ($base_name, $dir) = fileparse(File::Spec->rel2abs( $fname));

Ref: http://perldoc.perl.org/File/Basename.html

declare multiple variables in one line

% perl -e 'my ($a, $b) = (2, "raju"); print "a = $a\nb = $b\n"'
a = 2
b = raju

Other places where multiple variables get initialized in one line.

my ($var1, $var2, $var3) = &call_function($arg1, $arg2);
my ($var1, $var2) = @_;

run shell commands

     % cat do_it.pl
    #! /usr/bin/env perl
    
    use strict;
    
    my $dir = 'foo';
    &do_it("mkdir -p $dir", 1);  # dry run
    # &do_it("mkdir -p $dir"); # actually creates a directory
    
    sub do_it
    {
        my ($cmd, $dry, $debug) = @_;
        $dry = $dry ? $dry : 0;
        $debug = $debug ? $debug : 1;
    
        my $has_error=0;
    
        if (not $dry)
        {
            print "Running Command: $cmd\n" if $debug;
            my $cmd_exit_code = system($cmd);
    
            if ($cmd_exit_code != 0)
            {
                report("Error running: $cmd");
                $has_error=1;
            }
        }
        else
        {
            print "Command to run: $cmd\n" if $debug;
        }
        return $has_error;
    }
    

Sample run

     % ./do_it.pl
    Command to run: mkdir -p foo
    

full scripts

search and replace each element of an array

% cat test.pl
#! /usr/bin/env perl

use strict;
use warnings;
use Data::Dumper; # for debugging purposes

&outof_place();
&in_place();
&multiple_outof_place();
&multiple_in_place();

sub outof_place()
{
    print "outof_place:\n";
    my @a = ("apple", "ant", "alex");
    my @b = map { my $tmp=$_; $tmp =~ s/a/out_a/g; $tmp} @a;
    
    print Dumper(@a);
    print Dumper(@b);
}

sub in_place()
{
    print "in_place:\n";
    my @a = ("apple", "ant", "alex");
    my @b = map { s/a/in_a/g; $_} @a;
    
    print Dumper(@a);
    print Dumper(@b);
}

sub multiple_outof_place()
{
    print "multiple_outof_place:\n";
    my @a = ("apple", "ant", "alex");
    my @b = map { my $tmp=$_; $tmp =~ s/a/1_a/g; $tmp =~ s/1_/2_/; $tmp} @a;
    
    print Dumper(@a);
    print Dumper(@b);
}

sub multiple_in_place()
{
    print "multiple_in_place:\n";
    print "in_place:\n";
    my @a = ("apple", "ant", "alex");
    my @b = map { s/a/1_a/g; s/1_/2_/g; $_} @a;
    
    print Dumper(@a);
    print Dumper(@b);
}

Run it

% ./test.pl
outof_place:
$VAR1 = 'apple';
$VAR2 = 'ant';
$VAR3 = 'alex';
$VAR1 = 'out_apple';
$VAR2 = 'out_ant';
$VAR3 = 'out_alex';
in_place:
$VAR1 = 'in_apple';
$VAR2 = 'in_ant';
$VAR3 = 'in_alex';
$VAR1 = 'in_apple';
$VAR2 = 'in_ant';
$VAR3 = 'in_alex';
multiple_outof_place:
$VAR1 = 'apple';
$VAR2 = 'ant';
$VAR3 = 'alex';
$VAR1 = '2_apple';
$VAR2 = '2_ant';
$VAR3 = '2_alex';
multiple_in_place:
in_place:
$VAR1 = '2_apple';
$VAR2 = '2_ant';
$VAR3 = '2_alex';
$VAR1 = '2_apple';
$VAR2 = '2_ant';
$VAR3 = '2_alex';

delete elements in an array

% cat test.pl
#!/usr/bin/env perl

use strict;
use warnings;
use autodie;
use Data::Dumper; # for debugging purposes

&delete_elements();

sub delete_elements()
{
    my @array = qw(foo here bar here kama here raju here);
    print "original array:\n";
    print Dumper(@array);

    my $search = "here";

    # If the indx is stored in the reverse order, we avoid array renumbering
    # issue when deleting the elements. Otherwise an increasing offset is
    # required as each deletion would change the location of the matches.
    my @indx = reverse( grep {$array[$_] eq $search} 0..$#array );
    print "Matches are found at:\n";
    print Dumper(@indx);

    foreach (@indx) {
        splice(@array, $_, 1);
    }
    print "modified array:\n";
    print Dumper(@array);
}

sample run

% ./delete_elements_in_array.pl
original array:
$VAR1 = 'foo';
$VAR2 = 'here';
$VAR3 = 'bar';
$VAR4 = 'here';
$VAR5 = 'kama';
$VAR6 = 'here';
$VAR7 = 'raju';
$VAR8 = 'here';
Matches are found at:
$VAR1 = 7;
$VAR2 = 5;
$VAR3 = 3;
$VAR4 = 1;
modified array:
$VAR1 = 'foo';
$VAR2 = 'bar';
$VAR3 = 'kama';
$VAR4 = 'raju';

using if - elsif - else

#! /usr/bin/env perl

use strict;
use warnings;

my $str=$ARGV[0];

die "Have to supply at least one argument" unless defined $str;

if ($str eq "kama")
{
    print "In if condition. arg = $str\n";
}
elsif ($str eq "raju")
{
    print "In elsif condition. arg = $str\n";
}
else
{
    print "In else condition. arg = $str\n";
}

Sample run

 % ./using_elsif_01.pl kama
In if condition. arg = kama

 % ./using_elsif_01.pl raju
In elsif condition. arg = raju

 % ./using_elsif_01.pl kamaraju
In else condition. arg = kamaraju

unnamed code blocks

% cat unnamed_blocks.pl
#! /usr/bin/env perl

use strict;
use warnings;
use autodie;

my $g=0;
{
    my $m=1;
}
# Uncommenting this line will give the following error
# Global symbol "$l" requires explicit package name at ./unnamed_blocks.pl line 14.
# Execution of ./unnamed_blocks.pl aborted due to compilation errors.
# print "m = $m\n";
print "g = $g\n";

Remove prefix and suffix

% cat remove_prefix_suffix.pl
#! /usr/bin/perl -w

use strict;
use warnings;
use autodie;
use List::MoreUtils qw(uniq);

my @a=qw(k_foo_r k_bar_r);
my @b = map { my $tmp=$_; $tmp =~ s/^k_(.*)_r$/$1/g; $tmp} @a;
print join("\n", @a) . "\n";
print join("\n", @b) . "\n";

See also: http://perlmaven.com/filtering-values-with-perl-grep

opening and closing files

read whole file into array

Approach 1:- Handle Linux and Windows line endings on Linux

open(my $FH, "<", $fname);
my @data=<$FH>;
close($FH);
...
foreach my $line (@data)
{
    $line =~ s/(?:\012)|(?:\015)//g;
    ...
}

Ref:

Approach 2:- Handle Linux line endings on Linux

open(my $FH, "<", $fname);
chomp(my @data=<$FH>);
close($FH);
...
foreach my $line (@data)
{
    ...
}

nothing fancy

Approach 1

use autodie;
...
open LOG, '>>', 'logfile';
...
close LOG;

Approach 2

my $success = open LOG, '>>', 'logfile';
if ( ! $success  ) {
    die "Cannot create logfile: $!";
}
...
close LOG;

open a gzip file and process

use autodie;
...
# check if the file has a .gz extension
if ($file !~ m/\.gz$/)
{
    die "Invalid file name. No .gz extension found in $file\n";
}
...
my $nhits=0;
open(my $FH, "-|", "zcat $file")
    or die "cannot open $file: $!";
while (<$FH>)
{
    # count lines that contain the word raju
    if (/raju/)
    {
        ++$nhits;
    }
}
close($FH)
    or warn "close failed: $!";

Ref:-

  1. search for "cat -n" in http://perldoc.perl.org/functions/open.html which shows how to pipe output when using open
  2. using open with die is shown at the top of http://perldoc.perl.org/functions/open.html
  3. search for "close" in http://perldoc.perl.org/functions/open.html for an explanation of using close with warn

Placeholder

Useful External links

These links are useful to learn about Hashes of hashes, hashes of arrays, array of hashes, array of arrays, storing matrix data etc., see

Modules

Which module to use for a task

  • If a string contains some delimiters within the quotes and some delimiters outside the quotes and you want to ignore the delimiters within the quotes then use Text::ParseWords module.

sample code

$ cat quoted_strings.pl
#! /usr/bin/perl
use strict;
use warnings;
use Text::ParseWords;

my $line = '"IBM,MSFT","WMT,AMZN","VZ,S"';
my @words = parse_line(",", 1, $line);
print "line is\n";
print "$line\n";
print "words are\n";
print join("\n", @words) . "\n";

Sample output

% ./quoted_strings.pl
line is
"IBM,MSFT","WMT,AMZN","VZ,S"
words are
"IBM,MSFT"
"WMT,AMZN"
"VZ,S"

For example

eval( read_file($fname) );

will read all the perl code in $fname.

To learn more about eval and read_file, see http://perltricks.com/article/26/2013/5/28/Execute-Perl-code-stored-in-a-text-file-with-eval

frequently used perl modules

Some perl modules that I frequently use and find useful.

use strict;
use warnings;
use autodie;
use Getopt::Long;
use Data::Dumper;  # for debugging purposes
use POSIX;         # for getting date and time
use Sys::Hostname; # for hostname
use File::Path qw(make_path);
use File::Basename qw(dirname);
use File::Spec;    # for rel2abs
use File::Spec::Functions qw(catdir catfile);
use List::Util qw(min);
use List::MoreUtils qw(uniq);
use Set::CrossProduct;  # for doing cross products
use Archive::Extract;    # to extract tar gzipped files
use 5.10.0;

placeholder

get the username

$ perl -wle 'my $username = getpwuid($<) || $ENV{LOGNAME} || $ENV{USER}; print $username'
rajulocal

get the home directory

$ perl -wle 'my $home = $ENV{HOME} // $ENV{LOGDIR} // (getpwuid($<))[7] // die "You are homeless\n"; print $home'
/home/rajulocal

Ref:- http://perldoc.perl.org/perlop.html#Logical-Defined-Or

get the date and time

In Perl

$ perl -wle 'use POSIX; my $dt = POSIX::strftime("%Y-%m-%dT%H:%M:%S", localtime()); print $dt'
2014-11-27T17:11:45

In shell

$ date "+%Y-%m-%dT%H:%M:%S"
2014-11-27T17:11:59

Ref:

  1. http://en.wikipedia.org/wiki/ISO_8601
  2. In particular see http://en.wikipedia.org/wiki/ISO_8601#Combined_date_and_time_representations which tells that either basic or extended formats can be used when writing date and time. But both must use the same format.

print sequence of numbers

Here are some Perl one liners to print sequence of numbers.

Using 'for'

% perl -le 'print for 100..104'
100
101
102
103
104

Same thing but using 'foreach'

% perl -le 'foreach $i (100..104) {print $i}'
100
101
102
103
104

Same thing but using printf to format the output

% perl -le 'foreach $i (100..104) {printf("%d\t%.2f\n", $i, $i/100)}'
100     1.00
101     1.01
102     1.02
103     1.03
104     1.04

Also, print a string and enclose it in single quotes

% perl -le 'foreach $i (100..104) {printf("%d \t \047raju\047 \t %.2f\n", $i, $i/100)}'
100      'raju'          1.00
101      'raju'          1.01
102      'raju'          1.02
103      'raju'          1.03
104      'raju'          1.04

find and replace

Here is a one liner to change all the occurrences of wordA to wordB using the substitution operator.

% cat phone.txt
I have a smart phone.

% perl -npe '{s/smart/dumb/gc;}' phone.txt
I have a dumb phone.

which is same as

% perl -ne '{s/smart/dumb/gc; print $_}' phone.txt
I have a dumb phone.

which is same as

% perl -e 'while(<>) {s/smart/dumb/gc; print $_}' phone.txt
I have a dumb phone.

print array elements with a new line

print join("\n", @arr), "\n";

list files using glob

#! /usr/bin/perl -w
use strict;
use warnings;

my @perl_files = glob "*.pl";
print "@perl_files\n";

my $dir="/home/rajulocal/work/cpp";
my @cpp_files = glob "${dir}/*.cpp";
print "@cpp_files\n";

Ref:-

test simple perl scripts

Whenever I want to run perl interactively to see the output of a simple script, I use this instead.

% perl -e 'use List::MoreUtils qw(uniq); my @a=(1,2,3,4); my @b=(5,6); push(@a, @b, @a); @a = uniq @a; print "@a\n"; '
1 2 3 4 5 6

one liners

information on modules

To check if a module is installed or not

% perl -MSet::CrossProduct -e'print $_ ." => " . $INC{$_} . "\n" for keys %INC'

This is also useful to locate the source code of a module.

To find the version number of Set::CrossProduct module being used.

% perl -e 'use Set::CrossProduct; print "$Set::CrossProduct::VERSION\n";'
1.96

Ref:

using perl as an enhanced grep

perl -ne '{if (/office => "(.*)"/) {print "$1\n"} }' phone_numbers.txt

will extract all the values associated with "office => " in the phone_numbers.txt file.

Todo:- Provide a sample file and describe how grep can't achieve this.

Filtering values with perl grep

convert bps to percentage

% cat data_bps.txt
Date,col1,col2,col3
15-Nov-12,55.543,26.884,21.788
16-Nov-12,31.546,27.179,23.994
17-Nov-12,74.031,38.455,31.981

% cat bps_to_pct.sh
(head -n 1 data_bps.txt | cut -f1-4 -d ',' ; tail -n +2 data_bps.txt | perl -F/,/ -nae '$F[1] /= 100; $F[2] /= 100; $F[3] /= 100; print "$F[0],$F[1],$F[2],$F[3]\n"' ) > data_pct.txt

% ./bps_to_pct.sh

% cat data_pct.txt
Date,col1,col2,col3
15-Nov-12,0.55543,0.26884,0.21788
16-Nov-12,0.31546,0.27179,0.23994
17-Nov-12,0.74031,0.38455,0.31981

Demonstrates:

  • using -F in perl one liners

search and replace a word in a file

Consider

% cat ~/x/file14.txt                            
abcdefgh foo uvwxyz
foo uvwxyz foo abcdefgh

Replace foo with bar and make a backup. The extension in -i argument is used to derive the backup file's name.

% perl -p -i.bak -e 's/foo/bar/g' ~/x/file14.txt

% cat ~/x/file14.txt.bak 
abcdefgh foo uvwxyz
foo uvwxyz foo abcdefgh

% cat ~/x/file14.txt    
abcdefgh bar uvwxyz
bar uvwxyz bar abcdefgh

Replace foo with bar and make no backup.

% perl -p -i -e 's/foo/bar/g' ~/x/file14.txt

% cat ~/x/file14.txt                        
abcdefgh bar uvwxyz
bar uvwxyz bar abcdefgh

Remove the -i option to show the output on the screen but keep the file intact.

% perl -p -e 's/foo/bar/g' ~/x/file14.txt
abcdefgh bar uvwxyz
bar uvwxyz bar abcdefgh

% cat ~/x/file14.txt                     
abcdefgh foo uvwxyz
foo uvwxyz foo abcdefgh

Get latest unique lines

consider the file

% cat input.txt
whoami
ls -al
top
whoami
ls -rt
cd /usr/bin
whoami
ls -rt

To print unique lines in this file by preserving the order and retaining the latest of duplicated lines.

% cat input.txt | perl -MList::MoreUtils=uniq -e 'print reverse uniq reverse <>'
ls -al
top
cd /usr/bin
whoami
ls -rt

To do the same but retain the oldest of the duplicated lines.

 % cat input.txt | perl -MList::MoreUtils=uniq -e 'print uniq <>'
<pre>
whoami
ls -al
top
ls -rt
cd /usr/bin

external links

Boolean values in Perl

List files in a directory

http://perlmeme.org/faqs/file_io/directory_listing.html covers this topic very well. But just want to add that the file names from readdir will be relative to the directory name. So, sometimes we may have to manually embed the path information into it.

use File::Spec; # for catfile

sub list_files_in_dir
{
    my ($dir) = @_;

    my @files;
    opendir(DIR, $dir) or die $!;
    while (my $file = readdir(DIR))
    {
        # The file names will be relative to the directory. 
        # So we need to manually embed the path information.
        push(@files, File::Spec->catfile($dir, $file));
    }
    closedir(DIR);
    
    return \@files;
}

Debugging perl scripts

launching debugger

perl -d script.pl options

shortcuts

T - to print backtrace
R - restart
b 189 - set breakpoint at line 189
c - continue
B 274 - delete breakpoint at line 274

Ref: