#!/usr/bin/perl 
# make_sandbox
#    The MySQL Sandbox
#    Copyright (C) 2006, 2007, 2008, 2009 Giuseppe Maxia
#    Contacts: http://datacharmer.org
#
#    This program is free software; you can redistribute it and/or modify
#    it under the terms of the GNU General Public License as published by
#    the Free Software Foundation; version 2 of the License
#
#    This program 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 St, Fifth Floor, Boston, MA  02110-1301  USA

use strict;
use warnings;
# use Data::Dumper;
use English qw( -no_match_vars ); 
use MySQL::Sandbox qw( runs_as_root);
 
#my $install_dir = $PROGRAM_NAME;
#$install_dir =~ s{/\w+(\.pl)?$}{};

#unless ( $ENV{SANDBOX_HOME} ) { 
#    $ENV{SANDBOX_HOME} = "$ENV{HOME}/sandboxes";
#}

# eval "use lib q($install_dir)";

my $msb = MySQL::Sandbox->new();

runs_as_root();

my $where_to_install = shift
    or die "syntax $PROGRAM_NAME {VERSION|tarball_full_name} [options]\n";

my %options;
if ( $ARGV[0] && ($ARGV[0] eq '--export_binaries')) {
    shift;
    $options{export_binaries}++;
}


my $default_binary_base = $ENV{SANDBOX_BINARY} || ($ENV{HOME} . '/opt/mysql');
unless ( -d  $default_binary_base ) {
    $default_binary_base = '/opt/mysql';
}
my $binary_base = $ENV{'BINARY_BASE'} || $default_binary_base;

my $version;

my ($major, $minor, $release);

$where_to_install =~ s{ / \s* $ }{}x;

$where_to_install =~ s/^\s*\~/$ENV{HOME}/x;

# current directory
if  ( $where_to_install =~ m{^mysql\D+\d+\.\d+\.\d+.*\.tar\.gz$ }x ) { 
    $where_to_install = $ENV{PWD} . '/' . $where_to_install;
    unless ( -f $where_to_install ) {
        die "file not found in current directory ($where_to_install)\n";
    }
}

# bare version directory under $HOME/opt/bin
if  ( $where_to_install =~ /^(\d+)\.(\d+)\.(\d+)/x ) { 
    ($major, $minor, $release) =  ($1, $2, $3);
    $version = $where_to_install;
}
# absolute version directory
elsif  ( $where_to_install =~ m{^(/.+)/(\d+)\.(\d+)\.(\d+)$}x ) { 
    ($binary_base, $major, $minor, $release) =  ($1, $2, $3, $4);
    $version = "$major.$minor.$release";
    unless ( -d $where_to_install ) {
        die "directory not found ($where_to_install)\n";
    }
}
# full path to tarball
elsif  ( $where_to_install =~ m{^(/.+)/(mysql\D+(\d+)\.(\d+)\.(\d+)[^/]*)\.tar\.gz$ }x ) { 
    my $new_dir;
    unless ( -f $where_to_install ) {
        die "tarball file not found ($where_to_install)\n";
    }
    ($binary_base, $new_dir, $major, $minor, $release) =  ($1, $2, $3, $4, $5);
    print "unpacking $where_to_install\n";
    $version = "$major.$minor.$release";
    my $tar_executable='no_such_program';
    my $full_new_dir = "$binary_base/$version";
    if ( -d $full_new_dir ) {
        $where_to_install = $full_new_dir;
    }
    else {
        my $original_dir = $ENV{PWD};
        my @recognized_tar_executables = qw(gtar gnutar bsdtar);
        my $which_tar;
        my $tar_found = 0;
        for my $tar_exec (@recognized_tar_executables) {
            $which_tar = qx(which $tar_exec);
            if ((!$which_tar) or ($which_tar =~ /^no/i)) {
                next
            }
            else {
                $tar_found = 1; last
            }
        }
        unless ($tar_found ) {
            $which_tar = qx(which tar );
            if ((!$which_tar) or ($which_tar =~ /^no/i)) {
                $which_tar = undef;
            }
        }
        if ($which_tar) {
            chomp $which_tar;
            $tar_executable = $which_tar;
            my $tar_version = qx($tar_executable --help)
                or die "can't find tar program\n";
            unless ($tar_version =~ /(?:bsdtar|gnu\s+tar)/i) {
                die "this version of tar is not supported\n";
            }
        }
        else {
            die "tar program not found\n";
        }
        chdir $binary_base 
            or die "can't change directory to $binary_base\n";
        my $tar_file = $where_to_install;
        $tar_file =~ s{^.*/}{};
        my $result = system("gunzip -c $tar_file | $tar_executable -xf -");
        if ($result) {
            die "error unpacking $tar_file ($!)\n";
        }
        my $new_name = $version;
        if ($options{export_binaries} && ( -d $default_binary_base)) {
            $new_name = "$default_binary_base/$version";
            if ( -d $new_name) {
                warn "can't export to $binary_base. Directory $version already exists!\n";
                $new_name = $version;
            }
            else {
                $full_new_dir = $new_name;
                $binary_base = $default_binary_base;
            }
        }
        rename $new_dir, $new_name
            or die "can't rename $new_dir to $new_name";

        system "chmod -R ogu+r $new_name "; # Not sandbox related.
                                            # It is needed if the user wants 
                                            # to run the test suite

        $where_to_install = $full_new_dir;
        chdir $original_dir;
    }
}
# not a full path
elsif ($where_to_install =~ m{[^/].*\.tar\.gz$} ) {
    get_help( "You must enter a full path to the tarball. Relative paths are not supported.\n");
}
# not a tarball
elsif ($where_to_install =~ m{^/.*(?<!\.tar\.gz)$} ) {
    get_help( "Not a tarball ($where_to_install).\n"
            . "Accepted paramethers are: {VERSION|tarball_full_name} [options].\n");
}
# nothing was recognized. Print help
else {
    get_help();
}


