Perl scripts

From Wsms

Jump to: navigation, search

Contents

[edit]

ip-eth0.pl

The idomatic way to do this is to get the hostname and then use gethostbyname to get the IP address. See the Perl Cookbook http://wsms.wikiplanet.com/books/perl_cd/cook/ch17_09.htm#perlckbk2-CHP-17-ITERM-5633. That method probably won't work in our case because all the IP addresses are assigned by DHCP and the hostname is probably localhost.localdomain in every case. Another possiblity is to use getnet or a similar function documented int perldoc perlfunc. 

#!/usr/bin/env perl

# George G. Geller
# ip-eth0.pl
# December 22, 2006
# revised February 20, 2007

# Send the IP address of eth0 to stdout.

# For some other ways to do similar things, see:
# http://www.kernel-panic.org/pipermail/kplug-lpsg/2006-December/005720.html and links therin
# One-liner equivalents from John H. Robinson, IV:
# /sbin/ifconfig eth0| perl -ne 'm/inet addr:([^ ]*)/ && print "$1\n"'
# One-liners that use /sbin/ip:
# perl -e'print"$1\n"if`/sbin/ip addr show eth0`=~/inet ([\d.]*)/'
# perl -e'@a=("/sbin/ip",addr,show,eth0);print"$1\n"if`@a`=~/inet ([\d.]*)/'

use warnings;
use strict;

my $ifcfg = `/sbin/ifconfig eth0`;

# example:
# eth0      Link encap:Ethernet  HWaddr 00:14:2A:99:DF:2F
#           inet addr:192.168.2.12  Bcast:192.168.2.255  Mask:255.255.255.0
#           inet6 addr: fe80::214:2aff:fe99:df2f/64 Scope:Link
#           UP BROADCAST RUNNING MULTICAST  MTU:1500  Metric:1
#           RX packets:43306 errors:0 dropped:0 overruns:0 frame:0
#           TX packets:64326 errors:0 dropped:0 overruns:0 carrier:0
#           collisions:0 txqueuelen:1000
#           RX bytes:6378858 (6.0 MiB)  TX bytes:58482280 (55.7 MiB)
#           Interrupt:193 Base address:0xe000

if ( my ($ip) = $ifcfg =~ /inet addr:(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})/ ) {
    print "$ip\n";
  }
else {
    die "No match.\n";
}
[edit]

17.8 gethostbyname gethostbyaddr

This is the best I could do so far in following the Perl Cookbook recipe for getting your IP address using gethostbyname and get host by addr. 

#!/usr/bin/env perl
use warnings;
use strict;
use Sys::Hostname;

use vars qw /$kernel $hostname $release $version $hardware $address $a $b $c $d $ip/;

$hostname = hostname();
print "Line " . __LINE__ . ": hostname() gave = $hostname\n";

use POSIX qw(uname);
($kernel, $hostname, $release, $version, $hardware) = uname();
print "Line " . __LINE__ . ": uname() gave:\n";
print "    kernel   = $kernel\n";
print "    hostname = $hostname\n";
print "    release  = $release\n";
print "    version  = $version\n";
print "    hardware = $hardware\n";

# This doesn't work because gethostbyname uses DNS to lookup the IP address.
# Our workstations aren't in the DNS database.
use Socket;                         # for AF_INET
$address  = gethostbyname($hostname) or die "Couldn't resolve $hostname : $!";
$hostname = gethostbyaddr($address, AF_INET) or die "Couldn't re-resolve $hostname : $!";
($a,$b,$c,$d) = unpack('C4',$address);
$ip = sprintf("%d.%d.%d.%d", $a, $b, $c, $d);
print "Line " . __LINE__ . ": gethostbyname() gave: $ip\n";
print "Line " . __LINE__ . ": gethostbyaddr() gave: $hostname\n";

