The R Project SVN R

#-*- perl -*-

# Copyright (C) 2000-4  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::Path;

use Getopt::Long;

use R::Dcf;

use R::Utils;

my $revision = ' $Revision: 1.40 $ ';

my $version;

my $name;

$revision =~ / ([\d\.]*) /;

$version = $1;

($name = $0) =~ s|.*/||;

my @knownoptions = ("help|h", "version|v", "debug|d", "library|l:s",

		    "clean|c", "docs:s", "save|s", "no-save",

		    "with-package-versions",

		    "use-zip", "use-zip-data", "use-zip-help", 

		    "auto-zip", "build", "fake");

##   	topLevelFiles will be files that sit in the top level of a

##      zip/tarball along with any included directories.

##	This needs to be fixed: this file shouldn't do binary builds,

##	that's what build.in is for - DJM

##      No, that is what INSTALL --build is for, pace DJM

my $topLevelFiles = "DESCRIPTION";		    

GetOptions (@knownoptions) || usage();

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

my $R_HOME = $ENV{'R_HOME'} ||

    die "Error: Environment variable R_HOME not found\n";

usage() if $opt_help;

my $startdir = cwd();

my $library;

if($opt_library){

    # remove quotes around the library path

    $opt_library =~ s/^['"]//; $opt_library =~ s/['"]$//; #'"

    chdir($opt_library) ||

	die "Error: cannot change to directory \`$opt_library'\n";

    $library = cwd();

    $library = Win32::GetShortPathName($library) if $library =~ / /;

    chdir($startdir);

} else {

    $library = $R_HOME . "/library";

}

my $helpflags = "HELP=YES WINHELP=CHM";

if($opt_docs) {

    if ($opt_docs eq "none") {

	$helpflags = "HELP=NO";

    } elsif ($opt_docs eq "normal") {

	$helpflags = "HELP=YES WINHELP=NO";

    } elsif ($opt_docs eq "chm"|| ($opt_docs eq "all")) {

	$helpflags = "HELP=YES WINHELP=CHM";

    } else {

	die "ERROR: invalid --docs value `$opt_docs'\n";

    }

}

if((-e "$R_HOME/doc/html/R.css") && !(-e "$library/R.css")) {

    printf "installing R.css in $library\n";

    system("cp $R_HOME/doc/html/R.css $library/R.css");

}

## this is the main loop over all packages to be installed

my $pkg;

foreach $pkg (@ARGV){

    # remove misguided trailing separator (/ or \)

    $pkg =~ s/\/$//; $pkg =~ s/\\$//;

    my $pkgname = basename($pkg);

    my $is_bundle = 0;

    my $istar = 0;

    if (!(-e $pkg)) {

	warn "`$pkg' does not exist: skipping\n";

	next;

    }

## is this a tar archive?

    if($pkgname =~ /\.tar\.gz$/) {

	$pkgname =~ s/\.tar\.gz$//;

	$pkgname =~ s/_[0-9\.-]*$//;

	my $dir = "R.INSTALL";

	mkdir($dir, 755);

	## workaround for paths in Cygwin tar

	$pkg =~ s+^([A-Za-x]):+/cygdrive/\1+;

	if(system("tar -zxf '$pkg' -C $dir")) {

	    die "Error: cannot untar the package\n";}

	$pkg = $dir."/".$pkgname;

	$istar = 1;

    }

    chdir($pkg) || die "Error: cannot change to directory \`$pkg'\n";;

    my $canonpkg = cwd();

    chdir("..");

    my $pkgdir = cwd();

    chdir($startdir);

    die "no valid package name found\n" unless length($pkgname) > 0;

    my $pkgoutdir = "$library/$pkgname";

    die "  *** can't install into source directory ***\n" 

	if $canonpkg eq $pkgoutdir;

    rmtree($pkgoutdir) if (-d $pkgoutdir);

    $pkgdir = Win32::GetShortPathName($pkgdir) if $pkgdir =~ / /;

    my $makecmd = "pkg";

    $makecmd = "pkgfake" if $opt_fake;

    if(-r "$pkg/DESCRIPTION"){

	$description = new R::Dcf("$pkg/DESCRIPTION");

    }

    my $zippkgs = $pkgname;

    if($description->{"Contains"}) {

	print "\nLooks like \`${pkg}' is a package bundle\n";

	$makecmd = "bundle";

	$is_bundle = 1;

	@bundlepkgs = split(/\s+/, $description->{"Contains"});

	$zippkgs = join(" ", @bundlepkgs);

    }

    print "\n";

    if($description->{"Depends"}) {

	my $depends = $description->{"Depends"};

	if($depends =~ /\bR *\(([^) ]+) *([^) ]+)\)/) { # regexp from check

            my $op = $1;

            my $ver = $2; 

	    my $Rversion = $ENV{'R_VERSION'};

	    if ($op eq ">=" && $ver) {

		die "This R is version $Rversion\n".

		    "    package \`$pkgname' requires R $ver or later\n"

			unless $Rversion ge $ver;

	    } elsif ($op eq "<=" && $ver) {

		die "This R is version $Rversion\n".

		    "     package \`$pkgname' requires R $ver or earlier\n"

			unless $Rversion le $ver;

	    } else {

		printf "unsupported operator in dependence \"$depends\"\n";

	    }

        }

    }

    my $save = "CHECK";

    $save = "false" if $opt_no_save;

    $save = "true" if $opt_save;

    my $opt = "";

    my $dpkg = $library. "/" . $pkgname;

    if($opt_with_package_versions) {

        $dpkg = $dpkg . "_" . $description->{"Version"};

    }

    if(!$is_bundle) {

        if($opt_auto_zip || $opt_build) {

	    my $dir = $pkgdir. "/" . $pkgname . "/data";

	    if(-d $dir && 

	       $pkgname ne "RadioSonde" && $pkgname ne "dichromat"

	       && $pkgname ne "pls.pcr") {

		my $Rout = "datacnt";

		system("ls -s1 $dir > $Rout");

		my $out, $nodups=1, $prev="";

		open ROUT, "< $Rout";

		while(<ROUT>) {

		    if(/^total/) {

			s/^total //;

			$out = $_;

		    } else {

			chomp;

			s/\s*[0-9]+\ //;

			s/\.[a-zA-Z]+$//;

			$nodups = 0 if $_ eq $prev;

			$prev = $_;

		    }

		}

		close ROUT;

		unlink $Rout;

		$opt = "$pkgname-ZIPDATA=zip" if $out > 100 && $nodups;

	    }

	    $dir = $pkgdir. "/" . $pkgname . "/man";

	    if(-d $dir) {

		opendir(DIR, $dir) or die "cannot opendir $dir: $!";

		@files = grep{ /\.Rd$/ } readdir(DIR);

		closedir(DIR);

		$opt = $opt . " $pkgname-HELP=ziponly" if @files > 20;

	    }

	    print "Using auto-selected zip options '$opt'\n";

        } else {

            $opt = "$pkgname-ZIPDATA=zip" 

		if ($opt_use_zip || $opt_use_zip_data);

            $opt = $opt . " $pkgname-HELP=ziponly"

		if ($opt_use_zip || $opt_use_zip_help);

        }

    } else {

        ## note: --auto-zip is not supported for bundles

        foreach $ppkg (@bundlepkgs) {

	    $opt = $opt . " $ppkg-ZIPDATA=zip" if ($opt_use_zip || $opt_use_zip_data);

	    $opt = $opt . " $ppkg-HELP=ziponly" if ($opt_use_zip || $opt_use_zip_help);

	}

    }

    my $res = system("make --no-print-directory -C $R_HOME/src/gnuwin32 PKGDIR=$pkgdir RLIB=$library DPKG=$dpkg SAVE=$save $opt $helpflags $makecmd-$pkgname");

    if($res) {

	printf "*** Installation of $pkgname failed ***\n";

    } else {

        if($opt_build) {

	    my $filename = "${pkgname}_" . $description->{"Version"};

	    chdir($library);

	    $startdir = Win32::GetShortPathName($startdir) if $startdir =~ / /;

	    system("rm -f  $startdir/$filename.zip");

	    system("zip -r9Xq $startdir/$filename.zip $zippkgs");

	    if ($is_bundle) {

		## Need to get the toplevel files in there

		$currentDir = cwd();

		chdir($canonpkg);

		system("zip $startdir/$filename.zip $topLevelFiles");

		chdir($currentDir);

	    }

	}

    }

    system("make --no-print-directory -C $R_HOME/src/gnuwin32 PKGDIR=$pkgdir RLIB=$library pkgclean-$pkgname") if ($opt_clean && $is_bundle == 0);

    if($opt_clean && $is_bundle) {

	foreach $ppkg (@bundlepkgs) {

	    system("make --no-print-directory -C $R_HOME/src/gnuwin32 PKGDIR=$pkgdir/$pkgname RLIB=$library pkgclean-$ppkg") 

	}

    }

    if ($istar > 0) {

	chdir($startdir);

	rmtree("R.INSTALL");

    }

    print("\n");

    if(!$res) {print("\* DONE");}

}

sub usage {

    print STDERR <<END;

Usage: Rcmd $name [options] pkgs

Install the add-on packages specified by pkgs into the default R library

tree ($R_HOME/library) or the tree specified via \`--library'.  The

elements of pkgs can be relative or absolute paths to directories with

the package (bundle) sources, or to gzipped package \`tar' archives.

Then optionally pack the installed package into a zip file.

Options:

  -h, --help		print short help message and exit

  -v, --version		print version info and exit

  -c, --clean		remove all files created during installation

  -s, --save            Save the package source as an image file, and arrange for

                        this file to be loaded when the library is attached.

  --no-save             Do not save the package source as an image file.

  -d, --debug		[x] turn on shell and build-help debugging

  -l, --library=LIB	install packages to library tree LIB

      --docs=TYPE	type(s) of documentation to build and install

      --with-package-versions

                        allow for multiple versions of the same package

      --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\'

      --auto-zip	select whether to zip automatically

      --build		zip-up the installation. Implies --auto-zip

      --fake		do minimal install for testing purposes

TYPE can be "none" or "normal" or "chm" (the default) or "all"

Report bugs to <r-bugs\@r-project.org>.

END

    exit 0;

}