Difference between revisions of "Perl"

From dbawiki
Jump to: navigation, search
(→‎Difference in hours between two dates)
(→‎Use 'map' to apply transformations)
Line 95: Line 95:
 
Result: PERL PHP PYTHON
 
Result: PERL PHP PYTHON
 
</pre>
 
</pre>
 +
Use it with join to create clever stuff...
 +
<pre>
 +
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
 +
</pre>
 +
 
===Difference in hours between two dates===
 
===Difference in hours between two dates===
 
<pre>
 
<pre>

Revision as of 14:13, 11 August 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;

Implement a socket client/server in Perl

thegeekstuff.com

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." );

Sort a list

Numerical 

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

Alphabetic 

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

Alphabetic (case-insensitive) 

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

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 @lamps = qw(perl php python);
my @uclamps = map { uc($_) } @lamps;
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 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 (/\|/);

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=1475"