#=============================================================================
# Doloforge::Service : base object for the doloforge network services et al.
#
# This object defines the interface all Doloforge::Service:: objects should
# conform to.
#
# Full help :
#   perldoc Doloforge::Service
#=============================================================================


package Doloforge::Service;

use strict;
use warnings;

use base qw(Doloforge::Base);
use Cwd;
use File::Path;
use File::Basename;
use Text::Template;
use ConfHelper;


#=============================================================================
=encoding utf8

=head1 NAME

Doloforge::Service : Base object for the doloforge network services et al.

=cut


#=============================================================================
# Method new
#
# Creates a new service object, giving it the general Doloforge configuration.
#   $com = new Doloforge::Service($self->{global});

sub new {
    # Abstract base class constructor call, which expects 3 parameters after the class name or instance
    my $class = shift;
    my $self = $class->SUPER::new(shift, shift, shift);

    # This indicator will be incremented each time a project impacts the configuration.
    # This allows to know when reloading Apache is needed.
    $self->{modified} = 0;
    $self->{update_process} = 0;

    # Return de created instance to the caller...
    return $self;
}


# The destructor is called by Perl whenever possible (between destruction of the linked
# objects and finish of the whole program).
# Since Project only instanciate one Service:: for each service class, we can
# rely on the fact that this method will be called only once per service, allowing to
# reload the corresponding daemon without fear that it will be reloaded twice or more.

sub DESTROY {
    my $self = shift;

    # Call the last-resort function of the service (write configured files, reload service, etc.)
    if ($self->{update_process}) {
        foreach my $stage (@{$self->{global}->{stages}->{this_run}}) {
            $self->{global}->{stage} = $stage;
            $self->debug("Calling finish() for '$self->{global}->{stage}'");
            $self->finish();
        }
    }
    #$self->finish() if ($self->{update_process});
}


#=============================================================================
# Class-method Factory
#
# Creates a new command object from a class name, giving it the general
# Doloforge configuration, and reading the class-specific config file.
# This class-method facilitates full instanciation : require + yaml + new

sub Factory {
    # Call the generic factory, simply asking for a specific base class
    return &Doloforge::Base::Factory('Doloforge::Service', @_);
}


#=============================================================================
# Methods begin, update, remove, finish
#
# These methods must be subclassed by each child class to implement what's
# needed for each configuration step:
#   begin: read generic configuration files, reset update count, etc.
#   update: called once for each client/project using this service (generate config from template, etc.)
#   remove: ditto, removes the client/project from the running service (called instead of "update", when "active=0")
#   finish: call only once for all, allowing to write config files, restart the service, etc.
# These methods are related to running the service, instead of configuring them:
#   maintenance_on_appserv: called on every application servers, before the cron_run call
#   maintenance_on_nfs: called on the data storage (NFS) server, after the appserv calls
#   maintenance_on_db: called on the DB storage server, after the NFS call, or concurently to the previous calls if on a separate server
#   cron_run: called on a single application server, in the context of each project

sub begin {
    my $self = shift;

    #print ref($self)."::begin()\n";
    # If we begin the update process, we will have to actually finish() it upon destruction.
    # Just memorize it here so we don't forget later on...
    $self->{update_process} = 1;
}

# Update the service configuration on the host, depending on
# client/project/service config files...
# This method receives :
#   option: context options passed on the command-line (quite useless there)
#   client_conf: client configuration file contents (client.$name.yaml)
#   project_conf: project configuration file contents (project.$name.client.$name.yaml)
sub update {
    my $self = shift;

    #print ref(shift)."::update()\n";
    my ($option, $client_conf, $project_conf) = @_;

    # Copy the service skeleton directory into the project directory.
    if ($self->has_role('nfs_role')) {                                              # only create shared storage on the NFS server
        $self->skel_copy(
            "$self->{global}->{dir}->{skel}/service/shared/$self->{name}",          # Skeleton directory to copy (skel/service/shared/[service]/)
            ($self->{global}->{stages}->{$self->{global}->{stage}}->{dir}->{shared} || $self->{global}->{dir}->{shared}).
                "/$client_conf->{name}/$project_conf->{name}",                      # Where to copy it
            $self->{config}->{developerdirs},                                       # reference to the developers directories, that will have to be chown'ed to the following ownership
            ($client_conf->{uid} or $client_conf->{name}),                          # user/group id of the client who owns this project. Developers of the same group will have write-access to files there.
            ($client_conf->{gid} or $client_conf->{name}),                          # user/group id of the client who owns this project. Developers of the same group will have write-access to files there.
        );
    }
}

sub remove {
    #print ref(shift)."::remove()\n";
}

sub finish {
    #print ref(shift)."::finish()\n";
}

sub cron_run {
    #print ref(shift)."::cron_run()\n";
}

sub maintenance_on_appserv {
    #print ref(shift)."::maintenance_on_appserv()\n";
}

sub maintenance_on_nfs {
    #print ref(shift)."::maintenance_on_nfs()\n";
}

sub maintenance_on_db {
    #print ref(shift)."::maintenance_on_db()\n";
}

