#!/usr/bin/perl use warnings; use strict; use IO::File; use POSIX qw(strftime); for my $file (@ARGV) { my $fh = IO::File->new($file,'r'); my $fh_new = IO::File->new($file.".new",'w'); local $/; my $fh_contents = <$fh>; # rip out old serial my ($old_serial) = $fh_contents =~ /IN\s+SOA\s+\S+\s+\S+\s*(?:\s*\;.+\n)*\((?:\s*\;.+\n)*\s*(\d+)/; my ($ymd,$iter) = $old_serial =~ /(\d{4}\d{2}\d{2})(\d{2})/; my $new_serial = strftime("%Y%m%d",gmtime)."01" if ($ymd == strftime("%Y%m%d",gmtime)) { $new_serial = $ymd.($iter+1); } $fh_contents =~ s/(IN\s+SOA\s+\S+\s+\S+\s*(?:\s*\;.+\n)*\((?:\s*\;.+\n)*\s*)(\d+)/${1}${new_serial}/; print {$fh_new} $fh_contents; close $fh_new; close $fh; rename($file,"${file}.bak") or die "Unable to rename $file to ${file}.bak: $!"; rename("${file}.new",$file) or die "Unable to rename ${file}.new to ${file}: $!"; unlink("${file}.bak") or die "Unable to unlink ${file}.bak: $!"; }