$address  = gethostbyname("sdlinuxguy.com") or die "Couldn't resolve sdlinuxguy.com : $!";
$hostname = gethostbyaddr($address, AF_INET) or die "Couldn't re-resolve $hostname : $!";
($a,$b,$c,$d) = unpack('C4',$address);
$ip = sprintf("%d.%d.%d.%d", $a, $b, $c, $d);
print "Line " . __LINE__ . ": gethostbyname() gave: $ip\n";
print "Line " . __LINE__ . ": gethostbyaddr() gave: $hostname\n";

Line 9: hostname() gave = ws05.rop.ncc.sdccd.net
Line 13: uname() gave:
    kernel   = Linux
    hostname = ws05.rop.ncc.sdccd.net
    release  = 2.6.18-1.2257.fc5
    version  = #1 Fri Dec 15 16:06:24 EST 2006
    hardware = i686
Line 27: gethostbyname() gave: 127.0.0.1
Line 28: gethostbyaddr() gave: localhost.localdomain
Line 34: gethostbyname() gave: 69.17.112.40
Line 35: gethostbyaddr() gave: sdlinuxguy.com
[edit]

One-liners that grab IP addresses 

$ perl -MSocket -le 'print inet_ntoa ${\gethostbyname $ARGV[0]}' www.google.com
$ host google.com | perl -nle '/(\d+\.\d+\.\d+\.\d+)/ && print $1'
[edit]

a.pl

Do silly things with networking using perl's Net::Domain module. 

#!/usr/bin/perl

use Net::Domain qw(hostname hostfqdn hostdomain);

print "a.pl \n";

my $host = hostfqdn();

print "host = $host\n";

use Sys::Hostname;
$host = hostname();

print "host = $host\n";

# should assert host here
use Socket;
my $address = inet_ntoa(scalar gethostbyname( $host || 'localhost' ));
my $address = inet_ntoa(scalar gethostbyname( $host || 'localhost' ));

print "address = $address\n";

print `/sbin/ifconfig`;
[edit]

dupes.pl

Preliminary version 

#!/usr/bin/env perl
# GGG George G. Geller
# 20070130 - January 30,2007
# arthur:/home/ggeller/pupget_packages-1/dupes.pl

# Spit out a list of file that maybe should be deleted.
# This directory contains new and older versions of files that look like:
# libzvt-2.0.1.tar.gz
# libzvt-2.3.0.tar.gz
# and so on, for over five-hundred files.

use warnings;
use strict;

# Get names of all the files using the glob thingie
my @tz_files = glob "*tar.gz";
print @tz_files;
[edit]

binary

A one-liner to convert binary to decimal. 

[ggeller@arthur binary]$ perl -e 'print oct(<>)."\n";'
0b0100000000000110010111111100101100100101111111001011001001100000
4613480194407969376

Another way: 

[ggeller@arthur binary]$ perl -p -e '$_ = oct($_)."\n"'
0b0100000000000110010111111100101100100101111111001011001001100000
4613480194407969376
[edit]

Use pack and unpack to convert binary to double

See perldoc perlpacktut and http://babbage.cs.qc.edu/IEEE-754/Decimal.html 

#!/usr/bin/env perl
$c = pack('B64', "0100000000000110010111111100101100100101111111001011001001100000");
($d) = unpack('d', $c);
print "Converted binary string: $d", "\n";
$c = pack('B64', "0000000000000000000000000000000000000000000000000000000000000000");
($d) = unpack('d', $c);
print "Converted binary string: $d", "\n";
$c = pack('B64', "1000000000000000000000000000000000000000000000000000000000000000");
($d) = unpack('d', $c);
print "Converted binary string: $d", "\n";
$c = pack('B64', "1111111111111111111111111111111111111111111111111111111111111110");
($d) = unpack('d', $c);
print "Converted binary string: $d", "\n";

This is the output: 

