The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl
# make_sandbox_from_installed
#    The MySQL Sandbox
#    Copyright (C) 2006-2016 Giuseppe Maxia
#
#    Licensed under the Apache License, Version 2.0 (the "License");
#    you may not use this file except in compliance with the License.
#    You may obtain a copy of the License at
#
#        http://www.apache.org/licenses/LICENSE-2.0
#
#    Unless required by applicable law or agreed to in writing, software
#    distributed under the License is distributed on an "AS IS" BASIS,
#    WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
#    See the License for the specific language governing permissions and
#    limitations under the License.

use strict;
use warnings;
use MySQL::Sandbox qw(runs_as_root exists_in_path greater_version);
my $repository=$ENV{SANDBOX_REPO} || 'https://github.com/datacharmer/mysql-docker-minimal/blob/master/dbdata';
my $sandbox_binary=$ENV{SANDBOX_BINARY} || "$ENV{HOME}/opt/mysql";
my $pound_line = '#' x 80;
my %supported_versions =
(
    '5.0'   => ['5.0.96'],
    '5.1'   => ['5.1.72'],
    '5.5'   => ['5.5.51', '5.5.52' ],
    '5.6'   => ['5.6.32', '5.6.33' ],
    '5.7'   => ['5.7.14', '5.7.15' ],
    '8.0'   => ['8.0.0' ]
);

runs_as_root();
# ---------------------------------------------------------------------------------
# main 
# ---------------------------------------------------------------------------------

my $remote_version = shift
    or get_help("version needed");

my $wget =  exists_in_path ('wget');
unless ($wget )
{
    get_help( 'wget was not found in PATH' );
}

unless ($^O =~ /linux/i)
{
    get_help("This operating system ($^O) is not supported");
}


%supported_versions = update_supported_versions();

if (exists $supported_versions{$remote_version})
{
    $remote_version = get_latest($remote_version);
}
elsif ($remote_version =~ /^(\d+\.\d+)/)
{
    my $short_version = $1;
    if ((exists $supported_versions{$short_version} ) 
        && grep { $remote_version eq $_} @{ $supported_versions{$short_version}} )
    {
        # Do nothing. The request version exists
    }
    else
    {
        get_help( "Could not find $remote_version");
    }
}
else
{
    get_help( "Unsupported version $remote_version")
}
if ($remote_version =~ /^(-h|--help)$/) 
{
    get_help();
}

my $download_file="$repository/$remote_version.tar.gz";

if ( ! -d $sandbox_binary )
{
    system "mkdir -p $sandbox_binary";
    if ($?)
    {
        die "Can't create $sandbox_binary ($!)\n";
    }
}

if ( ! -d $sandbox_binary )
{
    get_help("Unable to use or create $sandbox_binary")
}

chdir $sandbox_binary;

if ( -d $remote_version)
{
    get_help(  "\n$pound_line\n"
             . "### Version $remote_version already exists in $sandbox_binary\n"
             . "### Run 'make_sandbox $remote_version' to use it\n"
             . $pound_line
    );
}

my $local_file = "$remote_version.tar.gz";
print "wget -nv -O $local_file '$download_file?raw=true' \n";
system "wget -nv -O $local_file '$download_file?raw=true' ";
if ($?)
{
    die "Error downloading $download_file\n";
}

if ( ! -f $local_file)
{
    die "Error downloading $download_file. Can't find '$local_file'\n"; 
}

system "tar -xzf $local_file";
if ($?)
{
    die "Error extracting from $local_file\n";
}

if ( ! -d $remote_version)
{
    die "Directory $remote_version was not created\n";
}

$ENV{SANDBOX_BINARY} = $sandbox_binary;
$ENV{PWD} = $sandbox_binary;

exec "make_sandbox $remote_version @ARGV";

# ---------------------------------------------------------------------------------
# Functions
# ---------------------------------------------------------------------------------
sub get_help
{
    my ($msg) = @_;

    print MySQL::Sandbox::credits();
    if ($msg)
    {
        print "### $msg\n";
    }
    print<<END_HELP1;

This script tries to create a sandbox using binaries downloaded from the web.
The success of this scripts depends on good connectivity 
and availability of downloading tools.
##########################
# IT ONLY WORKS ON LINUX
##########################
The repository of available binaries is at $repository .
Supported:
END_HELP1

    for my $major (sort keys %supported_versions )
    {
        print "# $major -> [ @{ [ @{$supported_versions{$major}} ]} ] \n";
    }

    print<<END_HELP2;
The binaries are imported into $sandbox_binary .

  make_sandbox_from_url X.X.XX [options]

    where X.X.XX is the version number. 
    You can then pass any options accepted by make_sandbox.
END_HELP2

    if ($msg)
    {
        exit 1;
    }
    else
    {
        exit 0;
    }
}
sub get_latest
{
    my ($wanted) = @_;
    my @versions = @{ $supported_versions{$wanted}};
    return $versions[-1]; 
}

sub update_supported_versions
{
    my $catalog = "$repository/available.txt";
    my $return_self =0;
    unless ($ENV{GETLOCAL} )
    {
        system "wget -nv -O /tmp/available.txt '$catalog?raw=true' ";
        if ($?)
        {
            warn "Error downloading $catalog\n";
            $return_self =1;
        }
    }
    if ( ! -f '/tmp/available.txt' )
    {
        warn "Error downloading $catalog. Can't find 'available.txt'\n"; 
        $return_self = 1;
    }
    if ($return_self)
    {
        return %supported_versions;
    }

    open my $FH , '<', '/tmp/available.txt'
        or die "Error opening /tmp/available.txt\n";
    my %latest_versions;
    while (my $line = readline($FH))
    {
        chomp $line;
        next if $line =~ /^\s*$/;
        next if $line =~ /^\s*#/;
        if ($line =~ /(\S+)\s*=\s*(.*)/)
        {
            my $key = $1;
            my $value = $2;
            my @value_list = split ' ', $value;
            $latest_versions{$key} = \@value_list;
        }
    }
    close $FH;
    return %latest_versions;
}