Vidul Nikolaev Petrov: Category Perl

Filtering Lists

root — Mon, 01 Dec 2008 01:33:00 -0700

Ruby

arr = (1..10).to_a
arr.select{ |e| e % 2 != 0 }

Python

arr = range(1,11)
[e for e in arr if e % 2]

Perl

@arr = (1..10);
grep($_ % 2, @arr);

Ultra Tiny Address Book

root — Wed, 29 Oct 2008 07:18:00 -0600

#!/usr/bin/perl

$s = shift;
$"  = "\n";
$/  = $\;
$_  = <DATA>;
@_ = /(.*?$s.*)/gi;

print "@_\n";

__DATA__

me "some address" my_phone_here
etc...
etc...

downloader

root — Mon, 09 Jun 2008 02:09:00 -0600

#!/usr/bin/perl

use strict;
use warnings;
use WWW::Mechanize;
use LWP::Simple;
use Data::Dumper;
use Time::HiRes qw( usleep tv_interval gettimeofday );
$|++;
my $url  = shift || die "no url given!\n";
my $ext  = shift || 'mp3'; #die "no file extention given!\n";
my $mech = WWW::Mechanize->new(agent=>"Mozilla/5.0");
my $ua   = LWP::UserAgent->new;
my %seen;

$mech->get($url);
$ua->timeout(5);

my $links = $mech->links;

no warnings;
my $c = 0;
for my $link ( @{$links} ) {
        my $url  = $link->url_abs;
        my $res  = $ua->head($url);
        my $http_res   = HTTP::Response->new($res);
        my $abs_name   = $http_res ->{'_rc'}->{'_previous'}->{'_headers'}->{'location'};
        my ($rel_name) = $abs_name =~ /.+\/(.+)$/;
        my $local_name = $rel_name;

        $seen{$local_name}++ and next;

        if( $rel_name =~ /\Q$ext\E$/i ){
                $rel_name =~ s/\%\d+/ /g;
                $rel_name =~ s/(.{35}).+/$1.../;
                print(pack('A45', "[$rel_name]"), "  is being downloaded ... ");
                my $s_time = q{};
                my $e_time = q{};
                my $flag = [];

                for( 1..5 ){
                        local $SIG{ALRM} = sub { die("timeout") };
                        eval {
                           alarm(10);
                           $flag = [head($abs_name)];
                           alarm(0);
                        };
                        next if $@ =~ m|timeout|;
                        last if $@ !~ m|timeout|;
                }

                if( $flag->[0] ){
                        $c++;
                        $s_time = [gettimeofday];
                        getstore($abs_name, $c."-".$local_name);
                        $e_time = tv_interval ($s_time, [gettimeofday]);
                }

                $e_time =  $e_time ? $e_time . " seconds" : 'less than 1 milisecond';
                print "timeout failure in $e_time seconds :(\n" and next if $@;
                print "done in $e_time\n";
        }
}

`ruby -e 'Dir["*"].each{|f| File.rename f, f.sub(/^\d+-/, "")}'`;
`ruby -e 'Dir["*"].each{|f| File.rename f, f.gsub(/%20/, "_")}'`;

How to find free domain name

root — Fri, 22 Feb 2008 14:23:00 -0700

#!/usr/bin/perl

use strict;
use warnings;

my $dom = shift || die "missing name\n";
my $res = qx{whois $dom};

die $1 . "for '$dom'\n" if $res =~ /(no\s+whois\s+server\s+)/i;
die "$dom is free\n"    if $res =~ /no\s+match|does\s+not\s+exist/i;
die "$dom is reserved\n";

__END__
_whois 123456.com
123456.com is reserved

_whois _123456_.com
_123456_.com is free

Scalar || List context

root — Tue, 12 Feb 2008 13:12:00 -0700

Perl

 $a  = ("a", "b", "c"); # $a is "c" - the last element
($a) = ("a", "b", "c"); # $a is "a" - the first element

Ruby

 obj        = ["a", "b", "c"] # obj is Array - ["a", "b", "c"]
 obj, b, c = ["a", "b", "c"] # obj is String - "a"

Perl script opening (vim variant)

root — Mon, 04 Feb 2008 14:57:00 -0700

#!/bin/bash

file=$1

if [ -e $file ]
then
        vim $file
else
        touch $file
        echo '#!/usr/bin/perl' > $file
        echo '' >> $file
        echo 'use strict;' >> $file
        echo 'use warnings;' >> $file
        echo 'use diagnostics;' >> $file
        echo '' >> $file
        chmod +x $file
        vim $file
fi

JAPH with AUTOLOAD

root — Sun, 03 Feb 2008 07:20:00 -0700


#!/usr/bin/perl

JAPH->Just->Another->Perl->Hacker;

package JAPH;

sub AUTOLOAD { bless [print+($AUTOLOAD=~/::(.+)/)[0], q/ /] } sub DESTROY {}

HTML To WIKI converter

root — Sat, 02 Feb 2008 05:59:00 -0700

Perl script (thanks to the author of HTML::WikiConverter):

#!/usr/bin/perl

use strict;
use warnings;
use HTML::WikiConverter;
use Perl6::Slurp;

my $file_name = shift;

-f $file_name or die "No file given!\n";

my $wiki = new HTML::WikiConverter(dialect=>'MediaWiki');

print $wiki->html2wiki(slurp $file_name);

