Perl

• The best reference to start off with
• http://perlmaven.com/simple-database-access-using-perl-dbi-and-sql

Some one liners: socher.org

Oneliners

To change only the fifth line, you can add a test checking $., the input line number, then only perform the operation when the test passes:

perl -pi -e 's/Fred/Barney/ if $. == 5' inFile.txt

To add lines before a certain line, you can add a line (or lines!) before Perl prints $_:

perl -pi -e 'print "Put before third line\n" if $. == 3' inFile.txt

You can even add a line to the beginning of a file, since the current line prints at the end of the loop:

perl -pi -e 'print "Put before first line\n" if $. == 1' inFile.txt

To insert a line after one already in the file, use the -n switch. It's just like -p except that it doesn't print $_ at the end of the loop, so you have to do that yourself. In this case, print $_ first, then print the line that you want to add.

perl -ni -e 'print; print "Put after fifth line\n" if $. == 5' inFile.txt

To delete lines, only print the ones that you want.

perl -ni -e 'print unless /d/' inFile.txt

… or …

perl -pi -e 'next unless /d/' inFile.txt

Using %ENV to pass parameters to a perl one-liner

Used here to clean up a comma-separated list of parameters passed into a shell.

# - remove all spaces
# - remove any quote characters
# - replace , with ','
# -----------------------------
SCHEMAE=`export quot="'"; echo $SCHEMAE | perl -lpe 's/\s+//g; s/$ENV{quot}//g; s/,/$ENV{quot},$ENV{quot}/g'`

Add a line after another one in a file using Perl

Use Perl to filter a script (or a load of scripts) and add an extra line when certain pattern match condition exists.
Uses -n switch with print because using -p switch evaluates your condition first and then prints the line. This could be used if you want to print a line before the matched line!

for commvaulthost in ci00031669-hn491 ci00031670-hn492 ci00031671-hn5407 ci00031672-hn364 ci00031673-hn5207 ci00031674-hn5217; do
    unixhost=$(echo ${commvaulthost} | awk -F\- '{print $NF}')
    perl -n -i -e 'print;print "TO_CV_HOST='${commvaulthost}'                                              # Commvault host\n" if /TO_HOST='${unixhost}'/' synchro*.cfg
done

perl -a

Turns on autosplit mode. Use -F<delim> to specify how to split the elements
Breaks down the input into elements of an automatically assigned array called @F.

perl -F: -lane 'print $F[0]' /etc/passwd

perl -l

When trimming whitespace from your input, the \n is removed also. Using -l adds it back in at the end of processing.
See examples above.

BEGIN and END

Allows you to run code before or after the loop over the lines.
Example, sum the values in the second column of a CSV file...
Replace the 'n' with a 'p' to see the numbers being summed.

perl -F, -lane '$sum += $F[1]; END { print $sum }' somefile.csv

.. operater

Cut chunks out of a file from /start range marker/ .. /end range marker/

perl -ne 'print if /-----BEGIN PGP PUBLIC KEY BLOCK-----/../-----END PGP PUBLIC KEY BLOCK-----/' file_containing_public_keys.txt

A one-liner web server!

perl -MIO::All -e 'io(":8080")->fork->accept->(sub { $_[0] < io(-x $1 ? "./$1 |" : $1) if /^GET \/(.*) / })'

• First we accept a socket and fork the server. Then we overload the new socket as a code ref. This code ref takes one argument, another code ref, which is used as a callback.
• The callback is called once for every line read on the socket. The line is put into $_ and the socket itself is passed in to the callback.
• Our callback is scanning the line in $_ for an HTTP GET request. If one is found it parses the file name into $1. Then we use $1 to create an new IO::All file object... with a twist. If the file is executable("-x"), then we create a piped command as our IO::All object. This somewhat approximates CGI support.
• Whatever the resulting object is, we direct the contents back at our socket which is in $_[0].

From: commandlinefu.com

What Perl modules are installed?

As found by typing "perldoc q installed"

#!/usr/bin/perl
use File::Find;
my @files;
find(
    sub {
        push @files, $File::Find::name
        if -f $File::Find::name && /\.pm$/
        },
    @INC
    );
