#!/usr/bin/perl

use strict;

use File::Copy;
use File::Find;
use Fcntl qw(:DEFAULT :flock);
use Getopt::Long;
use Symbol;
use Time::Local;

use NOCpulse::Notif::NotificationIni;
use NOCpulse::Notif::NotificationDB;
use NOCpulse::Notif::NotifIniInterface;

use NOCpulse::Log::Logger;

use Data::Dumper;

my $bailout;
$SIG{'INT'} = $SIG{'TERM'} = sub { $bailout = 1; };
$| = 1;

# Constants for time conversion
my $SECS  = 1;
my $MINS  = 60 * $SECS;
my $HOURS = 60 * $MINS;
my $DAYS  = 24 * $HOURS;
my $WEEKS = 7 * $DAYS;
my %WDAY = (
            0 => 'Sunday',
            1 => 'Monday',
            2 => 'Tuesday',
            3 => 'Wednesday',
            4 => 'Thursday',
            5 => 'Friday',
            6 => 'Saturday'
           );

use constant DAILY   => 6;
use constant WEEKLY  => 3;
use constant MONTHLY => 2;

my %FREQ = (
            6 => 'daily',
            3 => 'weekly',
            2 => 'monthly'
           );

my $TODAY    = time();
my $TOMORROW = $TODAY + $DAYS;

# NPalert environment
my $cfg = new NOCpulse::Config;

# File locations
my $LOGDIR  = $cfg->get('notification', 'log_dir');
my $PRODCFG = $cfg->get('notification', 'config_dir');
my $CONFIGBASE = "$PRODCFG";
my $CONFIG     = "$CONFIGBASE/generated";
my $STAGEBASE  = "$CONFIGBASE/stage";
my $STAGEDIR   = "$STAGEBASE/config";
my $STAGE      = "$STAGEDIR/generated";
my $STAGECFG   = "$STAGEBASE/etc";
my $ARCHIVE    = "$CONFIGBASE/archive";
my $FLAGFILE   = "$STAGE/FLAGS.gdbm";
my $LOCKFILE   = "$CONFIGBASE/static/.lock";
my $LOCKFH     = qualify_to_ref(gensym, 'main');

## initialize global variables
use constant SLEEP_INTERVAL => 60;    # How long to sleep between database polls

my $last_generate_date = 0;  # Date of last change to any important config table
my $last_redirect_date = 0;  # Date of last change to redirects tables only
my $generate           = 0;  # Generate the entire config
my $redir              = 0;  # Generate the redirects only
my %FILES;                   # List of files being generated

my $log_level = 3;
my $Log = NOCpulse::Log::Logger->new(__PACKAGE__, $log_level, 0);
my $stream = NOCpulse::Log::LogManager->instance->stream(
                                          FILE => "$LOGDIR/generate_config.log",
                                          LEVEL      => 4,
                                          APPEND     => 1,
                                          TIMESTAMPS => 1
);
$stream->autoflush(1);


my $ifc = new NOCpulse::Notif::NotificationIni(key_field => 'RECID');

my $ndb = new NOCpulse::Notif::NotificationDB;

my $arrayref;

#############
# Algorithm #
#############

# 1) Check for database connectivity and if anything in the database has been updated, if so, continue, else sleep and try again.
#
# 2) Prepare staging area
#        - delete old $STAGECFG dir
#        - create new $STAGECFG dir (lndir to $PRODCFG)
#        - delete old $STAGE if it exists
#
# 3) Generate new config in staging area ($STAGE)
#        Failure => notify NOC
#
# 4) Compile
#        Failure => move bad config to bad archive, notify NOC
#        Success =>
#          - move old config to good archive
#          - move new config to production config dir ($CONFIGBASE)
#          - init
#                Failure => notify NOC
#
# 5) Install the new config
#
# 6) Sleep a bit

# Now, let's get something done!

