Perl

From dbawiki
Revision as of 10:54, 10 July 2017 by Stuart (talk | contribs) (→‎Perl emulation of dos2unix command)
Jump to: navigation, search

Some one liners: socher.org

Contents

Oneliners

Perl one-liners can be a great time/code saver. Here are a few I found useful.

Using %ENV to pass in parameters

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'`

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: -anle '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, -anle '$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;

Implement a socket client/server in Perl

thegeekstuff.com

Scan for emails with attachments and save attachments to files

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

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

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

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__
Retrieved from "https://mailnest.com/dbawiki/index.php?title=Perl&oldid=2790"