#! @PERL@
#-*- perl -*-
# Copyright (C) 2000, 2001 R Development Core Team
#
# 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; either version 2, or (at your option)
# any later version.
#
# 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.
#
# A copy of the GNU General Public License is available via WWW at
# http://www.gnu.org/copyleft/gpl.html.	 You can also obtain it by
# writing to the Free Software Foundation, Inc., 59 Temple Place,
# Suite 330, Boston, MA  02111-1307  USA.

# Send any bug reports to r-bugs@r-project.org

use Cwd;
use File::Basename;
use File::Compare;
use File::Find;
use File::Path;
use Getopt::Long;
use R::Dcf;
use R::Utils;
use R::Rd;
#use strict;

## don't buffer output
$|=1;

my $revision = ' $Revision: 1.19.2.9 $ ';
my $version;
my $name;
$revision =~ / ([\d\.]*) /;
$version = $1;
($name = $0) =~ s|.*/||;

$make = '@MAKE@';

my @knownoptions = ("help|h", "version|v", "binary", "no-docs",
		    "use-zip", "use-zip-help", "use-zip-data", "force");

my $WINDOWS = R_getenv("R_UNDER_WINDOWS", 0);
my $tmpdir = R_getenv("TMPDIR", "/tmp");
my $R_exe = "${R_HOME}/bin/R";

if($WINDOWS){
    $tmpdir = R_getenv("TMPDIR", "/TEMP");
    die "Please set TMPDIR to a valid temporary directory\n" 
	unless (-e $tmpdir);
    $R_exe = "Rterm.exe";
    $MAKE = "make";
    @knownoptions = ("help|h", "version|v", "binary", "docs:s",
		    "use-zip", "use-zip-help", "use-zip-data", force);
}


GetOptions (@knownoptions) || usage();

R_version("R add-on package builder", $version) if $opt_version;
usage() if $opt_help;

my $startdir=getcwd();

my $R_platform = R_getenv("R_PLATFORM", "unknown-binary");

my $R_HOME = $ENV{'R_HOME'} ||
    die "Error: Environment variable R_HOME not found\n";

my $R_CMD = $ENV{'R_CMD'} ||
    die "Error: Environment variable R_CMD not found\n";

my $INS_opts = "";
$INS_opts .= " --use-zip" if $opt_use_zip;
$INS_opts .= " --use-zip-data" if $opt_use_zip_data;
$INS_opts .= " --use-zip-help" if $opt_use_zip_help;
if($WINDOWS) {
    $INS_opts .= " --docs=$opt_docs" if $opt_docs;
} else {
    $INS_opts .= " --no-docs" if $opt_no_docs;
}

if(!$opt_binary && $INS_opts ne "") {
    printf "** Options $INS_opts for --binary ignored\n";
}

## this is the main loop over all packages to be checked
my $pkg;
foreach $pkg (@ARGV){
    my $is_bundle=0;
    $pkg =~ s/\/$//;
    my $pkgname = basename($pkg);
    chdir($startdir);

    my $log = new R::Logfile();

    my $description;
    $log->checking("for file \`$pkg/DESCRIPTION'");
    if(-r "$pkg/DESCRIPTION"){
	$description = new R::Dcf("$pkg/DESCRIPTION");
	$log->result("OK");
    }
    else{
	$log->result("NO");
	exit(1);
    }
	
    
    if($opt_binary){
	my $libdir = "$tmpdir/Rbuild.$$";
	mkdir("$tmpdir/Rbuild.$$", 0755) ||
	    die "Cannot create directory $tmpdir/Rbuild.$$\n";

	if(system("$R_CMD INSTALL -l $libdir $INS_opts $pkg")){
	    $log->error("installation failed");
	}
	print("\n");
	chdir($libdir);
	
	my $pkgs = $pkgname;
	if($description->{"Contains"}){
	    $log->message("Looks like \`${pkg}' is a package bundle");
	    $is_bundle=1;
	    my @bundlepkgs = split(/\s+/, $description->{"Contains"});
	    $pkgs = join(" ", @bundlepkgs);
	}

	if($WINDOWS) {
	    my $filename =  "${pkgname}_" . $description->{"Version"};
	    $log->message("building \`$filename.zip'");
	    system("zip -r9X $startdir/$filename.zip $pkgs");
	    chdir($startdir);
	} else {
	    my $filename =  "${pkgname}_" . $description->{"Version"} .
		"_${R_platform}.tar";
	    $log->message("building \`$filename.gz'");
	    system("tar chf $startdir/$filename $pkgs");
	    chdir($startdir);
	    system("gzip -9f $filename");
	}

	rmtree($libdir);
    }
    else{
	if($description->{"Contains"}){
	    $log->message("Looks like \`${pkg}' is a package bundle");
	    $is_bundle=1;
	    my @bundlepkgs = split(/\s+/, $description->{"Contains"});
	    my $ppkg="";
	    foreach $ppkg (@bundlepkgs){
		$log->message("preparing \`$ppkg' in bundle \`$pkg':");
		$log->setstars("**");
		chdir($startdir);
		prepare_pkg("$pkg/$ppkg", $is_bundle, $description, $log);
		$log->setstars("*");
	    }
	}
	else{
	    $is_bundle=0;
	    chdir($startdir);
	    $log->message("preparing \`$pkg':");
	    prepare_pkg("$pkg", $is_bundle, $description, $log);
	}
	
	chdir($startdir);
	
	$log->message("removing junk files");
	find(\&deleteJunkFiles, $pkg);
	
	$exclude = "$tmpdir/Rbuild.$$";
	open exclude, "> $exclude" ||
	    die "Cannot write to \`$exclude'\n";
	binmode exclude if $WINDOWS;
	@excludepatterns = ("^.Rbuildignore\$", "\~\$");
	if(-f "$pkg/.Rbuildignore") {
	    open(RBUILDIGNORE, "$pkg/.Rbuildignore");
	    while(<RBUILDIGNORE>) {
		chop;
		push(@excludepatterns, $_);
	    }
	    close(RBUILDIGNORE);
	}
	chdir("$pkg/..");
	find(\&findExcludeFiles, "$pkgname");
	close exclude;
	
	my $filename = "${pkgname}_" . $description->{"Version"} . ".tar";
	$log->message("building \`$filename.gz'");
	my $filepath = "$startdir/$filename";
	if($WINDOWS) {
	    ## workaround for paths in Cygwin tar
	    $filepath =~ s+^([A-Za-x]):+//\1+;
	}	    
	system("tar chXf $exclude $filepath $pkgname");
	chdir($startdir);
	system("gzip -9f $filename");
	unlink($exclude);
    }
    $log->close();
    print("\n");
}

    
sub deleteJunkFiles {
    unlink($_) if /^(\.RData|\.Rhistory)$/;
    if(/^DESCRIPTION$/){
	unlink($_) if (-f "DESCRIPTION.in");
    }
}