while (1) {

  # Exit gracefully, if requested
  if ($bailout) {
    exit(0);
  }

  # Verify/renew database connectivity

  # Check if a new config needs to be generated
  ($generate, $redir) = &check_for_updates();

  unless ($generate or $redir) {
    $Log->log(3, "no config change...\n");
    next;
  }

  # Select the files to update
  if ($redir) {
    $Log->log(1, "Redirect config only!!\n");

    # Only generate the config files pertaining to redirects
    %FILES = (
              redirects         => "$STAGE/redirects.ini",
              redirect_criteria => "$STAGE/redirect_criteria.ini",
             );
  } else {
    %FILES = (
              message_formats   => "$STAGE/message_formats.ini",
              contacts          => "$STAGE/contacts.ini",
              contact_methods   => "$STAGE/contact_methods.ini",
              contact_groups    => "$STAGE/contact_groups.ini",
              redirects         => "$STAGE/redirects.ini",
              redirect_criteria => "$STAGE/redirect_criteria.ini",
              schedules         => "$STAGE/schedules.ini",
              customers         => "$STAGE/customers.ini"
             );
  } ## end else [ if ($redir)

  # Prepare staging area
  $Log->log(1, "Preparing staging area\n");
  my $rv = &prepare_stage($STAGE, $STAGECFG, $PRODCFG, [ keys %FILES ]);

  unless ($rv) {
    &notify("Preparation failed: $@");
    next;
  }

  # Generate the config
  $Log->log(1, "Generating config\n");

  $rv = &generate_config();
  unless ($rv) {
    &notify("Generation failed: $@");
    next;
    $@ = undef;
  }

  # Ensure the config is readable before installing
  if ($redir) {
    $Log->log(1, "Skipping compile, redirects only\n");
  } else {
    my $rv = &compile_config();
    if ($rv) {
      &notify("Compile failed: $@");
      next;
    }
  }

  # Install the new config
  $rv = &install();
  if ($rv) {
    &notify("Install failed: $@");
  } else {
    $Log->log(1, "Done.  Installed config.\n");
  }
}
continue {
  $ndb->rollback();
  sleep(SLEEP_INTERVAL);
}

#######################
#     SUBROUTINES     #
#######################

#######################
sub check_for_updates {
#######################
  my ($generate_all, $redir_only) = (0, 0);
  my $last_update_date;
  my @tables = qw(rhn_contact_groups rhn_contact_methods rhn_schedules);
  foreach my $table (@tables) {
    $last_update_date = $ndb->select_max_last_update_date($table);
    if ($last_update_date > $last_generate_date) {

      # time to generate a full config
      $last_generate_date = $last_update_date;
      $generate_all       = 1;
      return ($generate_all, $redir_only);
    }
  } ## end foreach my $table (@tables)
  $last_update_date = $ndb->select_max_last_update_date('rhn_redirects');
  if ($last_update_date > $last_redirect_date) {

    # time to generate a partial redirect config
    $last_redirect_date = $last_update_date;
    $redir_only         = 1;
  }
  return ($generate_all, $redir_only);
} ## end sub check_for_updates

#####################
sub generate_config {
#####################
  if ($redir) {

    # Only generate the config files pertaining to redirects
    &do_redirects($FILES{redirects});
    &do_redirect_criteria($FILES{redirect_criteria});
  } else {
    &do_message_formats($FILES{message_formats});
    &do_contacts($FILES{contacts});
    &do_contact_methods($FILES{contact_methods});
    &do_contact_groups($FILES{contact_groups});
    &do_redirects($FILES{redirects});
    &do_redirect_criteria($FILES{redirect_criteria});
    &do_customers($FILES{customers});
    &do_schedules($FILES{schedules});
  } ## end else [ if ($redir)
} ## end sub generate_config

########################
sub do_message_formats {
########################

  my $file = shift();
  $arrayref = $ndb->select_notification_formats();
  $Log->dump(4, 'message_formats:', $arrayref, "\n");
  $ifc->file_name($file);
  $ifc->create_file($arrayref);
}

#################
sub do_contacts {
#################

  my $file = shift();
  $arrayref = $ndb->select_contacts();
  $Log->dump(4, 'contacts:', $arrayref, "\n");
  $ifc->file_name($file);
  $ifc->create_file(
    $arrayref, qw (RECID CUSTOMER_ID CONTACT_LAST_NAME
      CONTACT_FIRST_NAME EMAIL_ADDRESS
      USERNAME LAST_UPDATE_USER LAST_UPDATE_DATE
      PREFERRED_TIME_ZONE )
  );

} ## end sub do_contacts

