#!/usr/bin/perl

# Copyright (c) 2012, 2014, Oracle and/or its affiliates. All rights reserved.
#
# 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

# -*- cperl -*-
#
# MySQL Cluster compile script to bridge the gap between
# different build systems in different versions of MySQL Server
#
# This script is intended for internal use
#
use strict;
use Cwd 'abs_path';
use File::Basename;
use Getopt::Long;

# Automatically flush STDOUT
select(STDOUT);
$| = 1;

# Only add the command line options handled by this script, 
# thus acting like a filter and passing all other arguments
# straight through
my $opt_debug;
my $opt_build_type;
my $opt_build = 1;
my $opt_just_print;
my $opt_vanilla;
my $opt_autotest;
my $opt_valgrind;
my $opt_distcheck;
my $opt_parse_log;
Getopt::Long::Configure("pass_through");
GetOptions(

  # Build MySQL Server and NDB with debug
  'debug!' => \$opt_debug,
  'with-debug:s' => sub { $opt_debug = 1; },
  'build-type=s' => \$opt_build_type,
  'build!' => \$opt_build,
  'c|just-configure' => sub { $opt_build = 0; },
  'n|just-print' => \$opt_just_print,
  'vanilla' => \$opt_vanilla,
  'autotest' => \$opt_autotest,
  'valgrind' => \$opt_valgrind,
  'distcheck' => \$opt_distcheck,

  # Special switch --parse-log=<file> which reads a log file (from build) and
  # parses it for warnings
  'parse-log=s' => \$opt_parse_log,
) or exit(1);

# Find source root directory, assume this script is
# in <srcroot>/storage/ndb/
my $opt_srcdir = dirname(dirname(dirname(abs_path($0))));
die unless -d $opt_srcdir; # Sanity check that the srcdir exist
if ($^O eq "cygwin") {
  # Convert posix path to Windows mixed path since cmake
  # is most likely a windows binary
  $opt_srcdir= `cygpath -m $opt_srcdir`;
  chomp $opt_srcdir;
}

# Parse given log file for warnings
if ($opt_parse_log)
{
  use IO::File;
  my $file = IO::File->new($opt_parse_log, 'r')
      or die "Failed to open file $opt_parse_log: $!";
  my $parser = WarningParser->new(srcdir => $opt_srcdir,
				  unified => 1,
                                  verbose => 1);
  while (my $line = <$file>)
  {
    $parser->parse_line($line);
  }
  $parser->report($0);
  exit(0);
}

# Check that cmake exists and figure out it's version
my $cmake_version_id;
{
  my $version_text = `cmake --version`;
  print $version_text;
  die "Could not find cmake" if ($?);
  if ( $version_text =~ /^cmake version ([0-9]*)\.([0-9]*)\.*([^\s]*)/ )
  {
    #print "1: $1 2: $2 3: $3\n";
    $cmake_version_id= $1*10000 + $2*100 + $3;
    #print "cmake_version_id: $cmake_version_id\n";
  }
  die "Could not parse cmake version" unless ($cmake_version_id);
}

# Replace gcc with g++ in CXX environment variable
if(defined $ENV{"CXX"} and $ENV{"CXX"} =~ m/gcc/)
{
  my $old_cxx= $ENV{"CXX"};
  $ENV{"CXX"} =~ s/gcc/g++/;
  print("compile-cluster: switched CXX compiler from '$old_cxx' to '$ENV{CXX}'\n");
}

# Remove -fno-exceptions from CXXFLAGS environment variable
if(defined $ENV{"CXXFLAGS"} and $ENV{"CXXFLAGS"} =~ "-fno-exceptions")
{
  $ENV{"CXXFLAGS"} =~ s/-fno-exceptions//g;
  print("compile-cluster: stripped off -fno-exceptions from CXXFLAGS='$ENV{CXXFLAGS}'\n");
}