print join "\n", @files;

Prepend a line at the beginning of a file

Surprisingly tricky thing to do as a one-liner. Seemingly cannot be done (cross-platform) in ksh in one line.

perl -p -i -e 'print "This is line 1 now!\n" if $. == 1' file.txt

Implement a socket client/server in Perl

thegeekstuff.com

Scan for emails with attachments and save attachments to files

• Chillkat - Imap save mail attachments

Install a Perl module from CPAN

perl -MCPAN -e 'install RRD::Simple'

Print out the first and last words of all lines in a file

perl -ae 'print "$F[0]:$F[-1]\n"'

Print only the lines in a file between 2 search patterns

perl -ne 'print unless /pattern1/ .. /pattern2/' filename

Mass update of files using perl inline script

for server in $(cat /home/tools/etc/oracle/oracle_servers); do
    ssh $server "perl -p -i -e 's/T01/D01/' /home/tools/scripts/rman/inclexcl.lst"
done

Perl emulation of dos2unix command

perl -p -i -e 's/\r\n/\n/' filename

and then back again with unix2dos

perl -p -i -e 's/[!\r]\n/\r\n/' filename

Print a file except / excluding certain lines

perl -ne 'next if (/pattern_for_removal/); print;' filename

Exclude the first few lines of a file

perl -ne 'print unless 1 .. 10' filename

Delete the last line of a file

perl -e '@x=<>; pop(@x); print @x'

Print lines between 2 markers in a file

perl -ne 'print if /START/ .. /STOP/' filename

Print lines not between 2 markers in a file!

perl -ne 'print unless /START/ .. /STOP/' filename

Print a few lines in a file

perl -ne 'print if 15 .. 17'

but more efficiently...

perl -ne 'print if $. >= 15; exit if $. >= 17;'

Print lines of a file in reverse order

perl -e 'print reverse <>' filename

Print characters in lines of a file in reverse order

perl -nle 'print scalar reverse $_' filename

Find palindromes in a file

perl -lne '$_ = lc; print if $_ eq reverse' filename

Reverse all the characters in a file

perl -0777e 'print scalar reverse <>' filename

Reverse all the characters in a paragraph but keeping the paragraphs in order

perl -00 -e 'print reverse <>' filename

Trim all heading and trailing spaces and compress any intermediate spaces to 1

perl -pe '$_ = " $_ "; tr/ \t/ /s; $_ = substr($_,1,-1)'

Nice one to reformat a document so that all lines are between 50 and 70 characters long. Only breaks on whitespace

perl -000 -p -e 'tr/ \t\n\r/ /;s/(.{50,72})\s/$1\n/g;$_.="\n"x2'

Substitute text in subject placing modified text in result

Variable "subject" remains unchanged

($result = $subject) =~ s/before/after/g;

Print balancing quotes

perl -ne '$q=($_=~tr/"//); print"$.\t$q\t$_";' filename

Capitalise all words in a file (ensuring all others letters in the words are lower case)

ref: Matz Kindahl

perl -pe 's/\w.+/\u\L$&/'

Translate into Zafir language!

perl -pe 's#\w+#ucfirst lc reverse $&#eg' filename

Read in (include) a configuration file in Perl

Although there are several ways to "include" files into the current program, this method is the simplest.
The problem with using require or include is that the scope is different so any my variables won't be visible
The trick here is the use of the "our" hash.

# ====================
# bring in config file
# ====================
our %config;
open (CONFIG, "<./config.txt") or die "Cannot locate configuration file";
while (<CONFIG>) {
    chomp; s/#.*//; s/^\s+//; s/\s+$//;
    next unless /=/;
    my ($var, $value) = split(/\s*=\s*/, $_, 2);
    $config{$var} = $value;
}
close CONFIG;

Send an email from perl without needing any external modules