########################
sub do_contact_methods {
########################

  my $file = shift();
  $arrayref = $ndb->select_contact_methods();
  $Log->dump(4, 'contact_methods:', $arrayref, "\n");
  $ifc->file_name($file);
  $ifc->create_file(
    $arrayref, qw (CONTACT_ID EMAIL_ADDRESS METHOD_NAME
      METHOD_TYPE_ID NOTIFICATION_FORMAT_ID PAGER_EMAIL
      PAGER_MAX_MESSAGE_LENGTH PAGER_SPLIT_LONG_MESSAGES
      RECID SCHEDULE_ID OLSON_TZ_ID
      SNMP_HOST SNMP_PORT)
  );
} ## end sub do_contact_methods

#######################
sub do_contact_groups {
#######################

  my $file = shift();
  $arrayref = $ndb->select_contact_groups_and_members();
  $Log->dump(4, 'contact_groups:', $arrayref, "\n");
  $ifc->file_name($file);
  $ifc->create_file($arrayref);
}

##################
sub do_redirects {
##################

  my $file = shift();
  $arrayref = $ndb->select_active_redirects();

  #  $Log->dump(4, 'redirects:', $arrayref, "\n");
  $Log->log(4, "processing recurring redirects\n");

  my @result;
  foreach my $record (@$arrayref) {

    unless ($record->{RECURRING}) {

      # Single event, just do it
      delete($record->{RECURRING_DURATION});    #don't store inaccurate data
      delete($record->{RECURRING_FREQUENCY});
      push(@result, $record);
      next;
    }

    # Clone the appropriate recurring records
    push(@result, make_recurring_redirects($record));
  } ## end foreach my $record (@$arrayref)

  $ifc->file_name($file);
  $ifc->create_file(\@result);
} ## end sub do_redirects

##############################
sub make_recurring_redirects {
##############################
  my $redirect = shift;
  my @result;

  #  $Log->dump(9, 'redirect:', $redirect, "\n");

  my $begin     = $redirect->{START_DATE};
  my $stop      = $redirect->{EXPIRATION};
  my $duration  = $redirect->{RECURRING_DURATION} * 60;    #convert to seconds
  my $frequency = $redirect->{RECURRING_FREQUENCY};
  my $recid     = $redirect->{RECID};
  delete($redirect->{RECURRING_DURATION});    #don't store redundant data
  $redirect->{RECURRING_FREQUENCY} = $FREQ{$frequency};    #make readable

  my ($sec, $min, $hour, $mday, $mon, $year, $interval);
  if ($frequency == MONTHLY) {
    ($sec, $min, $hour, $mday, $mon, $year) = gmtime($begin);
  } elsif ($frequency == WEEKLY) {
    $interval = $WEEKS;
  } else {
    $interval = $DAYS;
  }
  $Log->log(9, "redirect: ",  $redirect->{RECID},               "\n");
  $Log->log(9, "frequency: ", $redirect->{RECURRING_FREQUENCY}, "\n");
  $Log->log(9, "begin: ",     scalar(localtime($begin)),        "\n");
  $Log->log(9, "stop: ",      scalar(localtime($stop)),         "\n");
  $Log->log(9, "------------------------------\n");

  my $start_date = $begin;
  my $reps       = 1;
  $Log->log(9, "start date: ", scalar(localtime($start_date)), "\n");
  while ($start_date <= $stop && $start_date <= $TOMORROW) {
    my $expiration = $start_date + $duration;
    $Log->log(9, "expir date: ", scalar(localtime($expiration)), "\n");

    if ($expiration >= $TODAY) {

      # it is active
      my %newrec = %$redirect;
      $newrec{START_DATE} = $start_date;
      $newrec{EXPIRATION} = $expiration;
      $newrec{RECID}      = join('-', $recid, $reps); #treat each repetition as
                                                      #different single redirect

      ## $Log->dump(4, 'redirect: ', %newrec, "\n");
      ## $Log->log(4, "******active*****\n");
      push(@result, \%newrec);
      $reps++;
    } ## end if ($expiration >= $TODAY)

    #Increment start date for next attempt
    if ($frequency == MONTHLY) {
      $mon += 1;
      if ($mon == 12) {
        $mon = 0;
        $year++;
      }
      $Log->log(9, "mon: $mon, year: $year\n");
      $start_date = timegm($sec, $min, $hour, $mday, $mon, $year);
    } else {
      $start_date += $interval;
    }
    $Log->log(9, "start date: ", scalar(localtime($start_date)), "\n");
  } ## end while ($start_date <= $stop...
  $Log->log(9, "\n");

  print &Dumper(@result), "\n";
  return @result;
} ## end sub make_recurring_redirects

