package RDA::Daemon;

# $Id: Daemon.pm,v 1.30 2009/02/17 09:41:31 mschenke Exp $
# ARCS: $Header: /u02/webapps/workbench/cvs/RDA_4/src/scripting/lib/RDA/Daemon.pm,v 1.30 2009/02/17 09:41:31 mschenke Exp $
#
# Change History
# 20090217  MSC  Introduce file modes.

=head1 NAME

RDA::Daemon - Class Used for Objects to Control Background Collections

=head1 SYNOPSIS

require RDA::Daemon;

=head1 DESCRIPTION

The objects of the C<RDA::Daemon> class are used to control background
collections.

The following methods are available:

=cut

use strict;

BEGIN
{ use Exporter;
  use File::Copy;
  use File::Spec;
  use IO::File;
  use POSIX;
}

# Define the global public variables
use vars qw($VERSION);
$VERSION = sprintf("%d.%02d", q$Revision: 1.30 $ =~ /(\d+)\.(\d+)/);

# Define the global private variables
my $FORK = "Parent exit\n";
my $re_nam = qr/^S(\d{3})([A-Za-z]\w*)$/i;

# Report the module version number
sub Version
{ $VERSION;
}

=head2 S<$h = RDA::Daemon-E<gt>new($agt)>

The object constructor. It takes the agent reference as argument.

C<RDA::Daemon> is represented by a blessed hash reference. The following
special keys are used:

=over 12

=item S<    B<'_afl'> > Autoflush indicator

=item S<    B<'_agt'> > Reference to the agent object

=item S<    B<'_bas'> > Maximum length of the report basename

=item S<    B<'_ctl'> > Configuration and control directory

=item S<    B<'_mod'> > File mode hash

=item S<    B<'_nam'> > Setup name

=item S<    B<'_pid'> > Process identifier list

=item S<    B<'_top'> > RDA home directory

=back

Internal keys are prefixed by an underscore.

=cut

sub new
{ my $slf = shift;
  my $cls = ref($slf) || $slf;
  my $agt = shift;

  # Create the daemon object
  $slf = bless {}, $cls;

  # Get some setup information
  $slf->{'_agt'} = $agt;
  $slf->{'_afl'} = $agt->get_setting('RDA_FLUSH', 1);
  $slf->{'_bas'} = $agt->get_setting('RDA_BASENAME', 38);
  $slf->{'_ctl'} = exists($ENV{'RDA_PID'})
    ? $ENV{'RDA_PID'}
    : $agt->get_info('ctl');
  $slf->{'_mod'} = $agt->get_info('mod');
  $slf->{'_nam'} = $agt->get_info('nam');
  $slf->{'_pid'} = $agt->get_info('pid', []);
  $slf->{'_top'} = $agt->get_setting('RDA_HOME', File::Spec->curdir);

  # Return the object reference
  $slf;
}

=head2 S<$h-E<gt>halt_bgnd>

This method requests the data collection running in the background to stop.

=cut

sub halt_bgnd
{ my ($slf) = @_;
  my ($ctl, $end);

  $slf->{'_agt'}->log('h');
  if (-f ($ctl = File::Spec->catfile($slf->{'_ctl'}, $slf->{'_nam'}.'.pid')))
  { $end = $ctl;
    $end =~ s/pid$/end/i;
    rename($ctl, $end) ||
      die "RDA-00603: Cannot halt the background collection: $!\n";
  }
}

=head2 S<$h-E<gt>kill_bgnd>

This method kills any data collection that is running in the background.

=cut

sub kill_bgnd
{ my ($slf) = @_;

  $slf->{'_agt'}->log('k');
  _kill_bgnd(File::Spec->catfile($slf->{'_ctl'}, $slf->{'_nam'}.'.pid')) ||
  _kill_bgnd(File::Spec->catfile($slf->{'_ctl'}, $slf->{'_nam'}.'.end'));
}

