A Perl script template
May 25, 2013 Leave a comment
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.