#! @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.25 $ ';
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_OSTYPE", "") eq "windows");
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=cwd();
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_${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\$", "\~\$", "\.swp\$");
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 = cwd();
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;
}