sub _kill_bgnd
{ my ($fil) = @_;

  my $cnt = 0;
  if (open(PID, "<$fil"))
  { my $pid = <PID>;
    close(PID);
    $pid =~ s/[\n\r]+$//;
    kill(15, $pid) if $pid;
    ++$cnt while (unlink($fil));
  }
  $cnt;
}

1;

=head2 S<$h-E<gt>run_bgnd($out,[$module,...])>

This method attempts to transform the current process into a daemon and starts
the data collection loop. It redirects the standard output to the specified
output file. You can provide an alternative module list as arguments.

=cut

sub run_bgnd
{ my $slf = shift;
  my $out = shift;
  my ($agt, $arc, $cnt, $ctl, $cur, $dlt, $lck, $min, $ofh, $ref, $smp, $tim,
      $val, @tb1, @tb2, %mod, %tbl);

  # Prepare the data collection
  $agt = $slf->{'_agt'};
  foreach my $nam (@_)
  { $nam =~ s/\.(cfg|def)$//i;
    next unless $nam =~ $re_nam;

    # If not yet done, do the setup
    $agt->setup($nam)
      unless $agt->is_disabled($nam) || $agt->is_configured($nam);

    # If not disabled, add to the execution list
    $tbl{$nam} = 1 unless $agt->is_disabled($nam);
  }
  @tb1 = sort keys(%tbl);
  return -1 unless scalar(@tb1);

  # Take care that the sampling setup has been done
  foreach my $nam (split(/,/, $agt->get_setting('RDA_SAMPLE', '')))
  { $agt->setup($nam) unless $agt->is_configured($nam);
  }

  # Save the setup file
  $agt->save;

  # Prepare the pattern list
  $val = $agt->get_setting('RPT_GROUP');
  foreach my $nam (@tb1)
  { next unless $nam =~ $re_nam;
    $mod{$nam} = [
      $agt->get_setting("SMPL_$2\_APPEND",1),
      qr/^$val\_$2_.*\.(box|csv|dat|gif|jar|png|txt|zip)$/i,
      qr/^$val\_$nam(_\d+)?\.toc$/i,
      qr/^$val\_0$2\.fil$/i,
      "$val\_0$2\.fil",
      ];
  }
  
  # Prepare the initial data collection
  foreach my $nam (split(/,/, $agt->get_setting('RDA_COLLECT', '')))
  { $tbl{$nam} = 1;
  }
  @tb2 = sort keys(%tbl);

  # Prepare the sampling environment
  $val = $agt->get_setting('RPT_DIRECTORY');
  die "RDA-00200: Cannot create the report directory $val:\n $!\n"
    unless -d $val || mkdir($val, 0750);
  $arc = File::Spec->catdir($val,'archive');
  die "RDA-00604: Cannot create the archive directory $arc:\n $!\n"
    unless -d $arc || mkdir($arc, 0750);
  $ref = File::Spec->catdir($val,'ref');
  die "RDA-00605: Cannot create the ref directory $ref:\n $!\n"
    unless -d $ref || mkdir($ref, 0750);
  $smp = File::Spec->catdir($val,'sample');
  die "RDA-00606: Cannot create the sample directory $smp:\n $!\n"
    unless -d $smp || mkdir($smp, 0750);

  $dlt = $agt->get_setting('SMPL_DELTA',300);
  $min = $agt->get_setting('SMPL_SLEEP',60);

  # Try to transform the process in daemon
  $ctl = File::Spec->catfile($slf->{'_ctl'}, $slf->{'_nam'}.'.pid');
  $ofh = IO::File->new;
  $ofh->open($ctl, $slf->{'_mod'}->{'>'}, 0640)
    || die "RDA-00600: Cannot create the daemon file: $!\n";
  open(STDIN, '/dev/null') || die "RDA-00601: Cannot redirect input: $!\n";
  eval "fork() && die('$FORK');";
  if ($@ && $@ eq $FORK)
  { $ofh->close;
    return 0;
  }
  open(STDOUT, ">$out") || die "RDA-00602: Cannot redirect output: $!\n";
  eval "setsid();";
  print {$ofh} "$$\n";
  $ofh->close;
  $ctl =~s/pid$/end/i;
  $agt->log('f');

  # Perform an initial data collection and archiving
  $agt->init;
  $cur = strftime('%Y%m%d%H%M%S',gmtime($tim = time));
  $lck = '-B-'.$agt->get_info('nam');
  $agt->set_temp_setting('SMPL_CURRENT', $cur);
  $agt->set_temp_setting('SMPL_COUNT', $cnt = 0);
  _lock($agt, $lck);
  $slf->_do_archive($arc, $smp, $tim, $cur);
  foreach my $nam (@tb2)
  { exit(2) if $agt->collect($nam);
  }
  $slf->_wait($agt);
  _do_unlink($ref, \%mod);
  _do_move($ref, $agt->get_setting('RPT_DIRECTORY'), \%mod);
  _unlock($agt, $lck);
  $tim = _get_next($tim + $dlt, $min);

  # Perform sample loop
  while ($slf->_chk_end($ctl))
  { # Sleep until next sample
    $val = $tim - time;
    if ($val > 20)
    { sleep(15);
      next;
    }
    elsif ($val > 0)
    { sleep($val);
    }

    # Check if a halt request has been posted
    last unless $slf->_chk_end($ctl);
 
    # Collect a new sample
    $cur = strftime('%Y%m%d%H%M%S',gmtime($tim = time));
    $agt->set_temp_setting('SMPL_CURRENT', $cur);
    $agt->set_temp_setting('SMPL_COUNT', ++$cnt);
    foreach my $nam (@tb1)
    { exit(3) if $agt->collect($nam);
    }
    $slf->_wait($agt, $lck);
    _do_concat($slf, $smp, $agt->get_setting('RPT_DIRECTORY'), $cur, \%mod);
    _unlock($agt, $lck);

    # Check if a halt request has been posted
    last unless $slf->_chk_end($ctl);
 
    # Perform sample archiving when required
    $slf->_do_archive($arc, $smp, $tim, $cur, $lck);
    $tim = _get_next($tim + $dlt, $min);
  }
  1;
}