##########################
sub do_redirect_criteria {
##########################

  my $file = shift();
  $arrayref = $ndb->select_active_redirect_criteria();
  $Log->dump(4, 'redirect_criteria:', $arrayref, "\n");
  $ifc->file_name($file);
  $ifc->create_file($arrayref);
}

##################
sub do_customers {
##################

  my $file = shift();
  $arrayref =
    $ndb->select_customers_and_active_redirects(qw (RECID DESCRIPTION));
  $Log->dump(4, 'customers:', $arrayref, "\n");
  $ifc->file_name($file);
  $ifc->create_file($arrayref);
} ## end sub do_customers

##################
sub do_schedules {
##################
  # [Schedules] section
  #	 Tables: schedules,schedule_days,schedule_weeks

  my $file = shift;

  if (!open(CONF, ">$file")) {
    $@ = "Couldn't create $file: $!";
    die($@);
  }

  # Only supporting one type of schedule:
  #       Weekly:            join on schedule and schedule_days

  ##############################################################################
  # Load the component tables
  my $temp      = $ndb->select_schedules();
  my %hash1     = map { $_->{RECID} => $_ } @$temp;
  my $schedules = \%hash1;

  #Group the days for each schedule
  $temp = $ndb->select_schedule_days();
  my $sched_days = {};

  foreach (@$temp) {
    $sched_days->{ $_->{SCHEDULE_ID} } = []
      unless defined($sched_days->{ $_->{SCHEDULE_ID} });
    my $arrayptr = $sched_days->{ $_->{SCHEDULE_ID} };
    push(@$arrayptr, $_);
  }

  #  $Log->dump(4, "schedules:\n", $schedules, "\n");
  #  $Log->dump(4, "schedule days:\n", $sched_days, "\n");

  ##############################################################################
  # Figure out what schedule/zone combinations are configured

  my $combos = $ndb->select_schedule_and_zone_combos();

  #  $Log->dump(4, "schedule and zone combos:\n", $combos, "\n");

  my %schedzones;
  foreach my $row (@$combos) {
    my $recid = $row->{SCHEDULE_ID};
    my $zone  = $row->{OLSON_TZ_ID};
    $schedzones{$recid}{$zone}++;
  }

  ##############################################################################
  # At this point, we know all schedules and all zones.  Now we need to load
  # up the zoneless definitions.

  my %scheddata;

  my @sids = sort(keys(%schedzones));
  foreach my $scheduleid (@sids) {

    $Log->log(9, "processing schedule $scheduleid\n");

    my $record = $schedules->{$scheduleid};

    unless ($record) {
      $Log->log(1, "DATA CORRUPTION:  Schedule $scheduleid doesn't exist!\n");
      delete($schedzones{$scheduleid});
      next;
    }

    my $type = $record->{'SCHEDULE_TYPE_ID'};

    # Only supporting weekly schedules at this time (type 1)
    next unless ($type == 1);

    $scheddata{$scheduleid}->{'ZONELESS'}->{'title'} = $record->{'RECID'};

    $scheddata{$scheduleid}->{'ZONELESS'}->{'description'} =
      join("_", $record->{'CUSTOMER_ID'}, $record->{'DESCRIPTION'});

    $scheddata{$scheduleid}->{'ZONELESS'}->{'comment'} =
      join(' ',
           "ScheduleID $scheduleid, last updated",
           $record->{'LAST_UPDATE_DATE'},
           "by", $record->{'LAST_UPDATE_USER'});

    if ($sched_days->{$scheduleid}) {

#      $Log->dump(4,'$sched_days->{\$scheduleid}' . "\n",$sched_days->{$scheduleid}, "\n");

      foreach my $day (sort byord @{ $sched_days->{$scheduleid} }) {

        my ($index, @timespec);
        foreach $index (1, 2, 3, 4) {

          # get the timestamps
          my $start = $day->{"START_$index"};
          my $end   = $day->{"END_$index"};
          $Log->log(9, "(1) start: $start, end: $end\n");
          if (defined($start) && defined($end)) {
            $end = '24:00' if ($end eq '00:00');
            $Log->log(9, "(2) start: $start, end: $end\n");
            push(@timespec, "${start}-${end}");
          }
        } ## end foreach $index (1, 2, 3, 4)

        push(@{ $scheddata{$scheduleid}->{'ZONELESS'}->{'def'} }, \@timespec);
      } ## end foreach my $day (sort byord...
    } ## end if ($sched_days->{$scheduleid...
  } ## end foreach my $scheduleid (@sids)

  # $Log->dump(4, "schedule data:\n", %scheddata, "\n");

  ##############################################################################
  # Convert and print schedules for their configured zones
  @sids = sort(keys(%scheddata));

  # Now generate the [Schedules] config

  foreach my $scheduleid (@sids) {
    $Log->log(9, "PROCESSING SCHEDULE $scheduleid\n");
    &zonify_daily($scheddata{$scheduleid}, keys %{ $schedzones{$scheduleid} });
    &print_schedules(\*CONF, $scheddata{$scheduleid});
  }

  close(CONF);
  1;
} ## end sub do_schedules

