dbawiki

This page is read only. You can view the source, but not change it. Ask your administrator if you think this is wrong.
  *  [[https://ingram-braun.net/erga/online-regex-tester-perl-php-javascript/|Online Perl regex tester]]
  *  [[http://perl-tutorial.org/|The best reference to start off with]]
  *  [[http://perlmaven.com/simple-database-access-using-perl-dbi-and-sql|http://perlmaven.com/simple-database-access-using-perl-dbi-and-sql]]
Some one liners: [[http://www.socher.org/index.php/Main/PerlScriptsAndOneLiners|socher.org]]

===== Install local version of Perl without needing root access ====
If installing locally with a lighttpd webserver, see here for a lighttpd.conf file [[html css javascript]]
<code>
wget https://www.cpan.org/src/5.0/perl-5.34.0.tar.gz
tar -xzf perl-5.34.0.tar.gz
cd perl-5.34.0
mkdir -p $HOME/opt/perl
./Configure -des -Dprefix=$HOME/opt/perl
make
make test
make install
export PATH="${HOME}/opt/perl/bin:${PATH}"
</code>

==== Install additional modules locally without root access ====
Install this first one (Local::Lib) manually, the rest can be done using it.
  * Search CPAN for the module and click the download link on the left hand side
  * Copy the .gz file to a source directory and unzip it
<code>
mkdir ~/opt/perl/src
mv local-lib-2.000028.tar.gz ~/opt/perl/src/
cd ~/opt/perl/src/
tar -zxvf local-lib-2.000028.tar.gz
cd local-lib-2.000028
</code>
  * Use a prefix to force local installation
<code>
perl Makefile.PL PREFIX=~/opt/perl
make && make test && make install
</code>
  * Now additional modules can be installed using Local::Lib
<code>
perl -MCPAN -Mlocal::lib -e 'CPAN::install(Switch)'
</code>


===== Oneliners =====
Remove all non-ascii characters from a text file\\
If 'cat -v' shows up weird characters in the file, they can be removed like this:
<code>
perl -pe 's/[^[:ascii:]]/ /g;' bad_file > good_file
</code>

Print out just the connect identifiers of the connection clauses in tnsnames.ora\\
match an alphabetic or numeric (not space) as first character followed by any number of characters until the first =
<code>
perl -n -e 'print "$1\n" if m/^(\w.+?)=/' $TNS_ADMIN/tnsnames.ora|sort -u
</code>

To spit out only the stanzas in tnsnames.ora where the host and port are specific values
<code>perl -ne 'BEGIN { $/="";} { chomp; push @stanzas, $_ if m/hn481/i && m/3529/; } END { push @stanzas, ""; print join "\n\n", @stanzas; }' tnsnames.ora
</code>
Change the connect identifier in tnsnames.ora to upper case (anything from the start of line up to "= (" )
<code>
perl -p -i -e 's/^(.+?)= \(/\U$1= \(/' $TNS_ADMIN/tnsnames.ora
</code>

To spit out only the stanzas in /etc/filesystems where mount is set to false
<code>
perl -ne 'BEGIN { $/="";} { s/\s+\=/ =/g;s/\n\s+/\n/g;s/^(\/.+):/mp = \1/;print "$_\n" if !m/^\*/ && m/mount\s+=\s+false/i; }' /etc/filesystems
</code>
To modify the value in a variable
<code>
$variable =~ s/regex/replacement/g;
eg:
$sid =~ s/ora_pmon_//;
</code>
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:
<code>
perl -pi -e 's/Fred/Barney/ if $. == 5' inFile.txt
</code>
To add lines before a certain line, you can add a line (or lines!) before Perl prints $_:
<code>
perl -pi -e 'print "Put before third line\n" if $. == 3' inFile.txt
</code>
You can even add a line to the beginning of a file, since the current line prints at the end of the loop:
<code>
perl -pi -e 'print "Put before first line\n" if $. == 1' inFile.txt
</code>
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.
<code>
perl -ni -e 'print; print "Put after fifth line\n" if $. == 5' inFile.txt
</code>
To delete lines, only print the ones that you want.
<code>
perl -ni -e 'print unless /d/' inFile.txt
</code>
… or …
<code>
perl -pi -e 'next unless /d/' inFile.txt
</code>

==== Another set of useful one-liner tricks ====
  * Trick #1: -l (lower case L)
Smart newline processing. Normally, perl hands you entire lines, including a trailing newline. With -l, it will strip the trailing newline off of any lines read, and automatically add a newline to anything you print (including via -p).

Suppose I wanted to strip trailing whitespace from a file. I might naïvely try something like

<code>
perl -pe 's/\s*$//'
</code>

The problem, however, is that the line ends with "\n", which is whitespace, and so that snippet will also remove all newlines from my file! -l solves the problem, by pulling off the newline before handing my script the line, and then tacking a new one on afterwards:


 
<code>
perl -lpe 's/\s*$//'
</code>
 

  * Trick #2: -0
Occasionally, it's useful to run a script over an entire file, or over larger chunks at once. -0 makes -n and -p feed you chunks split on NULL bytes instead of newlines. This is often useful for, e.g. processing the output of find -print0. Furthermore, perl -0777 makes perl not do any splitting, and pass entire files to your script in $_.

<code>
find . -name '*~' -print0 | perl -0ne unlink
</code>
Could be used to delete all ~-files in a directory tree, without having to remember how xargs works.

  * Trick #3: -i (lower case I)
-i tells perl to operate on files in-place. If you use -n or -p with -i, and you pass perl filenames on the command-line, perl will run your script on those files, and then replace their contents with the output. -i optionally accepts an backup suffix as argument; Perl will write backup copies of edited files to names with that suffix added.

<code>
perl -i.bak -ne 'print unless /^#/' script.sh
</code>
Would strip all whole-line commands from script.sh, but leave a copy of the original in script.sh.bak.

  * Trick #4: The .. operator
Perl's .. operator is a stateful operator -- it remembers state between evaluations. As long as its left operand is false, it returns false; Once the left hand returns true, it starts evaluating the right-hand operand until that becomes true, at which point, on the next iteration it resets to false and starts testing the other operand again.

What does that mean in practice? It's a range operator: It can be easily used to act on a range of lines in a file. For instance, I can extract all GPG public keys from a file using:

<code>
perl -ne 'print if /-----BEGIN PGP PUBLIC KEY BLOCK-----/../-----END PGP PUBLIC KEY BLOCK-----/' FILE
</code>
  * Trick #5: -a
-a turns on autosplit mode – perl will automatically split input lines on whitespace into the @F array. If you ever run into any advice that accidentally escaped from 1980 telling you to use awk because it automatically splits lines into fields, this is how you use perl to do the same thing without learning another, even worse, language.

As an example, you could print a list of files along with their link counts using

<code>
ls -l | perl -lane 'print "$F[7] $F[1]"'
</code>
 

  * Trick #6: -F
-F is used in conjunction with -a, to choose the delimiter on which to split lines. To print every user in /etc/passwd (which is colon-separated with the user in the first column), we could do:

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

  * Trick #7: \K
\K is undoubtedly my favorite little-known-feature of Perl regular expressions.  If \K appears in a regex, it causes the regex matcher to drop everything before that point from the internal record of "Which string did this regex match?".\\
This is most useful in conjunction with <nowiki>'s///'</nowiki>, where it gives you a simple way to match a long expression, but only replace a suffix of it.

Suppose I want to replace the From: field in an email. We could write something like

<code>
perl -lape 's/(^From:).*/$1 Nelson Elhage <nelhage\@ksplice.com>/'
</code>
But having to parenthesize the right bit and include the $1 is annoying and error-prone. We can simplify the regex by using \K to tell perl we won't want to replace the start of the match:

<code>
perl -lape 's/^From:\K.*/ Nelson Elhage <nelhage\@ksplice.com>/'
</code>
  * Trick #8: $ENV{}
When you're writing a one-liner using -e in the shell, you generally want to quote it with ', so that dollar signs inside the one-liner aren't expanded by the shell. But that makes it annoying to use a ' inside your one-liner, since you can't escape a single quote inside of single quotes, in the shell.

Let's suppose we wanted to print the username of anyone in /etc/passwd whose name included an apostrophe. One option would be to use a standard shell-quoting trick to include the ':

<code>
perl -F: -lane 'print $F[0] if $F[4] =~ /'"'"'/' /etc/passwd
</code>
But counting apostrophes and backslashes gets old fast. A better option, in my opinion, is to use the environment to pass the regex into perl, which lets you dodge a layer of parsing entirely:

<code>
env re="'" perl -F: -lane 'print $F[0] if $F[4] =~ /$ENV{re}/' /etc/passwd
</code>
We use the env command to place the regex in a variable called re, which we can then refer to from the perl script through the %ENV hash. This way is slightly longer, but I find the savings in counting backslashes or quotes to be worth it, especially if you need to end up embedding strings with more than a single metacharacter.

  * Trick #9: BEGIN and END
BEGIN { ... } and END { ... } let you put code that gets run entirely before or after the loop over the lines.

For example, I could sum the values in the second column of a CSV file using:

<code>
perl -F, -lane '$t += $F[1]; END { print $t }'
</code>
  * Trick #10: -MRegexp::Common
Using -M on the command line tells perl to load the given module before running your code. There are thousands of modules available on CPAN, numerous of them potentially useful in one-liners, but one of my favorite for one-liner use is Regexp::Common, which, as its name suggests, contains regular expressions to match numerous commonly-used pieces of data.

The full set of regexes available in Regexp::Common is available in its documentation, but here's an example of where I might use it:

Neither the ifconfig nor the ip tool that is supposed to replace it provide, as far as I know, an easy way of extracting information for use by scripts. The ifdata program provides such an interface, but isn't installed everywhere. Using perl and Regexp::Common, however, we can do a pretty decent job of extracing an IP from ips output:

<code>
ip address list eth0 | \nperl -MRegexp::Common -lne 'print $1 if /($RE{net}{IPv4})/'
</code>

==== Perl oneliners from catonmat.net ====
Reference: [[https://catonmat.net/ftp/perl1line.txt]]
<code>
Useful One-Line Scripts for Perl                    Jan 27 2019 | version 1.12
--------------------------------                    -----------   ------------

Compiled by Peter Krumins (peter@catonmat.net, @pkrumins on twitter)
https://www.catonmat.net -- good coders code, great coders reuse

Latest version of this file is always at:

    https://catonmat.net/ftp/perl1line.txt

This file is also available in other languages:

    Chinese: https://github.com/vinian/perl1line.txt

    Please email me peter@catonmat.net if you want to translate it.

Perl One-Liners on Github:
 
    https://github.com/pkrumins/perl1line.txt

    You can send me pull requests over GitHub! I accept bug fixes,
    new one-liners, translations and everything else related.

I have also written "Perl One-Liners Explained" ebook that's based on
this file. It explains all the one-liners here. Get it at:

    https://catonmat.net/perl-book

No Starch Press has published "Perl One-Liners" as a real book too:

    https://nostarch.com/perloneliners

These one-liners work both on UNIX systems and Windows. Most likely your
UNIX system already has Perl. For Windows get the Strawberry Perl at:

    http://www.strawberryperl.com

Table of contents:

    1. File Spacing
    2. Line Numbering
    3. Calculations
    4. String Creation and Array Creation
    5. Text Conversion and Substitution
    6. Selective Printing and Deleting of Certain Lines    
    7. Handy Regular Expressions
    8. Perl tricks


FILE SPACING 
------------

# Double space a file
perl -pe '$\="\n"'
perl -pe 'BEGIN { $\="\n" }'
perl -pe '$_ .= "\n"'
perl -pe 's/$/\n/'
perl -nE 'say'

# Double space a file, except the blank lines
perl -pe '$_ .= "\n" unless /^$/'
perl -pe '$_ .= "\n" if /\S/'

# Triple space a file
perl -pe '$\="\n\n"'
perl -pe '$_.="\n\n"'

# N-space a file
perl -pe '$_.="\n"x7'

# Add a blank line before every line
perl -pe 's//\n/'

# Remove all blank lines
perl -ne 'print unless /^$/'
perl -lne 'print if length'
perl -ne 'print if /\S/'

# Remove all consecutive blank lines, leaving just one
perl -00 -pe ''
perl -00pe0

# Compress/expand all blank lines into N consecutive ones
perl -00 -pe '$_.="\n"x4'

# Fold a file so that every set of 10 lines becomes one tab-separated line
perl -lpe '$\ = $. % 10 ? "\t" : "\n"'


LINE NUMBERING
--------------

# Number all lines in a file
perl -pe '$_ = "$. $_"'

# Number only non-empty lines in a file
perl -pe '$_ = ++$a." $_" if /./'

# Number and print only non-empty lines in a file (drop empty lines)
perl -ne 'print ++$a." $_" if /./'

# Number all lines but print line numbers only non-empty lines
perl -pe '$_ = "$. $_" if /./'

# Number only lines that match a pattern, print others unmodified
perl -pe '$_ = ++$a." $_" if /regex/'

# Number and print only lines that match a pattern
perl -ne 'print ++$a." $_" if /regex/'

# Number all lines, but print line numbers only for lines that match a pattern
perl -pe '$_ = "$. $_" if /regex/'

# Number all lines in a file using a custom format (emulate cat -n)
perl -ne 'printf "%-5d %s", $., $_'

# Print the total number of lines in a file (emulate wc -l)
perl -lne 'END { print $. }'
perl -le 'print $n=()=<>'
perl -le 'print scalar(()=<>)'
perl -le 'print scalar(@foo=<>)'
perl -ne '}{print $.'
perl -nE '}{say $.'

# Print the number of non-empty lines in a file
perl -le 'print scalar(grep{/./}<>)'
perl -le 'print ~~grep{/./}<>'
perl -le 'print~~grep/./,<>'
perl -E 'say~~grep/./,<>'

# Print the number of empty lines in a file
perl -lne '$a++ if /^$/; END {print $a+0}'
perl -le 'print scalar(grep{/^$/}<>)'
perl -le 'print ~~grep{/^$/}<>'
perl -E 'say~~grep{/^$/}<>'

# Print the number of lines in a file that match a pattern (emulate grep -c)
perl -lne '$a++ if /regex/; END {print $a+0}'
perl -nE '$a++ if /regex/; END {say $a+0}'


CALCULATIONS
------------

# Check if a number is a prime
perl -lne '(1x$_) !~ /^1?$|^(11+?)\1+$/ && print "$_ is prime"'

# Print the sum of all the fields on a line
perl -MList::Util=sum -alne 'print sum @F'

# Print the sum of all the fields on all lines
perl -MList::Util=sum -alne 'push @S,@F; END { print sum @S }'
perl -MList::Util=sum -alne '$s += sum @F; END { print $s }'

# Shuffle all fields on a line
perl -MList::Util=shuffle -alne 'print "@{[shuffle @F]}"'
perl -MList::Util=shuffle -alne 'print join " ", shuffle @F'

# Find the minimum element on a line
perl -MList::Util=min -alne 'print min @F'

# Find the minimum element over all the lines
perl -MList::Util=min -alne '@M = (@M, @F); END { print min @M }'
perl -MList::Util=min -alne '$min = min @F; $rmin = $min unless defined $rmin && $min > $rmin; END { print $rmin }'

# Find the maximum element on a line
perl -MList::Util=max -alne 'print max @F'

# Find the maximum element over all the lines
perl -MList::Util=max -alne '@M = (@M, @F); END { print max @M }'

# Replace each field with its absolute value
perl -alne 'print "@{[map { abs } @F]}"'

# Find the total number of fields (words) on each line
perl -alne 'print scalar @F'

# Print the total number of fields (words) on each line followed by the line
perl -alne 'print scalar @F, " $_"'

# Find the total number of fields (words) on all lines
perl -alne '$t += @F; END { print $t}'

# Print the total number of fields that match a pattern
perl -alne 'map { /regex/ && $t++ } @F; END { print $t }'
perl -alne '$t += /regex/ for @F; END { print $t }'
perl -alne '$t += grep /regex/, @F; END { print $t }'

# Print the total number of lines that match a pattern
perl -lne '/regex/ && $t++; END { print $t }'

# Print the number PI to n decimal places
perl -Mbignum=bpi -le 'print bpi(n)'

# Print the number PI to 39 decimal places
perl -Mbignum=PI -le 'print PI'

# Print the number E to n decimal places
perl -Mbignum=bexp -le 'print bexp(1,n+1)'

# Print the number E to 39 decimal places
perl -Mbignum=e -le 'print e'

# Print UNIX time (seconds since Jan 1, 1970, 00:00:00 UTC)
perl -le 'print time'

# Print GMT (Greenwich Mean Time) and local computer time
perl -le 'print scalar gmtime'
perl -le 'print scalar localtime'

# Print local computer time in H:M:S format
perl -le 'print join ":", (localtime)[2,1,0]'

# Print yesterday's date
perl -MPOSIX -le '@now = localtime; $now[3] -= 1; print scalar localtime mktime @now'

# Print date 14 months, 9 days and 7 seconds ago
perl -MPOSIX -le '@now = localtime; $now[0] -= 7; $now[4] -= 14; $now[7] -= 9; print scalar localtime mktime @now'

# Prepend timestamps to stdout (GMT, localtime)
tail -f logfile | perl -ne 'print scalar gmtime," ",$_'
tail -f logfile | perl -ne 'print scalar localtime," ",$_'

# Calculate factorial of 5
perl -MMath::BigInt -le 'print Math::BigInt->new(5)->bfac()'
perl -le '$f = 1; $f *= $_ for 1..5; print $f'

# Calculate greatest common divisor (GCM)
perl -MMath::BigInt=bgcd -le 'print bgcd(@list_of_numbers)'

# Calculate GCM of numbers 20 and 35 using Euclid's algorithm
perl -le '$n = 20; $m = 35; ($m,$n) = ($n,$m%$n) while $n; print $m'

# Calculate least common multiple (LCM) of numbers 35, 20 and 8
perl -MMath::BigInt=blcm -le 'print blcm(35,20,8)'

# Calculate LCM of 20 and 35 using Euclid's formula: n*m/gcd(n,m)
perl -le '$a = $n = 20; $b = $m = 35; ($m,$n) = ($n,$m%$n) while $n; print $a*$b/$m'

# Generate 10 random numbers between 5 and 15 (excluding 15)
perl -le '$n=10; $min=5; $max=15; $, = " "; print map { int(rand($max-$min))+$min } 1..$n'

# Find and print all permutations of a list
perl -MAlgorithm::Permute -le '$l = [1,2,3,4,5]; $p = Algorithm::Permute->new($l); print @r while @r = $p->next'

# Generate the power set
perl -MList::PowerSet=powerset -le '@l = (1,2,3,4,5); for (@{powerset(@l)}) { print "@$_" }'

# Convert an IP address to unsigned integer
perl -le '$i=3; $u += ($_<<8*$i--) for "127.0.0.1" =~ /(\d+)/g; print $u'
perl -le '$ip="127.0.0.1"; $ip =~ s/(\d+)\.?/sprintf("%02x", $1)/ge; print hex($ip)'
perl -le 'print unpack("N", 127.0.0.1)'
perl -MSocket -le 'print unpack("N", inet_aton("127.0.0.1"))'

# Convert an unsigned integer to an IP address
perl -MSocket -le 'print inet_ntoa(pack("N", 2130706433))'
perl -le '$ip = 2130706433; print join ".", map { (($ip>>8*($_))&0xFF) } reverse 0..3'
perl -le '$ip = 2130706433; $, = "."; print map { (($ip>>8*($_))&0xFF) } reverse 0..3'


STRING CREATION AND ARRAY CREATION
----------------------------------

# Generate and print the alphabet
perl -le 'print a..z'
perl -le 'print ("a".."z")'
perl -le '$, = ","; print ("a".."z")'
perl -le 'print join ",", ("a".."z")'

# Generate and print all the strings from "a" to "zz"
perl -le 'print ("a".."zz")'
perl -le 'print "aa".."zz"'

# Create a hex lookup table
@hex = (0..9, "a".."f")

# Convert a decimal number to hex using @hex lookup table
perl -le '$num = 255; @hex = (0..9, "a".."f"); while ($num) { $s = $hex[($num%16)&15].$s; $num = int $num/16 } print $s'
perl -le '$hex = sprintf("%x", 255); print $hex'
perl -le '$num = "ff"; print hex $num'

# Generate a random 8 character password
perl -le 'print map { ("a".."z")[rand 26] } 1..8'
perl -le 'print map { ("a".."z", 0..9)[rand 36] } 1..8'

# Create a string of specific length
perl -le 'print "a"x50'

# Create a repeated list of elements
perl -le '@list = (1,2)x20; print "@list"'

# Create an array from a string
@months = split ' ', "Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec"
@months = qw/Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec/

# Create a string from an array
@stuff = ("hello", 0..9, "world"); $string = join '-', @stuff

# Find the numeric values for characters in the string
perl -le 'print join ", ", map { ord } split //, "hello world"'

# Convert a list of numeric ASCII values into a string
perl -le '@ascii = (99, 111, 100, 105, 110, 103); print pack("C*", @ascii)'
perl -le '@ascii = (99, 111, 100, 105, 110, 103); print map { chr } @ascii'

# Generate an array with odd numbers from 1 to 100
perl -le '@odd = grep {$_ % 2 == 1} 1..100; print "@odd"'
perl -le '@odd = grep { $_ & 1 } 1..100; print "@odd"'

# Generate an array with even numbers from 1 to 100
perl -le '@even = grep {$_ % 2 == 0} 1..100; print "@even"'

# Find the length of the string
perl -le 'print length "one-liners are great"'

# Find the number of elements in an array
perl -le '@array = ("a".."z"); print scalar @array'
perl -le '@array = ("a".."z"); print $#array + 1'


TEXT CONVERSION AND SUBSTITUTION
--------------------------------

# ROT13 a string
'y/A-Za-z/N-ZA-Mn-za-m/'

# ROT 13 a file
perl -lpe 'y/A-Za-z/N-ZA-Mn-za-m/' file

# Base64 encode a string
perl -MMIME::Base64 -e 'print encode_base64("string")'
perl -MMIME::Base64 -0777 -ne 'print encode_base64($_)' file

# Base64 decode a string
perl -MMIME::Base64 -le 'print decode_base64("base64string")'
perl -MMIME::Base64 -ne 'print decode_base64($_)' file

# URL-escape a string
perl -MURI::Escape -le 'print uri_escape($string)'

# URL-unescape a string
perl -MURI::Escape -le 'print uri_unescape($string)'

# HTML-encode a string
perl -MHTML::Entities -le 'print encode_entities($string)'

# HTML-decode a string
perl -MHTML::Entities -le 'print decode_entities($string)'

# Convert all text to uppercase
perl -nle 'print uc'
perl -ple '$_=uc'
perl -nle 'print "\U$_"'

# Convert all text to lowercase
perl -nle 'print lc'
perl -ple '$_=lc'
perl -nle 'print "\L$_"'

# Uppercase only the first word of each line
perl -nle 'print ucfirst lc'
perl -nle 'print "\u\L$_"'

# Invert the letter case
perl -ple 'y/A-Za-z/a-zA-Z/'

# Camel case each line
perl -ple 's/(\w+)/\u$1/g'
perl -ple 's/(?<![\'])(\w+)/\u\1/g'

# Strip leading whitespace (spaces, tabs) from the beginning of each line
perl -ple 's/^[ \t]+//'
perl -ple 's/^\s+//'

# Strip trailing whitespace (space, tabs) from the end of each line
perl -ple 's/[ \t]+$//'

# Strip whitespace from the beginning and end of each line
perl -ple 's/^[ \t]+|[ \t]+$//g'

# Convert UNIX newlines to DOS/Windows newlines
perl -pe 's|\n|\r\n|'

# Convert DOS/Windows newlines to UNIX newlines
perl -pe 's|\r\n|\n|'

# Convert UNIX newlines to Mac newlines
perl -pe 's|\n|\r|'

# Substitute (find and replace) "foo" with "bar" on each line
perl -pe 's/foo/bar/'

# Substitute (find and replace) all "foo"s with "bar" on each line
perl -pe 's/foo/bar/g'

# Substitute (find and replace) "foo" with "bar" on lines that match "baz"
perl -pe '/baz/ && s/foo/bar/'

# Binary patch a file (find and replace a given array of bytes as hex numbers)
perl -pi -e 's/\x89\xD8\x48\x8B/\x90\x90\x48\x8B/g' file


SELECTIVE PRINTING AND DELETING OF CERTAIN LINES
------------------------------------------------

# Print the first line of a file (emulate head -1)
perl -ne 'print; exit'

# Print the first 10 lines of a file (emulate head -10)
perl -ne 'print if $. <= 10'
perl -ne '$. <= 10 && print'
perl -ne 'print if 1..10'

# Print the last line of a file (emulate tail -1)
perl -ne '$last = $_; END { print $last }'
perl -ne 'print if eof'

# Print the last 10 lines of a file (emulate tail -10)
perl -ne 'push @a, $_; @a = @a[@a-10..$#a]; END { print @a }'

# Print only lines that match a regular expression
perl -ne '/regex/ && print'

# Print only lines that do not match a regular expression
perl -ne '!/regex/ && print'

# Print the line before a line that matches a regular expression
perl -ne '/regex/ && $last && print $last; $last = $_'

# Print the line after a line that matches a regular expression
perl -ne 'if ($p) { print; $p = 0 } $p++ if /regex/'

# Print lines that match regex AAA and regex BBB in any order
perl -ne '/AAA/ && /BBB/ && print'

# Print lines that don't match match regexes AAA and BBB
perl -ne '!/AAA/ && !/BBB/ && print'

# Print lines that match regex AAA followed by regex BBB followed by CCC
perl -ne '/AAA.*BBB.*CCC/ && print'

# Print lines that are 80 chars or longer
perl -ne 'print if length >= 80'

# Print lines that are less than 80 chars in length
perl -ne 'print if length < 80'

# Print only line 13
perl -ne '$. == 13 && print && exit'

# Print all lines except line 27
perl -ne '$. != 27 && print'
perl -ne 'print if $. != 27'

# Print only lines 13, 19 and 67
perl -ne 'print if $. == 13 || $. == 19 || $. == 67'
perl -ne 'print if int($.) ~~ (13, 19, 67)' 

# Print all lines between two regexes (including lines that match regex)
perl -ne 'print if /regex1/../regex2/'

# Print all lines from line 17 to line 30
perl -ne 'print if $. >= 17 && $. <= 30'
perl -ne 'print if int($.) ~~ (17..30)'
perl -ne 'print if grep { $_ == $. } 17..30'

# Print the longest line
perl -ne '$l = $_ if length($_) > length($l); END { print $l }'

# Print the shortest line
perl -ne '$s = $_ if $. == 1; $s = $_ if length($_) < length($s); END { print $s }'

# Print all lines that contain a number
perl -ne 'print if /\d/'

# Find all lines that contain only a number
perl -ne 'print if /^\d+$/'

# Print all lines that contain only characters
perl -ne 'print if /^[[:alpha:]]+$/'

# Print every second line
perl -ne 'print if $. % 2'

# Print every second line, starting the second line
perl -ne 'print if $. % 2 == 0'

# Print all lines that repeat
perl -ne 'print if ++$a{$_} == 2'

# Print all unique lines
perl -ne 'print unless $a{$_}++'

# Print the first field (word) of every line (emulate cut -f 1 -d ' ')
perl -alne 'print $F[0]'


HANDY REGULAR EXPRESSIONS
-------------------------

# Match something that looks like an IP address
/^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}$/
/^(\d{1,3}\.){3}\d{1,3}$/

# Test if a number is in range 0-255
/^([0-9]|[0-9][0-9]|1[0-9][0-9]|2[0-4][0-9]|25[0-5])$/

# Match an IP address
my $ip_part = qr|([0-9]|[0-9][0-9]|1[0-9][0-9]|2[0-4][0-9]|25[0-5])|;
if ($ip =~ /^($ip_part\.){3}$ip_part$/) {
 say "valid ip";
}

# Check if the string looks like an email address
/\S+@\S+\.\S+/

# Check if the string is a decimal number
/^\d+$/
/^[+-]?\d+$/
/^[+-]?\d+\.?\d*$/

# Check if the string is a hexadecimal number
/^0x[0-9a-f]+$/i

# Check if the string is an octal number
/^0[0-7]+$/

# Check if the string is binary
/^[01]+$/

# Check if a word appears twice in the string
/(word).*\1/

# Increase all numbers by one in the string
$str =~ s/(\d+)/$1+1/ge

# Extract HTTP User-Agent string from the HTTP headers
/^User-Agent: (.+)$/

# Match printable ASCII characters
/[ -~]/

# Match unprintable ASCII characters
/[^ -~]/

# Match text between two HTML tags
m|<strong>([^<]*)</strong>|
m|<strong>(.*?)</strong>|

# Replace all <b> tags with <strong>
$html =~ s|<(/)?b>|<$1strong>|g

# Extract all matches from a regular expression
my @matches = $text =~ /regex/g;


PERL TRICKS
-----------

# Print the version of a Perl module
perl -MModule -le 'print $Module::VERSION'
perl -MLWP::UserAgent -le 'print $LWP::UserAgent::VERSION'


PERL ONE-LINERS EXPLAINED E-BOOK
--------------------------------

I have written an ebook based on the one-liners in this file. If you want to
support my work and learn more about these one-liners, you can get a copy
of my ebook at:

    https://catonmat.net/perl-book

The ebook is based on the 7-part article series that I wrote on my blog.
In the ebook I reviewed all the one-liners, improved explanations, added
new ones, and added two new chapters - introduction to Perl one-liners
and summary of commonly used special variables.

You can read the original article series here:

    https://catonmat.net/perl-one-liners-explained-part-one
    https://catonmat.net/perl-one-liners-explained-part-two
    https://catonmat.net/perl-one-liners-explained-part-three
    https://catonmat.net/perl-one-liners-explained-part-four
    https://catonmat.net/perl-one-liners-explained-part-five
    https://catonmat.net/perl-one-liners-explained-part-six
    https://catonmat.net/perl-one-liners-explained-part-seven


CREDITS
-------

Andy Lester       http://www.petdance.com
Shlomi Fish       http://www.shlomifish.org
Madars Virza      http://www.madars.org
caffecaldo        https://github.com/caffecaldo
Kirk Kimmel       https://github.com/kimmel
avar              https://github.com/avar
rent0n


FOUND A BUG? HAVE ANOTHER ONE-LINER?
------------------------------------

Email bugs and new one-liners to me at peter@catonmat.net.


HAVE FUN
--------

I hope you found these one-liners useful. Have fun and see ya!

#---end of file---
</code>

==== 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.
<code>
  -  - 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'`
</code>

==== 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!
<code>
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
</code>

==== 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.
<code>
perl -F: -lane 'print $F[0]' /etc/passwd
</code>

==== 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.
<code>
perl -F, -lane '$sum += $F[1]; END { print $sum }' somefile.csv
</code>

==== .. operater ====
Cut chunks out of a file from /start range marker/ .. /end range marker/
<code>
perl -ne 'print if /-----BEGIN PGP PUBLIC KEY BLOCK-----/../-----END PGP PUBLIC KEY BLOCK-----/' file_containing_public_keys.txt
</code>

==== A one-liner web server! ====
<code>
perl -MIO::All -e 'io(":8080")->fork->accept->(sub { $_[0] < io(-x $1 ? "./$1 |" : $1) if /^GET \/(.*) / })'
</code>
  *  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: [[http://www.commandlinefu.com/commands/view/5235/perl-simple-webserver|commandlinefu.com]]

==== Print out all the environment variables on a Perl web server ====
This can be used as a test status page to see if the cgi-bin directory is working properly. And that Perl is processing the files correctly.
<code>
#!perl

print "Content-type: text/html\n\n";
print "<font size=+1>Environment</font>\n";

foreach (sort keys %ENV) {
   print "<b>$_</b>: $ENV{$_}<br>\n";
}

1;
</code>
or
<code>
#!perl

use HTML::Perlinfo;
use CGI qw(header);

$q = new CGI;
print $q->header;

print "<html><head><title>Perl Info</title></head>";
print "<body><p><a href='http://localhost/ampps'>Back to AMPPS Home</a></p><center><h2>Perl Info</h2></center>";
print "</body></html>";

$p = new HTML::Perlinfo;
$p->info_general;
$p->info_variables;
$p->info_modules;
$p->info_license;
</code>

==== Retrieve a file from an authenticated website using Perl ====
This site ([[https://jmorano.moretrix.com/2011/02/retrieve-a-file-from-an-authenticated-website-in-perl/]]) shows how to do it using LWP. Replicating it here in case the original goes down.

Call your modules
<code>
#!/usr/bin/perl
use strict; use warnings;

use LWP;
use HTTP::Cookies;
use HTTP::Request;
use File::Path qw{mkpath};
</code>
The modules HTTP::Cookies and HTTP::Request are required to create the cookie jar file and to make a HTTP request (duh!). These two modules will create the objects that are required for the LWP user-agent object we are about to create.

Check your temporary path:
<code>
my $HOME = $ENV{HOME} . '/tmp';
mkpath $HOME   unless -d $HOME;
</code>
We will need this location to save our cookie jar file and the file we want to download

Create a cookie jar and a LWP user-agent:
<code>
# create a cookie jar on disk
my $cookies = HTTP::Cookies->new(
        file     => $HOME.'/cookies.txt',
        autosave => 1,
        );

# create an user-agent and assign the cookie jar to it
my $http = LWP::UserAgent->new();
$http->cookie_jar($cookies);
</code>
No rocket science here, just create the objects!

Send the authentication request:
<code>
# try to log in
my $login = $http->post(
        'https://www.example.com/auth/login.pl', [
            username => 'user',
            password => 'secret', ]
        );
</code>
Once authenticated, the web site will create a cookie containing a session ID. This cookie will allow us to download the file we need from the secured part of the web site.
From this point on, it is required to check whether the log in succeeded and then continue with downloading the file. If the log in failed, an error message should be displayed with the reason on the failure.

<code>
# check if log in succeeded
if($login->is_success){
    print "- logged in successfully\n";
    print "- requesting file, might take a while\n";

    # make request to download the file
    my $url       = 'https://www.example.com/auth/files/backup.zip';
    my $file_req  = HTTP::Request->new('GET', $url);
    my $get_file  = $http->request( $file_req );

    # check request status
    if($get_file->is_success){
        print "--> downloaded $url, saving it to file\n";

        # save the file content to disk
        open my $fh, '>', $HOME.'/backup.zip' 
                                         or die "ERROR: $!\n";
        print $fh $get_file->decoded_content;
        close $fh;

        print "\nsaved file:\n";
        print "-------------\n";
        print "filename:  ".$get_file->filename."\n";
        print "size:      ".(-s $HOME.'/backup.zip')."\n";
    }
    else {
        die "ERROR: download of $url failed: " . $get_file->status_line . "\n";
    }
}
else {
    die "ERROR: login failed: " . $login->status_line . "\n";
}
</code>


==== What Perl modules are installed? ====
As found by typing "perldoc q installed"
<code>
#!/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;
</code>
==== 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.
<code>
perl -p -i -e 'print "This is line 1 now!\n" if $. == 1' file.txt
</code>

==== Implement a socket client/server in Perl ====
[[http://www.thegeekstuff.com/2010/07/perl-tcp-udp-socket-programming/|thegeekstuff.com]]

==== Scan for emails with attachments and save attachments to files ====
  *  [[https://www.example-code.com/perl/imap_downloadAttachment.asp|Chillkat - Imap save mail attachments]]
==== Install a Perl module from CPAN ====
<code>
perl -MCPAN -e 'install RRD::Simple'
</code>

==== Print out the first and last words of all lines in a file ====
<code>
perl -ae 'print "$F[0]:$F[-1]\n"'
</code>
==== Mass update of files using perl inline script ====
<code>
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
</code>

==== Perl emulation of dos2unix command ====
<code>
perl -p -i -e 's/\r\n/\n/' filename
</code>
and then back again with unix2dos
<code>
perl -p -i -e 's/[!\r]\n/\r\n/' filename
</code>

==== Print a file except / excluding certain lines ====
<code>
perl -ne 'next if (/pattern_for_removal/); print;' filename
</code>

==== Difference between double dot and triple dot operator ====
They can both work as flip-flop operators. The double dot will check the second pattern if it is on the same line as the first. For the triple dot to work, the end pattern must be on a different line from the begin pattern.\\
Explained better [[https://perlhacks.com/2014/01/dots-perl/|here]]

==== Exclude the first few lines of a file ====
<code>
perl -ne 'print unless 1 .. 10' filename
</code>
==== Print lines between 2 markers in a file ====
<code>
perl -ne 'print if /START/ .. /STOP/' filename
</code>
==== Print only the lines in a file between 2 search patterns (exclusive of the markers) ====
<code>
perl -ne 'print if /pattern1/ ... /pattern2/ and !/pattern1/ and !/pattern2/' filename
</code>
==== Print lines not between 2 markers in a file! ====
<code>
perl -ne 'print unless /START/ .. /STOP/' filename
</code>
==== Delete the last line of a file ====
<code>
perl -e '@x=<>; pop(@x); print @x'
</code>
==== Print a few lines in a file ====
<code>
perl -ne 'print if 15 .. 17'
</code>
but more efficiently...
<code>
perl -ne 'print if $. >= 15; exit if $. >= 17;'
</code>
==== Print lines of a file in reverse order ====
<code>
perl -e 'print reverse <>' filename
</code>
==== Print characters in lines of a file in reverse order ====
<code>
perl -nle 'print scalar reverse $_' filename
</code>
==== Find palindromes in a file ====
<code>
perl -lne '$_ = lc; print if $_ eq reverse' filename
</code>
==== Reverse all the characters in a file ====
<code>
perl -0777e 'print scalar reverse <>' filename
</code>
==== Reverse all the characters in a paragraph but keeping the paragraphs in order ====
<code>
perl -00 -e 'print reverse <>' filename
</code>
==== Trim all heading and trailing spaces and compress any intermediate spaces to 1 ====
<code>
perl -pe '$_ = " $_ "; tr/ \t/ /s; $_ = substr($_,1,-1)'
</code>
==== Nice one to reformat a document so that all lines are between 50 and 70 characters long. Only breaks on whitespace ====
<code>
perl -000 -p -e 'tr/ \t\nr/ /;s/(.{50,72})\s/$1\n/g;$_.="\n"x2'
</code>

==== Assign modified text in a variable keeping th original as it was ====
I aways forget the syntax for this so hopefully I will find this next time I need it!
<code>
($result = $subject) =~ s/before/after/g;
</code>

==== Print balancing quotes ====
<code>
perl -ne '$q=($_=~tr/"//); print"$.\t$q\t$_";' filename
</code>
==== Capitalise all words in a file (ensuring all others letters in the words are lower case) ====
ref: [[http://user.it.uu.se/~matkin/programming/PERL/|Matz Kindahl]]
<code>
perl -pe 's/\w.+/\u\L$&/'
</code>
==== Translate into Zafir language! ====
<code>
perl -pe 's#\w+#ucfirst lc reverse $&#eg' filename
</code>

==== 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.
<code>
# ====================
# 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;
</code>

==== Send an email from perl without needing any external modules ====
but it only works on Unix
<code>
  # 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);
}
</code>
Using the function is straightforward. Simply pass it the data in the correct order.
<code>
sendemail ( "toemail\@mydomain.com", "fromemail\@mydomain.com", "Simple email.", "This is a test of the email function." );
</code>
==== What "day of the year" (DOY) number was it yesterday? ====
<code>
YESTERDAY=`perl -e 'print sub{$_[7]}->(localtime);'`
</code>
==== What "day of the year" (DOY) number is it today? ====
<code>
TODAY=`perl -e 'print sub{$_[7]}->(localtime)+1;';`
</code>

==== Sort a list ====
  *  [[http://www.perlfect.com/articles/sorting.shtml|www.perlfect.com]]
  *  [[http://perlmaven.com/how-to-sort-faster-in-perl|perlmaven.com]]
  *  [[http://perlmaven.com/recursive-subroutines|perlmaven article on recursion]]
Numerically
<code>
@sorted = sort { $a <=> $b } @unsorted
</code>
Alphabetically
<code>
@sorted = sort { $a cmp $b } @unsorted
</code>
Alphabetically (case-insensitive)
<code>
@sorted = sort { lc($a) cmp lc($b) } @unsorted
</code>
Schwartzian transform
<code>
    my @quickly_sorted_files =
    map { $_->[0] }
    sort { $a->[1] <=> $b->[1] }
    map { [$_, -s $_] }
    @files;
</code>
broken down into (semi)understandable pieces looks like this...
<code>
    my @unsorted_pairs = map { [$_, -s $_] } @files;
    my @sorted_pairs = sort { $a->[1] <=> $b->[1] } @unsorted_pairs;
    my @quickly_sorted_files = map { $_->[0] } @sorted_pairs;
</code>

==== 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.
<code>
my @langs = qw(perl php python);
my @langs = map { uc($_) } @langs;
Result: PERL PHP PYTHON
</code>
Use it with join to create clever stuff...
<code>
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
</code>

==== Difference in hours between two dates ====
<code>
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");
</code>
or, without using any external modules...
<code>

        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);
</code>

==== Slurp an external file into a variable ====
The idea is to read an SQL file into a variable to prepare and execute it<code>
#!/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";
</code>

==== 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 [[http://stackoverflow.com/questions/13946302/find-all-the-occurrence-of-string-in-a-file-and-print-its-line-number-in-perl|Stackoverflow.com]]
<code>
#!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";
    }
}
</code>
basically it builds up a regular expression and searches for it. \\
See reference link for more details.\<br />
Can also be done very neatly with grep in shell
<code>
grep -n -f keywords.txt filewithlotsalines.txt
</code>
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:
<code>
Can't declare scalar assignment in "my" at filename line 9, near ") =~"
</code>

<code>
($new_var = $old_var) =~ s/find_this/change_it_to_this/;
</code>
or is this what you wanted :-)
<code>
my $sgasizes="1223,456,23234,-343,3457,82222";
my $currsga;
($currsga) = $sgasizes =~ m/-(\d+)?/p;
print "SGA:$currsga";

SGA:343
</code>
==== Match a regular expression across multiple lines ====
  *  [[http://www.regexplanet.com/advanced/perl/index.html|Try and work out the regex online]]\\
I always forget this regex and it's sooo useful!
<code>
perl -00 -ne 'print "$1 - $2\n"  if /^"(\w+?)"\).*?RMAN_RECOVERY_WINDOW=(\d+)?/s' backup.ini
</code>
where backup.ini looks like this:
<code>
"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
;;
</code>

==== Using /s and /m modifiers in a regular expression ====
Tom Christiansen in his [[https://en.wikipedia.org/wiki/Perl_Cookbook|Perl Cookbook]] demonstrates the difference between these 2 confusing modifiers
<code>
$/ = //;            # 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";
    }
}
</code>

==== Match regular expression and assign to a variable in a single step ====
<code>
$started = $1 if $stmt =~ /Export started at (\d+)/;
</code>
or split directory and filenames (on Windows or Unix)
<code>
($dirname,$filename) = $fullname =~ m|^(.*[/\])([^/\]+?)$|;
</code>
or split a line into bits and assign the bits to variables
<code>
my ($host,$sid,$dbid,$timethen,$timesuccess,$recid,$stamp,$started,$ended,$size,$status,$type) = split (/\|/);
</code>

==== Perl ternary operator ====
Putting examples here as I keep forgetting the syntax/semantics!
Theoretically it should be:
<code>
condition ? evaluate_if_condition_was_true : evaluate_if_condition_was_false
</code>
which to me means:
<code>
($type == 'ARCHIVELOG') ? $age_alert = $arc_alert : $age_alert = $job_alert;
</code>
but it's not like that, it's like this:
<code>
$age_alert = ($type == 'ARCHIVELOG') ?  $arc_alert : $job_alert;
</code>
and this
<code>
print "<td class=\"left\">"; print $created ne // ? scalar(gmtime($created)) : "&nbsp"; print "</td>";
</code>

==== 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'
<code>
/^(?:[^,]+,){9}([^,]+),(?:[^,]+,)*detail$/
</code>
or
<code>
$input =~ /detail$/ && my @fields = split(/,/, $input);
</code>
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!
<code>
  - !/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__
</code>