# --- Internal methods --------------------------------------------------------

# Check if a halt request has been posted
sub _chk_end
{ my ($slf, $fil) = @_;

  # Continue unless an halt request is detected
  return 1 unless -f $fil;

  # Remove the control file
  0 while (unlink($fil));

  # Indicate that the collection should stop
  0;
}

# Perform sample archiving
sub _do_archive
{ my ($slf, $arc, $smp, $tim, $cur, $lck) = @_;
  my ($agt, $cmd, $err, $flg, $fil, $grp, $max, $pth, $re, $vol, %tbl);

  # Check if it is archive time
  $agt = $slf->{'_agt'};
  return if $tim < ($agt->get_setting('SMPL_LAST', 0) +
    3600 * $agt->get_setting('SMPL_RATE', 0));
  $agt->set_setting('SMPL_LAST', $tim);

  # Request a log before manipulating the files
  _lock($agt, $lck) if $lck;

  # Archive the sample files
  $grp = $agt->get_setting('RPT_GROUP');
  $re  = qr/^$grp\_.*\.(box|csv|dat|fil|gif|jar|png|toc|txt|zip)$/i;
  if (_chk_package($smp, $re))
  { chdir($smp) ||
      die "RDA-00607: Cannot change to the sample directory\n";
    eval {
      if (($cmd = $agt->get_setting('CMD_ZIP')) &&
        !exists($ENV{'RDA_NO_ZIP'}))
      { $fil = "RDA.$grp\_smp\_$cur.zip";
        _exe_package("$cmd -9 -q -D -j $fil -\@", $re,
           "RDA-00610: Cannot zip the reports\n");
      }
      elsif (($cmd = $agt->get_setting('CMD_PAX')) &&
        !exists($ENV{'RDA_NO_PAX'}))
      { $fil = "RDA.$grp\_smp\_$cur.tar";
        _exe_package("$cmd -w -f $fil", $re,
          "RDA-00611: Cannot package the reports using pax\n");
        $fil = _exe_compress($agt, $fil);
      }
      elsif (($cmd = $agt->get_setting('CMD_TAR')) &&
        !exists($ENV{'RDA_NO_TAR'}))
      { $fil = "RDA.$grp\_smp\_$cur.tar";
        system("$cmd -cf $fil $grp\_*");
        die "RDA-00612: Cannot package the reports using tar\n" if $?;
        $fil = _exe_compress($agt, $fil);
      }
      elsif (($cmd = $agt->get_setting('CMD_JAR')) &&
        !exists($ENV{'RDA_NO_JAR'}))
      { $fil = "RDA.$grp\_smp\_$cur.zip";
        system("$cmd -cfM $fil $grp\_*");
        die "RDA-00614: Cannot package the reports using jar\n" if $?;
      }
      else
      { die "RDA-00613: Archive command not -yet- identified\n";
      }
    };
    $agt->log('E', $@) if ($err = $@);
    chdir($agt->get_setting('RDA_HOME')) ||
      die "RDA-00609: Cannot change to the RDA install directory\n";
  }

  # If there are no errors, clean up the sample directory
  if (!$err && opendir(DIR, $smp))
  { while (defined($fil = readdir(DIR)))
    { if ($fil =~ m/^RDA.$grp\_smp_/i)
      { move(File::Spec->catfile($smp, $fil),
             File::Spec->catfile($arc, substr($fil,4)));
      }
      elsif ($fil =~ $re)
      { $fil = File::Spec->catfile($smp, $fil);
        1 while unlink($fil);
      }
    }
    closedir(DIR);
  }

  # Cleanup the archive directory
  if (opendir(DIR, $arc))
  { # Get the archive files
    while (defined($fil = readdir(DIR)))
    { if ($fil =~ m/^$grp\_smp_/i)
      { $pth = File::Spec->catfile($arc, $fil);
        $tbl{$fil} = [$pth, (stat($pth))[7]];
      }
    }
    closedir(DIR);

    # Keep more recent archives
    $max = $agt->get_setting('SMPL_KEEP',0);
    $vol = 1048576 * $agt->get_setting('SMPL_SIZE',0);
    $flg = 0;
    foreach $fil (sort {$b cmp $a} keys(%tbl))
    { if ($vol > 0)
      { $vol -= $tbl{$fil}->[1];
        $flg = 1 unless $vol > 0;
      }
      if ($flg)
      { 1 while unlink($tbl{$fil}->[0]);
      }
      if ($max > 0)
      { # Must we still keep the next one ?
        $flg = 1 unless --$max > 0;
      }
    }
  }

  # Save the setup file and release the lock
  $agt->save;
  _unlock($agt, $lck) if $lck;
}

