#=============================================================================
# Doloforge::Service::Postgres7 : add a PosgtreSQL 7 database for back-end use
#
# Generate config files from templates, add a config file to the whole, etc.
#
# Full help :
#   perldoc Doloforge::Service::Postgres7
#=============================================================================


package Doloforge::Service::Postgres7;

use strict;

# This base class implements the constructor and help methods in a generic way.
use base qw(Doloforge::Service);

use DBI;
use DBD::Pg;



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

=head1 NAME

Doloforge::Service::Postgres7 : Add a PosgtreSQL 7 database for back-end use

=head1 SYNOPSIS

    # Update the full configuration, running each client/project/service update
    doloforge config --update

=head1 DESCRIPTION

Todo

=cut


#=============================================================================
# Method update
#
# Create DB if it is configured but does not exist.
# This method receives :
#   option: context options passesd 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)
# Things we need to do (psql equivalent) :
#   CREATE GROUP "internal";
#   CREATE USER "internal" IN GROUP "internal";
#   CREATE DATABASE "internal_sandbox" WITH OWNER "internal" ENCODING 'UNICODE';
#   \c internal_sandbox
#   COMMENT ON DATABASE "internal_sandbox" IS 'Sandbox project for developer training';

sub update {
    my $self = shift;

    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}->{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->{name}, $client_conf->{name},                                     # user/group id of the client who own this project. Developers of the same group will have write-access to files there.
            $self->{global}->{permissions}->{user}->[0], $client_conf->{name},              # group id of the client who own this project. Developers of the same group will have write-access to files there.
            # This is a special permissions setup here, to allow cron_run() below to restore DBs on the mirror stage, after publishing them from prod to mirror using reverse_rsync
            # We need both the client UID to write the backup to the dump/auto dir on the mirror,
            # and the doloforge user on the mirror to restore the DB, while outputting its log in the same directory.
        );
    }

    # If that project has the correct services ("postgres7" or inherited),
    # and has a database name definition,
    # and we're running on a database server, then we go...
    if ($self->has_role('db_role') and exists($project_conf->{services}->{$self->{name}}) and exists($project_conf->{services}->{$self->{name}}->{dbname})) {

        # Retrieve database name and hosting server from the configuration, resp. "project.*.yaml":services:[name]:dbname and "doloforge.yaml":cluster:[stage]:services:[name]:hostname
        # In fact, the hosting server is always localhost, since we already checked that we're only running on a server with this DB role...
        my $dbname = $project_conf->{services}->{$self->{name}}->{dbname};
        my $dbhost = 'localhost'; #$self->{config}->{stages}->{$self->{global}->{stage}}->{hostname};
        my $dbport = $self->{config}->{stages}->{$self->{global}->{stage}}->{port}; #$self->{config}->{port};

        $self->info("Checking $self->{name} database '$dbname' on '$dbhost:$dbport'");
        $self->_check_db($option, $client_conf, $project_conf, $dbname, $dbhost, $dbport);
    }
}


#=============================================================================
# Method finish
#
# Called when the whole processing is finished : disconnect the cached database handles

sub finish {
    my $self = shift;

    # If there is a cached template1 connection, disconnect it to avoid "Issuing rollback() for database handle being DESTROY'd without explicit disconnect()" warning...
    $self->{dbh}->disconnect() if $self->{dbh};
}


#=============================================================================
# Method cron_run
#
# Run the regular cron tasks on a per-project basis, on the application servers,
# which is mainly DB backup for every project that uses this RDBMS.