sub get_help {
    my ($msg) = @_;
    print $msb->credits(), "\n"; 
    if ($msg) {
        my $len = length($msg);
        $len = 80 if $len > 80;
        print '*' x $len, "\n",
              $msg,
              '*' x $len, "\n";
    }
    print <<SYNTAX;
usage: ./make_sandbox version [options] {VERSION|tarball_full_name}.

  --export_binaries    exports the new binary to $binary_base

Additionally, you can pass any option accepted by "low_level_make_sandbox"
SYNTAX

    print "You should provide either a version from '$binary_base' \n",
          "or an absolute path to the tarball to extract.\n",
          "See (below) ./low_level_make_sandbox --help for more detail\n";
    print "version should be provided as #.#.#\n";
    exit 1;
    #print q{-} x 50, "\n";
    #exec "$install_dir/low_level_make_sandbox --help ";
}

my ($bare_basedir) = (split /\//, $where_to_install)[-1];

# print "<$bare_basedir>\n";exit;

unless ( -d $binary_base ) {
    die "$binary_base does not exist\n";
}

my @supported_versions = @{ MySQL::Sandbox::supported_versions() };

my $simple_version = "$major.$minor";

unless ( grep { $simple_version eq $_ } @supported_versions) {
    die "unsupported version $simple_version\n";
}

my $port = ($major . $minor. $release) ;

if ($port < 1024) {
    $port .= '0';
}

if ( -d "$binary_base/$bare_basedir" ) {

    my $text_version = $version;
    $text_version =~ tr/./_/d; ## no critic
    my @install_options = (
                "--basedir=$binary_base/$bare_basedir", 
                "--sandbox_directory=msb_$text_version",
                "--install_version=$simple_version",
                "--sandbox_port=$port",
                "--no_ver_after_name",
                @ARGV
            );
    if ($major >=5) {
        push(@install_options, qq(--my_clause=log-error=msandbox.err));
    }
    unless (grep {$_ eq '--no_show'} @install_options) {
        print "Executing low_level_make_sandbox ", join( " \\\n\t", @install_options ), "\n";
    }
    exec "low_level_make_sandbox", @install_options;
}
else {
    die "there is no $bare_basedir directory under $binary_base\n";
}


