lib/Statistics/R/Win32.pm

   1 package Statistics::R::Win32;
   2
   3
   4 use strict;
   5 use warnings;
   6 use File::Spec::Functions;
   7 use File::DosGlob qw( glob );
   8 use Env qw( @PATH $PROGRAMFILES );
   9
  10 use vars qw{@ISA @EXPORT};
  11
  12 BEGIN {
  13    @ISA     = 'Exporter';
  14    @EXPORT  = qw{
  15       win32_path_adjust
  16       win32_space_quote
  17       win32_space_escape
  18       win32_double_bs
  19    };
  20 }
  21
  22 our $PROG = 'R';
  23
  24
  25 =head1 NAME
  26
  27 Statistics::R::Win32 - Helper functions for Statistics::R on MS Windows platforms
  28
  29 =head1 DESCRIPTION
  30
  31 Helper functions to deal with environment variables and escape file paths on
  32 MS Windows platforms.
  33
  34 =head1 SYNOPSIS
  35
  36    if ( $^O =~ m/^(?:.*?win32|dos)$/i ) {
  37       require Statistics::R::Win32;
  38    }
  39
  40 =head1 METHODS
  41
  42 =over 4
  43
  44 =item win32_path_adjust( )
  45
  46 Looks for paths where R could be installed, e.g. C:\Program Files (x86)\R-2.1\bin
  47 and add it to the PATH environment variable.
  48
  49 =item win32_space_quote( )
  50
  51 Takes a path and return a path that is surrounded by double-quotes if the path
  52 contains whitespaces. Example:
  53
  54    C:\Program Files\R\bin\x64
  55
  56 becomes
  57
  58    "C:\Program Files\R\bin\x64"
  59
  60 =item win32_space_escape( )
  61
  62 Takes a path and return a path where spaces have been escaped by a backslash.
  63 contains whitespaces. Example:
  64
  65    C:\Program Files\R\bin\x64
  66
  67 becomes
  68
  69    C:\Program\ Files\R\bin\x64
  70
  71 =item win32_double_bs
  72
  73 Takes a path and return a path where each backslash was replaced by two backslashes.
  74  Example:
  75
  76    C:\Program Files\R\bin\x64
  77
  78 becomes
  79
  80    C:\\Program Files\\R\\bin\\x64
  81
  82 =back
  83
  84 =head1 SEE ALSO
  85
  86 =over 4
  87
  88 =item * L<Statistics::R>
  89
  90 =back
  91
  92 =head1 AUTHORS
  93
  94 Florent Angly E<lt>florent.angly@gmail.comE<gt> (2011 rewrite)
  95
  96 Graciliano M. P. E<lt>gm@virtuasites.com.brE<gt> (original code)
  97
  98 =head1 MAINTAINER
  99
 100 Brian Cassidy E<lt>bricas@cpan.orgE<gt>
 101
 102 =head1 COPYRIGHT & LICENSE
 103
 104 This program is free software; you can redistribute it and/or
 105 modify it under the same terms as Perl itself.
 106
 107 =head1 BUGS
 108
 109 All complex software has bugs lurking in it, and this program is no exception.
 110 If you find a bug, please report it on the CPAN Tracker of Statistics::R:
 111 L<http://rt.cpan.org/Dist/Display.html?Name=Statistics-R>
 112
 113 Bug reports, suggestions and patches are welcome. The Statistics::R code is
 114 developed on Github (L<http://github.com/bricas/statistics-r>) and is under Git
 115 revision control. To get the latest revision, run:
 116
 117    git clone git@github.com:bricas/statistics-r.git
 118
 119 =cut
 120
 121
 122 # Adjust PATH environment variable when this module is loaded.
 123 win32_path_adjust();
 124
 125
 126 sub win32_path_adjust {
 127    # Find potential R directories in the Windows Program Files folder and add
 128    # them to the PATH environment variable
 129
 130    # Find potential R directories, e.g.  C:\Program Files (x86)\R-2.1\bin
 131    #                                 or  C:\Program Files\R\bin\x64
 132    my @r_dirs;
 133    my @prog_file_dirs;
 134    if (defined $PROGRAMFILES) {
 135       push @prog_file_dirs, $PROGRAMFILES;                   # e.g. C:\Program Files (x86)
 136       my ($programfiles_2) = ($PROGRAMFILES =~ m/^(.*) \(/); # e.g. C:\Program Files
 137       push @prog_file_dirs, $programfiles_2 if not $programfiles_2 eq $PROGRAMFILES;
 138    }
 139    for my $prog_file_dir ( @prog_file_dirs ) {
 140       next if not -d $prog_file_dir;
 141       my @subdirs;
 142       my @globs = ( catfile($prog_file_dir, $PROG), catfile($prog_file_dir, $PROG.'-*') );
 143       for my $glob ( @globs ) {
 144          $glob = win32_space_escape( win32_double_bs( $glob ) );
 145          push @subdirs, glob $glob; # DosGlob
 146       }
 147       for my $subdir (@subdirs) {
 148          my $subdir2 = catfile($subdir, 'bin');
 149          if ( -d $subdir2 ) {
 150             my $subdir3 = catfile($subdir2, 'x64');
 151             if ( -d $subdir3 ) {
 152                push @r_dirs, $subdir3;
 153             }
 154             push @r_dirs, $subdir2;
 155          }
 156          push @r_dirs, $subdir;
 157       }
 158    }
 159
 160    # Append R directories to PATH (order is important)
 161    push @PATH, @r_dirs;
 162
 163    return 1;
 164 }
 165
 166
 167 sub win32_space_quote {
 168    # Quote a path if it contains whitespaces
 169    my $path = shift;
 170    $path = '"'.$path.'"' if $path =~ /\s/;
 171    return $path;
 172 }
 173
 174
 175 sub win32_space_escape {
 176    # Escape spaces with a single backslash
 177    my $path = shift;
 178    $path =~ s/ /\\ /g;
 179    return $path;
 180 }
 181
 182
 183 sub win32_double_bs {
 184    # Double the backslashes
 185    my $path = shift;
 186    $path =~ s/\\/\\\\/g;
 187    return $path;
 188 }
 189
 190
 191 1;