#
# Configure
#
{
  # Remove old CMakeCache.txt(ignore if not exists) to
  # force fresh configure
  unlink("CMakeCache.txt");

  my @args;
  if ($opt_debug)
  {
    print("compile-cluster: debug build requested\n");
    push(@args, "-DWITH_DEBUG=1");
    push(@args, "-DMYSQL_MAINTAINER_MODE=0");
  }

  if ($opt_vanilla)
  {
    # Use default options for building
    print("compile-cluster: vanilla build requested, no sugar\n");

    # Turn off automatic detection of WITH_NDBCLUSTER
    # in MySQL Cluster version(i.e when version string ends in -ndb-Y.Y.Y)
    push(@args, "-DWITH_NDB_DEFAULT_PLUGIN_DETECT=0");
  }
  else
  {
    # Hardcoded options controlling how to build MySQL Server
    push(@args, "-DWITH_SSL=bundled"); # Consistent error messages

    # Hardcoded options controlling how to build NDB
    push(@args, "-DWITH_PLUGIN_NDBCLUSTER=1");
    push(@args, "-DWITH_NDB_TEST=1");
    push(@args, "-DWITH_NDBAPI_EXAMPLES=1")
      unless ($^O eq "cygwin" or $^O eq "MSWin32")
  }

  if ($opt_autotest)
  {
    print("compile-cluster: autotest build requested, extra everything\n");
    push(@args, "-DWITH_NDB_CCFLAGS='-DERROR_INSERT'");
    push(@args, "-DWITH_EMBEDDED_SERVER=1");
  }

  if ($opt_valgrind)
  {
    print("compile-cluster: valgrind build requested, adjusting the knobs\n");
    # Add HAVE_purify to compiler flags in order to silence
    # inspected warnings
    push(@args, "-DCMAKE_C_FLAGS='-DHAVE_purify'");
    push(@args, "-DCMAKE_CXX_FLAGS='-DHAVE_purify'");
    # Turn on use of the valgrind headers to enhance detection
    push(@args, "-DWITH_VALGRIND=1");
  }

  # The cmake generator to use
  if ($opt_build_type)
  {
    push(@args, "-G \"$opt_build_type\"");
  }

  # Sets installation directory,  bindir, libdir, libexecdir etc.
  # The equivalent CMake variables are given without prefix
  # e.g if --prefix is /usr and --bindir is /usr/bin
  # then cmake variable (INSTALL_BINDIR) must be just "bin"
  my $opt_prefix;
  sub set_installdir
  {
    my($path, $varname) = @_;
    my $prefix_length = length($opt_prefix);
    if (($prefix_length > 0) && (index($path,$opt_prefix) == 0))
    {
      # path is under the prefix, remove the prefix and
      # maybe following "/"
      $path = substr($path, $prefix_length);
      if(length($path) > 0)
      {
        my $char = substr($path, 0, 1);
        if($char eq "/")
        {
          $path= substr($path, 1);
        }
      }
      if(length($path) > 0)
      {
        push(@args, "-D$varname=$path");
      }
    }
  }

  # Process --configure style arguments which need special conversion 
  my $opt_bindir;
  my $opt_libdir;
  my $opt_libexecdir;
  my $opt_includedir;
  my $opt_with_zlib_dir;
  my $opt_with_ssl;
  my $opt_localstatedir;
  my $opt_mysql_maintainer_mode;
  my $opt_with_gcov;
  my $opt_with_comment;
  my $opt_with_plugins;
  my $opt_without_plugin;
  my $opt_extra_charsets;
  my $opt_with_extra_charsets;  
  Getopt::Long::Configure("pass_through");
  GetOptions(
    'prefix=s' => \$opt_prefix,
    'srcdir=s' => \$opt_srcdir,
    'bindir=s' => \$opt_bindir,
    'libdir=s' => \$opt_libdir,
    'libexecdir=s' => \$opt_libexecdir,
    'includedir=s' => \$opt_includedir,
    'with-zlib-dir=s' => \$opt_with_zlib_dir,
    'with-ssl:s' => \$opt_with_ssl,
    'localstatedir=s' => \$opt_localstatedir,
    'mysql-maintainer-mode=s' => \$opt_mysql_maintainer_mode,
    'with-gcov' => \$opt_with_gcov,
    'with-comment=s' => \$opt_with_comment,
    'with-plugins=s' => \$opt_with_plugins,
    'without-plugin=s' => \$opt_without_plugin,
    'with-extra-charsets=s' => \$opt_with_extra_charsets,
    'extra-charsets=s' => \$opt_extra_charsets,
  ) or exit(1);

  if($opt_prefix)
  {
    push(@args, "-DCMAKE_INSTALL_PREFIX=$opt_prefix");
  }
  if($opt_bindir)
  {
    set_installdir($opt_bindir, "INSTALL_BINDIR");
  }
  if($opt_libdir)
  {
    set_installdir($opt_libdir, "INSTALL_LIBDIR");
  }
  if($opt_libexecdir)
  {
    set_installdir($opt_libexecdir, "INSTALL_SBINDIR");
  }
  if($opt_includedir)
  {
    set_installdir($opt_includedir, "INSTALL_INCLUDEDIR");
  }
  if($opt_with_zlib_dir)
  {
    $opt_with_zlib_dir = "system"
      if ($opt_with_zlib_dir ne "bundled");
    push(@args, "-DWITH_ZLIB=$opt_with_zlib_dir");
  }
  if($opt_with_ssl)
  {
    push(@args, "-DWITH_SSL=".($opt_with_ssl ? "yes" : "bundled"));
  }
  if ($opt_localstatedir)
  {
    push(@args, "-DMYSQL_DATADIR=$opt_localstatedir"); 
  }
  if ($opt_mysql_maintainer_mode)
  {
    push(@args, "-DMYSQL_MAINTAINER_MODE=" .
                 ($opt_mysql_maintainer_mode =~ /enable/ ? "1" : "0"));
  }
  if ($opt_with_gcov)
  {
    push(@args, "-DENABLE_GCOV=ON"); 
  }
  if ($opt_with_comment)
  {
    push(@args, "\"-DWITH_COMMENT=$opt_with_comment\""); 
  }
  if($opt_with_plugins)
  {
    my @plugins= split(/,/, $opt_with_plugins);
    foreach my $p (@plugins)
    {
      $p =~ s/-/_/g;
      push(@args, "-DWITH_".uc($p)."=1");
    }
  }
  if($opt_without_plugin)
  {
    push(@args, "-DWITHOUT_".uc($opt_without_plugin)."=1");
  }
  if ($opt_extra_charsets)
  {
    push(@args, "-DWITH_CHARSETS=$opt_extra_charsets"); 
  }
  if($opt_with_extra_charsets)
  {
    push(@args, "-DWITH_EXTRA_CHARSETS=$opt_with_extra_charsets");
  }
  

  # Default conversion of remaining args in ARGV from
  # 1) --arg          -> -DARG=1
  # 2) --arg=value    -> -DARG=value
  # 3) arg=value      -> environment variable arg=value
  foreach my $option (@ARGV)
  {
    if ($option =~  /^--/)
    {  
      # Remove leading --
      $option = substr($option, 2);
    
      my @v  = split('=', $option);
      my $name = shift(@v);
      $name = uc($name);
      $name =~ s/-/_/g;
      if (@v)
      {
        push(@args, "-D$name=".join('=', @v));
      }
      else
      {
        push(@args, "-D$name=1");
      }
    }
    else
    {
 
      # This must be environment variable
      my @v  = split('=', $option);
      my $name = shift(@v);
      if(@v)
      {
        $ENV{$name} = join('=', @v);  
      }
      else
      {
        die "unhandled argument '$option' found"; 
      }
    }
  }
  
  # The source directory to build from
  die "srcdir already contains CMakeCache.txt, this will not work!"
    if (-f "$opt_srcdir/CMakeCache.txt");
  push(@args, $opt_srcdir);
  
  cmd("cmake", @args);
}

