A Perl script template

I wrote lots of Perl scripts recently. I feel it’s quit good to have a template. When I need to create a new one, I can start with the template, so I can focus on the real logical. Here is the template perl script:

#!/usr/bin/perl -w

format HEADER =
/ ------------------------------------------------------------------------------------------------------------------
| Purpose : update a file by querying DB
| 
|  Options:
|    -v    verbose mode
|    -d    debug mode
|    -t    test mode
|    -h    Give help screen
|  
|  Example:
|    update_vip_file.pl   --silent mode
\ ------------------------------------------------------------------------------------------------------
.

#
# History
# -------
# Alex Zeng      05/15/13  create it

use strict;
use DBI;
use Data::Dumper;
use Getopt::Long;

#DB inventory source
my $dbh = DBI->connect("DBI:mysql:host=alexzeng.wordpress.com;database=mydb","mydb","mydb",{ RaiseError => 1, AutoCommit => 1 });
my $target_file = "/repository/vips";
my $target_file_test = "/tmp/vips";

# configuration
my $home = "/export/home/oracle/admin/cron";
my $loc_file = "$home/log/update_vips_list.loc";
my $log_file = "$home/log/update_vips_list.log";

my ($list, @final_list);
my ($verbose, $debug_on, $istest);
my $finished = 'n';
my $mailwho = 'alexzeng\@wordpress.com';

# -------------------------------------------------------------------
# Main functions
# -------------------------------------------------------------------
&init;

&get_data;
&format_data;
&write_data;

$finished = 'y';
&quit(0);

# -------------------------------------------------------------------
# Sub functions
# -------------------------------------------------------------------
sub get_data {
# Get vip list from inventory 
  my $get_list_sql = qq{select vip, target_fqdn
                        from dblist_dbvip 
                        order by target_fqdn, vip
  };
  my $update_sql = qq{update dblist_dbvip
                         set vip=trim(vip)
                           , target_fqdn=trim(target_fqdn)
                     };
  $dbh->do($update_sql);

  &prtit("Get data start\n");
  $list = $dbh->selectall_arrayref($get_list_sql);
  &debug($list);
  &prtit("Get data done\n");
}

sub format_data {
# -------------------------------------------------------------------
# format vip list
# -------------------------------------------------------------------
  my $i = 0;
  &prtit("Format data start\n");

  foreach my $rowRef (@$list) {
    my ($vip, $target_fqdn)=@$rowRef; 
    
	&debug("$vip, $target_fqdn");
	$final_list[$i]->{vip} = $vip;
	$final_list[$i]->{target_fqdn} = $target_fqdn;
	$i++;  
  }
  &debug(\@final_list);
  &prtit("Format data done\n");
}

sub write_data {
# -------------------------------------------------------------------
# write data to the target file:
#@ VIP # HOST
# world.vip.wordpress.com#db01.wordpress.com
# -------------------------------------------------------------------
  my $target_file_tmp = "${target_file}.tmp";
  my $target_file_bak = "${target_file}.bak";
  
  my $fmstr = "%-50s #%-40s \n";
  &prtit("Write data start\n");
  open (TFT, ">$target_file_tmp") or die "Cannot open $target_file_tmp to write";
  print TFT "#This file is updated by cron job automatically\n";
  print TFT "#If you want to modify the data, please update it from mydb. Manually updates will be overwrote!\n";
  printf TFT $fmstr, "\@VIP", "HOST";
  #printf TFT "\n#\n";
  foreach my $row ( @final_list ){
    printf TFT $fmstr, $row->{vip}, $row->{target_fqdn};
  }
  close TFT;
  chmod 0444, $target_file_tmp or die "Can't chmod: $!";
  rename($target_file,$target_file_bak);
  rename($target_file_tmp,$target_file) or die "Can't rename: $!";
  &debug($target_file);
  &prtit("Write data done\n");
}

sub init {
  my ($opt_h, $rc);

  GetOptions ("h"  => \$opt_h,
			  "v"  => \$verbose,
              "d"  => \$debug_on,
              "t"  => \$istest
  );
  
  &do_help if  (defined $opt_h);
  if($istest) {
    $target_file = $target_file_test; 
  }

  $rc = &flock_lockfile($loc_file); 
  if ($rc) {
  # This means we couldn't get a lock on the file.  Lets do more checking and see whats going on...
    if ($verbose) {
      print ("\n")                  if ($verbose);
      print ("flock NOT obtained on $loc_file\n")   if ($verbose);
    }
    exit 100;
  }

  open (LOG,">$log_file") || die ("\n\nCan't open file to write : $log_file");
}

sub flock_lockfile {
  #--------------------------------------------------------------------------
  # Try to obtain a lock on a file name $file.  Returns non-zero return code
  # if file lock cannot be obtained.
  #--------------------------------------------------------------------------
  my ($lockfile) = @_;

  my $LOCK_EX = 2;

  open (LOC,">$lockfile") ||
    die ("\n\nCan't write to file: $lockfile\n");

  eval {
    local $SIG{ALRM} = sub { die "flock timeout" };
    alarm 5;
    flock(LOC, $LOCK_EX);
    alarm 0;
  };
  alarm 0;

  return ($@);
}

sub do_help {
  #--------------------------------------------------------------------------
  # Give help screen and exit
  #--------------------------------------------------------------------------
  $~ = "HEADER";
  write;
  exit;
}

sub debug {
  # -------------------------------------------------------------------
  # Print debug info to screen
  # -------------------------------------------------------------------
  my ($line) = @_;
  print Dumper($line) if($debug_on);
}

sub prtit {
  # -------------------------------------------------------------------
  # Print lines to screen and log
  # -------------------------------------------------------------------
  my ($line) = @_;

  my $date = localtime;
  my $str = "$date : $line";
  #my $str = "$line";

  print LOG $str;
  print     $str  if ( $verbose);
}

sub quit {
  # -------------------------------------------------------------------------
  # Clean up our mess.
  # -------------------------------------------------------------------------
  my ($retcode) = @_;
  
  $dbh->disconnect if defined($dbh);
  close LOG;
  if($finished eq 'n' && !$verbose) {
    `mailx -s "Cron job $0 failed" $mailwho < $log_file`;
  }
  exit($retcode);
}

As always, it’s not perfect, but a good start.