sub _chk_package
{ my ($dir, $re) = @_;
  my ($fil, $flg);

  if (opendir(DIR, $dir))
  { while (defined($fil = readdir(DIR)))
    { if ($fil =~$re)
      { $flg = 1;
        last;
      }
    }
    closedir(DIR);
  }
  $flg;
}

sub _exe_compress
{ my ($agt, $fil) = @_;
  my $cmd;

  if (($cmd = $agt->get_setting('CMD_GZIP')) &&
    !exists($ENV{'RDA_NO_GZIP'}))
  { system("$cmd -9 -q $fil");
    $fil .= '.gz';
  }
  elsif (($cmd = $agt->get_setting('CMD_COMPRESS')) &&
    !exists($ENV{'RDA_NO_COMPRESS'}))
  { system("$cmd $fil");
    $fil .= '.Z';
  }
  $fil;
}

sub _exe_package
{ my ($cmd, $re, $err) = @_;

  opendir(DIR, '.') || die "RDA-00608: Cannot list the samples\n";
  open(CMD, "| $cmd") || die $err;
  foreach my $nam (readdir(DIR))
  { print CMD $nam, "\n" if $nam =~ $re;
  }
  closedir(DIR);
  close(CMD) || die $err;
}

# Concatenate sample files
sub _do_concat
{ my ($slf, $dst, $src, $cur, $tbl) = @_;
  my ($buf, $fil, $lgt, $nam, $ofh, $rec, $rpt, $suf, $typ);

  # Load aliases
  foreach my $key (keys(%$tbl))
  { $rec = $tbl->{$key};
    $rec->[5] = {};
    if (open(ALT,'<'.File::Spec->catfile($src, $rec->[4])))
    { while (<ALT>)
      { ($typ, $nam, $fil) = split(/\|/);
        $rec->[5]->{$fil} = $nam if $typ eq 'R';
      }
      close(ALT);
    }
    $rec->[6] = {};
    $rec->[7] = {};
    if (-r ($fil = File::Spec->catfile($dst, $rec->[4])))
    { $rec->[8] = IO::File->new;
      $rec->[8]->open("+<$fil") ||
        die "RDA-00616: Cannot open the sample alias file '$fil':\n $!\n";
      while ($buf = $rec->[8]->getline)
      { ($typ, $nam, $fil) = split(/\|/, $buf);
        next unless $typ eq 'R' && $fil =~ m/^(.*)-(\d+).\w+$/;
        $rec->[6]->{$nam} = $fil;
        $rec->[7]->{$1} = $2;
      }
      $rec->[8]->autoflush(1) if $slf->{'afl'};
    }
  }

  # Treat output files
  if (opendir(DIR, $src))
  { while (defined($fil = readdir(DIR)))
    { foreach my $key (keys(%$tbl))
      { $rec = $tbl->{$key};
        if ($fil =~ $rec->[1])             # TXT or DAT
        { $rpt = File::Spec->catfile($src, $fil);
          $nam = exists($rec->[5]->{$fil}) ? $rec->[5]->{$fil} : $fil;
          $nam =~ m/^(.*)(\.\w+)$/;
          ($nam, $suf) = ($1, $2);
          if ($suf =~ m/^\.(box|csv|dat|gif|jar|png|zip)$/i)  # DAT
          { $fil = _get_dest($slf, $rec, $dst, $nam, $suf);
            1 while unlink($fil);
            move($rpt, $fil);
            last;
          }
          elsif (!$rec->[0])                             # Not concatenated TXT
          { move($rpt, _get_dest($slf, $rec, $dst, "$nam\_$cur", $suf));
            last;
          }
          elsif (open(SRC, "<$rpt"))                     # Concatenated TXT
          { $ofh = IO::File->new; 
            binmode(SRC);
            if ($ofh->open(_get_dest($slf, $rec, $dst, $nam, $suf),
              $slf->{'_mod'}->{'>>'}, 0644))
            { $ofh->binmode;
              $buf = "---+ $cur\n";
              syswrite($ofh, $buf, length($buf));
              while ($lgt = sysread(SRC, $buf, 4096))
              { syswrite($ofh, $buf, $lgt);
              }
              $ofh->close;
            }
            close(SRC);
          }
          1 while unlink($rpt);
          last;
        }
        elsif ($fil =~ $rec->[2])          # TOC
        { $rpt = File::Spec->catfile($src, $fil);
          $fil =~ s/\.toc$/_$cur.toc/i;
          move($rpt, File::Spec->catfile($dst, $fil));
          last;
        }
      }
    }
    closedir(DIR);
  }

  # Close sample alias files
  foreach my $key (keys(%$tbl))
  { $tbl->{$key}->[8]->close if $tbl->{$key}->[8]; 
  }
}