__END__

  Supported dialects:  

  DokuWiki
  Kwiki
  MediaWiki
  MoinMoin
  Oddmuse
  PbWiki
  PhpWiki
  PmWiki
  SlipSlap
  TikiWiki
  UseMod
  WakkaWiki
  WikkaWiki

File Splitter

root — Fri, 18 Jan 2008 22:28:00 -0700

use strict;
use Getopt::Std;
use File::Basename;

getopts('scf:p:'); 

our($opt_s, $opt_c, $opt_f, $opt_p);

my $file = $opt_f;
my $size = $opt_p || 1;
my $len  = 1024;
my $c = 1;
my ($buf, $counter);

-f $file or usage();

if($opt_s){
    $size = 1024 * $size;

    open IN, "< $file" or die "cannot open_r $file $!";
    open OUT, "> $file.$c"  or die "cannot open_w $file $!";
    binmode IN;
    binmode OUT;

    while(read(IN, $buf, $len)){
        $counter++;
        if($counter > $size){
            $counter = 0;
            $c++;
            close OUT;
            open OUT, "> $file.$c"  or die "cannot open_w $file $!";
            binmode OUT;
        } 
        print OUT $buf
    }
} elsif($opt_c) {
    my @files = grep { -f and /^$file\.\d+$/ } glob '*';
    my $newfile = "splitter_$file";
    open OUT, ">> $newfile" or die "cannot open_w $file $!";
    binmode OUT;
    map { $_ =~ s/^$file\.// } @files;
    for(sort {$a<=>$b} @files ){
        open IN, "$file.$_" or die "cannot open_r $file $!";
        binmode IN;
        print OUT $_ while <IN>;
        close IN;
    }
} else {
    usage()
}

sub usage{
    my $pro = basename($0);
    print <<SQ;

$pro (-s|-c) -p piece size -f filename

    -s    split a file into pieces
    -c    collect a file from pieces
    -p     chunk size (defaults to 1MB)
    -f     file to be processed
SQ
    exit 1
}

Sort By Part Of Filename

root — Sat, 12 Jan 2008 01:57:00 -0700

Assume that we have directory, containing files like:

part_1.txt
part_2.txt
part_100.txt
part_200.txt

In case that we are interested in /(\d+)\.\w+$/ as part of the sorting criteria:

Perl

# short but unefficient
@a = sort {($a =~ /(\d+)\.\w+$/)[0] <=> ($b =~  /(\d+)\.\w+$/)[0]} <*>;

Ruby

regex = Regexp.new(/(\d+)\.\w+$/)

# enum.sort {| a, b | block } => array
Dir["*"].grep(regex).sort do |a, b|
  a.match(regex)[0].to_i <=> b.match(regex)[0].to_i
end

# enum.sort_by {| obj | block } => array
Dir["*"].grep(regex).sort_by do |name|
  name.match(regex)[1].to_i
end

Dynamically Define Methods

root — Fri, 11 Jan 2008 00:21:00 -0700

Perl

package MyClass;
package main;

*MyClass::from_my_class = sub { 
   print "defined in ", __PACKAGE__, "\n" 
};

MyClass::from_my_class();

Ruby

class String
  def self.from_string
    print "defined in " + self.name + $/
  end
end

String::from_string
String. from_string

perldoc usage

root — Wed, 09 Jan 2008 03:59:00 -0700

function manual:

perldoc -f grep

search the text in perlfaq:

perldoc -q grep

module content:

perldoc -m IO::Socket

module absolute filename:

perldoc -l IO::Socket

and of course:

perldoc perl

Just_Another_Perl_Hacker.pm

root — Tue, 08 Jan 2008 22:03:00 -0700

package Just_Another_Perl_Hacker; $$

perl -MJust_Another_Perl_Hacker -e 's|(?<=\w)_| |g && tr/:://d && print for keys %main::'

Getting ip addresses from log file

root — Tue, 08 Jan 2008 02:10:00 -0700

perl -ne ‘

$_{$1}=1 if /(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})/;eof&&{print join("\n", sort keys %_)}

‘ access.log

Fast ICMP scanner (Perl oneliner)

root — Tue, 08 Jan 2008 01:05:00 -0700

[localhost]$

time perl -MNet::Ping -e '$p = Net::Ping->new();
@hosts = qw(
127.0.0.1 
172.16.0.1 
172.16.0.2 
172.16.0.5 
172.16.0.254);
#the significant detail
$p->{"timeout"} = 0.005; 
for (@hosts) { print "$_ is ".($p->ping($_) ? "up" : "down").$/ }'

127.0.0.1 is up
172.16.0.1 is up
172.16.0.2 is down
172.16.0.5 is up
172.16.0.254 is down

real 0m0.062s
user 0m0.040s
sys 0m0.000s

nmap cleaner in Perl

root — Sat, 29 Dec 2007 08:26:00 -0700

$”=” @ARGV”;/^\D+/||print for`nmap$”`

List Values and Arrays

root — Fri, 30 Nov 2007 07:28:00 -0700

Perl

($a, $b) = (1, 2);
 @arr    = (1, 2);

Python

 a, b = 1, 2
 arr  = 1, 2;

Ruby

 a, b = 1, 2
 arr  = 1, 2
 arr  = 1,2, *[11,22] # the same as 
 arr  = [1,2, [11,22]].flatten

the ’*’ example was stolen from Ola Bini’s blog