#!/usr/bin/perl
# BEGIN BPS TAGGED BLOCK {{{
#
# COPYRIGHT:
#
# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC
#                                          <sales@bestpractical.com>
#
# (Except where explicitly superseded by other copyright notices)
#
#
# LICENSE:
#
# This work is made available to you under the terms of Version 2 of
# the GNU General Public License. A copy of that license should have
# been provided with this software, but in any event can be snarfed
# from www.gnu.org.
#
# This work is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
# 02110-1301 or visit their web page on the internet at
# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
#
#
# CONTRIBUTION SUBMISSION POLICY:
#
# (The following paragraph is not intended to limit the rights granted
# to you to modify and distribute this software under the terms of
# the GNU General Public License and is only of importance to you if
# you choose to contribute your changes and enhancements to the
# community by submitting them to Best Practical Solutions, LLC.)
#
# By intentionally submitting any modifications, corrections or
# derivatives to this work, or any other work intended for use with
# Request Tracker, to Best Practical Solutions, LLC, you confirm that
# you are the copyright holder for those contributions and you grant
# Best Practical Solutions,  LLC a nonexclusive, worldwide, irrevocable,
# royalty-free, perpetual, license to use, copy, create derivative
# works based on those contributions, and sublicense and distribute
# those contributions and any derivatives thereof.
#
# END BPS TAGGED BLOCK }}}
use strict;
use warnings;

use vars qw($Nobody $SystemUser $item);

# fix lib paths, some may be relative
BEGIN {
    require File::Spec;
    my @libs = ("lib", "local/lib");
    my $bin_path;

    for my $lib (@libs) {
        unless ( File::Spec->file_name_is_absolute($lib) ) {
            unless ($bin_path) {
                if ( File::Spec->file_name_is_absolute(__FILE__) ) {
                    $bin_path = ( File::Spec->splitpath(__FILE__) )[1];
                }
                else {
                    require FindBin;
                    no warnings "once";
                    $bin_path = $FindBin::Bin;
                }
            }
            $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib );
        }
        unshift @INC, $lib;
    }

}

use Term::ReadKey;
use Getopt::Long;

$| = 1; # unbuffer all output.

my %args = (
    dba => 'root',
    package => 'RT',
);
GetOptions(
    \%args,
    'action=s',
    'force', 'debug',
    'dba=s', 'dba-password=s', 'prompt-for-dba-password', 'package=s',
    'datafile=s', 'datadir=s', 'skip-create', 'root-password-file=s',
    'upgrade-from=s', 'upgrade-to=s',
    'help|h',
);

no warnings 'once';
if ( $args{help} || ! $args{'action'} ) {
    require Pod::Usage;
    Pod::Usage::pod2usage({ verbose => 2 });
    exit;
}

require RT;
RT->LoadConfig();
RT->InitClasses();

# Force warnings to be output to STDERR if we're not already logging
# them at a higher level
RT->Config->Set( LogToScreen => 'warning')
    unless ( RT->Config->Get( 'LogToScreen' )
             && RT->Config->Get( 'LogToScreen' ) =~ /^(debug|info|notice)$/ );

# get customized root password
my $root_password;
if ( $args{'root-password-file'} ) {
    open( my $fh, '<', $args{'root-password-file'} )
      or die "Couldn't open 'args{'root-password-file'}' for reading: $!";
    $root_password = <$fh>;
    chomp $root_password;
    my $min_length = RT->Config->Get('MinimumPasswordLength');
    if ($min_length) {
        die
"password needs to be at least $min_length long, please check file '$args{'root-password-file'}'"
          if length $root_password < $min_length;
    }
    close $fh;
}


# check and setup @actions
my @actions = grep $_, split /,/, $args{'action'};
if ( @actions > 1 && $args{'datafile'} ) {
    print STDERR "You can not use --datafile option with multiple actions.\n";
    exit(-1);
}
foreach ( @actions ) {
    unless ( /^(?:init|create|drop|schema|acl|coredata|insert|upgrade)$/ ) {
        print STDERR "$0 called with an invalid --action parameter.\n";
        exit(-1);
    }
    if ( /^(?:init|drop|upgrade)$/ && @actions > 1 ) {
        print STDERR "You can not mix init, drop or upgrade action with any action.\n";
        exit(-1);
    }
}

# convert init to multiple actions
my $init = 0;
if ( $actions[0] eq 'init' ) {
    if ($args{'skip-create'}) {
        @actions = qw(schema coredata insert);
    } else {
        @actions = qw(create schema acl coredata insert);
    }
    $init = 1;
}

# set options from environment
foreach my $key(qw(Type Host Name User Password)) {
    next unless exists $ENV{ 'RT_DB_'. uc $key };
    print "Using Database$key from RT_DB_". uc($key) ." environment variable.\n";
    RT->Config->Set( "Database$key", $ENV{ 'RT_DB_'. uc $key });
}