sub cron_run {
    my $self = shift;

    my ($client, $project, $date, $interval) = @_;

    # Do not dump the DB is the config does not want it
    #   - the default dump interval is 'daily'
    #   - if a project specifies another interval, take it into account
    #   - an interval of 'none' will never be granted, thus no backup will be attempted
    #   - continue only if the wanted interval is the one we're currently running
    my $dump_interval = (exists($project->{services}->{$self->{name}}->{dump_interval}) ? $project->{services}->{$self->{name}}->{dump_interval} : 'daily');
    return unless ($dump_interval eq $interval);

    # Backup the project database, with basically the following command :
    #   pg_dump --format=t PGDATABASE | gzip > DUMP
    # Check the contents with :
    #   zcat DUMP | pg_restore --format=t --list
    # Eventually restore with :
    #   zcat DUMP | pg_restore --format=t --use-list=LIST --no-owner | psql --dbname PGDATABASE

    # The following configuration entry will trigger a restore (from the defined stage) instead of a dump :
    #  stages:
    #    mirror:
    #      db_restore_from: prod
    my $restore = (exists($project->{stages}->{$self->{global}->{stage}}->{db_restore_from}) ? $project->{stages}->{$self->{global}->{stage}}->{db_restore_from} : '' );

    # Some projects have manually hacked additionnal databases: don't forget to also dump them
    unless (exists($project->{services}->{$self->{name}}->{dbname})) {
        $self->warn("No database name found in config file for $client->{name}/$project->{name}");
        return;
    }
    my @dbname = ($project->{services}->{$self->{name}}->{dbname});
    push(@dbname, @{$project->{services}->{$self->{name}}->{otherdbs}}) if (exists($project->{services}->{$self->{name}}->{otherdbs}));

    foreach my $dbname (@dbname) {
        # Do not run the dump more than once for a single DB used by many projects (spit a message and get out)
        # Use the dump_interval parameter above to prevent dump for some of the projects that use the same DB
        if (exists($self->{_cron_run_dbname}->{($restore ? 'restore' : 'dump')}->{$dbname})) {
            $self->warn("Already ".($restore ? 'restored' : 'dumped')." $self->{name} database $dbname within ".$self->{_cron_run_dbname}->{($restore ? 'restore' : 'dump')}->{$dbname}." while trying $client->{name}/$project->{name} (use \"dump_interval: none\" to avoid)");
        } else {
            $self->run_sub(
                "cron run for $self->{name} ".($restore ? 'restoring' : 'dumping')." $dbname within $client->{name}/$project->{name}",
                $self->{global}->{permissions}->{user}->[1], $self->{global}->{permissions}->{group}->[1], # Use the doloforge administrator ID to execute the dump
                sub {
                    my $elapsed = time;
                    my $projectdir = "$self->{global}->{dir}->{shared}/$client->{name}/$project->{name}";
                    my $dumpdir = "$self->{name}/_dump/auto"; # This directory belongs to the doloforge administrator, who connects to the RDBMS
                    my $dumpfile  = "pg_dump.$dbname.".($restore || $self->{global}->{stage}).".$date.tar.gz"; # Dumps to the stage file, or restore from the defined stage file
                    my $dumpfiles = "pg_dump.$dbname.".($restore || $self->{global}->{stage}).".*.tar.gz";     # Glob matching all the dump files, in order to restore the lastest one
                    my $dumpglob  = "pg_dump.$dbname.$self->{global}->{stage}.*.tar.gz";                       # Used to search for older dump files for removal on the dump stage (not the restore stage)
                    my $keepdumps = ($self->{config}->{keepdumps} || 5) + 1; # Convert "number of files to keep" to "order from which to remove files" (passed to tail)
                    my $restorelog = "_pg_restore.$dbname.$self->{global}->{stage}.log"; # Restore log, which must NOT be removed by subsequent mirroring rsync, thus the leading "_"

                    # Prepare a dump command, in the project context (will work for all flavors of Debian Postgres clusters)
                    #   - load the project environment
                    #   - make sure the following pipe will report the result code of the first failing command (which will probably be pg_dump)
                    #   - pg_dump, TAR format, for easy restore with many options
                    #   - gzip the output
                    #   - store in the dump/auto/ directory
                    #   - never erase the previous dump until the new one is completed
                    #   - if everything is OK, then remove older dump files
                    my $dump_command = join(' ', split(/\s+/, # join(split("")) will simply remove formatting spaces and newlines in the output traces file and actual shell command...
                        "cd $projectdir;
                        source ./_conf/project_env.sh;
                        set -o pipefail -o errexit;
                        pg_dump --format=t $dbname
                        | gzip --to-stdout --best --rsyncable
                        > $dumpdir/.tmp.pg_dump.tar.gz;
                        mv -f $dumpdir/.tmp.pg_dump.tar.gz $dumpdir/$dumpfile;
                        ls -t $dumpdir/$dumpglob
                        | tail -n +$keepdumps
                        | xargs --no-run-if-empty rm"
                    ));
                    # Restore that dump with the following command :
                    #   - load the project environment
                    #   - we don't need the pipefail option here
                    #   - gunzip the dump file
                    #   - pg_restore, TAR format, but do not let it connect to the DB, in order to avoid commom problems
                    #   - let psql execute the SQL text
                    # Do not pipefail/errexit, because psql may trigger errors (rc=141) upon DROP CASCADE and subsequent DROPs
                    #    set -o pipefail -o errexit;
                    my $restore_command = join(' ', split(/\s+/,
                        "cd $projectdir;
                        source ./_conf/project_env.sh;
                        gunzip --to-stdout \$(ls -t $dumpdir/$dumpfiles | head -1)
                        | pg_restore --format=t --clean --no-owner
                        | grep -v -e '^DROP TRIGGER \"RI_ConstraintTrigger_'
                        | psql --quiet $dbname
                        > $dumpdir/$restorelog 2>&1"
                    ));

                    # Keep a trace of what command was run, an how to restore
                    $self->write_file(undef, "$projectdir/$dumpdir/readme_$dbname.txt",
                        "The dump was created with the following command:",
                        "\t($dump_command)",
                        "",
                        "Restore the database with the following command:",
                        "\t($restore_command)",
                    ) unless ($restore);

                    # Actually run the command...
                    my $command = ($restore ? $restore_command : $dump_command);
                    $self->info("Running command : $command");
                    my $rc = system('/bin/bash', '-c', $command);

                    # Test for return code et al, and report to the doloforge administrator
                    if ($rc == -1) {
                        $self->warn("Failed to execute $command: $!");
                    } elsif ($rc & 127) {
                        $self->warn("Child $command died with signal ".($rc & 127).", ".(($rc & 128) ? 'with' : 'without')." coredump");
                    } elsif ($rc >= 256) {
                        $self->warn("Child $command exited with value ".($rc >> 8));
                    } else {
                        $self->info("Finished $command rc=$rc elapsed=".(time - $elapsed));
                    }
                }
            );

            # Mark the DB as processed
            $self->{_cron_run_dbname}->{($restore ? 'restore' : 'dump')}->{$dbname} = "$client->{name}/$project->{name}";

            # Refresh the DB connections if the DB was restored, because of errors like
            #   la relation "tbl_doc" n'existe pas
            #   la relation d'OID 1614105246 n'existe pas
            # killall doesn't semem to work with complex process names :
            #   killall --verbose --signal HUP --regexp -- 'postgres: www-data $dbname'
            system("ps ax | grep 'postgres[:] .* $dbname' | awk '{print \$1}' | xargs --no-run-if-empty kill -TERM");
        }
    }
}


