The R Project SVN R

#! @PERL@
#-*- perl -*-

use Cwd;
use File::Basename;
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.6 $ ';
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");

GetOptions (@knownoptions) || usage();

R_version($name, $version) if $opt_version;
usage() if $opt_help;

my $startdir=getcwd();

my $tmpdir = R_getenv("TMPDIR", "/tmp");
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 $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;
$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 that shall 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_HOME}/bin/R INSTALL -l $libdir $INS_opts $pkg")){
        $log->error("installation failed");
    }
    print("\n");
    chdir($libdir);
    my $filename =  "${pkgname}_" . $description->{"Version"} .
        "_${R_platform}.tar";
    $log->message("building \`$filename.gz'");
    
    my $pkgs = $pkg;
    if($description->{"Contains"}){
        $log->message("Looks like \`${pkg}' is a package bundle");
        $is_bundle=1;
        my @bundlepkgs = split(/\s+/, $description->{"Contains"});
        $pkgs = join(" ", @bundlepkgs);
    }   
    system("tar -c -h $pkgs > $startdir/$filename");
    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";
    find(\&findExcludeFiles, $pkg);
    close exclude;
    
    my $filename = "${pkgname}_" . $description->{"Version"} . ".tar";
    $log->message("building \`$filename.gz'");
    system("tar -c -h -X $exclude -f $filename $pkg");
    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 $_ && /[Oo]ld$/);
    print exclude "$File::Find::name\n" if /^GNUMakefile$/;
    print exclude "$File::Find::name\n" if /^CVS$/;
    print exclude "$File::Find::name\n" if /\~$/;
}
    
    


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

sub prepare_pkg {

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

    chdir($pkg);
    my $pkgdir = getcwd();
    if(-d "src"){
    chdir("src");
    $log->message("cleaning src");
    if(-r "Makefile"){
        system("$make clean");
    }
    else{
        my $file;
        foreach $file (<*.o *s[lo]>){
        unlink($file);
        }
    }
    }
    chdir($pkgdir);
    if(-x "./cleanup"){
    $log->message("running cleanup");
    system("./cleanup");
    }

    ### !!! Missing: check & rebuild various indices !!!

    1;
}

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

sub usage {
    print STDERR <<END;
Usage: $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

  --binary              build pre-compiled binary packages, with options:
  --no-docs             do not build and install documentation
  --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\@lists.r-project.org>.
END
    exit 0;
}