sub _get_dest
{ my ($slf, $rec, $dst, $fil, $suf) = @_;
  my ($alt, $nam);

  # Check if truncation is needed
  $nam = $fil.$suf;
  return File::Spec->catfile($dst, $nam)
    unless length($fil) > $slf->{'_bas'};

  # Check if an alias has already been defined
  return File::Spec->catfile($dst, $rec->[6]->{$nam})
    if exists($rec->[6]->{$nam});

  # Truncate the name
  $fil = substr($fil, 0, $slf->{'_bas'} - 5);
  $rec->[7]->{$fil} = 0 unless exists($rec->[7]->{$fil});
  $fil = sprintf("%s-%04d", $fil, ++$rec->[7]->{$fil});
  unless ($rec->[8])
  { $alt = File::Spec->catfile($dst, $rec->[4]);
    $rec->[8] = IO::File->new;
    $rec->[8]->open($alt, $slf->{'_mod'}->{'>'}, 0640) ||
      die "RDA-00615: Cannot create the sample alias file '$alt':\n $!\n";
    $rec->[8]->autoflush(1) if $slf->{'_afl'};
  }
  print {$rec->[8]} "R|$nam|$fil$suf|\n";
  File::Spec->catfile($dst, $fil.$suf);
}

# Move sample files
sub _do_move
{ my ($dst, $src, $tbl) = @_;
  my ($fil);

  if (opendir(DIR, $src))
  { while (defined($fil = readdir(DIR)))
    { foreach my $key (keys(%$tbl))
      { if ($fil =~ $tbl->{$key}->[1] ||
            $fil =~ $tbl->{$key}->[2] ||
            $fil =~ $tbl->{$key}->[3])
        { move(File::Spec->catfile($src, $fil),
               File::Spec->catfile($dst, $fil));
          last;
        }
      }
    }
    closedir(DIR);
  }
}