#
# Build
#
if (!$opt_build)
{
  print "Configuration completed, skipping build(used --no-build)\n";
  exit(0);
}

{
  if ($cmake_version_id >= 20800)
  {
    # Use the universal "cmake --build <dir>" way of building
    # which is available from cmake 2.8 and works on all platforms
    my @args;
    push(@args, "--build");
    push(@args, ".");

    if ($^O eq "cygwin" or $^O eq "MSWin32")
    {
      # Choose to build RelWitDebInfo by default on Windows
      my $config = 'RelWithDebInfo';
      if ($opt_debug)
      {
	$config = 'Debug';
      }
      push(@args, "--config");
      push(@args, $config);
    }

    build_cmd("cmake", @args);

  }
  else
  {
    # Use make to build, not supported on Windows
    die "You need to install cmake with version > 2.8"
      if ($^O eq "cygwin" or $^O eq "MSWin32");

    build_cmd("make");
  }
}

if ($opt_distcheck)
{
    print "\n";
    print "NOTE! 'make distcheck' not (yet) supported in this version\n";
    print "\n";
}

exit(0);


sub cmd {
  my ($cmd, @a)= @_;
  my $cmd_str = join(' ', $cmd, @a);
  print "compile-cluster: '$cmd_str'\n";
  return if ($opt_just_print);
  system($cmd, @a)
    and print("command '$cmd_str' failed\n")
	  and exit(1);
}