my $db_type = RT->Config->Get('DatabaseType') || '';
my $db_host = RT->Config->Get('DatabaseHost') || '';
my $db_port = RT->Config->Get('DatabasePort') || '';
my $db_name = RT->Config->Get('DatabaseName') || '';
my $db_user = RT->Config->Get('DatabaseUser') || '';
my $db_pass = RT->Config->Get('DatabasePassword') || '';

# load it here to get error immidiatly if DB type is not supported
require RT::Handle;

if ( $db_type eq 'SQLite' && !File::Spec->file_name_is_absolute($db_name) ) {
    $db_name = File::Spec->catfile($RT::VarPath, $db_name);
    RT->Config->Set( DatabaseName => $db_name );
}

my $dba_user = $args{'dba'} || $ENV{'RT_DBA_USER'} || $db_user || '';
my $dba_pass = $args{'dba-password'} || $ENV{'RT_DBA_PASSWORD'};

if ($args{'skip-create'}) {
    $dba_user = $db_user;
    $dba_pass = $db_pass;
} else {
    if ( !$args{force} && ( !defined $dba_pass || $args{'prompt-for-dba-password'} ) ) {
        $dba_pass = get_dba_password();
        chomp $dba_pass if defined($dba_pass);
    }
}

my $version_word_regex = join '|', RT::Handle->version_words;
my $version_dir = qr/^\d+\.\d+\.\d+(?:$version_word_regex)?\d*$/;

print "Working with:\n"
    ."Type:\t$db_type\nHost:\t$db_host\nPort:\t$db_port\nName:\t$db_name\n"
    ."User:\t$db_user\nDBA:\t$dba_user" . ($args{'skip-create'} ? ' (No DBA)' : '') . "\n";

foreach my $action ( @actions ) {
    no strict 'refs';
    my ($status, $msg) = *{ 'action_'. $action }{'CODE'}->( %args );
    error($action, $msg) unless $status;
    print $msg .".\n" if $msg;
    print "Done.\n";
}

sub action_create {
    my %args = @_;
    my $dbh = get_system_dbh();
    my ($status, $msg) = RT::Handle->CheckCompatibility( $dbh, 'create' );
    return ($status, $msg) unless $status;

    print "Now creating a $db_type database $db_name for RT.\n";
    return RT::Handle->CreateDatabase( $dbh );
}

sub action_drop {
    my %args = @_;

    print "Dropping $db_type database $db_name.\n";
    unless ( $args{'force'} ) {
        print <<END;

About to drop $db_type database $db_name on $db_host (port '$db_port').
WARNING: This will erase all data in $db_name.

END
        exit(-2) unless _yesno();
    }

    my $dbh = get_system_dbh();
    return RT::Handle->DropDatabase( $dbh );
}

sub action_schema {
    my %args = @_;
    my $dbh = get_admin_dbh();
    my ($status, $msg) = RT::Handle->CheckCompatibility( $dbh, 'schema' );
    return ($status, $msg) unless $status;

    print "Now populating database schema.\n";
    return RT::Handle->InsertSchema( $dbh, $args{'datafile'} || $args{'datadir'} );
}

sub action_acl {
    my %args = @_;
    my $dbh = get_admin_dbh();
    my ($status, $msg) = RT::Handle->CheckCompatibility( $dbh, 'acl' );
    return ($status, $msg) unless $status;

    print "Now inserting database ACLs.\n";
    return RT::Handle->InsertACL( $dbh, $args{'datafile'} || $args{'datadir'} );
}

sub action_coredata {
    my %args = @_;
    $RT::Handle = RT::Handle->new;
    $RT::Handle->dbh( undef );
    RT::ConnectToDatabase();
    RT::InitLogging();
    my ($status, $msg) = RT::Handle->CheckCompatibility( $RT::Handle->dbh, 'coredata' );
    return ($status, $msg) unless $status;

    print "Now inserting RT core system objects.\n";
    return $RT::Handle->InsertInitialData;
}

sub action_insert {
    my %args = @_;
    $RT::Handle = RT::Handle->new;
    RT::Init();
    my ($status, $msg) = RT::Handle->CheckCompatibility( $RT::Handle->dbh, 'insert' );
    return ($status, $msg) unless $status;

    print "Now inserting data.\n";
    my $file = $args{'datafile'};
    $file = $RT::EtcPath . "/initialdata" if $init && !$file;
    $file ||= $args{'datadir'}."/content";

    # Slurp in backcompat
    my %removed;
    my @back = @{$args{backcompat} || []};
    if (@back) {
        my @lines = do {local @ARGV = @back; <>};
        for (@lines) {
            s/\#.*//;
            next unless /\S/;
            my ($class, @fields) = split;
            $class->_BuildTableAttributes;
            $RT::Logger->debug("Temporarily removing @fields from $class");
            $removed{$class}{$_} = delete $RT::Record::_TABLE_ATTR->{$class}{$_}
                for @fields;
        }
    }

    my @ret = $RT::Handle->InsertData( $file, $root_password );

    # Put back the fields we chopped off
    for my $class (keys %removed) {
        $RT::Record::_TABLE_ATTR->{$class}{$_} = $removed{$class}{$_}
            for keys %{$removed{$class}};
    }
    return @ret;
}