##################
sub zonify_daily {
##################
  my ($sdb, @zones) = @_;
  my $srec = $sdb->{'ZONELESS'};

  my $oldtz = $ENV{'TZ'};

  foreach my $zone (sort(@zones)) {
    $Log->log(9, "PROCESSING ZONE $zone\n");

    $ENV{'TZ'} = $zone;

    # Note:  log here will have confusing timestamps

    # Fetch absolute day ranges
    my @absranges = &absranges($srec->{'def'});

    # Initialize GMT range datastructure
    $Log->log(9, "\tInitialize GMT range datastructure\n");
    my @gmtranges;
    for (@{ $srec->{'def'} }) {
      push(@gmtranges, []);
    }

    # Handle day wraps and end-of-day stuff.
    $Log->log(9, "\tHandle day wraps and end-of-day stuff\n");
    my ($start, $end);
    while (($start, $end) = splice(@absranges, 0, 2)) {

      $Log->log(9, "timezone: ", $ENV{TZ}, "\n");
      $Log->log(9, "start: ",
                scalar(localtime($start)),
                " gmtime(start):",
                scalar(gmtime($start)), "\n");
      $Log->log(9, "end: ",
                scalar(localtime($end)),
                " , gmtime(end):",
                scalar(gmtime($end)), "\n");

      my ($smin, $shour, $swday) = (gmtime($start))[ 1, 2, 6 ];
      my ($emin, $ehour, $ewday) = (gmtime($end))[ 1,   2, 6 ];

      $Log->log(
        9,
"\t\tsmin: $smin, shour: $shour, swday: $swday, emin: $emin, ehour: $ehour, ewday: $ewday\n"
      );

      if ($swday == $ewday) {

        # Range does not span a day boundary
        my $value =
          sprintf("%02d:%02d-%02d:%02d", $shour, $smin, $ehour, $emin);
        push(@{ $gmtranges[$swday] }, $value);
        $Log->log(9, "\t\tRange does not span a day boundary; $value\n");
      } else {

        # Range spans a day boundary
        my $value = sprintf("%02d:%02d-%02d:%02d", $shour, $smin, 23, 59);
        push(@{ $gmtranges[$swday] }, $value);
        $Log->log(9, "\t\tRange spans a day boundary: $value ");

        if ($ehour || $emin) {
          $value = sprintf("%02d:%02d-%02d:%02d", 00, 00, $ehour, $emin);
          push(@{ $gmtranges[$ewday] }, $value);
          $Log->log(9, " $value\n");
        } else {
          $Log->log(9, "\n");
        }
      } ## end else [ if ($swday == $ewday)

    } ## end while (($start, $end) = splice...

    # Make a new record for the zoned schedule
    $sdb->{$zone} = {
                      'comment'     => $srec->{'comment'} . " (for zone $zone)",
                      'title'       => $srec->{'title'} . " $zone",
                      'description' => $srec->{'description'},
                      'def'         => \@gmtranges,
                    };

  } ## end foreach my $zone (sort(@zones...

  if ($oldtz) {
    $ENV{'TZ'} = $oldtz;
  } else {
    delete $ENV{'TZ'};
  }

  # Note:  log OK again
} ## end sub zonify_daily