sub maintenance_on_mail {
    #print ref(shift)."::maintenance_on_mail()\n";
}


#=============================================================================
# Method link_file
#
# Maintain a symbolic link to the specified file (central repository -> project)
# Does not check if the existing link points to the correct file, because a
# link shouldn't be modified. Ever...
#

sub link_file {
    my $self = shift;

    my ($merged, $linked) = @_;

    # Don't do anything if the symbolic link already exist
    unless (-l $linked) {
        # If the link name is actually a file, silently remove it first
        unlink($linked) if (-f $linked);

        # If the target of the symlink is a relative path, convert it to absolute.
        # This is really only necessary during testing, since relative configuration paths is not a good idea...
        #$merged = abs_path($merged);
        $merged = cwd . "/$merged" unless ($merged =~ m/^\//);

        # If the link name is something else, don't do anything, or the damage could be enormous.
        # (automatically removing a directory tree that shouldn't be there in the first place is not a good idea)
        $self->error("Can't create the symbolic link '$linked' to '$merged': already exist in a non-file form")
            if (-e $linked);

        $self->info("Creating symbolic link '$linked' to '$merged'");

        # Create the directory in which the symlink will be placed, just in case
        mkpath(dirname($linked));

        # Create the symlink, and warn in case of error
        symlink($merged, $linked)
            or $self->warn("Can't create symbolic link '$linked' to '$merged': $!");
    }
}


#=============================================================================
# Method merge_template
#
# Merge a template file with the configuration data, and save it under another
# file. Also maintain a link to the generated file (central repository -> project)
# The actual merging is only done if:
#   the destination file doesn't exist
#   or it is older than the template
#   or it is older than the config files it uses
# Returns a boolean indicating if the file was actually modified/merged.
#

sub merge_template {
    my $self = shift;

    my ($option, $client_conf, $project_conf, $template, $alternate_template, $merged, $linked) = @_;
    my $modified = undef;

    # Use the alternate template instead of the main one, if it exists.
    # This allow to create a project-specific template that will take precedence over the standard one...
    $template = $alternate_template if (defined($alternate_template) and -f $alternate_template);

    # Some sub-services use unexisting template files. Just stop if we try to generate such a non-file...
    return $modified unless (-e $template);

    # Get file modification time for each, and keep it in cache (instance property),
    # to speed up numerous stats (same template used by many projects)
    # The cache is a global notepad property, shared by all services
    my $mtime = $self->{global}->{notes}->{merge_template}->{mtime} ||= {};
    my $merged_mtime = (exists($mtime->{$merged}) ? $mtime->{$merged} : ((stat($merged))[9] or 0));
    $self->debug("Trying to merge $merged (".localtime($merged_mtime).") from $template");
    foreach my $file ($template, $client_conf->{_infile}, $project_conf->{_infile}) {
        $mtime->{$file} ||= (stat($file))[9] if ($file and -e $file);
        $self->debug("Checking mtime($file) = ".localtime($mtime->{$file}));
    }

    # Test mod times
    # Even with --force, does no allow a $merged file to be generated more than once (ie. with the Apache service, and then with the Project service).
    # $mtime->{$merged} will be set at the end of the block, once the file has been generated once, preventing further generatings.
    if (($option->{force} and not exists($mtime->{$merged}))
    or ($merged_mtime < $mtime->{$template})
    or ($merged_mtime < $mtime->{$client_conf->{_infile}})
    or ($merged_mtime < $mtime->{$project_conf->{_infile}})) {
        # Mod time of the files indicate that the template should be regenerated
        $self->info("Regenerating $merged file");

        # Read and cache the content of the template file, creating a template objet at the same time
        $self->{template}->{$template} ||= new Text::Template(
            type => 'FILE',                     # read the template file once
            source => $template,                # and cache the whole Text::Template object for later reuse
            delimiters => [ '<%', '%>' ],       # those delimiters look like Mason ones, and allow to be free of {}' matching problems
        );
        my $filled = $self->{template}->{$template}->fill_in(
            Package => 'Doloforge::Service::Template', # every template is evaluated in the context of that packages defined below in the same source file
            hash => {                           # available variables for template evaluation covers :
                # Configuration hashes (YAML onbjects, in fact)
                option => \$option,             # general context options (mainly 'stage' => 'devl')
                global => \$self->{global},     # global doloforge YAML configuration (doloforge.yaml)
                service => \$self->{config},    # service class YAML configuration ([service].yaml)
                client => \$client_conf,        # client YAML configuration file content
                project => \$project_conf,      # project YAML configuration file content
                # Shortcut for regularly used values
                stage => $self->{global}->{stage},  # actual stage we're running on
                mode => ($project_conf->{stages}->{$self->{global}->{stage}}->{mode} || $self->{global}->{stages}->{$self->{global}->{stage}}->{mode} || $self->{global}->{stage}), # run-mode, ie. "devl", "prod", matching the stage as the last resort
                template_file => $template,         # name of the main template file (will give the correct name until another template is include'd)
                service_name => $self->{name},      # service name as defined in the base class ('apache', 'mason', etc.)
                shared => "$self->{global}->{dir}->{shared}/$client_conf->{name}/$project_conf->{name}",    # Shared storage directory
                client_descr => ($client_conf->{description} || $client_conf->{name}),                      # Client description, or name if description is not defined
                project_descr => ($project_conf->{description} || $project_conf->{name}),                   # Ditto for project description/name
            },
        );
        # Write the filled template in the $merged file, probably located in the client/project/_conf directory
        if ($self->write_file($option->{diff}, $merged, $filled)) {
            $modified = 1;

            # Increment the counter of modifications impacting the whole service (used to trigged service reload at finish())
            $self->{modified} += 1;
        }

        # Keep track of updated file generation times, even if the file is not actually written out (same contents, or --diff)
        $mtime->{$merged} = time;
        $self->debug("Setting mtime($merged) = ".localtime($mtime->{$merged}));
    }

    # Check the presence of the symbolic link to the filled-in file.
    # Does not check if the linked file is the correct one. It should be...
    # Always check, even when the template was not regenerated (events are differents),
    # allowing specific templates to be generated by the 'project' all-services class
    # and still be linked by the specific service class.
    # The order of the parameters is the same as the "ln" command.
    $self->link_file($merged, $linked) if ($linked);

    # Return 1 if the file was merged, or undef if it was not.
    return $modified;
}


#=============================================================================
# Method merge_conffile
#
# Merge a set of line inside a system config file, using debconf helpers.
# See the behaviour of ConfHelper(3) found in the libconfhelper-perl
# Debian package.
#

sub merge_conffile {
    my $self = shift;

    my $confile = shift;
    my $hosts_file = new ConfHelper($self->{class}, $confile);
    $hosts_file->config('startline', "### $self->{class}. DO NOT EDIT THIS AREA.");
    $hosts_file->config('endline',   "### $self->{class}. END OF AUTOMATED AREA.");
    $hosts_file->setconfarea(@_);
}



#=============================================================================
# Package where the templates evaluation take place
# Any template-generic variables or functions should be declared/imported there

package Doloforge::Service::Template;

no warnings;
use Date::Format;


# Include a sub-template and evaluate it. The template is read in a named file.
# This may be quite sub-optimized, but allow to call a back-end template for 
# Apache rewrite rules from within the front-end Apache template itself...
# cf. Text::Template(3pm) for the trick...

# We can't use this simple trick, because the default delimiters are not the right ones for us...
#*include = \&Text::Template::fill_in_file;
sub include {
    # Call the fill_in_file() shotcut function, adding the proper delimiters
    # (see /usr/share/perl5/Text/Template.pm for the details)
    my $template = shift;
    &Text::Template::fill_in_file(
        $template,                                  # file name passed as argument
        delimiters => [ '<%', '%>' ],               # same delimiters than main template
        Package => 'Doloforge::Service::Template',  # same package, allowing to use the same substitution variables
        hash => {                                   # overrides for some of the variables of the main evaluation
            template_file => $template,             # name of the included template file (overwrites the main template name as soon as a sub-template is include'd)
        },
    );
}

# Include a simple file without executing is as a template...
use vars qw(*include_file);
*Doloforge::Service::Template::include_file = \&Text::Template::_load_text;



#=============================================================================
# ConfHelper object cheat : we define here the "setconfarea()" function, which
# will then not be autoloaded by the AutoLoader modules, because it's already
# defined...
#
# This function will append the data at the end of the files instead of the
# beginning... This is particularly important for the /etc/hosts file...

package ConfHelper;

use IO::File;


# Totally redefine the setconfarea method, and only this one...
# This is a cut'n'paste from the /usr/share/perl5/ConfHelper.pm, with identified changes
sub setconfarea {
  my ($s, @dcarea) = @_;
  my $fd = $s->{fd};
  my @otherarea = $s->getotherareas();

  # Close the file, rotate it.

  close $fd;

  my $log = new Logfile::Rotate(File => $s->{filename},
                Count => 9,
                Gzip => 'no');
  $log->rotate();
  undef $log;

  # Reopen it.

  $fd = new IO::File;
  sysopen($fd, $s->{filename}, O_CREAT | O_RDWR, 0644) ||
      # NH : begin change
      #die "Can't open $filename: $!";
      die "Can't open $s->{filename}: $!";
      # NH : end change
  $s->{fd} = $fd;

  seek $fd, 0, SEEK_SET;

  # NH : begin add
  print $fd join("\n", @otherarea), "\n";
  # NH : end add
  print $fd $s->{startline}, "\n";
  print $fd join("\n", @dcarea), "\n";
  print $fd $s->{endline}, "\n";
  # NH : begin remove
  #print $fd join("\n", @otherarea), "\n";
  # NH : end remove
  truncate($fd, tell($fd));

  return 1;
}




1;
__END__

=head1 AUTHOR

Nicolas Huillard <F<nicolas@huillard.net>>, Dolomède

=head1 SEE ALSO

doloforge(1)

=cut
