#! @PERL@
#-*- perl -*-
# Copyright (C) 2000-2003 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
## <FIXME>
## This is not portable: has Unix-style file paths and system(). (But
## we need to call tar/gzip and zip, respectively, so it is not clear
## how platform-independent the code can be.
## </FIXME>
use Cwd;
use File::Basename;
use File::Compare;
use File::Find;
use File::Path;
use File::Copy;
use Getopt::Long;
use R::Dcf;
use R::Logfile;
use R::Rd;
use R::Utils;
use R::Vars;
use Text::DelimMatch;
use Text::Wrap;
## don't buffer output
$| = 1;
my $revision = ' $Revision: 1.57.2.4 $ ';
my $version;
my $name;
$revision =~ / ([\d\.]*) /;
$version = $1;
($name = $0) =~ s|.*/||;
R::Vars::error("R_HOME", "R_CMD");
my $WINDOWS = ($R::Vars::OSTYPE eq "windows");
my @exclude_patterns = R::Utils::get_exclude_patterns();
my @known_options = ("help|h", "version|v", "binary", "no-docs",
"use-zip", "use-zip-help", "use-zip-data",
"force", "no-vignettes");
if($WINDOWS) {
die "Please set TMPDIR to a valid temporary directory\n"
unless (-e ${R::Vars::TMPDIR});
@known_options = ("help|h", "version|v", "binary", "docs:s", "auto-zip",
"use-zip", "use-zip-help", "use-zip-data",
"force", "no-vignettes");
}
GetOptions(@known_options) or 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 $tar = R_getenv("TAR", "tar");
## JG: topLevelFiles will be files that sit in the top level of a
## zip/tarball along with any included directories.
my $topLevelFiles = "DESCRIPTION";
my $INSTALL_opts = "";
$INSTALL_opts .= " --use-zip" if $opt_use_zip;
$INSTALL_opts .= " --use-zip-data" if $opt_use_zip_data;
$INSTALL_opts .= " --use-zip-help" if $opt_use_zip_help;
if($WINDOWS) {
$INSTALL_opts .= " --docs=$opt_docs" if $opt_docs;
$INSTALL_opts .= " --auto-zip" if $opt_auto_zip;
} else {
$INSTALL_opts .= " --no-docs" if $opt_no_docs;
}
## <FIXME>
## Once we have a 'global' log file, use $log->warning() instead of just
## print().
if(!$opt_binary && $INSTALL_opts ne "") {
print "** Options '$INSTALL_opts' for '--binary' ignored\n";
}
## </FIXME>
## This is the main loop over all packages to be checked.
foreach my $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 = "${R::Vars::TMPDIR}/Rbuild.$$";
mkdir("$libdir", 0755)
or die "Cannot create directory '$libdir'\n";
if(system("${R::Vars::R_CMD} INSTALL -l $libdir " .
"$INSTALL_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"});
## JG: Get a copy of the bundle's DESCRIPTION file
## and add it into the zip archive
$log->message("Copying $pkg/DESCRIPTION");
copy("$startdir/$pkg/DESCRIPTION","DESCRIPTION");
$pkgs = join(" ", @bundlepkgs);
}
if($WINDOWS) {
my $filename = "${pkgname}_" . $description->{"Version"};
$log->message("building '$filename.zip'");
system("rm -f $startdir/$filename.zip");
system("zip -r9X $startdir/$filename.zip $pkgs $topLevelFiles");
chdir($startdir);
} else {
## <FIXME>
## As R CMD INSTALL recursively copies all of 'inst', we at
## least need to make sure that CVS subdirs are excluded.
## It is not clear whether more patterns should be excluded,
## and we also need to fix this under Windows.
my $exclude = "${R::Vars::TMPDIR}/Rbuild-exclude.$$";
open(EXCLUDE, "> $exclude")
or die "Cannot write to '$exclude'\n";
sub findExcludeFiles {
print EXCLUDE "$File::Find::name\n" if /^CVS$/;
}
foreach my $p (split(/\s+/, $pkgs)) {
find(\&findExcludeFiles, "$p");
}
close(EXCLUDE);
my $filename = "${pkgname}_" . $description->{"Version"} .
"_R_${R_platform}.tar";
$log->message("building '$filename.gz'");
system("$tar chXf $exclude $startdir/$filename $pkgs $topLevelFiles");
chdir($startdir);
system("gzip -9f $filename");
unlink($exclude);
## </FIXME>
}
rmtree($libdir);
}
else {
if($description->{"Contains"}) {
$log->message("Looks like '${pkg}' is a package bundle");
$is_bundle = 1;
my @bundlepkgs = split(/\s+/, $description->{"Contains"});
foreach my $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);
my $exclude = "${R::Vars::TMPDIR}/Rbuild-exclude.$$";
open(EXCLUDE, "> $exclude")
or die "Cannot write to '$exclude'\n";
binmode EXCLUDE if $WINDOWS;
## <NOTE>
## For bundles, the .Rbuildignore mechanism is not consistent
## between build and check: the latter always works on a per
## package basis. Maybe fix this once we know whether we want
## to keep bundles ...
if(-f "$pkg/.Rbuildignore") {
open(RBUILDIGNORE, "$pkg/.Rbuildignore");
while(<RBUILDIGNORE>) {
chop;
push(@exclude_patterns, $_) if $_;
}
close(RBUILDIGNORE);
}
## </NOTE>
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$/;
if($WINDOWS) {
## exclude stray dependency files
print EXCLUDE "$File::Find::name\n" if /\.d$/;
print EXCLUDE "$File::Find::name\n" if /^Makedeps$/;
}
my $filename = $File::Find::name;
$filename =~ s/^[^\/]*\///;
foreach my $p (@exclude_patterns) {
if($WINDOWS) {
## Argh: Windows is case-honoring but not
## case-insensitive ...
print EXCLUDE "$File::Find::name\n"
if($filename =~ /$p/i);
}
else {
if($filename =~ /$p/) {
## Seems that the Tar '-X' option uses exclude
## *shell* patterns, where '*', '?', and '[...]'
## are the usual shell wildcards and '\' escapes
## them. Hence we need to escape the wildchard
## characters in file names (maybe we should do
## the same on Windows). Not that using these
## characters in file names seems a good idea ...
$filename = "$File::Find::name";
$filename =~ s/\*/\\\*/g;
$filename =~ s/\?/\\\?/g;
$filename =~ s/\[/\\\[/g;
$filename =~ s/\]/\\\]/g;
print EXCLUDE "$filename\n";
}
}
}
}
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]):+/cygdrive/\1+;
}
system("$tar chXf $exclude $filepath $pkgname");
chdir($startdir);
system("gzip -9f $filename");
unlink($exclude);
}
$log->close();
print("\n");
}
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) {
## a Windows Makefile.win might use $(RHOME)/src/gnuwin32/MkRules
$ENV{RHOME} = $ENV{R_HOME};
if(-r "Makefile.win") {
system("${R::Vars::MAKE} -f Makefile.win clean");
} else {
foreach my $file (<*.o $pkgname.a $pkgname.dll $pkgname.def>) {
unlink($file);
}
rmtree("_libs") if (-d "_libs");
}
} else {
if(-r "Makefile") {
system("${R::Vars::MAKE} -f Makefile clean");
} else {
foreach my $file (<*.o *s[lo]>) {
unlink($file);
}
rmtree(".libs") if (-d ".libs");
}
}
}
chdir($pkgdir);
if(!$WINDOWS && -x "./cleanup") {
$log->message("running cleanup");
system("./cleanup");
}
&updateRdIndex("INDEX", "man", 0, $log);
&updateRdIndex(&file_path("data", "00Index"), "man", 1, $log)
if((-d "data") && &list_files_with_type("data", "data"));
if((-d &file_path("inst", "doc"))
&& &list_files_with_type(&file_path("inst", "doc"),
"vignette")) {
if(!$opt_no_vignettes) {
$log->creating("vignettes");
my $Rcmd = "library(tools); buildVignettes(dir='.')\n";
my @out = R_runR($Rcmd, "--vanilla --no-save --quiet");
my @err = grep(/^Error/, @out);
if($#err >= 0) {
@out = grep(!/^\>/, @out);
$log->error();
$log->print(join("\n", @out) . "\n");
exit(1);
}
else {
$log->result("OK");
}
}
&updateVignetteIndex(&file_path("inst", "doc", "00Index.dcf"),
&file_path("inst", "doc"),
$log);
}
1;
}
sub deleteJunkFiles {
unlink($_) if /^(\.RData|\.Rhistory)$/;
if(/^DESCRIPTION$/) {
unlink($_) if (-f "DESCRIPTION.in");
}
}
sub updateIndex {
my ($oldindex, $newindex, $log) = @_;
$log->checking("whether '$oldindex' is up-to-date");
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 updateRdIndex {
my ($oldindex, $Rdfiles, $dataset, $log) = @_;
my $newindex = ".Rbuildindex.$$";
my $Rcmd = "library(tools)\n";
$Rcmd .= "Rdindex(\"${Rdfiles}\", \"${newindex}\"";
$Rcmd .= ", type = \"data\"" if($dataset);
$Rcmd .= ")";
## <FIXME>
## What if this fails?
R_runR($Rcmd, "--vanilla --quiet");
## </FIXME>
updateIndex($oldindex, $newindex, $log);
1;
}
sub updateVignetteIndex {
my ($oldindex, $dir, $log) = @_;
my $newindex = ".Rbuildindex.$$";
buildVignetteIndex($dir, $newindex);
updateIndex($oldindex, $newindex, $log);
1;
}
sub buildVignetteIndex {
my ($dir, $newindex) = @_;
my $delimcurly = new Text::DelimMatch("\\{", "\\}");
$delimcurly->escape("\\");
my @entries = ();
my @vignette_files = &list_files_with_type($dir, "vignette");
foreach my $file (@vignette_files) {
open(FILE, "< $file")
or die("Error: cannot open '$file' for reading");
my @text = <FILE>;
@text = split(/\n\s*\%+\s*\\VignetteIndexEntry\{/,
"\n" . join("\n", @text));
$file =~ s/\.[[:alpha:]]+$//;
$file = basename($file);
if($#text >= 1) {
$delimcurly->match("\{" . $text[1]);
push(@entries,
"$file.pdf: " . substr($delimcurly->matched, 1, -1));
}
else {
push(@entries, "$file.pdf:");
}
close(FILE);
}
open(NEWINDEX, "> $newindex")
or die("Error: cannot open '$newindex' for writing");
foreach my $entry (@entries) {
print NEWINDEX wrap("", " ", $entry), "\n";
}
close(NEWINDEX);
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
--no-vignettes do not rebuild package vignettes
--binary build pre-compiled binary packages, with options:
END
if($WINDOWS) {
print STDERR " --docs=TYPE " .
"type(s) of documentation to build and install\n";
print STDERR " --auto-zip " .
"select zipping of data and help based on size\n";
} else {
print STDERR " --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;
}