#!/usr/bin/perl

# BEGIN _new_install_
#*******************************************************************************
#*
#* Licensed Materials - Property of IBM
#* IBM XL C for OpenCL, V0.3 (technology preview)
#* technology preview
#* 
#* Copyright IBM Corp. 1990, 2008, and by others.   All Rights Reserved.
#* IBM is a registered trademark of IBM Corp. in the U.S., other
#* countries or both.
#* US Government Users Restricted Rights - Use, duplication or disclosure
#* restricted by GSA ADP Schedule Contract with IBM Corp.
#*
#* SCCS 1/21/11 1.15.16.4
#*******************************************************************************

$PROD     = 'xlc'; $ver = '0.3';

my $__TARGET_GCC__ = undef;
my $__RPM_PREFIX__ = undef;
my $__LIC_PREFIX__ = undef;
my $__LIC_DEFINE__ = undef;
my $__DBP_PREFIX__ = undef;

while (@ARGV > 0) {
  $tmpArg = shift(@ARGV);
  if    ($tmpArg eq '-v')         { $VERBOSE=1; }
  elsif ($tmpArg eq '-vv')        { $VERBOSE=1; $VERY_VERBOSE=1; }
  elsif ($tmpArg eq '-targetgcc') { $__TARGET_GCC__ = shift(@ARGV); }
  elsif ($tmpArg eq '-prefix')    { $__RPM_PREFIX__ = shift(@ARGV);
                                    $__RPM_PREFIX__ =~s/\/\/*/\//g;
                                    $__RPM_PREFIX__ =~s/\/*$//; }
  elsif ($tmpArg eq '-dbpath')    { $__DBP_PREFIX__ = shift(@ARGV);
                                    $__DBP_PREFIX__ =~s/\/\/*/\//g;
                                    $__DBP_PREFIX__ =~s/\/*$//; }
  elsif ($tmpArg eq "-${PROD}lic"){ $__LIC_PREFIX__ = shift(@ARGV);
                                    $__LIC_PREFIX__ =~s/\/\//\//;
                                    $__LIC_PREFIX__ =~s/\/*$//; }
}

{ # _beg_main_

  local $__BG_VERSION__   = undef; 
  local $__OPENCL_MODE__    = "cbe";

  my ($ibmcmp)        = (defined $__RPM_PREFIX__?$__RPM_PREFIX__:'opt/ibmcmp');

  my ($cmp_pkg)       = (&isOpenCL? 
    "opencl-$PROD-cmp":
    "$PROD.".&getCompilerVariation('.')."cmp");
  my ($lic_pkg)       = (&isOpenCL?
    "opencl-$PROD-lic":
    "$PROD.".&getCompilerVariation('.')."lic");
  my ($vacpp_pkg)     = "vacpp."  . &getCompilerVariation('.') . "cmp";
  my ($rte_pkg)       = ($PROD eq 'vac' ? "${PROD}pp." : "$PROD.")
                                  . &getCompilerVariation('.') . "rte";
  my ($xlfmsg_pkg)    = "xlf."    . &getCompilerVariation('.') . "msg.rte";
  my ($smplib_pkg)    = "xlsmp."  . &getCompilerVariation('.') . "lib";
  my ($masslib_pkg)   = "xlmass." . &getCompilerVariation('.') . "lib";

  my ($template)      = "etc/$PROD.base.cfg";
  my ($configure)     = "${PROD}_configure";
  my ($configure_cmd) = "bin/$configure";
  my ($lap)           = "lap/lapc";
  my ($umask)         = "0022";
  my (%isGCC);

  local (%TEMP);
  $TEMP{'DUMMYC'}      = &gen_tempfile ("${PROD}cfg_simple.c");
  $TEMP{'TEMPEXEC'}    = &gen_tempfile ("${PROD}cfg_simple");

  my (%packages);

  my (@executables) = ( 'gcc' );
  my (@packages)    = ( $cmp_pkg, $lic_pkg, $rte_pkg, $smplib_pkg, $masslib_pkg );
  if ($PROD eq 'vac') {
    push (@packages, $vacpp_pkg);
  } elsif ($PROD eq 'xlf') {
    push (@packages, $xlfmsg_pkg);
  }
  my (%keys) = (
    $lic_pkg     => 'lib/libxlcmp.so.1',
    $masslib_pkg => 'lib/libmassvp4.a',
    $smplib_pkg  => 'lib/libxlsmp.a',
  );

  if ($PROD eq 'vac' || $PROD eq 'xlc') {
    $keys{$cmp_pkg}   = 'exe/xlcentry';
    $keys{$vacpp_pkg} = 'exe/xlCentry';
    $keys{$rte_pkg}   = 'lib/' . &getCompilerVariation('/') . 'libibmc\+\+.so';
  } elsif ($PROD eq 'xlf') {
    $keys{$cmp_pkg}   = 'exe/xlfentry';
    $keys{$rte_pkg}   = 'lib/' . &getCompilerVariation('/') . 'libxlfmath.so';
  }

  # Set the umask to the standard 0077 for root because we cannot assume
  # customer has the proper umask value
  umask oct($umask);

  unless (&isOpenCL) {
    &click_accept(&get_package_install_location ($cmp_pkg, $keys{$cmp_pkg}),$lap)
      or printAndDie ("Default compiler configuration file could not be generated. ");
  }

  foreach $p (@packages) {
    $packages{$p} = &get_package_install_location ($p, $keys{$p});
    printExtraDebug ("WARNING: \"$p\" not installed.") unless (defined ($packages{$p}));
  }

  $packages{$lic_pkg} = $packages{$cmp_pkg} if ($__LIC_DEFINE__);

  foreach $e (@executables) {
    $executables{$e} = &get_executable_path ($e);
    printExtraDebug ("\"$e\" not found.") unless (defined ($executables{$e}));
  }

#*******************************************************************************
  # check for must haves..
  printDebug ("Checking for essential data..");
  my (@must_packages) = (
    (&isOpenCL?():($smplib_pkg, $masslib_pkg, $lic_pkg, $rte_pkg)),
    $cmp_pkg);
  if ($PROD eq 'vac') {
    push (@must_packages, $vacpp_pkg);
  }

  foreach (@must_packages) {
    unless (defined ($packages{$_})) {
      printErr ("Could not determine install location of \"$_\".");
      printAndDie ("Please run \"$configure\" manually.");
    }
  }
  foreach ('gcc') {
    unless (defined ($executables{$_})) {
      printErr ("Could not determine location of \"$_\".");
      printAndDie ("Please run \"$configure\" manually.");
    }
  }
  if (&isBlueGene()) {
    unless (-e "$__TARGET_GCC__/bin/gcc") {
      printErr ("Could not determine location of Blue Gene tool chain.");
      printAndDie ("Please run \"$configure\" manually.");
    }
  }

  # test if 32-bit and 64-bit GCC are installed
  &gen_c_program($TEMP{'DUMMYC'});
  $isGCC{'32-bit'} = &testCompilerOption($executables{'gcc'},
                                    '-m32',
                                    $TEMP{'DUMMYC'},
                                    undef);
  &gen_c_program($TEMP{'DUMMYC'});
  $isGCC{'64-bit'} = &testCompilerOption($executables{'gcc'},
                                    '-m64',
                                    $TEMP{'DUMMYC'},
                                    undef);

  if (&isBlueGene()) {
    &gen_c_program($TEMP{'DUMMYC'});
    $isGCC{'Blue Gene'} = &testCompilerOption("$__TARGET_GCC__/bin/gcc",
                                    '',
                                    $TEMP{'DUMMYC'},
                                    undef);
  }
  else {
    $isGCC{'Blue Gene'} = 1;
  }

  foreach $check ('32-bit', '64-bit', 'Blue Gene') {
    unless ($isGCC{$check} == 1) {
      unless ($check eq 'Blue Gene') {
        printErr ("Could not determine location of $check GCC.  Suggestion: Ensure $check \"glibc-devel\", $check \"libgcc\", $check \"libstdc++\", and $check \"libstdc++-devel\" are installed.  These packages can be obtained from your operating system install media.");
      }
      else {
      	printErr ("Could not determine location of $check GCC.");
      }
      $isGCC{$check} = 0;
    }
  }
  unless ($isGCC{'32-bit'} and $isGCC{'64-bit'} and $isGCC{'Blue Gene'}) {
    printAndDie ("Please ensure all relevant 32 and 64-bit GCC packages" . (&isBlueGene() ? ", and the Blue Gene tool chain, " : " ") .
                 "are installed before running \"new_install\" again.  If they are installed but cannot be detected by \"new_install\", please run \"$configure\" manually.");
  }

  # we only need the 'root' of the gcc install
  $executables{'gcc'} =~ /^(\S+)\/bin\/gcc$/;
  my ($gcc_location) = $1;

  # check to ensure we have the configure command..
  unless (-e "$packages{$cmp_pkg}/$configure_cmd") {
    printErr ("\"$packages{$cmp_pkg}/$configure_cmd\" does not exist");
    printAndDie ("Please run \"$configure\" manually.");
  }

  # check to ensure the default configuration file location exists..
  if (! -e "/$ibmcmp/$PROD/" . &getCompilerVariation('/') . "$ver/etc") {
    unless (system ("mkdir -p /$ibmcmp/$PROD/" . &getCompilerVariation('/') . "$ver/etc") == 0) {
      printErr ("Could not create \"/$ibmcmp/$PROD/" . &getCompilerVariation('/') . "$ver/etc\" -- $!");
      printAndDie ("Please run \"$configure\" manually.");
    }
  }

#*******************************************************************************

  my ($target_cfg)    = "$packages{$cmp_pkg}/etc/${PROD}.cfg" . "." . &getConfigExt();
  my ($cmd) = join (' ',
    "$packages{$cmp_pkg}/$configure_cmd",
    (&isOpenCL?():
      ("-smprt  $packages{$smplib_pkg}",
      "-mass   $packages{$masslib_pkg}")),
    "-$PROD  $packages{$cmp_pkg}",
    "-o      $target_cfg",
    "$packages{$cmp_pkg}/$template",
    "-gcc    $gcc_location",
    "-gcc64  $gcc_location",
  );

  if (&isBlueGene()) {
    $cmd .= " -targetgcc $__TARGET_GCC__";
  }

  # Option compiler filesets..
  if ($PROD eq 'vac') {
    if (defined ($packages{$vacpp_pkg})) {
      $cmd .= " -vacpp   $packages{$vacpp_pkg}";
      $cmd .= " -vacpprt $packages{$rte_pkg}/${PROD}pp/" . &getCompilerVariation('/') . $ver;
      $cmd .= " -vaclic  $__LIC_PREFIX__$packages{$lic_pkg}";
    }
  } elsif ($PROD eq 'xlf') {
    if (defined ($packages{$rte_pkg})) {
      $cmd .= " -xlfrt  $packages{$rte_pkg}/$PROD/"       . &getCompilerVariation('/') . $ver;
      $cmd .= " -xlflic $__LIC_PREFIX__$packages{$lic_pkg}";
    }
  }

  &save_cfg ("$target_cfg")
    or printAndDie ("Default compiler configuration file could not be generated.");

  printDebug ("Running: \"$cmd\"..");
  unless (system ($cmd) == 0) {
    printErr ("Default compiler configuration file could not be generated.");
    printAndDie ("Please run \"$configure\" manually.");
  } else {
    printDebug ("Default compiler configuration file generated successfully.");
  }

  exit 0;
} # _end_main_

#*******************************************************************************

sub get_executable_path {
#*******************************************************************************
#* Looks for the given executable in the $PATH variable. Returns the path
#* returned by the 'which' command if found; undef otherwise.
#*******************************************************************************
  my ($exec) = $_[0];
  printDebug ("Looking for location of \"$exec\"..");
  if ($ENV{'PATH'}=~m/ccache/ && $exec eq 'gcc' && &isOpenCL) {
    my $newPath=$ENV{'PATH'};
    $newPath=~s/([\:]*ccache[\:]*)//;
    open (WHICH, "PATH=$newPath && which $exec 2>/dev/null |") or return undef;
  } else {
    open (WHICH, "which $exec 2>/dev/null |") or return undef;
  }
  my ($path) = <WHICH>; chomp ($path);
  close (WHICH);
  return undef unless (-e "$path");
  printExtraDebug ("Found \"$exec\" at \"$path\"");
  return "$path";
} # END get_executable_path ()

sub get_package_install_location {
#*******************************************************************************
#* Looks for the install receipt for the given package.  Returns the install
#* location of the package if found; undef otherwise.
#*******************************************************************************
  my ($pkg) = $_[0];
  my ($key) = $_[1];
  my ($loc);

  printDebug ("Looking for install location of \"$pkg\" using \"$key\"..");
  return undef unless (defined ($key));
  open (RPM_Q, "rpm -ql $pkg ".
    (defined $__DBP_PREFIX__?"--dbpath $__DBP_PREFIX__":"")."|") or return undef;
  while (<RPM_Q>) { chomp;
    if (/(\S+)\/$key/) { $loc = $1; $loc = undef unless ($loc=~m/^\Q$__RPM_PREFIX__\E/); }
  } # END _while_
  close (RPM_Q);

  return undef unless (defined ($loc));
  printExtraDebug ("Found \"$pkg\" installed at \"$loc\"");
  return "$loc";
} # END get_package_install_location ()

sub save_cfg {
#******************************************************************************
#* If the given file already exists, create a back up and return the backed
#* up file name. If the file does not exist, then undef is returned. 0 is
#* returned otherwise.
#******************************************************************************
  my ($file)      = $_[0];
  my ($sec,$min,$hour,$mday,$mon,$year) = (localtime())[0..5];
  $mon++; $year+=1900 if $year < 1900;
  my ($timestamp) = "$year.$mon.$mday.$hour.$min.$sec";
  my ($backup)    = "$file.$timestamp";
  my ($rc)        = 0;

  printDebug ("Looking for previous version of \"$file\"..");
  if (-e "$file") {
    printExtraDebug ("Existing configuration file was found.");
    if (rename  ("$file", "$backup") == 0) {
      printErr  ("Existing configuration file \"$file\" could not be backed up as \"$backup\" -- $!");
      printErr  ("Please manually rename or delete this file and run \"new_install\" again.");
      $rc = 0;
    } else {
      printInfo ("Existing configuration file \"$file\" has been saved as \"$backup\".");
      $rc = 1;
    }
  } else {
    # Configuration file does not exist, so no need to do anything..
    printDebug ("No previous version of the file was found.");
    $rc = 1;
  } # END _if_exists_

  return $rc;
} # END save_cfg ()

sub testCompilerOption {
#*******************************************************************************
#* Generate the command "$compiler $option $dummy".
#* $dummy is the input file provided when the function is invoked.
#* The information (e.g. error/warning) of the compilation will be saved to
#* $out if it is defined
#* Returns 1 if compiled successfully
#*******************************************************************************
  my ($compiler) = $_[0];
  my ($option)   = $_[1];
  my ($dummy)    = $_[2];
  my ($out)      = $_[3];
  my ($exec)     = $TEMP{'TEMPEXEC'};
  my ($rc);

  if (defined $out) { open (OUT, ">$out") or return undef; }
  printDebug ("Running: \"$compiler $option $dummy -o $exec\"..\n");
  open (CCOUT, "$compiler $option $dummy -o $exec 2>&1 |") or return undef;
  while (<CCOUT>) { chomp;
    printExtraDebug ("$_");
    if (defined $out) { print OUT "$_\n"; }
  }
  $rc = close (CCOUT);

  if (defined ($out)) {
    close (OUT) or return undef;
    printDebug ("Output written to \"$out\".");
  }

  foreach ($dummy,$exec) { unlink ($_); }
  return $rc;
} # END testCompilerOption ()

sub gen_tempfile {
#******************************************************************************
#* Takes in a string and returns a process unique temporary file name.
#******************************************************************************
  my ($string) = $_[0];
  my ($unique) = "/tmp/__${$}_${string}";
  return $unique;
} # END gen_tempfile ()

sub gen_c_program {
#*******************************************************************************
#* Create dummy C program with the given file name
#*******************************************************************************
  my ($file) = $_[0];
  unless (open (FILE, ">$file")) {
    printErr ("Error: Cannot create dummy C program \"$file\""); return 0;
  }
  print FILE "int main() { return 0; }\n";
  close (FILE) or return undef;
  printDebug ("Simple C program \"$file\" created.");
  return 1;
} # END gen_c_program ()

sub isFedora {
#******************************************************************************
#* Returns true if operating system is Fedora
#******************************************************************************
  my ($osFilename) = "/etc/fedora-release";
  if (-e $osFilename && &isLinux) { return 1; }
  else                            { return 0; }
} # END isFedora ()

sub isYHPC {
#******************************************************************************
#* Returns true if operating system is YHPC
#******************************************************************************
  my ($osFilename) = "/etc/yhpc-release";
  if (-e $osFilename && &isLinux) { return 1; }
  else                            { return 0; }
} # END isYHPC ()

sub isRHEL {
#******************************************************************************
#* Returns true if operating system is Red Hat
#******************************************************************************
  my ($osFilename) = "/etc/redhat-release";
  if (-e $osFilename) { return 1; }
  else                { return 0; }
} # END isRHEL

sub isSLES {
#******************************************************************************
#* Returns true if operating system is SLES
#******************************************************************************
  my ($osFilename) = "/etc/SuSE-release";
  if (-e $osFilename) { return 1; }
  else                { return 0; }
} # END isSLES

sub getCompilerVariation {
#******************************************************************************
#* Returns 'bg.' if &isBlueGene() is true, '' otherwise
#******************************************************************************
  my $separator = shift;
  return (&isBlueGene() ? "bg$separator" : '');
} # END getCompilerVariation ()

sub getConfigExt {
#******************************************************************************
#* Returns the extension of the configure file associate with different system
#******************************************************************************
  my $gcc_ver = `rpm -q --qf '%{VERSION}\\n' gcc | sed -e 's/\\.//g'`;
  my ($os_rel,$os) = ();
  my $ext = "";
  
  if(&isRHEL()) {
    $os_rel = `lsb_release -r`;
    $os_rel =~ s/Release:[ \t]*//g;
    $os     = 'rhel';
    chomp $gcc_ver; chomp $os_rel;
    $ext    = "$os$os_rel.gcc$gcc_ver";
  } elsif (&isSLES()) {
    $os_rel = `head -1 /etc/SuSE-release | sed -e "s/ppc64//Ig" -e "s/[a-z() ]*//Ig"`;
    $os     = 'sles';
    chomp $gcc_ver; chomp $os_rel;
    $ext    = "$os$os_rel.gcc$gcc_ver";
  }

  return $ext;
} # END getConfigExt ()