###############
sub absranges {
###############
# Convert abstract day number and time ranges to apply to this week and the timezone
# currently set in the environment

  my $nozone =
    shift;  #reference to an array containing a list of time ranges for each day
  my $t0 = &sunday_midnight();

  my @absranges;
  for (my $i = 0 ; $i < scalar(@$nozone) ; $i++) {
    my $day = $nozone->[$i];
    foreach my $range (@$day) {
      my ($start, $end) = split(/-/, $range);
      my ($sh,    $sm)  = split(/:/, $start);
      my ($eh,    $em)  = split(/:/, $end);

      # Decrement end time by 1 minute for Notification
      if ($em == 0) {
        $eh--;
        $em = 59;
      } else {
        $em--;
      }

      $Log->log(
        9,
"range: $range, start: $start, end: $end, sh: $sh, sm: $sm, eh: $eh, em: $em\n"
      );

      my $sx = &dayrange2abs($i, $sh, $sm, $t0);
      my $ex = &dayrange2abs($i, $eh, $em, $t0);
      push(@absranges, $sx, $ex);
    } ## end foreach my $range (@$day)
  } ## end for (my $i = 0 ; $i < scalar...
  return @absranges;
} ## end sub absranges

#####################
sub sunday_midnight {
#####################
  # return UNIX timestamp representing Sunday at midnight for the current week
  # according to the timezone currently set in the environment

  my $now = time;
  my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) =
    localtime($now);
  my $sunday = $now - ($wday * $DAYS);
  ($sec, $min, $hour, $mday, $mon, $year, $wday) = localtime($sunday);

  # Ugly hack for switch to standard time -- last Sunday in October
  if (($mon == 9) && ($mday + 7 > 31)) {
    $sunday = $sunday + (14 * $DAYS);
    ($sec, $min, $hour, $mday, $mon, $year, $wday) = localtime($sunday);
  }

  my $retval = timelocal(0, 0, 0, $mday, $mon, $year);
  $Log->log(9,
            "now: $now, sunday: $sunday (",
            scalar(localtime($sunday)),
            "), retval: $retval\n");
  return $retval;
} ## end sub sunday_midnight

##################
sub dayrange2abs {
##################
# convert a day of week numeral and time to a concrete UNIX timestamp based on an
# absolute offset representing Sunday at midnight

  my ($dayno, $hour, $min, $smid) = @_;
  $Log->log(9, "dayno: $dayno, hour: $hour, min: $min, smid: $smid\n");

  # Figure out day, month, and year from $dayno
  my ($mday, $mon, $year) = (localtime($smid + $dayno * $DAYS))[ 3, 4, 5 ];

  # Figure out absolute time for $hour:$min
  my $retval = timelocal(0, $min, $hour, $mday, $mon, $year);

  $Log->log(9, "retval: $retval (", scalar(localtime($retval)), ")\n");
  return $retval;

} ## end sub dayrange2abs

#####################
sub print_schedules {
#####################
  my ($fh, $scheduleref) = @_;

  foreach my $zone (sort(keys %{$scheduleref})) {

    next if ($zone eq 'ZONELESS');    # Skip zoneless representation

    my $srec = $scheduleref->{$zone};
    my @days = @{ $srec->{'def'} };

    my $str = "[$srec->{'title'}]\n";
    $str .= "description=$srec->{'description'}\n";
    $str .= "comment=$srec->{'comment'}\n";

    for (my $i = 0 ; $i < @days ; $i++) {
      $str .= "$WDAY{$i}=";
      $str .= join(",", sort @{ $days[$i] }) . "\n";
    }

    $str .= "\n";
    print $fh $str;
    $Log->log(4, $str);
  } ## end foreach my $zone (sort(keys...
} ## end sub print_schedules

###########
sub byord {
###########
  die "ord not defined" unless defined($a->{'ORD'});
  $a->{'ORD'} <=> $b->{'ORD'};
}

