The R Project SVN R

Rev

Rev 29864 | Blame | Last modification | View Log | Download | RSS feed 

#-*- 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.44.8.2 $ ';
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", 
            "lazy", "no-lazy", "lazy-data", "no-lazy-data");
            
##      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;

if($opt_debug) {
    print "\nOption -d or --debug is accepted for compatibility with Unix.\n";
    print "However, it does less.\n\n";
}

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");
}

my $istar = 0; # any tar in the args

## this is the main loop over all packages/bundles 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;

    if (!(-e $pkg)) {
    warn "`$pkg' does not exist: skipping\n";
    next;
    }

## is this a tar archive?
    if($pkgname =~ /\.tar\.gz$/ || $pkgname =~ /\.tgz$/) {
    $pkgname =~ s/\.tar\.gz$//;
    $pkgname =~ s/\.tgz$//;
    $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;
    $pkgdir = Win32::GetShortPathName($pkgdir) if $pkgdir =~ / /;

    my $makecmd = "pkg";
    $makecmd = "pkgfake" if $opt_fake;
    $description = new R::Dcf("$pkg/DESCRIPTION");
    
    ## do we have a package bundle?
    my $zippkgs = $pkgname;
    my @bundlepkgs = ($pkgname);
    if($description->{"Contains"}) {
    print "\nLooks like \`${pkg}' is a package bundle\n";
    $is_bundle = 1;
    @bundlepkgs = split(/\s+/, $description->{"Contains"});
    $zippkgs = join(" ", @bundlepkgs);
    ## join up description files
    foreach $ppkg (@bundlepkgs) {
        open pkgdesc, "> $pkg/$ppkg/DESCRIPTION" 
        || die "cannot write $ppkg/DESCRIPTION";
        if (open pkgdescin, "< $pkg/$ppkg/DESCRIPTION.in") {
        while(<pkgdescin>) { print pkgdesc $_; }
        close pkgdescin;
        } else {
        print "no DESCRIPTION.in found for package $ppkg\n";
        print pkgdesc "Package: $ppkg\n";
        }
        open bundledesc, "< $pkg/DESCRIPTION"
        || die "no DESCRIPTION found for bundle";
        while(<bundledesc>) {
        if(!/^Contains:/) {print pkgdesc $_;}
        }
        close bundledesc;
        close pkgdesc;
    }
    $pkgdir = $pkg;
    }
    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";
        }
        }
    }
    ## Now we are ready to install
    my $lockdir = $library . "/" . "00LOCK";
    if(-d $lockdir || -f $lockdir) {
    print "Failed to lock directory '${library}' for modifying\n";
    print "Try removing '${lockdir}'\n";
    exit 3;
    }
    mkpath($lockdir);
    if(! -d $lockdir) {
    print "Failed to lock directory '${library}' for modifying\n";
    print "Permission problem?\n";
    exit 3;
    }

    my $res;
    ## loop over pkgs in the bundle
    for $pkgname (@bundlepkgs) {
    my $dpkg = $library. "/" . $pkgname;
    if($opt_with_package_versions) {
        $dpkg = $dpkg . "_" . $description->{"Version"};
        $decpkgname = $pkgname . "_" . $description->{"Version"};
    } else {
        $decpkgname = $pkgname;
    }
    # if exists, move existing installation to $lockdir
    system("mv $dpkg $lockdir") if -d $dpkg;

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

    my $save = "CHECK";
    $save = "false" if $opt_no_save;
    $save = "true" if $opt_save;
    my $tmp = parse_description_field("SaveImage");
    $save = "false" if($tmp == 0);
    $save = "true" if($tmp == 1);
    print "*** save is $save ***\n" if($opt_debug);

    my $lazyload = -1;
    $lazyload = 1 if $opt_lazy;
    $lazyload = 0 if $opt_no_lazy;
    my $tmp = parse_description_field("LazyLoad");
    $lazyload = $tmp if($tmp >= 0);

    my $lazydata = 0;
    $lazydata = 1 if $opt_lazy_data;
    $lazydata = 0 if $opt_no_lazy_data;
    my $tmp = parse_description_field("LazyData");
    $lazydata = $tmp if($tmp >= 0);
    print "*** lazydata is $lazydata ***\n" if($opt_debug);

    my $opt = "";

    $opt = "DPKG=$dpkg";;
    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);
    }
#   print "make --no-print-directory -C $R_HOME/src/gnuwin32 PKGDIR=$pkgdir RLIB=$library SAVE=$save $opt $helpflags $makecmd-$pkgname\n";
        $res = system("make --no-print-directory -C $R_HOME/src/gnuwin32 PKGDIR=$pkgdir RLIB=$library SAVE=$save $opt $helpflags $makecmd-$pkgname");
    if($res) {
        printf "*** Installation of $pkgname failed ***\n";
    } else {
        if($lazyload == -1) { # choose based on code size
        my $codesize = `wc -c $library/$decpkgname/R/$pkgname`;
        $codesize =~ / *([0-9]+)/;
        $codesize = $1;
        print "*** codesize is $codesize ***\n" if $opt_debug;
        if($codesize > 50000) {$lazyload = 1;} else {$lazyload = 0;}
        }
        print "*** lazyload is $lazyload ***\n" if $opt_debug;
        if($lazyload) {
        my $cmd = "make --no-print-directory -f $R_HOME/src/gnuwin32/MakePkg ";
        $cmd .= "RHOME=$R_HOME SPKG=$pkg DPKG=$library/$decpkgname PKG=$decpkgname RLIB=$library lazyload";
#       print "$cmd\n";
        system($cmd);
        }

        if($lazydata) {
        my $cmd = "make --no-print-directory -C $R_HOME/src/gnuwin32";
        $cmd .= " lazydata-$decpkgname";
        system($cmd);
        }

        
    } # end of if($res)

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

    print("\n");
    if($res) {
        rmtree($dpkg);
        # move back any previously installed package
        $dppkg = $lockdir . "/" . $decpkgname;
        system("mv $dppkg $library") if -d $dppkg;
        last;
    }
    } # end of loop over bundle

    if(!$res && $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);
    }
    }
    # wipe out lockdir
    rmtree($lockdir);
    exit $res if $res;
    print("\* DONE\n");
}

## remove unpack directory
if ($istar > 0) { chdir($startdir); rmtree("R.INSTALL"); }

sub parse_description_field { # fieldname
    my ($field) = @_;
    my $tmp = $description->{$field}, $res = -1;
    if($tmp ne "") {
    $tmp = lc $tmp;
    $res = 1 if ($tmp eq "yes") || ($tmp eq "true");
    $res = 0 if ($tmp eq "no") || ($tmp eq "false");
    # or throw an error, but then we need to recover
    }
    return $res;
}

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

  --lazy                use lazy loading
  --no-lazy             do not use lazy loading
  --lazy-data           use lazy loading for data
  --no-lazy-data        do not use lazy loading for data (current default)

  --fake        do minimal install for testing purposes
  -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

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

Report bugs to <r-bugs\@r-project.org>.
END
    exit 0;
}