but it only works on Unix :(

#	Simple Email Function
#	($to, $from, $subject, $message)
sub sendemail
{
    my ($to, $from, $subject, $message) = @_;
    my $sendmail = '/usr/lib/sendmail';
    open(MAIL, "|$sendmail -oi -t");
    print MAIL "From: $from\n";
    print MAIL "To: $to\n";
    print MAIL "Subject: $subject\n\n";
    print MAIL "$message\n";
    close(MAIL);
}

Using the function is straightforward. Simply pass it the data in the correct order.

sendemail ( "toemail\@mydomain.com", "fromemail\@mydomain.com", "Simple email.", "This is a test of the email function." );

What "day of the year" (DOY) number was it yesterday?

YESTERDAY=`perl -e 'print sub{$_[7]}->(localtime);'`

What "day of the year" (DOY) number is it today?

TODAY=`perl -e 'print sub{$_[7]}->(localtime)+1;';`

Sort a list

• www.perlfect.com
• perlmaven.com
• perlmaven article on recursion

Numerically

@sorted = sort { $a <=> $b } @unsorted

Alphabetically

@sorted = sort { $a cmp $b } @unsorted

Alphabetically (case-insensitive)

@sorted = sort { lc($a) cmp lc($b) } @unsorted

Schwartzian transform

    my @quickly_sorted_files =
    map { $_->[0] }
    sort { $a->[1] <=> $b->[1] }
    map { [$_, -s $_] }
    @files;

broken down into (semi)understandable pieces looks like this...

    my @unsorted_pairs = map { [$_, -s $_] } @files;
    my @sorted_pairs = sort { $a->[1] <=> $b->[1] } @unsorted_pairs;
    my @quickly_sorted_files = map { $_->[0] } @sorted_pairs;

Use 'map' to apply transformations

• http://www.xaprb.com/blog/2006/10/05/five-great-perl-programming-techniques-to-make-your-life-fun-again/

Push the list in one side (right) and get it back on the other (left) with some transformation applied.
Inside the code block, you refer to the current element with the traditional $_ variable.

my @langs = qw(perl php python);
my @langs = map { uc($_) } @langs;
Result: PERL PHP PYTHON

Use it with join to create clever stuff...

sub make_query_string {
   my ( $vals ) = @_;
   return join("&", map { "$_=$vals->{$_}" } keys %$vals);
}
my %query_params = (
   a => 1,
   b => 2,
   c => 3,
   d => 4,
);
my $query_string = make_query_string(\%query_params);
Result: &a=1&b=2&c=3&d=4

Difference in hours between two dates

use Time::localtime;
use DateTime::Format::Strptime qw();

        my $parser = DateTime::Format::Strptime->new (
            pattern  => '%d-%b-%y %H:%M:%S',
            locale   => 'en',   # 'Mon', 'Jul' are English
            on_error => 'croak'
        );
        my $timethen = $parser->parse_datetime( $started );
        my $timenow  = DateTime->now( time_zone => 'local' )->set_time_zone('floating');
        my $timediff = $timenow->subtract_datetime($timethen);

print ('<!-- HOURS: ',$timediff->hours(),' -->',"\n");

or, without using any external modules...

        my ($host,$sid,$dbid,$timethen,$recid,$stamp,$started,$duration,$size,$status,$type) = split (/\|/);

        # ----------------------------
        # work out how old the file is
        # ----------------------------
        my $timenow    = time();
        my $difference = $timenow - $timethen;  # in seconds
        my $hours      = $difference/60/60;
        $difference    = $difference - ($hours*60*60);
        my $mins       = $difference/60;
        my $secs       = $difference - ($mins*60);

Slurp an external file into a variable

The idea is to read an SQL file into a variable to prepare and execute it

#!/usr/bin/perl -w
use strict;
my $stmt;
my $quoted_stmt;
$quoted_stmt = 7;
open (FH,"<","test.sql") or die $!;
local $/ = undef;
$stmt = <FH>;
close FH;
$quoted_stmt = eval('q('.$stmt.')');
print $quoted_stmt."\n";

Search for a (list of) keyword(s) in a file

Could write this in several loops but here is a very neat way. Spotted on Stackoverflow.com

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

#Lexical variable for filehandle is preferred, and always error check opens.
open my $keywords,    '<', 'keywords.txt' or die "Can't open keywords: $!";
open my $search_file, '<', 'search.txt'   or die "Can't open search file: $!";

my $keyword_or = join '|', map {chomp;qr/\Q$_\E/} <$keywords>;
my $regex = qr|\b($keyword_or)\b|;

while (<$search_file>)
{
    while (/$regex/g)
    {
        print "$.: $1\n";
    }
}

basically it builds up a regular expression and searches for it.
See reference link for more details.

Can also be done very neatly with grep in shell

grep -n -f keywords.txt filewithlotsalines.txt

where keywords.txt is a file containing the list of words to search for.

Assign and substitute a value to a variable in one statement

Keep forgetting where the parentheses go so have to write it down…
Have to pre-define the variable $new_var otherwise you will get:

Can't declare scalar assignment in "my" at filename line 9, near ") =~"

($new_var = $old_var) =~ s/find_this/change_it_to_this/;

Match a regular expression across multiple lines

• Try and work out the regex online
  

I always forget this regex and it's sooo useful!

perl -00 -ne 'print "$1 - $2\n"  if /^"(\w+?)"\).*?RMAN_RECOVERY_WINDOW=(\d+)?/s' backup.ini

where backup.ini looks like this:

"SIANAP1")
EXP_ZIP_DUMPS="Y"
;;

