http:// www.jms1.net / code / perl.shtml

Random Perl Code

This page contains pieces of Perl code which I find my self using over and over again. I'm putting them here so that I know where to find them; if you happen to find them useful, glad I could help.

Insert commas into a number

This is lifted, almost verbatim, from the Perl Cookbook first edition, recipe 2.17, page 64.

sub comma($) { my $x = reverse $_[0] ; $x =~ s/(\d\d\d)(?=\d)(?!\d*\.)/$1,/g ; return scalar reverse $x ; }

DNS lookups

Functions for doing DNS forward and reverse lookups

use Socket ; ######################################## # in: "www.jms1.net" # out: ( "208.111.3.163" ) sub dnsip($) { my @a = gethostbyname ( $_[0] ) or return undef ; # can't resolve name @a = map { inet_ntoa($_) } @a[ 4 .. $#a ] ; return wantarray ? @a : $a[0] ; } ######################################## # in: "208.111.3.163" # out: "phineas.jms1.net" sub dnsname($) { my $n = gethostbyaddr ( inet_aton ( $_[0] ) , AF_INET ) or return undef ; # can't resolve IP return $n ; }

More complicated functions, using Net::DNS

use Net::DNS ; sub dnstxt($) { my $name = shift ; my $res = new Net::DNS::Resolver() ; my $answer = $res->query ( $name , "TXT" ) ; my @a = $answer->answer() ; return undef unless ( $#a >= 0 ) ; my @rv = () ; for my $n ( 0 .. $#a ) { next unless ( $a[$n]->type() eq "TXT" ) ; $a[$n]->rdata() =~ /^(.)(.*)$/ ; my ( $xl , $xt ) = ( $1 , $2 ) ; push ( @rv , $xt ) ; } return wantarray ? @rv : $rv[0] ; }

Parse an array of tokens into a template

This is a function I use in a lot of the web applications I write. The idea is to read a disk file containing a template for a page, substitute specific data items into the text where tokens appear, and return a string containing the template with the data substituted in.

The tokens look like "${name}" within the template.

sub parse_string($;@) { my $string = shift ; my %rep = @_ ; my @d = localtime ; my $today = sprintf ( "%04d-%02d-%02d" , $d[5]+1900 , $d[4]+1 , $d[3] ) ; ######################################## # the application may have constant tokens which are always present # and therefore shouldn't need to be explicitly named whenever this # function is called. $rep{"today"} = $today ; $rep{"year"} = $d[5]+1900 ; $rep{"remote_ip"} = ( $ENV{"REMOTE_ADDR"} || "" ) ; ######################################## # here's where the magic happens $string =~ s/\$\{(.+?)\}/$rep{$1}/gms ; return $string ; } sub read_file($) { my $file = shift ; my $text = "" ; open ( I , "<$file" ) or die "Can\'t read $file: $!\n" ; while ( my $line = <I> ) { $text .= $line ; } close I ; return $text ; } sub parse_file($;@) { my $file = shift ; my $text = read_file ( $file ) ; return parse_string ( $text , @_ ) ; }