sub findExcludeFiles {
    print exclude "$File::Find::name\n" if(-d $_ && /^check$/);
    print exclude "$File::Find::name\n" if(-d $_ && /^chm$/);
    print exclude "$File::Find::name\n" if(-d $_ && /[Oo]ld$/);
    print exclude "$File::Find::name\n" if /^GNUMakefile$/;
    print exclude "$File::Find::name\n" if /^CVS$/;
    my $filename = $File::Find::name;
    $filename =~ s/^[^\/]*\///;
    foreach $p (@excludepatterns) {
	print exclude "$File::Find::name\n" if($filename =~ /$p/);
    }
}


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

sub prepare_pkg {

    my ($pkg, $in_bundle, $description, $log) = @_;

    chdir($pkg);
    my $pkgdir = getcwd();
    my $pkgname = basename($pkg);

    if(-d "src"){
	chdir("src");
	$log->message("cleaning src");
	if($WINDOWS) {
	    if(-r "Makefile.win") {
		system("$make -f Makefile.win clean");
	    } else {
		my $file;
		foreach $file (<*.o $pkgname.a $pkgname.dll $pkgname.def>){
		    unlink($file);
		}
	    }
	} else{
	    my $file;
	    foreach $file (<*.o *s[lo]>){
		unlink($file);
	    }
	}
    }
    chdir($pkgdir);
    if(!$WINDOWS && -x "./cleanup"){
	$log->message("running cleanup");
	system("./cleanup");
    }

    updateIndex("INDEX", "man", 0, $log);
    updateIndex("data/00Index", "man", 1, $log) if(-d "data");
    
    1;
}

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

sub updateIndex {

    my ($oldindex, $Rdfiles, $dataset, $log) = @_;
    my $newindex = ".Rbuildindex.$$";

    $log->checking("whether \`$oldindex' is up-to-date");
    my $dataopt = "-d" if $dataset;
    system("${R_CMD} Rdindex $dataopt ${Rdfiles} > ${newindex}");

    if(-r $oldindex){
	if(compare($oldindex, $newindex) != 0){
	    $log->result("NO");
	    if($opt_force){
		$log->message("overwriting \`${oldindex}' as " .
			      "\`--force' was given");
		unlink $oldindex ;
		rename($newindex, $oldindex);
	    }
	    else{
		$log->message("use \`--force' to overwrite the existing \`${oldindex}'");
		unlink $newindex;
	    }
	}
	else{
	    $log->result("OK");
	    unlink $newindex;

	}
    }
    else{
	$log->result("NO");
	$log->message("creating new $oldindex");
	unlink $oldindex ;
	rename($newindex, $oldindex);
    }
    1;
}


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

sub usage {
    print STDERR <<END;
Usage: R CMD $name [options] pkgdirs

Build R packages from package sources in the directories specified by
pkgdirs. 

Options:
  -h, --help		print short help message and exit
  -v, --version		print version info and exit

  --force               force overwriting of (index) files

  --binary              build pre-compiled binary packages, with options:
END
    if($WINDOWS) {
    print "  --docs=TYPE           type(s) of documentation to build and install\n";
} else {
    print "  --no-docs             do not build and install documentation\n"
}
    print STDERR <<END;
  --use-zip-data        collect data files in zip archive
  --use-zip-help        collect help and examples into zip archives
  --use-zip             combine \`--use-zip-data\' and \`--use-zip-help\'

Email bug reports to <r-bugs\@r-project.org>.
END
    exit 0;
}