sub getBlueGeneVersion {
#******************************************************************************
#* Returns the Blue Gene version if it's defined, otherwise returns undef
#******************************************************************************
  return $__BG_VERSION__;
} # END getBlueGeneVersion ()

sub getOpenCLMode {
#******************************************************************************
#* Returns the Cell source mode if it's defined, otherwise returns undef
#******************************************************************************
  return $__OPENCL_MODE__;
} # END getOpenCLMode ()

sub isBlueGene {
#******************************************************************************
#* Returns true if operating system is SLES and getBlueGeneVersion() is defined
#******************************************************************************
  if (&isSLES && defined(&getBlueGeneVersion())) { return 1; }
  else                                           { return 0; }
} # END isBlueGene ()

sub isOpenCL {
#******************************************************************************
#* Returns true if targetting operating system is cell
#******************************************************************************
  return &getOpenCLMode();

  return 0;
} # END isOpenCL ()

sub printDebug {
#******************************************************************************
#* Prints only if in verbose mode..
#******************************************************************************
  return 1 unless ($VERBOSE);
  my ($str) = $_[0]; print "DEBUG: $str\n"; return 1;
} # END printDebug ()

sub printExtraDebug {
#******************************************************************************
#* Prints only if in very verbose mode..
#******************************************************************************
  return 1 unless ($VERY_VERBOSE);
  my ($str) = $_[0]; print "DEBUG: --$str\n"; return 1;
} # END printDebug ()