sub action_upgrade {
    my %args = @_;
    my $base_dir = $args{'datadir'} || "./etc/upgrade";
    return (0, "Couldn't read dir '$base_dir' with upgrade data")
        unless -d $base_dir || -r _;

    my $upgrading_from = undef;
    do {
        if ( defined $upgrading_from ) {
            print "Doesn't match #.#.#: ";
        } else {
            print "Enter $args{package} version you're upgrading from: ";
        }
        $upgrading_from = $args{'upgrade-from'} || scalar <STDIN>;
        chomp $upgrading_from;
        $upgrading_from =~ s/\s+//g;
    } while $upgrading_from !~ /$version_dir/;

    my $upgrading_to = $RT::VERSION;
    return (0, "The current version $upgrading_to is lower than $upgrading_from")
        if RT::Handle::cmp_version( $upgrading_from, $upgrading_to ) > 0;

    return (1, "The version $upgrading_to you're upgrading to is up to date")
        if RT::Handle::cmp_version( $upgrading_from, $upgrading_to ) == 0;

    my @versions = get_versions_from_to($base_dir, $upgrading_from, undef);
    return (1, "No DB changes since $upgrading_from")
        unless @versions;

    if (RT::Handle::cmp_version($versions[-1], $upgrading_to) > 0) {
        print "\n***** There are upgrades for $versions[-1], which is later than $upgrading_to,\n";
        print   "***** which you are nominally upgrading to.  Upgrading to $versions[-1] instead.\n";
        $upgrading_to = $versions[-1];
    }

    print "\nGoing to apply following upgrades:\n";
    print map "* $_\n", @versions;

    {
        my $custom_upgrading_to = undef;
        do {
            if ( defined $custom_upgrading_to ) {
                print "Doesn't match #.#.#: ";
            } else {
                print "\nEnter $args{package} version if you want to stop upgrade at some point,\n";
                print "  or leave it blank if you want apply above upgrades: ";
            }
            $custom_upgrading_to = $args{'upgrade-to'} || scalar <STDIN>;
            chomp $custom_upgrading_to;
            $custom_upgrading_to =~ s/\s+//g;
            last unless $custom_upgrading_to;
        } while $custom_upgrading_to !~ /$version_dir/;

        if ( $custom_upgrading_to ) {
            return (
                0, "The version you entered ($custom_upgrading_to) is lower than\n"
                ."version you're upgrading from ($upgrading_from)"
            ) if RT::Handle::cmp_version( $upgrading_from, $custom_upgrading_to ) > 0;

            return (1, "The version you're upgrading to is up to date")
                if RT::Handle::cmp_version( $upgrading_from, $custom_upgrading_to ) == 0;

            if ( RT::Handle::cmp_version( $RT::VERSION, $custom_upgrading_to ) < 0 ) {
                print "Version you entered is greater than installed ($RT::VERSION).\n";
                _yesno() or exit(-2);
            }
            # ok, checked everything no let's refresh list
            $upgrading_to = $custom_upgrading_to;
            @versions = get_versions_from_to($base_dir, $upgrading_from, $upgrading_to);

            return (1, "No DB changes between $upgrading_from and $upgrading_to")
                unless @versions;

            print "\nGoing to apply following upgrades:\n";
            print map "* $_\n", @versions;
        }
    }

    print "\nIT'S VERY IMPORTANT TO BACK UP BEFORE THIS STEP\n\n";
    _yesno() or exit(-2) unless $args{'force'};

    my ( $ret, $msg );
    foreach my $n ( 0..$#versions ) {
        my $v = $versions[$n];
        my @back = grep {-e $_} map {"$base_dir/$versions[$_]/backcompat"} $n+1..$#versions;
        print "Processing $v\n";
        my %tmp = (%args, datadir => "$base_dir/$v", datafile => undef, backcompat => \@back);
        if ( -e "$base_dir/$v/schema.$db_type" ) {
            ( $ret, $msg ) = action_schema( %tmp );
            return ( $ret, $msg ) unless $ret;
        }
        if ( -e "$base_dir/$v/acl.$db_type" ) {
            ( $ret, $msg ) = action_acl( %tmp );
            return ( $ret, $msg ) unless $ret;
        }
        if ( -e "$base_dir/$v/content" ) {
            ( $ret, $msg ) = action_insert( %tmp );
            return ( $ret, $msg ) unless $ret;
        }
    }
    return 1;
}