use IPC::Open2;
sub build_cmd {
  my ($cmd, @args) = @_;
  my $cmd_str = join(' ', $cmd, @args);
  print "compile-cluster: '$cmd_str'\n";
  return if ($opt_just_print);
  $cmd_str.= " 2>&1";

  # Create warning parser and pass every ouput line through it
  my $parser = WarningParser->new(srcdir => $opt_srcdir,
                                  unified => 1,
                                  verbose => 1);

  my ($chld_out, $chld_in);
  my $pid = open2($chld_out, $chld_in, $cmd_str) or die $!;

  # Install handler to make sure that build is killed
  # off even in case the perl script dies
  local $SIG{__DIE__} = sub {
      print STDERR "Ooops, script died! Killing the build(pid = $pid)\n";

      # NOTE! Kill with negative signal number means kill process group
      my $ret = kill(-9, $pid);
      print STDERR "  kill(-9, $pid) -> $ret\n";

      # Just checking, should return 0
      $ret = kill(0, $pid);
      print STDERR "  kill(0, $pid) ->  $ret\n";

      # Wait for process to terminate
      print STDERR "  waitpid($pid, 0)\n";
      $ret= waitpid($pid, 0);
      print STDERR "  waitpid returned $ret!\n";
  };

  while (my $line = <$chld_out>)
  {
    if (!$parser->parse_line($line))
    {
      # Warning parser didn't print the line, print it
      print $line;
    }
  }
  waitpid($pid, 0);
  my $exit_status = $?;
  my $exit_code = ($exit_status >> 8);
  print "Build completed with exit_code: $exit_code(status: $exit_status)\n";
  if ($exit_code)
  {
    print("command '$cmd_str' failed: $!\n");
    exit(1);
  }
  $parser->report($0);
}


# Perl class used by WarningParser for keeping
# track of one individual warning
#
package WarningParser::Warning;
use strict;

sub new {
  my ($class, $file, $line, $text, $compiler)= @_;
  my $self= bless {
    FILE => $file,
    LINE => $line,
    TEXT => $text,
    COMPILER => $compiler,
  }, $class;
  return $self;
}

sub file {
  my ($self) = @_;
  return $self->{FILE};
}