sub printWarn {
#******************************************************************************
#* Prints given string prefixed with "WARNING:" to standard error.
#******************************************************************************
  my ($str) = $_[0]; print STDERR "WARNING: $str\n"; return 1;
} # END printWarn ()

sub printInfo {
#******************************************************************************
#* Prints given string prefixed with "INFORMATIONAL:" to standard error.
#******************************************************************************
  my ($str) = $_[0]; print STDERR "INFORMATIONAL: $str\n"; return 1;
} # END printInfo ()

sub printErr {
#******************************************************************************
#* Prints given string prefixed with "ERROR:" to standard error.
#******************************************************************************
  my ($str) = $_[0]; print STDERR "ERROR: $str\n"; return 1;
} # END printErr ()

sub printAndDie {
#******************************************************************************
#* Prints only if in very verbose mode..
#******************************************************************************
  my ($str) = $_[0]; print STDERR "ERROR: $str\n"; exit 1;
} # END printAndDie ()

sub click_accept {
#******************************************************************************
#* Runs license accept process..
#*
#* Return values of LAP tool:
#* 1 : no LAP status available
#* 3 : declined
#* 5 : bypassed
#* 9 : accepted
#* 11: exception during retrieval of LA files
#* 13: exception during retrieval of LI files
#* 15: exception during recording of status and text license files
#* 17: missing arguments exception
#* 18: invalid arguments exception
#* 19: path to license files is invalid
#* 20: path to read status file is invalid
#* 21: path to write status file is invalid
#******************************************************************************
  my ($loc)       = $_[0];
  my ($lap)       = $_[1];
  my ($rc)        = 0;

  unless (-e "$loc/$lap") {
    printDebug ("LAP tool \"$loc/$lap\" does not exist.");
    printErr ("Could not determine the location of LAP tool.");
    return 0;
  }

  unless (-e "$loc/lap/license/status.dat") {
    print "\n";
    print "If your language of preference is not available, please\n";
    print "exit the application and view the PDF version of the\n";
    print "license ($loc/license.pdf) before proceeding.\n";
    print "\n";
  }

  my ($lap_cmd) = join (' ',
    "cd $loc &&",
    "$lap",
    "-l $loc/lap",
    "-s $loc/lap",
  );

  printDebug ("Running: $lap_cmd");
  $rc = system ($lap_cmd) >> 8;
  if ($rc == 21) {
    print "\n";
    print "Please ensure you have write permission in $loc/lap location\n";
    print "You must be a superuser to run this script.\n";
  } elsif ($rc == 20) {
    print "\n";
    print "Please ensure you have read permission in $loc/lap location\n";
    print "You must be a superuser to run this script.\n";
  }
  printDebug ("LAP return code: $rc");
  unless ($rc == 9) {
    printErr ("License NOT accepted.");
    return 0;
  }

  return 1;

} # END click_accept ()

# END _new_install_