# Remove sample files
sub _do_unlink
{ my ($dst, $tbl) = @_;
  my ($fil);

  if (opendir(DIR, $dst))
  { while (defined($fil = readdir(DIR)))
    { foreach my $key (keys(%$tbl))
      { if ($fil =~ $tbl->{$key}->[1] ||
            $fil =~ $tbl->{$key}->[2] ||
            $fil =~ $tbl->{$key}->[3])
        { $fil = File::Spec->catfile($dst, $fil);
          1 while unlink($fil);
          last;
        }
      }
    }
    closedir(DIR);
  }
}

# Define when the next sample must be taken
sub _get_next
{ my ($nxt, $min) = @_;
  $min += time;
  ($nxt < $min) ? $min : $nxt;
}

# Take a lock
sub _lock
{ my ($agt, $lck) = @_;

  eval {
    require RDA::Lock;
    RDA::Lock::lock($agt, $lck);
  };
}

# Release a lock
sub _unlock
{ my ($agt, $lck) = @_;

  eval {
    require RDA::Lock;
    RDA::Lock::unlock($agt, $lck);
  };
}

# Wait for thread execution completion
sub _wait
{ my ($slf, $agt, $lck) = @_;
  my $pid;

  # When fork is emulated, wait for thread completion
  while (defined($pid = shift(@{$slf->{'_pid'}})))
  { waitpid($pid, 0);
  }

  # Wait until the thread lock can be get
  eval {
    require RDA::Lock;
    RDA::Lock::wait_thread($agt);
    RDA::Lock::lock($agt, $lck) if $lck;
  };
}

1;

__END__

=head1 SEE ALSO

L<RDA::Agent|RDA::Agent>, L<RDA::Block|RDA::Block>,
L<RDA::Discover|RDA::Discover>, L<RDA::Extra|RDA::Extra>,
L<RDA::Filter|RDA::Filter>, L<RDA::Lock|RDA::Lock>,
L<RDA::Log|RDA::Log>, L<RDA::Module|RDA::Module>,
L<RDA::Output|RDA::Output>, L<RDA::Pod|RDA::Pod>,
L<RDA::Profile|RDA::Profile>, L<RDA::Remote|RDA::Remote>,
L<RDA::Render|RDA::Render>, L<RDA::Setting|RDA::Setting>,
L<RDA::Upgrade|RDA::Upgrade>, L<RDA::Value|RDA::Value>,
L<RDA::Web|RDA::Web>

=head1 COPYRIGHT NOTICE

Copyright (c) 2002-2009, Oracle. All rights reserved.

=head1 TRADEMARK NOTICE

Oracle, JD Edwards, PeopleSoft, and Siebel are registered trademarks of Oracle
Corporation and/or its affiliates. Other names may be trademarks of their
respective owners.

=cut