sub line {
  my ($self) = @_;
  return $self->{LINE};
}

sub text {
  my ($self) = @_;
  return $self->{TEXT};
}

# Print the warning in verbose format for easier debugging
sub print_verbose {
  my ($self) = @_;

  print "{\n";
  foreach my $key (keys %$self)
  {
    print "  $key => '$self->{$key}'\n";
  }
  print "}\n";
}

# Print the warning in unified format(easy for automated build system to parse)
# emulate gcc
sub print_unified {
  my ($self) = @_;
  my $file = $self->file();
  my $line = $self->line();
  my $text = $self->text();
  print "$file:$line: warning: $text\n";
}

sub suppress {
  my ($self, $message) = @_;
  die if exists $self->{SUPPRESSED}; # Already suppressed
  die unless $message; # No message
  $self->{SUPPRESSED} = $message;
}

sub is_suppressed {
  my ($self) = @_;
  return exists $self->{SUPPRESSED};
}

sub is_cluster_warning {
  my ($self) = @_;
  my $file = $self->{FILE};
  # Have the string ndb in the file name(including
  # directory so everything below storage/ndb is
  # automatically included)
  if ($file =~ /ndb/)
  {
    return 1;
  }
  return 0;
}


package WarningParser;
use strict;
use Cwd 'abs_path';

sub new {
  my $class= shift;
  my %opts= ( @_ );
  my $srcdir = $opts{srcdir} || die "Must supply srcdir";
  my $verbose = $opts{verbose} || 0;
  my $unified = $opts{unified} || 0;
  my $track_dirs = $opts{track_dirs} || 0;

  my $self= bless {
    # empty array of warnings
    WARNINGS => [],

    # print each warning object as they are accumulated
    VERBOSE => $verbose,

    # print warnings in unified format(i.e the format
    # is converted to look like standard gcc). This makes it
    # easy for higher level tools to parse the warnings
    # regardless of compiler.
    UNIFIED => $unified,

    # Need to keep track of current dir since file name in
    # warnings does not include directory(this is normal
    # in makefiles generated by automake)
    TRACK_DIRS => $track_dirs,

    # Location of source
    SRCDIR => $srcdir,

  }, $class;
  return $self;
}

sub new_warning {
  my ($self, $file, $line, $text, $compiler) = @_;
  #print "new_warning>\n";
  #print "file: '$file', line: $line, text: '$text', compiler: '$compiler'\n";
  my $srcdir = $self->{SRCDIR};
  #print "srcdir: $srcdir\n";
  if ($self->{TRACK_DIRS})
  {
    # "file" does not contain directory, add currently
    # tracked dir
    my $dir = $self->{DIR};
    $file= "$dir/$file";
  }
  if (! -e $file)
  {
    # safety, "file" does not always contain full path
    # and thus calling 'abs_path' on a non existing file
    # would make the script die
    print "Hmmpf, creating warning for file without full path!\n";
  }
  else
  {
    # "srcdir" is in abs_path form, convert also "file" to abs_path
    $file = abs_path($file);
  }

  $file =~ s/^$srcdir//; # Remove leading srcdir
  $file =~ s:^\/::; # Remove leading slash

  return WarningParser::Warning->new($file, $line, $text, $compiler);
}

