how-can-i-create-xml-from-perl

Reference: http://stackoverflow.com/questions/154762/how-can-i-create-xml-from-perl 

use strict;
use warnings;
use XML::LibXML;

my $doc = XML::LibXML::Document->new('1.0', 'utf-8');

my $root = $doc->createElement("my-root-element");
$root->setAttribute('some-attr'=> 'some-value');

my %tags = (
    color => 'blue',
    metal => 'steel',
);

for my $name (keys %tags) {
    my $tag = $doc->createElement($name);
    my $value = $tags{$name};
    $tag->appendTextNode($value);
    $root->appendChild($tag);
}

$doc->setDocumentElement($root);
print $doc->toString();

output:

<?xml version="1.0" encoding="utf-8"?>
<my-root-element some-attr="some-value">
    <color>blue</color>
    <metal>steel</metal>

</my-root-element>

how-do-you-round-a-floating-point-number-in-perl

    use POSIX;
    $ceil   = ceil(3.5);                        # 4
    $floor  = floor(3.5);                     # 3

Reference: http://stackoverflow.com/questions/178539/how-do-you-round-a-  floating-point-number-in-perl 

Print total count of files recursively in a directory

#!/usr/bin/perl

use strict;
use warnings;
use Cwd;
use File::Find;

my $dir = getcwd ; # Get the current working directory
my $filename = $ARGV[0];
my $counter = 0;
my $file_counter = 0;
find(\&wanted, $dir);
print "Found $counter files at and below $dir\n";

sub wanted {
    -f && $counter++; # Only count files
    }

creating a log file

code snippet to create a module to open a log file for your perl script:

use Fcntl ':flock';
my $openlog = 0;
my $openlog_name="";

sub open_log
{
 my $logfilename = $_[0];
 $openlog = sysopen (LOGFILE, $logfilename, Fcntl::O_WRONLY|Fcntl::O_APPEND|Fcntl::O_CREAT, 0755);
 select(LOGFILE); $| = 1; # make the output unbuffered.  See the discussion of fork in the perlfunc man page.
 select(STDOUT);
 $openlog_name = $logfilename;
 return $openlog;
}

sub log_message {
   my($arg) = @_;
   my $t = localtime;
   # If the log file was successfully opened then log
   if ($openlog) {
       print LOGFILE "$$:${t}: $arg\n";
   } else {
       print "$$:${t}: $arg\n";
   }
}

close(LOGFILE);

date to epoch stamp conversion

I have a requirement to see the utc timestamps(GMT) of a given date (YYYYMMDD) or a date range (YYYYMMDD-YYYYMMDD) format.This is how i have done it.

#!usr/bin/perl
use strict;use Time::Local;
my $usage = "------------Usage----------- \n $0 YYYYMMDD-YYYYMMDD time range to convert to epochtime)";
my $NOARGS=66;
my ($year,$mon,$day);
my @range = split(/-/,$ARGV[0]);

if( @ARGV != 1 )
{    print "$usage :
        ./epoch.pl 20091021
    1256083200
    or
    ./epoch.pl 20091015-20091022
   1255564800
   1255651200
   1255737600
   1255824000
   1255910400
   1255996800
   1256083200
   1256169600\n",sprintf("%s\n",'---------------------------') and exit $NOARGS;
}

#print "@range\n" ;
if( scalar(@range) == 2 )
{
  foreach my $date ($range[0]..$range[1]) # expand range sequencially
  {           
   ($year,$mon,$day) = $date =~ /^(\d{4})(\d{2})(\d{2})$/ ;  #collecting year,month,day into list   
    my $epoch = timegm(0,0,0,$day,$mon-1,$year-1900); #timegm function to return epochtime from the default variable list
    print "$epoch\n"; 
  }
}
else
{
   ($year,$mon,$day) = $range[0] =~ /^(\d{4})(\d{2})(\d{2})$/ ;   
   my $epoch = timegm(0,0,0,$day,$mon-1,$year-1900);    
   print "$epoch\n";
}