sub get_versions_from_to {
    my ($base_dir, $from, $to) = @_;

    opendir( my $dh, $base_dir ) or die "couldn't open dir: $!";
    my @versions = grep -d "$base_dir/$_" && /$version_dir/, readdir $dh;
    closedir $dh;

    die "\nERROR: No upgrade data found in '$base_dir'!  Perhaps you specified the wrong --datadir?\n"
        unless @versions;

    return
        grep defined $to ? RT::Handle::cmp_version($_, $to) <= 0 : 1,
        grep RT::Handle::cmp_version($_, $from) > 0,
        sort RT::Handle::cmp_version @versions;
}

sub error {
    my ($action, $msg) = @_;
    print STDERR "Couldn't finish '$action' step.\n\n";
    print STDERR "ERROR: $msg\n\n";
    exit(-1);
}

sub get_dba_password {
    print "In order to create or update your RT database,"
        . " this script needs to connect to your "
        . " $db_type instance on $db_host (port '$db_port') as $dba_user\n";
    print "Please specify that user's database password below. If the user has no database\n";
    print "password, just press return.\n\n";
    print "Password: ";
    ReadMode('noecho');
    my $password = ReadLine(0);
    ReadMode('normal');
    print "\n";
    return ($password);
}

#   get_system_dbh
#   Returns L<DBI> database handle connected to B<system> with DBA credentials.
#   See also L<RT::Handle/SystemDSN>.


sub get_system_dbh {
    return _get_dbh( RT::Handle->SystemDSN, $dba_user, $dba_pass );
}

sub get_admin_dbh {
    return _get_dbh( RT::Handle->DSN, $dba_user, $dba_pass );
}

# get_rt_dbh [USER, PASSWORD]

# Returns L<DBI> database handle connected to RT database,
# you may specify credentials(USER and PASSWORD) to connect
# with. By default connects with credentials from RT config.

sub get_rt_dbh {
    return _get_dbh( RT::Handle->DSN, $db_user, $db_pass );
}

sub _get_dbh {
    my ($dsn, $user, $pass) = @_;
    my $dbh = DBI->connect(
        $dsn, $user, $pass,
        { RaiseError => 0, PrintError => 0 },
    );
    unless ( $dbh ) {
        my $msg = "Failed to connect to $dsn as user '$user': ". $DBI::errstr;
        if ( $args{'debug'} ) {
            require Carp; Carp::confess( $msg );
        } else {
            print STDERR $msg; exit -1;
        }
    }
    return $dbh;
}

sub _yesno {
    print "Proceed [y/N]:";
    my $x = scalar(<STDIN>);
    $x =~ /^y/i;
}

1;

__END__

=head1 NAME

rt-setup-database - Set up RT's database

=head1 SYNOPSIS

    rt-setup-database --action ... 

=head1 OPTIONS

=over

=item action

Several actions can be combined using comma separated list.

=over

=item init

Initialize the database. This is combination of multiple actions listed below.
Create DB, schema, setup acl, insert core data and initial data.

=item upgrade

Apply all needed schema/acl/content updates (will ask for version to upgrade
from)

=item create

Create the database.

=item drop

Drop the database.  This will B<ERASE ALL YOUR DATA>.

=item schema

Initialize only the database schema

To use a local or supplementary datafile, specify it using the '--datadir'
option below.

=item acl

Initialize only the database ACLs

To use a local or supplementary datafile, specify it using the '--datadir'
option below.

=item coredata 

Insert data into RT's database. This data is required for normal functioning of
any RT instance.

=item insert

Insert data into RT's database.  By default, will use RT's installation data.
To use a local or supplementary datafile, specify it using the '--datafile'
option below.

=back

=item datafile

file path of the data you want to action on

e.g. C<--datafile /path/to/datafile>

=item datadir

Used to specify a path to find the local database schema and acls to be
installed.

e.g. C<--datadir /path/to/>

=item dba

dba's username

=item dba-password

dba's password

=item prompt-for-dba-password

Ask for the database administrator's password interactively

=item skip-create

for 'init': skip creating the database and the user account, so we don't need
administrator privileges

=item root-password-file

for 'init' and 'insert': rather than using the default administrative password
for RT's "root" user, use the password in this file.

=item upgrade-from

for 'upgrade': specifies the version to upgrade from, and do not prompt
for it if it appears to be a valid version.

=item upgrade-to

for 'upgrade': specifies the version to upgrade to, and do not prompt
for it if it appears to be a valid version.

=back
