Perl one-liners

From AJS.COM

Jump to: navigation, search

This is my collection of useful Perl one-liners, simple Perl programs, typically most useful from the command-line. If you have one that you'd like to share, please feel free to contribute (you'll need an account).

Contents

First things first

Here are some of the more useful command-line flags:

-l
Include a trailing newline when printing, and chop them off of input.
-n
Wrap the entire program (or one liner) in a loop that reads input using <> and assigns each input line to $_
-p
The same as -n, but includes an extra print at the end of the implicit loop, so that the current contents of $_ will be printed.
-a
"AWK mode." Used in conjunction with -n or -p, splits each input line into fields (on whitespace by default) and stores them into the array @F.
-F
Given a pattern, that pattern is used to separate fields for -a.

To put all of this together, here's a one-liner that reads the password file of a Unix or Linux system (colon separated fields) and writes out just the usernames (first field): 

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

That's all there is to it. -n does most of the heavy lifting in terms of looping and IO, and then -a manages the population of the @F array with the fields of the input file. Notice that either listing input files on the command line or reading them as standard input will work. This is because the implicit loop created by -n uses <> which performs the check to see if there are command-line input files and defaults to reading from standard input (STDIN).

Text

Grepping

A simple grep-alike: 

perl -nle 'print if /pattern/' file(s)

Same as above, but print the filename too: 

perl -nle 'print "$ARGV:$_" if /pattern/' file(s)

Same as above, but print only the text that matched: 

perl -nle 'print $1 if /(pattern)/' file(s)

The trade-off in using perl to do grep's job is that perl is more cumbersome because it's a general-purpose language, but the advantage is just the same. For example, you might do this with grep: 

grep 'pattern' file(s) | sort -u | wc -l

In perl, we don't need the extra commands: 

perl -nle '$x{$1}++ if /(pattern)/;END{print scalar keys %x}' file(s)

Even here, the perl takes a bit more space, but as complexity grows, perl begins to be much simpler. However, even in the above example, it should be noted that perl is doing less work than the grep/sort/wc pipeline because it doesn't need to sort in order to find unique values.

Processes

Sometimes I need to look for a process in the output of ps, but I don't want to just "grep" for the process, I want to see all of its children. Here's a handy way to do that under Linux, and related techniques will work on most other systems, I imagine: 

ps axf | perl -nle '$c=!/:\d+  /?/pattern/:$c and print'

Replace pattern with a pattern that matches the lead process. I often use /crond/ to search for all cron jobs currently running.

HTML

Find URLs in HREFs: 

perl -nle 'print $1 while /\<a\b[^\>"]*?\bhref=\"?([^\>"]*)/g' file(s)

This technique of matching \<tag\b[^>"]* and related variants is very powerful. For example, here's a way to strip most HTML markup from the input: 

perl -ple 's/\<\/?(\w+|\!)[^>]*\>//g'

Anagrams

Just change wordlist to the filename of a wordlist and phrase to some phrase (in quotes) that you want to find anagrams for: 

perl -le '
   chomp(@words = sort {length($b) <=> length($a)}
       grep {/^[a-z\-]{2,}\s*$/} `cat wordlist`);
   push @words, "a", "i";$source=shift @ARGV;
   $let{lc $1}++ while $source =~ /([a-z])/ig;
   @owords{map {lc $_} ($source=~/\b([a-z]+)\b/ig)}=();
   $p=join "", map {"$_*"} sort keys %let;@words = grep {!exists $owords{$_}}
       grep {join("",sort split //, $_) =~ /^$p$/} @words;
   sub next_word {
       my $wi=shift;my $l = shift @_;
       W:for(my $i=$wi;$i<@words;$i++){
           my $word=$words[$i];my %t = %$l;
           foreach my $ll (grep {/[a-z]/} split //, $word) { next W if --$t{$ll} < 0 }
           if (grep {$_ > 0} values %t){next_word($i,\%t,@_,$word)}
           else{print join ", ", @_, $word}}};next_word(0,\%let)' "phrase"

For a more optimized and full-featured anagram generator, see anagrammer and its default wordlist.

Files

Finding and acting on files

This file removal one-liner is widely used, and I have no idea if I was the first one to think of it (use with caution!): 

find directory -name 'fileglob' -print | perl -nle unlink

The reason this very cool command works is that the "-n" flag tells perl to loop over every line of input, executing your "script" once for every line, setting $_ to the line of input. The "-l" argument causes newlines to be chopped off, so just the filename from find is in $_. The "unlink" defaults to operating on $_ and deletes the file it was given as a parameter. So, all together, this just loops over its input, deleting every file that is found under the given directory (do this to / at your own peril!) 

find directory -name 'fileglob' -exec rm -f {} \;

is similar to the above, but creates a new process for every file, which can be much slower on large directories. 

find directory -name 'fileglob' -print | xargs rm -f

also works well only on small directories, but since it constructs a single command-line, it will fail for large directories. Some implementations of xargs have workarounds for this, but such fixes are not portable.

And of course, using Perl as a filter means that you have ultimate control, and a full, general-purpose programming langauge available to decide how and when to deal with the files found by find. Here's another example that moves all object files to a sub-directory based on their name: 

find directory -name '*_*.o' -print | \
  perl -nle '($subdir=$_)=~s/_\w+\.o// and rename($_,"$subdir/$_")'

File monitoring

Here is a fun one that requires the optional Number::Format module. I use this when I am downloading files using a file sharing (see Peer-to-peer) network. From a remote system, I can log in and watch the download progress in a text winodw. Asterisks are used for progress meters. Progress is measured as a ratio of the number of disk blocks allocated to the file vs. the file "size". 

while true; do
  clear
  perl -MNumber::Format=format_bytes -le '
    foreach my $f (sort @ARGV) {
      -f $f or next;
      ($s,$sz,$b)=(stat($f))[7,11,12];
      if(!$s) { warn "$f: empty file\n"; next }
      $b*=512; $p = $b/$s;
      printf "%-40s %-15s %s\n", substr($f,0,40),"*"x($p*15),
        format_bytes($b)
    }' *
  sleep 10
done

Network

Ever want to just put up a "server" that allows you to connect and send simple data (e.g. to test network connectivity)? Here's a one-liner: 

perl -MIO::Socket::INET -e '$s=IO::Socket::INET->new(LocalPort=>port,
                                                     Proto=>"tcp",
                                                     ReuseAddr=>1,
                                                     Listen=>5) or die "socket: $!";
                            while($in=$s->accept()){
                              $in->print("Hi\n");print while <$in>;undef $in
                            }'

External links

Insertformulahere

Retrieved from "http://www.ajs.com/ajswiki/Perl_one-liners"
Personal tools