Sample output :

./epoch.pl 20091110
1257811200

remove duplicate words from a line

Perl's robust way of doing the same thing with much simplicity than awk to understand, which we did using awk some time back that removes the duplicate words of every line on per line basis.But,the same word can occur for once in every line.

input : cat a.txt

i am fine sriram
krishna how r u , how r u sriram , How r u jadu
thank you , Thankyou sir, thank you
how r u krishna ? how r u sriram?

required output:

i am fine sriram
krishna how r u , sriram How jadu
thank you , Thankyou sir,
how r u krishna ? sriram?


Script usage: ./merge.pl -file=a.txt

#!/usr/bin/perl -ws
#objective of this script is to remove duplicate words that occur in every line of a file on per line basis, same words can occur for once in every line

our ($file); # switch variable to take file name from command line
my @words; # array of words
my %seen=(); # initalizing a hash

if( !defined $file )
{
      print "Usage: $0 -file=<filename>\n";
      exit 255;

}

unless(open(FH1,"$file")) # check the file , if it doesnot exist throw error
{
      print "couldnot open file: $!\n";
}


if ( -r "$file" )  #if file is readable

{

      while (< FH1 >)
      {
              chomp;
              my @words = split();

              foreach (@words)
              {
                      unless( $seen{$_} ) # every word if it's not seen then increment it in hash value and assign it as hash key
                      {

                              $seen{$_}++ ;
                              push @nodup, $_; # push all words to an  array , $_ is default variable that holds anything
                      }

              }
              push @nodup,"\n"; # after a line,put "\n" at the end before going to next line
              %seen = (); # reinitialize hash before going to next line and traversing every word
      }


}


close(FH1); # close the file at the end
print "@nodup\n"; # print the modifed text at the end

Hash of Functions

Hats off!! to larry wall.. a code snippet from his book for me to recall his creative brilliance.

When writing a complex application or network service in Perl, you might want to make a large number of commands available to your users. Such a program might have code like this to examine the user's selection and take appropriate action:

 if    ($cmd =~ /^exit$/i)     { exit }
 elsif ($cmd =~ /^help$/i)     { show_help() }
 elsif ($cmd =~ /^watch$/i)    { $watch = 1 }
 elsif ($cmd =~ /^mail$/i)     { mail_msg($msg) }
 elsif ($cmd =~ /^edit$/i)     { $edited++; editmsg($msg); }
 elsif ($cmd =~ /^delete$/i)   { confirm_kill() }
 else {
   warn "Unknown command: `$cmd'; Try `help' next time\n";
 }

You can also store references to functions in your data structures, just as you can store references to arrays or hashes:

 %HoF = (                           # Compose a hash of functions
   exit    =>  sub { exit },
   help    =>  \&show_help,
   watch   =>  sub { $watch = 1 },
   mail    =>  sub { mail_msg($msg) },
   edit    =>  sub { $edited++; editmsg($msg); },
   delete  =>  \&confirm_kill,
 );

 if   ($HoF{lc $cmd}) { $HoF{lc $cmd}->() }   # Call function
 else { warn "Unknown command: `$cmd'; Try `help' next time\n" }

In the second to last line, we check whether the specified command name (in lowercase) exists in our "dispatch table", %HoF. If so, we invoke the appropriate command by dereferencing the hash value as a function and pass that function an empty argument list. We could also have dereferenced it as &{ $HoF{lc $cmd} }(), or simply $HoF{lc $cmd}().

For more complex datastructures and references refer to :

http://docstore.mik.ua/orelly/perl/prog3/ch09_06.htm

Perl Hash of Hashes demo

I want to extract users and their uid,gid and home dir and print each of them corresponding to user from /etc/passwd file. This is how we can do:

#!/usr/bin/perl

  sub func
  {
      my ( $login, $p, $uid, $gid, $gecos, $dir, $s );
      my %HoH = ();
      my $file = '/etc/passwd';
      open( PASSWD, "< $file" ) or die "Can't open $file : $!";
      while( <PASSWD> )
      {
          ( $login, $p, $uid, $gid, $gecos, $dir, $s ) = split( ':' );
#writing a hash of hash using reference
          $HoH{$login} =  {
                           'uid' => $uid,
                           'gid' => $gid,
                           'dir' => $dir,
                          };
      }
      close PASSWD;
      return \%HoH;

  }
  my $hash_ref = &func;

# Print Outer hash keys and take values(Inner hash)

  while( my ($k, $v) = each %$hash_ref )
  {
      print "login: $k ";

# Print Inner hash keys and values

       while ( my ($key,$val) = each %$v )
      {
          print "$key:$val ";
      }
          print "\n";
  }


O/p:

login: sriram uid:101 dir:/home/sriram gid:102
login: jadu uid:9 dir:/home/jadu gid:9
login: kiran uid:100 dir:/home/krian gid:101
login: vikas uid:109 dir:/home/vikas gid:65534

run only one instance of perl script

This is one out of many ways of allowing only one instance or perl script to run using cron..

# Needed for "Only allow one process of this script" rule
use Fcntl ':flock';
# Only allow one process of this script
INIT {

# Lock current script's disk file so that it can only be accessed by the current running script instance.
# When the script exits or dies, the lock is released.
open LH, $0
or die "Can't open $0 for locking!\nError: $!\n";

# LOCK_EX means exclusive lock, LOCK_NB means non-blocking
flock LH, LOCK_EX | LOCK_NB
or die "$0 is already running somewhere!\n";
}

Perl one liner to remove new line char,leading space and trailing space

perl -e
'while (<>)   {
      foreach ($_)    {
                 chomp;
                 s/^\s+//;
          s/\s+$//;
          next unless length ;
          print $_."\n"
             }
}' sample > sample.nospace

count no.of words and each word's occurrence in file(s)

If I want to extract a word that i want and see how many times it occurred out of those number of files,here is one way of doing it in perl .
cat word.pl

#!/usr/bin/perl

     my %count = ();
      while (<>) {
              @words = split(' ');
              my %count = ();
              foreach $word (@words) {
                      $count{$word}++ if($word =~ /sachin/);
              }
      }
      foreach $word (sort keys %count) {
              print "$word : occured $count{$word} number of times\n";
      }

Note: <> - the daimond operator reads all the command line arguments (file by file) and split each line into words seperated by space.I have taken a hash to collect the words as my keys and it's num.of occurrence as value and incremented only if it matches word "sachin"

execute : perl word.pl cricketers.dat
output : sachin : occured 10 number of times

clean up files older than a week

#!/usr/bin/perl
use strict;

my $TODAY = time;
my $BACKUP_DIR = "/home/sriram/backup";
my $LOGFILE = "$ENV{HOME}/logs/cleanup.log";
my $wktime = 604800; #(ie 86400*7)

sub remove_old_files

{

open (LOGFILE, ">$LOGFILE");
opendir(DIR, $BACKUP_DIR) or die "could not open directory: $!";

while (my $file = readdir DIR){
next if -d "$DIR/$file";
my $mtime = (stat "$DIR/$file")[9];
 if ($TODAY - $wktime > $mtime){

       print LOGFILE "$DIR/$file is older than 7 days...removing\n";
       unlink $file;
 }
}
}

close LOGFILE;
close DIR;

sub main()
{
remove_old_files();
}

main();

Counting totalwords,validwords, each word count in a file?

#!/usr/bin/perl

while (<>) {

foreach (split) {
$total++;
next if /\W/;
$valid++;
$count{$_}++;

}

}

print "total words= $total, validwords = $valid \n";
foreach $word (sort keys %count) {

print "$word was seen $count{$word} times.\n";

}

Note : We can pass any number of files to this program, as $lt;> - the diamond operator takes all the command line arguments (file names) specified.