"SICRMA3")
EXP_FLASHBACK="N"
RMAN_RECOVERY_WINDOW=5
RMAN_HOURS_TO_KEEP_ARCHIVES_ON_DISK=48
EXP_NUM_PARALLEL_WORKERS=16
;;

"SICRMA4")
RMAN_RECOVERY_WINDOW=10
RMAN_HOURS_TO_KEEP_ARCHIVES_ON_DISK=48
EXP_NUM_PARALLEL_WORKERS=5
;;

"SICRMP1")
RMAN_RECOVERY_WINDOW=15
;;

"SICRMP2")
RMAN_RECOVERY_WINDOW=20
;;

"SICRMQ2")
RMAN_RECOVERY_WINDOW=25
RMAN_HOURS_TO_KEEP_ARCHIVES_ON_DISK=48
;;

Using /s and /m modifiers in a regular expression

Tom Christiansen in his Perl Cookbook demonstrates the difference between these 2 confusing modifiers

$/ = '';            # paragraph read mode for readline access
while (<ARGV>) {
    while (m#^START(.*?)^END#sm) {  # /s makes . span line boundaries
                                    # /m makes ^ match near newlines
        print "chunk $. in $ARGV has <<$1>>\n";
    }
}

Match regular expression and assign to a variable in a single step

$started = $1 if $stmt =~ /Export started at (\d+)/;

or split directory and filenames (on Windows or Unix)

($dirname,$filename) = $fullname =~ m|^(.*[/\\])([^/\\]+?)$|;

or split a line into bits and assign the bits to variables

my ($host,$sid,$dbid,$timethen,$timesuccess,$recid,$stamp,$started,$ended,$size,$status,$type) = split (/\|/);

Perl ternary operator

Putting examples here as I keep forgetting the syntax/semantics!
Theoretically it should be:

condition ? evaluate_if_condition_was_true : evaluate_if_condition_was_false

which to me means:

($type == 'ARCHIVELOG') ? $age_alert = $arc_alert : $age_alert = $job_alert;

but it's not like that, it's like this:

$age_alert = ($type == 'ARCHIVELOG') ?  $arc_alert : $job_alert;

and this

print "<td class=\"left\">"; print $created ne '' ? scalar(gmtime($created)) : "&nbsp"; print "</td>";

Extract a value from a comma separated list of values in Perl

Suppose you need the 10th column …but only from the lines ending in 'detail'

/^(?:[^,]+,){9}([^,]+),(?:[^,]+,)*detail$/

or

$input =~ /detail$/ && my @fields = split(/,/, $input);

and print out the 10th element of @fields

Typical filter program (without needing to slurp)

Keep one of these here to save me looking it up all the time!

#!/usr/bin/perl

use strict;
use warnings;

my $filename = "$ENV{TEMP}/test.txt";
open (my $input, '<', $filename) or die "Cannot open '$filename' for reading: $!";

my $count;

while ( my $line = <$input> ) {
    my @words = grep { /X/ } split /\b/, $line;
    $count += @words;
    print join(', ', @words), "\n";
}

print "$count\n";

__END__