#=============================================================================
# Private method to select a count from the database
# The provided query must be of the form "SELECT count() FROM ..."
# ...resulting in a single row of a single column... which is returned by the method...

sub _get_count {
    my $self = shift;

    my ($dbh, $statement, @bind_values) = @_;
    my $count = 0;

    # DBI(3pm) : "...the statement handle returned will be stored in a hash associated with the $dbh."
    # Instead of $dbh->do(), we prefer to cache the query and reuse them for other runs on other projects.
    my $sth = $dbh->prepare_cached($statement); # Prepare the statement and cache it in the $dbh for later reuse
    $sth->execute(@bind_values);                # Execute the cached statement
    $sth->bind_columns(\$count);                # Bind the only SELECTed column to the local variable
    $sth->fetch;                                # Fetch the only row returned by the query
    $sth->finish();                             # Finish using the statement, for later reuse (because of the cache) and destruction without warning

    return $count;                              # Return the only data returned by the query
}


# Private method that checks the presence of a DB name, DB owner, etc.
sub _check_db {
    my $self = shift;

    my ($option, $client_conf, $project_conf, $dbname, $dbhost, $dbport) = @_;

    # Connect to the "template1" database, the always-available central point for other databases manipulation.
    # Also cache the created connection, for other projects's use in the same instance...
    # The user running this process (root) must have privileged access to the database server : check pg_hba.conf
    # "CREATE DATABASE cannot run inside a transaction block" : no transactions on this connection...
    $self->{dbh} ||= DBI->connect("DBI:Pg(RaiseError=>1,AutoCommit=>1):dbname=template1;host=$dbhost;port=$dbport")
        or $self->error("Postgres template1 database connection denied on '$dbhost:$dbport'.");
    my $dbh = $self->{dbh};

    # Check for $dbname existance in the pg_database : the query returns the number of databases with the required name (0 or 1, obviously)
    unless ($self->_get_count($dbh, 'SELECT count(datname) AS count FROM pg_database WHERE datname = ?', $dbname)) {

        # We do not use "prepare_cached" below, because database and user names are not strings, but identifiers in the DB.
        # They can't be replaced by "bind values" with "?" in the SQL statements. They must be hard-coded.
        # Proper encoding of the identifers is still necessary ($dbh->quote_identifier will add "" quoting around the identifier, and will properly quote inner characters)

        # If the user (and group) already exist (for previous project's need), do not create them again :
        unless ($self->_get_count($dbh, 'SELECT count(usename) AS count FROM pg_user WHERE usename = ?', $client_conf->{name})) {
            $self->message("Creating $self->{name} group '$client_conf->{name}'");
            $dbh->do('CREATE GROUP ' . $dbh->quote_identifier($client_conf->{name}));
            $self->message("Creating $self->{name} user '$client_conf->{name}'");
            $dbh->do('CREATE USER ' . $dbh->quote_identifier($client_conf->{name}) . ' IN GROUP ' . $dbh->quote_identifier($client_conf->{name}));
        }
        # Actually create the database :
        $self->message("Creating $self->{name} database '$dbname' on '$dbhost:$dbport'");
        $dbh->do('CREATE DATABASE ' . $dbh->quote_identifier($dbname) . ' WITH OWNER ' . $dbh->quote_identifier($client_conf->{name}) . ' ENCODING \'UNICODE\'');

        if ($project_conf->{description}) {
            # Add "COMMENT ON DATABASE" in the project database itself...
            # Reuse the $dbh variable itself, but still don't lose the connection to the template1 DB, cached in $self->{dbh}
            # No transaction, since there is only one statement...
            $dbh = DBI->connect("DBI:Pg(RaiseError=>1,AutoCommit=>1):dbname=$dbname;host=$dbhost;port=$dbport")
                or $self->error("Postgres $dbname database connection denied on '$dbhost:$dbport'.");
            # The $dbname string is a non-bindable DB identifier, thus the static SQL and the quote_identifier call...
            $dbh->do('COMMENT ON DATABASE ' . $dbh->quote_identifier($dbname) . ' IS ' . $dbh->quote($project_conf->{description}));
        }
    }
}



1;
__END__

=head1 AUTHOR

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

=head1 SEE ALSO

doloforge(1)

=cut