##################
sub acquire_lock {
##################
  my $file = shift;
  my $fh   = shift;

  $Log->log(3, "Acquiring lock on $file\n");

  unless (open($fh, ">>$file")) {
    $@ = "Couldn't open lockfile $file: $!";
    return 0;
  }

  unless (flock($fh, LOCK_EX | LOCK_NB)) {
    $@ = "Couldn't acquire config lock: $!";
    return 0;
  }

  truncate($fh, 0);
  select((select($fh), $| = 1)[0]);
  print $fh "$0 (pid $$) acquired lock at ", scalar(localtime()), "\n";

  return 1;    # Lock acquired
} ## end sub acquire_lock

##################
sub release_lock {
##################
  my $fh = shift;

  flock($fh, LOCK_UN);

  close($fh);
}

###################
sub prepare_stage {
###################

  my ($targetdir, $stagecfg, $prodcfg, $requiredref) = @_;

  # Prepare the staging area for a new config:

  # 1) Delete $targetdir and $stagecfg if they exist
  my $dir;
  foreach $dir ($targetdir, $stagecfg) {
    if (-e $dir) {
      my $command = "/bin/rm -rf $dir 2>&1";
      $Log->log(2, "\tExecuting: $command\n");
      chomp(my $output = `$command`);

      if ($?) {
        $@ =
            "Error: couldn't erase old staging dir $targetdir\n"
          . "Command: $command\n"
          . "Output: $output\n";
        $Log->log(2, "\tERROR:     $@");
        return undef;
      }
    } ## end if (-e $dir)
  } ## end foreach $dir ($targetdir, $stagecfg)

  # 2) Create new $targetdir
  $Log->log(2, "\tCreating dir $targetdir\n");
  unless (mkdir($targetdir, 0755)) {
    $@ = "Couldn't create new staging dir $targetdir: $!";
    $Log->log(2, "\tERROR:     $@");
    return undef;
  }

  # 3) Make sure $targetdir will contain all required files (if specified)
  if (ref $requiredref) {
    my $required;
    foreach $required (@$requiredref) {
      my $filename = "$targetdir/$required.ini";
      open(FILE, ">$filename") or warn("Couldn't create $filename: $!");
      close(FILE);
    }
  }

  # 4) Create new $stagecfg as a shadow dir to $prodcfg
  $Log->log(2, "\tCreating $stagecfg\n");
  if (mkdir($stagecfg, 0755)) {
    $Log->log(2, "\t  Making shadow dir $stagecfg -> $prodcfg\n");
    my $rv = &lndir($prodcfg, $stagecfg);

    unless ($rv) {
      $Log->log(2, "\tERROR: $@");
      return undef;
    }

  } else {
    $@ = "Couldn't create new shadow dir $stagecfg: $!";
    $Log->log(2, "\tERROR: $@\n");
    return undef;
  }
} ## end sub prepare_stage

############
sub notify {
############
  my ($summary, $details) = @_;
  $Log->log(1, "ERROR: $summary: $details\n");
}

###########
sub lndir {
###########
  # foreach entry in $fromdir create symlink in $todir

  my ($fromdir, $todir) = @_;
  # Make sure source and destination directories exist
  if (!-d $todir) {
    $@ = "$todir does not exist or is not a directory\n";
    return undef;
  } elsif (!-d $fromdir) {
    $@ = "$fromdir does not exist or is not a directory\n";
    return undef;
  }

  # Determine what actions need to be taken.
  my @actions;
  sub wanted {
    my $file_name = shift;
    return if ($file_name eq $fromdir);
    $file_name =~ s/^$fromdir\/?//;
    if (-l $_) {    # SYMLINK
      my $dest = readlink($_);
      push(@actions, [ 'LINK', $dest, "$todir/$file_name" ]);
      push(@actions, [ 'MKDIR', "$todir/$file_name" ]);
    } else {        # REGULAR FILE
      push(@actions,
           [ 'LINK', "$fromdir/$file_name", "$todir/$file_name" ]
          );

    }
  };

  # do not traverse tree, just one level, dirs will be symlinked
  opendir(DIR, $fromdir) || die "can't opendir $fromdir: $!";
  my @dir_entry = grep { /^[^.]/} readdir(DIR);
  closedir DIR;
  foreach my $entry (@dir_entry) {
	wanted($entry)
  }

  # Now take the requested actions
  my ($action, @errs);
  foreach $action (@actions) {

    my $op = shift(@$action);

    if ($op eq 'LINK') {

      my ($target, $link) = @$action;
      symlink($target, $link)
        or push(@errs, "link $link -> $target failed: $!");

    } elsif ($op eq 'MKDIR') {

      my ($dir) = @$action;
      unless (-e $dir) {
        mkdir($dir, 0755)
          or push(@errs, "couldn't mkdir $dir: $!");
      }

    } else {

      push(@errs, "Unknown directive $op $@action\n");

    }

  } ## end foreach $action (@actions)

  if (scalar(@errs)) {
    $@ = join("\n", @errs);
    return undef;
  } else {
    return 1;
  }

} ## end sub lndir

