Difference between revisions of "Perl"

Revision as of 22:43, 29 March 2014

Some one liners: socher.org

A one-line 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;

Install a Perl module from CPAN

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

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

# ====================
# bring in config file
# ====================
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." );

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

#!/usr/bin/perl -w
use strict;
my $stmt;
my $quoted_stmt;
$quoted_stmt = 7;
open (FH,"<","test.sql") or die $!;
local $/='';
$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.

Assign and substitute a value to a variable in one statement

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 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 (/\|/);