Converted binary string: 6.51639259938447e+157
Converted binary string: 0
Converted binary string: 6.32404026676796e-322
Converted binary string: -5.48612406879369e+303
[edit]

Count in binary

This is my version of Hello World: 

#!/usr/bin/env perl

for (0..2**16-1){
  $hi = reverse(unpack("b*", pack ("S", $_)));
  for (0..2**16-1){
    print $hi . reverse(unpack("b*", pack ("S", $_))) . "\n";
  }
}
print "Percenseo ergo sum.\n";

Output: 

00000000000000000000000000000000
00000000000000000000000000000001
00000000000000000000000000000010
00000000000000000000000000000011
00000000000000000000000000000100
00000000000000000000000000000101
00000000000000000000000000000110
00000000000000000000000000000111
00000000000000000000000000001000
00000000000000000000000000001001
...
11111111111111111111111111110111
11111111111111111111111111111000
11111111111111111111111111111001
11111111111111111111111111111010
11111111111111111111111111111011
11111111111111111111111111111100
11111111111111111111111111111101
11111111111111111111111111111110
11111111111111111111111111111111
Percenseo ergo sum.
[edit]

List installed perl modules 

#!/usr/bin/env perl
#see: perldoc -q installed

use ExtUtils::Installed;
my $inst    = ExtUtils::Installed->new();
my @modules = $inst->modules();
print ">>The short list:\n";
print join "\n", @modules;
print "\n";

print "\n";
use File::Find::Rule;
my @files = File::Find::Rule->file()->name( '*.pm' )->in( @INC );
print ">>The long list:\n";
print join "\n", @files;
print "\n";
[edit]

perl one-liner to simplify ls -lR listings

When you do ls -lR, you probably get some stuff you don't want, especially if you are working on a FAT or ntfs volume. So filter the results like this: 

[ggeller@arthur ~]$ ls -lR
.:
total 1272
drwx------ 2 ggeller ggeller   4096 Jun  4 09:41 amsn_received
drwxrwxr-x 2 ggeller ggeller   4096 May  9 18:05 cpan.org
-rw-r--r-- 1 ggeller ggeller    668 May 14 09:20 default.id_dsa.key
drwxrwxr-x 8 ggeller ggeller  28672 Jun 26 13:45 Desktop
drwxr-xr-x 2 ggeller ggeller   4096 Dec 24  2006 downloads
-rw-r--r-- 1 ggeller ggeller   1738 Nov 21  2006 ggeller-key.asc
-rw-rw-r-- 1 ggeller ggeller  24651 Jun 20 11:55 history.out
-rw-r--r-- 1 ggeller ggeller    862 Jan 28 15:46 hosts
...

[ggeller@arthur ~]$ ls -lR | perl -n -e 's/^(.).*\w*\d\w* ggeller ggeller(.*)/$1$2/; print' | head
.:
total 1272
d   4096 Jun  4 09:41 amsn_received
d   4096 May  9 18:05 cpan.org
-    668 May 14 09:20 default.id_dsa.key
d  28672 Jun 26 13:45 Desktop
d   4096 Dec 24  2006 downloads
-   1738 Nov 21  2006 ggeller-key.asc
-  24651 Jun 20 11:55 history.out
-    862 Jan 28 15:46 hosts
...
[edit]

perl one-liner to simplify output from find

When you do find, you probably don't want to see the leading ./ everywhere. So filter the results like this: 

ggeller@roosevelt:/media/sda1/Documents and Settings/NetworkService$ find . -name "*"
.
./.test
./Application Data
./Application Data/Microsoft
...

ggeller@roosevelt:/media/sda1/Documents and Settings/NetworkService$ find . -name "*" | perl -n -e 's/^\.\/// ; print;'
.
.test
Application Data
Application Data/Microsoft
...
[edit]

see also

Perl
Perl/LWP

Retrieved from "http://wsms.wikiplanet.com/mediawiki/index.php/Perl_scripts"
Personal tools