sub parse_warning {
  my ($self, $line) = @_;

  if ($self->{TRACK_DIRS})
  {
    # Track current directory by parsing makes
    # "Entering/Leaving directory" messages
    if ($line =~ /Entering directory \`(.*)\'/)
    {
      my $dir= $1;
      # Push previous dir onto stack before setting new
      push(@{$self->{DIRSTACK}}, $self->{DIR});
      $self->{DIR}= $dir;
    }

    if ($line =~ /Leaving directory \`(.*)\'/)
    {
      # Pop previous dir from stack and set it as current
      my $prevdir= pop(@{$self->{DIRSTACK}});
      $self->{DIR}= $prevdir;
    }
  }

  # cmake and Visual Studio 10(seems to use msbuild)
  if ($line =~ /^(\d+>)?\s*(.*)\((\d+)\): warning ([^ ]*:.*)$/)
  {
    return $self->new_warning($2, $3, $4, "vs10_msbuild");
  }

  # cmake and Visual Studio 9
  if ($line =~ /^(\d+>)?(?:[a-z]:)?([^:()]*)\((\d+)\) : warning ([^ ]*:.*)$/)
  {
    my ($project, $file, $lineno, $text) = ($1, $2, $3, $4);
    return $self->new_warning($file, $lineno, $text, "vs9");
  }

  # cmake and gcc with line number AND column
  if ($line =~ /([^ ]+\.(c|h|cc|cpp|hpp|ic|i|y|l)):([0-9]+):([0-9]+):[ \t]*warning:[ \t]*(.*)$/)
  {
    my ($file, $junk, $lineno, $colno, $text) = ($1, $2, $3, $4, $5);
    return $self->new_warning($file, $lineno, $text, , "gcc_with_col");
  }

  # cmake and gcc
  if ($line =~ /([^ ]+\.(c|h|cc|cpp|hpp|ic|i|y|l)):[ \t]*([0-9]+):[ \t]*warning:[ \t]*(.*)$/)
  {
    return $self->new_warning($1, $3, $4, "gcc");
  }

  return undef;
}

sub suppress_warning {
  my ($self, $w) = @_;

  # Ignore files not owned by cluster team
  if (!$w->is_cluster_warning())
  {
    $w->suppress('Warning in file not owned by cluster team');
    return 1;
  }

  if ($w->file() =~ /memcache\/extra/)
  {
    $w->suppress('Warning in imported memcache code');
    return 1; 
  }

  # List of supressions consisting of one regex for the dir+file name
  # and one for the warning text. The suppression is stored as a
  # list of arrays, where each array contains two precompiled
  # regexes. If both expressions match, the warning is suppressed.
  my @suppressions = (
    # [ qr/<dirname+filename regex>/, qr/<warning regex>/ ],
    [ qr/DbtuxMeta.cpp/, qr/Warray-bounds/ ],
  );

  foreach my $sup ( @suppressions )
  {
    my $file_pat = $sup->[0];
    my $text_pat = $sup->[1];
    if ($w->file() =~ /$file_pat/ and
	$w->text() =~ /$text_pat/)
    {
      $w->suppress("Suppressed by file suppression: '$file_pat, $text_pat'");
      return 1;
    }
  }

  return 0;
}

# Parse a line for warnings and return 1 if warning was
# found(even if it was suppressed)
#
sub parse_line {
  my ($self, $line) = @_;
  $self->{LINES}++;

  # Remove trailing line feed and new line
  $line =~ s/[\r]+$//g;
  $line =~ s/[\n]+$//g;

  my $w = $self->parse_warning($line);
  if (defined $w)
  {
    if (!$self->suppress_warning($w))
    {
      if ($self->{UNIFIED})
      {
        # Print the warning in UNIFIED format
        $w->print_unified();
      }
      else
      {
        # Just echo the line verbatim
	print "\n$line\n";
      }
    }
    # Print the warning object in verbose mode
    $w->print_verbose() if $self->{VERBOSE};

    # Save the warning for final report
    push(@{$self->{WARNINGS}}, $w);

    return 1;
  }

  return 0;
}

sub report {
  my ($self, $prefix) = @_;
  my $lines = $self->{LINES};

  my $warnings = 0;
  my $suppressed= 0;

  foreach my $w (@{$self->{WARNINGS}})
  {
    if ($w->is_suppressed())
    {
      $suppressed++;
    }
    else
    {
      $warnings++;
    }
  }
  my $total = $warnings + $suppressed;
  print "$prefix: $warnings warnings found(suppressed $suppressed of total $total)\n";
}

1;