Rev 46659 | Blame | Compare with Previous | Last modification | View Log | Download | RSS feed
#! @PERL@#-*- perl -*-## Copyright (C) 2000-2008 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 at## http://www.r-project.org/Licenses/## Send any bug reports to r-bugs@r-project.orguse Cwd;use File::Basename;use File::Compare;use File::Find;use File::Path;use File::Copy;use Getopt::Long;use IO::File;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 = ' $Rev: 46906 $ ';my $version;my $name;$revision =~ / ([\d\.]*) /;$version = $1;($name = $0) =~ s|.*/||;R::Vars::error("R_HOME", "R_EXE");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 (-d ${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;## Use system default unless explicitly specified otherwise.$ENV{"R_DEFAULT_PACKAGES"} = "";my $startdir = R_cwd();my $R_platform = R_getenv("R_PLATFORM", "unknown-binary");my $gzip = R_getenv("R_GZIPCMD", "gzip");## The tar.exe in Rtools has --force-local by default, but this## enables people to use Cygwin or MSYS tar.my $tar_default = "tar";$tar_default = "tar --force-local" if $WINDOWS;my $tar = R_getenv("TAR", $tar_default);my $libdir = R_tempfile("Rinst");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' only for '--binary' ignored\n";}## </FIXME>## This is the main loop over all packages to be packaged.foreach my $pkg (@ARGV) {my $is_bundle = 0;$pkg =~ s/\/$//;## Older versions used $pkg as absolute or relative to $startdir.## This does not easily work if $pkg is a symbolic link.## Hence, we now convert to absolute paths.chdir($startdir);chdir($pkg) or die "Error: cannot change to directory '$pkg'\n";## (We could be nicer ...)my $pkgdir = R_cwd();my $pkgname = basename($pkgdir);my $intname;## chdir($startdir);## (Does not hurt, but should no longer be necessary.)my $log = new R::Logfile();my $description;$log->checking("for file '$pkg/DESCRIPTION'");if(-r &file_path($pkgdir, "DESCRIPTION")) {$description = new R::Dcf(&file_path($pkgdir, "DESCRIPTION"));$log->result("OK");}else {$log->result("NO");exit(1);}my @bundlepkgs;if($description->{"Contains"}) {$log->message("looks like '${pkgname}' is a package bundle");$is_bundle = 1;$intname = $description->{"Bundle"};@bundlepkgs = split(/\s+/, $description->{"Contains"});foreach my $ppkg (@bundlepkgs) {$log->message("cleaning '$ppkg' in bundle '$pkgname'");$log->setstars("**");## chdir($startdir);cleanup_pkg(&file_path("$pkgdir", "$ppkg"), $log);$log->setstars("*");}foreach my $ppkg (@bundlepkgs) {$log->message("preparing '$ppkg' in bundle '$pkgname':");$log->setstars("**");## chdir($startdir);prepare_pkg(&file_path("$pkgdir", "$ppkg"), $is_bundle,$description, $log);$log->setstars("*");}foreach my $ppkg (@bundlepkgs) {$log->message("cleaning '$ppkg' in bundle '$pkgname'");$log->setstars("**");## chdir($startdir);cleanup_pkg(&file_path("$pkgdir", "$ppkg"), $log);$log->setstars("*");}rmtree("$libdir") if (-d "$libdir");} else {$is_bundle = 0;## chdir($startdir);$log->message("preparing '$pkg':");$intname = $description->{"Package"};prepare_pkg($pkgdir, $is_bundle, $description, $log);}## chdir($startdir);$log->message("removing junk files");find(\&unlink_junk_files, $pkgdir);chdir(dirname($pkgdir));my $filename = "${intname}_" . $description->{"Version"} . ".tar";my $filepath = &file_path($startdir, $filename);R_system(join(" ",("$tar -chf",&shell_quote_file_path($filepath),"$pkgname")));my $tmpdir = R_tempfile("Rbuild");rmtree($tmpdir) if(-d $tmpdir);mkdir("$tmpdir", 0755)or die "Error: cannot create directory '$tmpdir'\n";chdir($tmpdir);## was xhf, but there are no symbolic links here and that is invalid## on FreeBSD, see http://www.freebsd.org/cgi/man.cgi?query=tar&apropos=0&sektion=0&manpath=FreeBSD+5.4-RELEASE+and+Ports&format=htmlR_system(join(" ",("$tar -xf",&shell_quote_file_path($filepath))));my $exclude = R_tempfile("Rbuild-exclude");open(EXCLUDE, "> $exclude")or die "Error: cannot open file '$exclude' for writing\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.if(-f &file_path($pkgdir, ".Rbuildignore")) {open(RBUILDIGNORE, &file_path($pkgdir, ".Rbuildignore"));while(<RBUILDIGNORE>) {chomp;s/\r$//; # careless people get Windows files on other OSespush(@exclude_patterns, $_) if $_;}close(RBUILDIGNORE);}## </NOTE>sub find_exclude_files {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(-d $_ && /^CVS$/);print EXCLUDE "$File::Find::name\n" if(-d $_ && /^\.svn$/);print EXCLUDE "$File::Find::name\n" if(-d $_ && /^\.arch-ids$/);print EXCLUDE "$File::Find::name\n" if(-d $_ && /^\.bzr$/);print EXCLUDE "$File::Find::name\n" if(-d $_ && /^\.git$/);## some authors managed to create ..Rcheck as well as pkgname.Rcheckprint EXCLUDE "$File::Find::name\n" if(-d $_ && /\.Rcheck$/);print EXCLUDE "$File::Find::name\n" if /^GNUMakefile$/;## Mac resource forksprint EXCLUDE "$File::Find::name\n" if(/^\._/);## Mac Finder filesprint EXCLUDE "$File::Find::name\n" if(/^\.DS_Store$/);## Windows DLL resource filepush(@exclude_patterns, "^src/" . $pkgname . "_res\\.rc");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 wildcard## characters in file names. On Windows, the## first two are invalid (and hence rejected by## R CMD check), and the last two do not need## escaping.$filename = "$File::Find::name";$filename =~ s/\[/\\\[/g;$filename =~ s/\]/\\\]/g;print EXCLUDE "$filename\n";}}}}find(\&find_exclude_files, "$pkgname");close(EXCLUDE);## Remove exclude files.open(EXCLUDE, "< $exclude");while(<EXCLUDE>) {rmtree(glob($_));}close(EXCLUDE);unlink($exclude);unlink($filepath);## Now correct the package name (PR#9266)if($pkgname ne $intname) {rename $pkgname, $intnameor die "Error: cannot rename directory to '$intname'\n";$pkgname = $intname;}## Fix up man, R, demo inst/doc directories (in each package for a bundle)sub find_invalid_files {my ($dpath) = @_;my $Rcmd = "tools:::.check_package_subdirs(\"$dpath\", TRUE)\n";## We don't run this in the C locale, as we only require## certain filenames to start with ASCII letters/digits, and not## to be entirely ASCII.my @out = R_runR($Rcmd, "--vanilla --slave","R_DEFAULT_PACKAGES=NULL");@out = grep(!/^\>/, @out);if(scalar(@out) > 0) {$log->message("excluding invalid files from '$dpath'");$log->print(join("\n", @out) . "\n");}}if($is_bundle) {foreach $ppkg (@bundlepkgs) {&find_invalid_files(&file_path($pkgname, $ppkg));chdir($tmpdir);}} else {&find_invalid_files($pkgname);chdir($tmpdir);}## Fix permissions.sub fix_permissions {## Note that when called via File::Find::find, $_ holds the## file name within the current directory.if(-d $_) {## Directories should really be mode 00755 if possible.chmod(00755, $_);}elsif(-f $_) {## Files should be readable by everyone, and writable## only for user. This leaves a bit of uncertainty## about the execute bits.chmod(((stat $_)[2] | 00644) & 00755, $_);}}find(\&fix_permissions, "${pkgname}") if(!$WINDOWS);## Add build stamp to the DESCRIPTION file.&add_build_stamp_to_description_file(&file_path($pkgname,"DESCRIPTION"));$log->message("checking for LF line-endings in source and make files");if($is_bundle) {foreach my $ppkg (@bundlepkgs) {&fix_nonLF_in_source_files(&file_path($pkgname, $ppkg), $log);&fix_nonLF_in_make_files(&file_path($pkgname, $ppkg), $log);}} else {&fix_nonLF_in_source_files($pkgname, $log);&fix_nonLF_in_make_files($pkgname, $log);}sub empty_dir_check {if(-d $_) {opendir(DIR, $_) or die "cannot open dir $File::Find::name: $!";my @files = readdir(DIR);closedir(DIR);if (@files <= 2) {$log->print("WARNING: directory '$File::Find::name' is empty\n");}}}$log->message("checking for empty or unneeded directories");find(\&empty_dir_check, "${pkgname}");sub fix_unneeded_dirs {my ($path) = @_;my $dir;foreach my $system_dir ("Meta", "R-ex", "chtml","help", "html", "latex") {$dir = &file_path($path, $system_dir);if(-d "$dir") {$log->print(wrap("", " ",("WARNING: Removing directory '$dir'","which should only occur","in an installed package\n")));rmtree("$dir");}}}if($is_bundle) {foreach my $ppkg (@bundlepkgs) {&fix_unneeded_dirs(&file_path($pkgname, $ppkg));}} else {&fix_unneeded_dirs($pkgname);}## Finalize.if($opt_binary) {$log->message("building binary distribution");chdir($startdir);if (!-d "$libdir") {mkdir("$libdir", 0755)or die "Error: cannot create directory '$libdir'\n";}my $srcdir = &file_path($tmpdir, $pkgname);my $cmd;if($WINDOWS) {$log->print("WARNING: some HTML links may not be found\n");$cmd = join(" ",("Rcmd.exe INSTALL -l",&shell_quote_file_path($libdir),"--build $INSTALL_opts",&shell_quote_file_path($srcdir)));if(R_system($cmd)) { $log->error("installation failed"); }} elsif($is_bundle) {$binfilename = "${pkgname}_" . $description->{"Version"} ."_R_${R_platform}.tar";my $filepath = &file_path($startdir, $binfilename);$cmd = join(" ",(&shell_quote_file_path(${R::Vars::R_EXE}),"CMD INSTALL -l",&shell_quote_file_path($libdir),"$INSTALL_opts",&shell_quote_file_path($srcdir)));if(R_system($cmd)) { $log->error("installation failed"); }chdir("$libdir");copy(&file_path($pkgdir, "DESCRIPTION"), "DESCRIPTION");## precaution for Mac OS X to omit resource forks$ENV{COPYFILE_DISABLE} = 1; # Leopard$ENV{COPY_EXTENDED_ATTRIBUTES_DISABLE} = 1; # TigerR_system(join(" ",("$tar -chf ",&shell_quote_file_path($filepath),@bundlepkgs, "DESCRIPTION")));R_system(join(" ",("$gzip -9f ",&shell_quote_file_path($filepath))));chdir($startdir);$log->message("packaged bundle '$pkgname' as '$binfilename.gz'");} else {$cmd = join(" ",(&shell_quote_file_path(${R::Vars::R_EXE}),"CMD INSTALL -l",&shell_quote_file_path($libdir),"--build $INSTALL_opts",&shell_quote_file_path($srcdir)));if(R_system($cmd)) { $log->error("installation failed"); }}} else {## precaution for Mac OS X to omit resource forks$ENV{COPYFILE_DISABLE} = 1; # Leopard$ENV{COPY_EXTENDED_ATTRIBUTES_DISABLE} = 1; # Tiger$log->message("building '$filename.gz'");R_system(join(" ",("$tar -chf",&shell_quote_file_path($filepath),"$pkgname")));R_system(join(" ",("$gzip -9f",&shell_quote_file_path($filepath))));}chdir($startdir);rmtree($tmpdir);$log->close();print("\n");}sub add_build_stamp_to_description_file {my ($dpath) = @_;my @lines = &read_lines($dpath);@lines = grep(!/^\s*$/, @lines); # Remove blank lines.my $user_name;if($WINDOWS) {$user_name = Win32::LoginName();}else {$user_name = (getpwuid($<))[0];}my $fh = new IO::File($dpath, "w")or die "Error: cannot open file '$dpath' for writing\n";## Do not keep previous build stamps.@lines = grep(!/^Packaged:/, @lines);$fh->print(join("\n", @lines), "\n");$fh->print("Packaged: ",scalar(localtime()), "; ",$user_name, "\n");$fh->close();}sub prepare_pkg {my ($pkgdir, $in_bundle, $description, $log) = @_;my $pkgname = basename($pkgdir);&R::Utils::check_package_description($pkgdir, $pkgname, $log,$in_bundle, 0, 1);&cleanup_pkg($pkgdir, $log) if(!$in_bundle);## Only update existing INDEX files.&update_Rd_index("INDEX", "man", $log) if(-f "INDEX");if((-d &file_path("inst", "doc"))&& &list_files_with_type(&file_path("inst", "doc"),"vignette")) {if(!$opt_no_vignettes) {my $doit = 1;## if we are in a bundle, need to install the whole bundle## once.my $pkg_or_bundle_dir;if ($in_bundle) {$pkg_or_bundle_dir = dirname($pkgdir);if(-d "$libdir") {$doit = 0;} else {$log->message("installing the *bundle* to re-build vignettes");mkdir("$libdir", 0755)or die "Error: cannot create directory '$libdir'\n";}} else {$pkg_or_bundle_dir = $pkgdir;$log->message("installing the package to re-build vignettes");mkdir("$libdir", 0755)or die "Error: cannot create directory '$libdir'\n";}my $cmd;if($WINDOWS) {$cmd = join(" ",("Rcmd.exe INSTALL -l",&shell_quote_file_path($libdir),&shell_quote_file_path($pkg_or_bundle_dir)));} else {$cmd = join(" ",(&shell_quote_file_path(${R::Vars::R_EXE}),"CMD INSTALL -l",&shell_quote_file_path($libdir),&shell_quote_file_path($pkg_or_bundle_dir)));}if($doit && R_system($cmd)) {$log->error();$log->print("Installation failed.\n");$log->print("Removing '$libdir'\n");rmtree($libdir);exit(1);}my $R_LIBS = $ENV{'R_LIBS'};$ENV{'R_LIBS'} = env_path("$libdir", $R_LIBS);$log->creating("vignettes");my $Rcmd = "library(tools)\n";$Rcmd .= "buildVignettes(dir = '.')\n";my %result = R_run_R($Rcmd, "--vanilla --no-save --quiet");rmtree("$libdir") unless $in_bundle;$ENV{'R_LIBS'} = $R_LIBS;if($result{"status"}) {my @out = grep(!/^\>/, @{$result{"out"}});$log->error();$log->print(join("\n", @out) . "\n");exit(1);}else {$log->result("OK");}## And finally, clean up again (if not in a bundle).&cleanup_pkg($pkgdir, $log) if(!$in_bundle);}}1;}sub cleanup_pkg {my ($pkgdir, $log) = @_;my $pkgname = basename($pkgdir);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") {R_system("${R::Vars::MAKE} -f Makefile.win clean");} else {if(-r "Makevars.win") {R_system("${R::Vars::MAKE} -f Makevars.win clean");}foreach my $file (<*.o $pkgname.a $pkgname.dll $pkgname.def>) {unlink($file);}rmtree("_libs") if (-d "_libs");}} else {my $makefiles = "-f " .&shell_quote_file_path(&file_path(${R::Vars::R_HOME},"etc".$ENV{"R_ARCH"},"Makeconf"));if(-r "Makefile") {$makefiles .= " -f Makefile";R_system("${R::Vars::MAKE} $makefiles clean");} else {if(-r "Makevars") {$makefiles .= " -f Makevars";R_system("${R::Vars::MAKE} $makefiles clean");}## Also cleanup possible Windows leftovers ...unlink((<*.o *.s[lo] *.dylib>,"$pkgname.a", "$pkgname.dll", "$pkgname.def"));rmtree(".libs") if (-d ".libs");rmtree("_libs") if (-d "_libs");}}}chdir($pkgdir);if(!$WINDOWS && -x "./cleanup") {$log->message("running cleanup");R_system("./cleanup");}1;}sub unlink_junk_files {unlink($_) if /^(\.RData|\.Rhistory)$/;if(/^DESCRIPTION$/) {unlink($_) if (-f "DESCRIPTION.in");}}sub update_index {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 update_Rd_index {my ($oldindex, $Rd_files, $log) = @_;my $newindex = ".Rbuildindex.$$";my $Rcmd = "Rdindex(\"${Rd_files}\", \"${newindex}\")\n";my %result =R_run_R($Rcmd, "--vanilla --quiet", "R_DEFAULT_PACKAGES=tools");if($result{"status"}) {## This is a bit silly ... but just in case this fails, we want## a decent error message.my @out = grep(!/^\>/, @{$result{"out"}});$log->message("computing Rd index");$log->error();$log->print(join("\n", @out) . "\n");exit(1);}update_index($oldindex, $newindex, $log);1;}sub fix_nonLF_in_source_files {my ($pkgname, $log) = @_;if(-d "$pkgname/src") {my @src_files = &list_files_with_type("$pkgname/src","src_no_CRLF");foreach my $file (@src_files) {my $has_nonLF = 0;open(FILE, "< $file")or die "Error: cannot open '$file' for reading\n";open(TFILE, "> $file.tmp")or die "Error: cannot open '$file.tmp' for writing\n";binmode(FILE); binmode(TFILE); # for Windowswhile(<FILE>) {chomp;$has_nonLF = 1 if $_ =~ /\r/;$_ =~ s/\r$//;# any remaining CRs are internal and so line endings.$_ =~ s/\r/\n/g;print TFILE "$_\n";}close(TFILE); close(FILE);if ($has_nonLF) {$log->print(" file '$file' had non-LF line endings\n");unlink($file); # should not be necessary, but is on Windowsrename("$file.tmp", $file)or die "Error: cannot rename '$file.tmp'\n";} else {unlink("$file.tmp");}}}}sub fix_nonLF_in_make_files {my ($pkgname, $log) = @_;if(-d "$pkgname/src") {my $file;foreach my $f ("Makefile", "Makefile.in", "Makevars", "Makevars.in") {$file = "$pkgname/src/$f";next unless -f "$file";my $has_nonLF = 0;open(FILE, "< $file")or die "Error: cannot open '$file' for reading\n";open(TFILE, "> $file.tmp")or die "Error: cannot open '$file.tmp' for writing\n";binmode(FILE); binmode(TFILE); # for Windowswhile(<FILE>) {chomp;$has_nonLF = 1 if $_ =~ /\r/;$_ =~ s/\r$//;# any remaining CRs are internal and so line endings.$_ =~ s/\r/\n/g;print TFILE "$_\n";}close(TFILE); close(FILE);if ($has_nonLF) {$log->print(" file '$file' had non-LF line endings\n");unlink("$file"); # should not be necessary, but is on Windowsrename("$file.tmp", $file)or die "Error: cannot rename '$file.tmp'\n";} else {unlink("$file.tmp");}}}}sub usage {print STDERR <<END;Usage: R CMD $name [options] pkgdirsBuild R packages from package sources in the directories specified bypkgdirs.Options:-h, --help print short help message and exit-v, --version print 'build' version info and exit--force force overwriting of INDEX file--no-vignettes do not rebuild package vignettes--binary build pre-compiled binary packages, with options:ENDif($WINDOWS) {print STDERR " --docs=TYPE " ."type(s) of documentation to build and INSTALL\n";print STDERR " " ."See Rcmd INSTALL --help for possible values of TYPE\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>.ENDexit 0;}