####################
sub compare_config {
####################

  $Log->log(1, "Comparing generated and stage configurations\n");

  foreach (keys(%FILES)) {
    if (-s "$STAGE/$_.ini" != -s "$CONFIG/$_.ini") {
      $Log->log(1, "\tConfig file $_ changed, proceeding to compile step\n");
      return 1;
    }
    my $result = `diff --brief $STAGE/$_.ini $CONFIG/$_.ini 2>&1`;
    $Log->log(2, "$result\n") if $result;
    if ($?) {
      $Log->log(1, "\tProceeding to compile step\n");
      return 1;
    }
  } ## end foreach (keys(%FILES))

  $Log->log(1,
            "\tConfiguration unchanged, compile and install steps ignored\n");
  exit 0;
} ## end sub compare_config

####################
sub archive_config {
####################
  my ($confdir) = shift;
  my ($archive) = shift;

  my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) =
    localtime(time);
  $mon++;
  $year += 1900;
  my $label = sprintf("%d-%02d-%02d.%02d:%02d:%02d",
                      $year, $mon, $mday, $hour, $min, $sec);

  rename($confdir, "$archive/$label");
} ## end sub archive_config

####################
sub compile_config {
####################
  $@ = undef;
  eval {
    my $interface = new NOCpulse::Notif::NotifIniInterface('config' => 'stage');

    $Log->log(1, "Compiling new configuration\n");

    $Log->log(3, "...loading Customers\n");
    my $CUSTOMERS = $interface->buildCustomers();

    $Log->log(3, "...loading MessageFormats\n");
    my $FORMATS = $interface->buildMessageFormats();

    $Log->log(3, "...loading Schedules\n");
    my $SCHEDULES = $interface->buildSchedules();

    $Log->log(3, "...loading ContactMethods\n");
    my $METHODS = $interface->buildContactMethods($FORMATS, $SCHEDULES);

    $Log->log(3, "...loading ContactGroups\n");
    my $GROUPS = $interface->buildContactGroups($METHODS, $CUSTOMERS);

    $Log->log(3, "...loading Redirects\n");
    my $REDIRECTS = $interface->buildRedirects($CUSTOMERS, $GROUPS, $METHODS);

    $Log->log(3, "...loading completed\n");
  };
  return $@;
} ## end sub compile_config

#############
sub install {
#############
  my $flagfile;
  $Log->log(1, "Installing config\n");
  if ($redir) {

    # Only generate the config files pertaining to redirects
    foreach (keys(%FILES)) {
      my $result = copy("$STAGE/$_.ini", "$CONFIG/$_.ini");
      unless ($result) {
        &notify("Unable to copy redirect file");
        return 1;
      }
    }
    $flagfile = $cfg->get('notification', 'redirects_reload_flag_file');
  } else {
    &archive_config($CONFIG, $ARCHIVE);
    my $result = rename($STAGE, $CONFIG);
    unless ($result) {
      &notify("Couldn't move $STAGE -> $CONFIG: $!");
      return 1;
    }

    $flagfile = $cfg->get('notification', 'config_reload_flag_file');
  } ## end else [ if ($redir)

  # drop flag to update notif-launcher
  open(H, ">>$flagfile");
  print H "1";
  close(H);

  return 0;
} ## end sub install
