Statistics-R-0.34/0000755000175000017500000000000012611225004014202 5ustar flofloooflofloooStatistics-R-0.34/MYMETA.yml0000644000175000017500000000161712611224732015735 0ustar floflooofloflooo--- abstract: 'Perl interface with the R statistical program' author: - 'Florent Angly (2011 rewrite)' build_requires: ExtUtils::MakeMaker: '6.59' Test::More: '0.47' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 0 generated_by: 'Module::Install version 1.16, CPAN::Meta::Converter version 2.150005' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Statistics-R no_index: directory: - inc - t requires: IPC::Run: '0.1' Regexp::Common: '0' Text::Balanced: '1.97' Text::Wrap: '0' perl: '5.006' version: '0.77' resources: bugtracker: http://rt.cpan.org/Dist/Display.html?Name=Statistics-R homepage: http://search.cpan.org/search?query=statistics%3A%3AR&mode=dist license: http://dev.perl.org/licenses/ version: '0.33' x_serialization_backend: 'CPAN::Meta::YAML version 0.012' Statistics-R-0.34/inc/0000755000175000017500000000000012611225004014753 5ustar flofloooflofloooStatistics-R-0.34/inc/Module/0000755000175000017500000000000012611225004016200 5ustar flofloooflofloooStatistics-R-0.34/inc/Module/Install/0000755000175000017500000000000012611225004017606 5ustar flofloooflofloooStatistics-R-0.34/inc/Module/Install/WriteAll.pm0000644000175000017500000000237612611224732021706 0ustar floflooofloflooo#line 1 package Module::Install::WriteAll; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.16'; @ISA = qw{Module::Install::Base}; $ISCORE = 1; } sub WriteAll { my $self = shift; my %args = ( meta => 1, sign => 0, inline => 0, check_nmake => 1, @_, ); $self->sign(1) if $args{sign}; $self->admin->WriteAll(%args) if $self->is_admin; $self->check_nmake if $args{check_nmake}; unless ( $self->makemaker_args->{PL_FILES} ) { # XXX: This still may be a bit over-defensive... unless ($self->makemaker(6.25)) { $self->makemaker_args( PL_FILES => {} ) if -f 'Build.PL'; } } # Until ExtUtils::MakeMaker support MYMETA.yml, make sure # we clean it up properly ourself. $self->realclean_files('MYMETA.yml'); if ( $args{inline} ) { $self->Inline->write; } else { $self->Makefile->write; } # The Makefile write process adds a couple of dependencies, # so write the META.yml files after the Makefile. if ( $args{meta} ) { $self->Meta->write; } # Experimental support for MYMETA if ( $ENV{X_MYMETA} ) { if ( $ENV{X_MYMETA} eq 'JSON' ) { $self->Meta->write_mymeta_json; } else { $self->Meta->write_mymeta_yaml; } } return 1; } 1; Statistics-R-0.34/inc/Module/Install/Makefile.pm0000644000175000017500000002743712611224732021705 0ustar floflooofloflooo#line 1 package Module::Install::Makefile; use strict 'vars'; use ExtUtils::MakeMaker (); use Module::Install::Base (); use Fcntl qw/:flock :seek/; use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.16'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } sub Makefile { $_[0] } my %seen = (); sub prompt { shift; # Infinite loop protection my @c = caller(); if ( ++$seen{"$c[1]|$c[2]|$_[0]"} > 3 ) { die "Caught an potential prompt infinite loop ($c[1]|$c[2]|$_[0])"; } # In automated testing or non-interactive session, always use defaults if ( ($ENV{AUTOMATED_TESTING} or -! -t STDIN) and ! $ENV{PERL_MM_USE_DEFAULT} ) { local $ENV{PERL_MM_USE_DEFAULT} = 1; goto &ExtUtils::MakeMaker::prompt; } else { goto &ExtUtils::MakeMaker::prompt; } } # Store a cleaned up version of the MakeMaker version, # since we need to behave differently in a variety of # ways based on the MM version. my $makemaker = eval $ExtUtils::MakeMaker::VERSION; # If we are passed a param, do a "newer than" comparison. # Otherwise, just return the MakeMaker version. sub makemaker { ( @_ < 2 or $makemaker >= eval($_[1]) ) ? $makemaker : 0 } # Ripped from ExtUtils::MakeMaker 6.56, and slightly modified # as we only need to know here whether the attribute is an array # or a hash or something else (which may or may not be appendable). my %makemaker_argtype = ( C => 'ARRAY', CONFIG => 'ARRAY', # CONFIGURE => 'CODE', # ignore DIR => 'ARRAY', DL_FUNCS => 'HASH', DL_VARS => 'ARRAY', EXCLUDE_EXT => 'ARRAY', EXE_FILES => 'ARRAY', FUNCLIST => 'ARRAY', H => 'ARRAY', IMPORTS => 'HASH', INCLUDE_EXT => 'ARRAY', LIBS => 'ARRAY', # ignore '' MAN1PODS => 'HASH', MAN3PODS => 'HASH', META_ADD => 'HASH', META_MERGE => 'HASH', PL_FILES => 'HASH', PM => 'HASH', PMLIBDIRS => 'ARRAY', PMLIBPARENTDIRS => 'ARRAY', PREREQ_PM => 'HASH', CONFIGURE_REQUIRES => 'HASH', SKIP => 'ARRAY', TYPEMAPS => 'ARRAY', XS => 'HASH', # VERSION => ['version',''], # ignore # _KEEP_AFTER_FLUSH => '', clean => 'HASH', depend => 'HASH', dist => 'HASH', dynamic_lib=> 'HASH', linkext => 'HASH', macro => 'HASH', postamble => 'HASH', realclean => 'HASH', test => 'HASH', tool_autosplit => 'HASH', # special cases where you can use makemaker_append CCFLAGS => 'APPENDABLE', DEFINE => 'APPENDABLE', INC => 'APPENDABLE', LDDLFLAGS => 'APPENDABLE', LDFROM => 'APPENDABLE', ); sub makemaker_args { my ($self, %new_args) = @_; my $args = ( $self->{makemaker_args} ||= {} ); foreach my $key (keys %new_args) { if ($makemaker_argtype{$key}) { if ($makemaker_argtype{$key} eq 'ARRAY') { $args->{$key} = [] unless defined $args->{$key}; unless (ref $args->{$key} eq 'ARRAY') { $args->{$key} = [$args->{$key}] } push @{$args->{$key}}, ref $new_args{$key} eq 'ARRAY' ? @{$new_args{$key}} : $new_args{$key}; } elsif ($makemaker_argtype{$key} eq 'HASH') { $args->{$key} = {} unless defined $args->{$key}; foreach my $skey (keys %{ $new_args{$key} }) { $args->{$key}{$skey} = $new_args{$key}{$skey}; } } elsif ($makemaker_argtype{$key} eq 'APPENDABLE') { $self->makemaker_append($key => $new_args{$key}); } } else { if (defined $args->{$key}) { warn qq{MakeMaker attribute "$key" is overriden; use "makemaker_append" to append values\n}; } $args->{$key} = $new_args{$key}; } } return $args; } # For mm args that take multiple space-separated args, # append an argument to the current list. sub makemaker_append { my $self = shift; my $name = shift; my $args = $self->makemaker_args; $args->{$name} = defined $args->{$name} ? join( ' ', $args->{$name}, @_ ) : join( ' ', @_ ); } sub build_subdirs { my $self = shift; my $subdirs = $self->makemaker_args->{DIR} ||= []; for my $subdir (@_) { push @$subdirs, $subdir; } } sub clean_files { my $self = shift; my $clean = $self->makemaker_args->{clean} ||= {}; %$clean = ( %$clean, FILES => join ' ', grep { length $_ } ($clean->{FILES} || (), @_), ); } sub realclean_files { my $self = shift; my $realclean = $self->makemaker_args->{realclean} ||= {}; %$realclean = ( %$realclean, FILES => join ' ', grep { length $_ } ($realclean->{FILES} || (), @_), ); } sub libs { my $self = shift; my $libs = ref $_[0] ? shift : [ shift ]; $self->makemaker_args( LIBS => $libs ); } sub inc { my $self = shift; $self->makemaker_args( INC => shift ); } sub _wanted_t { } sub tests_recursive { my $self = shift; my $dir = shift || 't'; unless ( -d $dir ) { die "tests_recursive dir '$dir' does not exist"; } my %tests = map { $_ => 1 } split / /, ($self->tests || ''); require File::Find; File::Find::find( sub { /\.t$/ and -f $_ and $tests{"$File::Find::dir/*.t"} = 1 }, $dir ); $self->tests( join ' ', sort keys %tests ); } sub write { my $self = shift; die "&Makefile->write() takes no arguments\n" if @_; # Check the current Perl version my $perl_version = $self->perl_version; if ( $perl_version ) { eval "use $perl_version; 1" or die "ERROR: perl: Version $] is installed, " . "but we need version >= $perl_version"; } # Make sure we have a new enough MakeMaker require ExtUtils::MakeMaker; if ( $perl_version and $self->_cmp($perl_version, '5.006') >= 0 ) { # This previous attempted to inherit the version of # ExtUtils::MakeMaker in use by the module author, but this # was found to be untenable as some authors build releases # using future dev versions of EU:MM that nobody else has. # Instead, #toolchain suggests we use 6.59 which is the most # stable version on CPAN at time of writing and is, to quote # ribasushi, "not terminally fucked, > and tested enough". # TODO: We will now need to maintain this over time to push # the version up as new versions are released. $self->build_requires( 'ExtUtils::MakeMaker' => 6.59 ); $self->configure_requires( 'ExtUtils::MakeMaker' => 6.59 ); } else { # Allow legacy-compatibility with 5.005 by depending on the # most recent EU:MM that supported 5.005. $self->build_requires( 'ExtUtils::MakeMaker' => 6.36 ); $self->configure_requires( 'ExtUtils::MakeMaker' => 6.36 ); } # Generate the MakeMaker params my $args = $self->makemaker_args; $args->{DISTNAME} = $self->name; $args->{NAME} = $self->module_name || $self->name; $args->{NAME} =~ s/-/::/g; $args->{VERSION} = $self->version or die <<'EOT'; ERROR: Can't determine distribution version. Please specify it explicitly via 'version' in Makefile.PL, or set a valid $VERSION in a module, and provide its file path via 'version_from' (or 'all_from' if you prefer) in Makefile.PL. EOT if ( $self->tests ) { my @tests = split ' ', $self->tests; my %seen; $args->{test} = { TESTS => (join ' ', grep {!$seen{$_}++} @tests), }; } elsif ( $Module::Install::ExtraTests::use_extratests ) { # Module::Install::ExtraTests doesn't set $self->tests and does its own tests via harness. # So, just ignore our xt tests here. } elsif ( -d 'xt' and ($Module::Install::AUTHOR or $ENV{RELEASE_TESTING}) ) { $args->{test} = { TESTS => join( ' ', map { "$_/*.t" } grep { -d $_ } qw{ t xt } ), }; } if ( $] >= 5.005 ) { $args->{ABSTRACT} = $self->abstract; $args->{AUTHOR} = join ', ', @{$self->author || []}; } if ( $self->makemaker(6.10) ) { $args->{NO_META} = 1; #$args->{NO_MYMETA} = 1; } if ( $self->makemaker(6.17) and $self->sign ) { $args->{SIGN} = 1; } unless ( $self->is_admin ) { delete $args->{SIGN}; } if ( $self->makemaker(6.31) and $self->license ) { $args->{LICENSE} = $self->license; } my $prereq = ($args->{PREREQ_PM} ||= {}); %$prereq = ( %$prereq, map { @$_ } # flatten [module => version] map { @$_ } grep $_, ($self->requires) ); # Remove any reference to perl, PREREQ_PM doesn't support it delete $args->{PREREQ_PM}->{perl}; # Merge both kinds of requires into BUILD_REQUIRES my $build_prereq = ($args->{BUILD_REQUIRES} ||= {}); %$build_prereq = ( %$build_prereq, map { @$_ } # flatten [module => version] map { @$_ } grep $_, ($self->configure_requires, $self->build_requires) ); # Remove any reference to perl, BUILD_REQUIRES doesn't support it delete $args->{BUILD_REQUIRES}->{perl}; # Delete bundled dists from prereq_pm, add it to Makefile DIR my $subdirs = ($args->{DIR} || []); if ($self->bundles) { my %processed; foreach my $bundle (@{ $self->bundles }) { my ($mod_name, $dist_dir) = @$bundle; delete $prereq->{$mod_name}; $dist_dir = File::Basename::basename($dist_dir); # dir for building this module if (not exists $processed{$dist_dir}) { if (-d $dist_dir) { # List as sub-directory to be processed by make push @$subdirs, $dist_dir; } # Else do nothing: the module is already present on the system $processed{$dist_dir} = undef; } } } unless ( $self->makemaker('6.55_03') ) { %$prereq = (%$prereq,%$build_prereq); delete $args->{BUILD_REQUIRES}; } if ( my $perl_version = $self->perl_version ) { eval "use $perl_version; 1" or die "ERROR: perl: Version $] is installed, " . "but we need version >= $perl_version"; if ( $self->makemaker(6.48) ) { $args->{MIN_PERL_VERSION} = $perl_version; } } if ($self->installdirs) { warn qq{old INSTALLDIRS (probably set by makemaker_args) is overriden by installdirs\n} if $args->{INSTALLDIRS}; $args->{INSTALLDIRS} = $self->installdirs; } my %args = map { ( $_ => $args->{$_} ) } grep {defined($args->{$_} ) } keys %$args; my $user_preop = delete $args{dist}->{PREOP}; if ( my $preop = $self->admin->preop($user_preop) ) { foreach my $key ( keys %$preop ) { $args{dist}->{$key} = $preop->{$key}; } } my $mm = ExtUtils::MakeMaker::WriteMakefile(%args); $self->fix_up_makefile($mm->{FIRST_MAKEFILE} || 'Makefile'); } sub fix_up_makefile { my $self = shift; my $makefile_name = shift; my $top_class = ref($self->_top) || ''; my $top_version = $self->_top->VERSION || ''; my $preamble = $self->preamble ? "# Preamble by $top_class $top_version\n" . $self->preamble : ''; my $postamble = "# Postamble by $top_class $top_version\n" . ($self->postamble || ''); local *MAKEFILE; open MAKEFILE, "+< $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!"; eval { flock MAKEFILE, LOCK_EX }; my $makefile = do { local $/; }; $makefile =~ s/\b(test_harness\(\$\(TEST_VERBOSE\), )/$1'inc', /; $makefile =~ s/( -I\$\(INST_ARCHLIB\))/ -Iinc$1/g; $makefile =~ s/( "-I\$\(INST_LIB\)")/ "-Iinc"$1/g; $makefile =~ s/^(FULLPERL = .*)/$1 "-Iinc"/m; $makefile =~ s/^(PERL = .*)/$1 "-Iinc"/m; # Module::Install will never be used to build the Core Perl # Sometimes PERL_LIB and PERL_ARCHLIB get written anyway, which breaks # PREFIX/PERL5LIB, and thus, install_share. Blank them if they exist $makefile =~ s/^PERL_LIB = .+/PERL_LIB =/m; #$makefile =~ s/^PERL_ARCHLIB = .+/PERL_ARCHLIB =/m; # Perl 5.005 mentions PERL_LIB explicitly, so we have to remove that as well. $makefile =~ s/(\"?)-I\$\(PERL_LIB\)\1//g; # XXX - This is currently unused; not sure if it breaks other MM-users # $makefile =~ s/^pm_to_blib\s+:\s+/pm_to_blib :: /mg; seek MAKEFILE, 0, SEEK_SET; truncate MAKEFILE, 0; print MAKEFILE "$preamble$makefile$postamble" or die $!; close MAKEFILE or die $!; 1; } sub preamble { my ($self, $text) = @_; $self->{preamble} = $text . $self->{preamble} if defined $text; $self->{preamble}; } sub postamble { my ($self, $text) = @_; $self->{postamble} ||= $self->admin->postamble; $self->{postamble} .= $text if defined $text; $self->{postamble} } 1; __END__ #line 544 Statistics-R-0.34/inc/Module/Install/Fetch.pm0000644000175000017500000000462712611224732021215 0ustar floflooofloflooo#line 1 package Module::Install::Fetch; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.16'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } sub get_file { my ($self, %args) = @_; my ($scheme, $host, $path, $file) = $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return; if ( $scheme eq 'http' and ! eval { require LWP::Simple; 1 } ) { $args{url} = $args{ftp_url} or (warn("LWP support unavailable!\n"), return); ($scheme, $host, $path, $file) = $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return; } $|++; print "Fetching '$file' from $host... "; unless (eval { require Socket; Socket::inet_aton($host) }) { warn "'$host' resolve failed!\n"; return; } return unless $scheme eq 'ftp' or $scheme eq 'http'; require Cwd; my $dir = Cwd::getcwd(); chdir $args{local_dir} or return if exists $args{local_dir}; if (eval { require LWP::Simple; 1 }) { LWP::Simple::mirror($args{url}, $file); } elsif (eval { require Net::FTP; 1 }) { eval { # use Net::FTP to get past firewall my $ftp = Net::FTP->new($host, Passive => 1, Timeout => 600); $ftp->login("anonymous", 'anonymous@example.com'); $ftp->cwd($path); $ftp->binary; $ftp->get($file) or (warn("$!\n"), return); $ftp->quit; } } elsif (my $ftp = $self->can_run('ftp')) { eval { # no Net::FTP, fallback to ftp.exe require FileHandle; my $fh = FileHandle->new; local $SIG{CHLD} = 'IGNORE'; unless ($fh->open("|$ftp -n")) { warn "Couldn't open ftp: $!\n"; chdir $dir; return; } my @dialog = split(/\n/, <<"END_FTP"); open $host user anonymous anonymous\@example.com cd $path binary get $file $file quit END_FTP foreach (@dialog) { $fh->print("$_\n") } $fh->close; } } else { warn "No working 'ftp' program available!\n"; chdir $dir; return; } unless (-f $file) { warn "Fetching failed: $@\n"; chdir $dir; return; } return if exists $args{size} and -s $file != $args{size}; system($args{run}) if exists $args{run}; unlink($file) if $args{remove}; print(((!exists $args{check_for} or -e $args{check_for}) ? "done!" : "failed! ($!)"), "\n"); chdir $dir; return !$?; } 1; Statistics-R-0.34/inc/Module/Install/Metadata.pm0000644000175000017500000004330212611224732021675 0ustar floflooofloflooo#line 1 package Module::Install::Metadata; use strict 'vars'; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.16'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } my @boolean_keys = qw{ sign }; my @scalar_keys = qw{ name module_name abstract version distribution_type tests installdirs }; my @tuple_keys = qw{ configure_requires build_requires requires recommends bundles resources }; my @resource_keys = qw{ homepage bugtracker repository }; my @array_keys = qw{ keywords author }; *authors = \&author; sub Meta { shift } sub Meta_BooleanKeys { @boolean_keys } sub Meta_ScalarKeys { @scalar_keys } sub Meta_TupleKeys { @tuple_keys } sub Meta_ResourceKeys { @resource_keys } sub Meta_ArrayKeys { @array_keys } foreach my $key ( @boolean_keys ) { *$key = sub { my $self = shift; if ( defined wantarray and not @_ ) { return $self->{values}->{$key}; } $self->{values}->{$key} = ( @_ ? $_[0] : 1 ); return $self; }; } foreach my $key ( @scalar_keys ) { *$key = sub { my $self = shift; return $self->{values}->{$key} if defined wantarray and !@_; $self->{values}->{$key} = shift; return $self; }; } foreach my $key ( @array_keys ) { *$key = sub { my $self = shift; return $self->{values}->{$key} if defined wantarray and !@_; $self->{values}->{$key} ||= []; push @{$self->{values}->{$key}}, @_; return $self; }; } foreach my $key ( @resource_keys ) { *$key = sub { my $self = shift; unless ( @_ ) { return () unless $self->{values}->{resources}; return map { $_->[1] } grep { $_->[0] eq $key } @{ $self->{values}->{resources} }; } return $self->{values}->{resources}->{$key} unless @_; my $uri = shift or die( "Did not provide a value to $key()" ); $self->resources( $key => $uri ); return 1; }; } foreach my $key ( grep { $_ ne "resources" } @tuple_keys) { *$key = sub { my $self = shift; return $self->{values}->{$key} unless @_; my @added; while ( @_ ) { my $module = shift or last; my $version = shift || 0; push @added, [ $module, $version ]; } push @{ $self->{values}->{$key} }, @added; return map {@$_} @added; }; } # Resource handling my %lc_resource = map { $_ => 1 } qw{ homepage license bugtracker repository }; sub resources { my $self = shift; while ( @_ ) { my $name = shift or last; my $value = shift or next; if ( $name eq lc $name and ! $lc_resource{$name} ) { die("Unsupported reserved lowercase resource '$name'"); } $self->{values}->{resources} ||= []; push @{ $self->{values}->{resources} }, [ $name, $value ]; } $self->{values}->{resources}; } # Aliases for build_requires that will have alternative # meanings in some future version of META.yml. sub test_requires { shift->build_requires(@_) } sub install_requires { shift->build_requires(@_) } # Aliases for installdirs options sub install_as_core { $_[0]->installdirs('perl') } sub install_as_cpan { $_[0]->installdirs('site') } sub install_as_site { $_[0]->installdirs('site') } sub install_as_vendor { $_[0]->installdirs('vendor') } sub dynamic_config { my $self = shift; my $value = @_ ? shift : 1; if ( $self->{values}->{dynamic_config} ) { # Once dynamic we never change to static, for safety return 0; } $self->{values}->{dynamic_config} = $value ? 1 : 0; return 1; } # Convenience command sub static_config { shift->dynamic_config(0); } sub perl_version { my $self = shift; return $self->{values}->{perl_version} unless @_; my $version = shift or die( "Did not provide a value to perl_version()" ); # Normalize the version $version = $self->_perl_version($version); # We don't support the really old versions unless ( $version >= 5.005 ) { die "Module::Install only supports 5.005 or newer (use ExtUtils::MakeMaker)\n"; } $self->{values}->{perl_version} = $version; } sub all_from { my ( $self, $file ) = @_; unless ( defined($file) ) { my $name = $self->name or die( "all_from called with no args without setting name() first" ); $file = join('/', 'lib', split(/-/, $name)) . '.pm'; $file =~ s{.*/}{} unless -e $file; unless ( -e $file ) { die("all_from cannot find $file from $name"); } } unless ( -f $file ) { die("The path '$file' does not exist, or is not a file"); } $self->{values}{all_from} = $file; # Some methods pull from POD instead of code. # If there is a matching .pod, use that instead my $pod = $file; $pod =~ s/\.pm$/.pod/i; $pod = $file unless -e $pod; # Pull the different values $self->name_from($file) unless $self->name; $self->version_from($file) unless $self->version; $self->perl_version_from($file) unless $self->perl_version; $self->author_from($pod) unless @{$self->author || []}; $self->license_from($pod) unless $self->license; $self->abstract_from($pod) unless $self->abstract; return 1; } sub provides { my $self = shift; my $provides = ( $self->{values}->{provides} ||= {} ); %$provides = (%$provides, @_) if @_; return $provides; } sub auto_provides { my $self = shift; return $self unless $self->is_admin; unless (-e 'MANIFEST') { warn "Cannot deduce auto_provides without a MANIFEST, skipping\n"; return $self; } # Avoid spurious warnings as we are not checking manifest here. local $SIG{__WARN__} = sub {1}; require ExtUtils::Manifest; local *ExtUtils::Manifest::manicheck = sub { return }; require Module::Build; my $build = Module::Build->new( dist_name => $self->name, dist_version => $self->version, license => $self->license, ); $self->provides( %{ $build->find_dist_packages || {} } ); } sub feature { my $self = shift; my $name = shift; my $features = ( $self->{values}->{features} ||= [] ); my $mods; if ( @_ == 1 and ref( $_[0] ) ) { # The user used ->feature like ->features by passing in the second # argument as a reference. Accomodate for that. $mods = $_[0]; } else { $mods = \@_; } my $count = 0; push @$features, ( $name => [ map { ref($_) ? ( ref($_) eq 'HASH' ) ? %$_ : @$_ : $_ } @$mods ] ); return @$features; } sub features { my $self = shift; while ( my ( $name, $mods ) = splice( @_, 0, 2 ) ) { $self->feature( $name, @$mods ); } return $self->{values}->{features} ? @{ $self->{values}->{features} } : (); } sub no_index { my $self = shift; my $type = shift; push @{ $self->{values}->{no_index}->{$type} }, @_ if $type; return $self->{values}->{no_index}; } sub read { my $self = shift; $self->include_deps( 'YAML::Tiny', 0 ); require YAML::Tiny; my $data = YAML::Tiny::LoadFile('META.yml'); # Call methods explicitly in case user has already set some values. while ( my ( $key, $value ) = each %$data ) { next unless $self->can($key); if ( ref $value eq 'HASH' ) { while ( my ( $module, $version ) = each %$value ) { $self->can($key)->($self, $module => $version ); } } else { $self->can($key)->($self, $value); } } return $self; } sub write { my $self = shift; return $self unless $self->is_admin; $self->admin->write_meta; return $self; } sub version_from { require ExtUtils::MM_Unix; my ( $self, $file ) = @_; $self->version( ExtUtils::MM_Unix->parse_version($file) ); # for version integrity check $self->makemaker_args( VERSION_FROM => $file ); } sub abstract_from { require ExtUtils::MM_Unix; my ( $self, $file ) = @_; $self->abstract( bless( { DISTNAME => $self->name }, 'ExtUtils::MM_Unix' )->parse_abstract($file) ); } # Add both distribution and module name sub name_from { my ($self, $file) = @_; if ( Module::Install::_read($file) =~ m/ ^ \s* package \s* ([\w:]+) [\s|;]* /ixms ) { my ($name, $module_name) = ($1, $1); $name =~ s{::}{-}g; $self->name($name); unless ( $self->module_name ) { $self->module_name($module_name); } } else { die("Cannot determine name from $file\n"); } } sub _extract_perl_version { if ( $_[0] =~ m/ ^\s* (?:use|require) \s* v? ([\d_\.]+) \s* ; /ixms ) { my $perl_version = $1; $perl_version =~ s{_}{}g; return $perl_version; } else { return; } } sub perl_version_from { my $self = shift; my $perl_version=_extract_perl_version(Module::Install::_read($_[0])); if ($perl_version) { $self->perl_version($perl_version); } else { warn "Cannot determine perl version info from $_[0]\n"; return; } } sub author_from { my $self = shift; my $content = Module::Install::_read($_[0]); if ($content =~ m/ =head \d \s+ (?:authors?)\b \s* ([^\n]*) | =head \d \s+ (?:licen[cs]e|licensing|copyright|legal)\b \s* .*? copyright .*? \d\d\d[\d.]+ \s* (?:\bby\b)? \s* ([^\n]*) /ixms) { my $author = $1 || $2; # XXX: ugly but should work anyway... if (eval "require Pod::Escapes; 1") { # Pod::Escapes has a mapping table. # It's in core of perl >= 5.9.3, and should be installed # as one of the Pod::Simple's prereqs, which is a prereq # of Pod::Text 3.x (see also below). $author =~ s{ E<( (\d+) | ([A-Za-z]+) )> } { defined $2 ? chr($2) : defined $Pod::Escapes::Name2character_number{$1} ? chr($Pod::Escapes::Name2character_number{$1}) : do { warn "Unknown escape: E<$1>"; "E<$1>"; }; }gex; } elsif (eval "require Pod::Text; 1" && $Pod::Text::VERSION < 3) { # Pod::Text < 3.0 has yet another mapping table, # though the table name of 2.x and 1.x are different. # (1.x is in core of Perl < 5.6, 2.x is in core of # Perl < 5.9.3) my $mapping = ($Pod::Text::VERSION < 2) ? \%Pod::Text::HTML_Escapes : \%Pod::Text::ESCAPES; $author =~ s{ E<( (\d+) | ([A-Za-z]+) )> } { defined $2 ? chr($2) : defined $mapping->{$1} ? $mapping->{$1} : do { warn "Unknown escape: E<$1>"; "E<$1>"; }; }gex; } else { $author =~ s{E}{<}g; $author =~ s{E}{>}g; } $self->author($author); } else { warn "Cannot determine author info from $_[0]\n"; } } #Stolen from M::B my %license_urls = ( perl => 'http://dev.perl.org/licenses/', apache => 'http://apache.org/licenses/LICENSE-2.0', apache_1_1 => 'http://apache.org/licenses/LICENSE-1.1', artistic => 'http://opensource.org/licenses/artistic-license.php', artistic_2 => 'http://opensource.org/licenses/artistic-license-2.0.php', lgpl => 'http://opensource.org/licenses/lgpl-license.php', lgpl2 => 'http://opensource.org/licenses/lgpl-2.1.php', lgpl3 => 'http://opensource.org/licenses/lgpl-3.0.html', bsd => 'http://opensource.org/licenses/bsd-license.php', gpl => 'http://opensource.org/licenses/gpl-license.php', gpl2 => 'http://opensource.org/licenses/gpl-2.0.php', gpl3 => 'http://opensource.org/licenses/gpl-3.0.html', mit => 'http://opensource.org/licenses/mit-license.php', mozilla => 'http://opensource.org/licenses/mozilla1.1.php', open_source => undef, unrestricted => undef, restrictive => undef, unknown => undef, ); sub license { my $self = shift; return $self->{values}->{license} unless @_; my $license = shift or die( 'Did not provide a value to license()' ); $license = __extract_license($license) || lc $license; $self->{values}->{license} = $license; # Automatically fill in license URLs if ( $license_urls{$license} ) { $self->resources( license => $license_urls{$license} ); } return 1; } sub _extract_license { my $pod = shift; my $matched; return __extract_license( ($matched) = $pod =~ m/ (=head \d \s+ L(?i:ICEN[CS]E|ICENSING)\b.*?) (=head \d.*|=cut.*|)\z /xms ) || __extract_license( ($matched) = $pod =~ m/ (=head \d \s+ (?:C(?i:OPYRIGHTS?)|L(?i:EGAL))\b.*?) (=head \d.*|=cut.*|)\z /xms ); } sub __extract_license { my $license_text = shift or return; my @phrases = ( '(?:under )?the same (?:terms|license) as (?:perl|the perl (?:\d )?programming language)' => 'perl', 1, '(?:under )?the terms of (?:perl|the perl programming language) itself' => 'perl', 1, 'Artistic and GPL' => 'perl', 1, 'GNU general public license' => 'gpl', 1, 'GNU public license' => 'gpl', 1, 'GNU lesser general public license' => 'lgpl', 1, 'GNU lesser public license' => 'lgpl', 1, 'GNU library general public license' => 'lgpl', 1, 'GNU library public license' => 'lgpl', 1, 'GNU Free Documentation license' => 'unrestricted', 1, 'GNU Affero General Public License' => 'open_source', 1, '(?:Free)?BSD license' => 'bsd', 1, 'Artistic license 2\.0' => 'artistic_2', 1, 'Artistic license' => 'artistic', 1, 'Apache (?:Software )?license' => 'apache', 1, 'GPL' => 'gpl', 1, 'LGPL' => 'lgpl', 1, 'BSD' => 'bsd', 1, 'Artistic' => 'artistic', 1, 'MIT' => 'mit', 1, 'Mozilla Public License' => 'mozilla', 1, 'Q Public License' => 'open_source', 1, 'OpenSSL License' => 'unrestricted', 1, 'SSLeay License' => 'unrestricted', 1, 'zlib License' => 'open_source', 1, 'proprietary' => 'proprietary', 0, ); while ( my ($pattern, $license, $osi) = splice(@phrases, 0, 3) ) { $pattern =~ s#\s+#\\s+#gs; if ( $license_text =~ /\b$pattern\b/i ) { return $license; } } return ''; } sub license_from { my $self = shift; if (my $license=_extract_license(Module::Install::_read($_[0]))) { $self->license($license); } else { warn "Cannot determine license info from $_[0]\n"; return 'unknown'; } } sub _extract_bugtracker { my @links = $_[0] =~ m#L<( https?\Q://rt.cpan.org/\E[^>]+| https?\Q://github.com/\E[\w_]+/[\w_]+/issues| https?\Q://code.google.com/p/\E[\w_\-]+/issues/list )>#gx; my %links; @links{@links}=(); @links=keys %links; return @links; } sub bugtracker_from { my $self = shift; my $content = Module::Install::_read($_[0]); my @links = _extract_bugtracker($content); unless ( @links ) { warn "Cannot determine bugtracker info from $_[0]\n"; return 0; } if ( @links > 1 ) { warn "Found more than one bugtracker link in $_[0]\n"; return 0; } # Set the bugtracker bugtracker( $links[0] ); return 1; } sub requires_from { my $self = shift; my $content = Module::Install::_readperl($_[0]); my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+(v?[\d\.]+)/mg; while ( @requires ) { my $module = shift @requires; my $version = shift @requires; $self->requires( $module => $version ); } } sub test_requires_from { my $self = shift; my $content = Module::Install::_readperl($_[0]); my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+([\d\.]+)/mg; while ( @requires ) { my $module = shift @requires; my $version = shift @requires; $self->test_requires( $module => $version ); } } # Convert triple-part versions (eg, 5.6.1 or 5.8.9) to # numbers (eg, 5.006001 or 5.008009). # Also, convert double-part versions (eg, 5.8) sub _perl_version { my $v = $_[-1]; $v =~ s/^([1-9])\.([1-9]\d?\d?)$/sprintf("%d.%03d",$1,$2)/e; $v =~ s/^([1-9])\.([1-9]\d?\d?)\.(0|[1-9]\d?\d?)$/sprintf("%d.%03d%03d",$1,$2,$3 || 0)/e; $v =~ s/(\.\d\d\d)000$/$1/; $v =~ s/_.+$//; if ( ref($v) ) { # Numify $v = $v + 0; } return $v; } sub add_metadata { my $self = shift; my %hash = @_; for my $key (keys %hash) { warn "add_metadata: $key is not prefixed with 'x_'.\n" . "Use appopriate function to add non-private metadata.\n" unless $key =~ /^x_/; $self->{values}->{$key} = $hash{$key}; } } ###################################################################### # MYMETA Support sub WriteMyMeta { die "WriteMyMeta has been deprecated"; } sub write_mymeta_yaml { my $self = shift; # We need YAML::Tiny to write the MYMETA.yml file unless ( eval { require YAML::Tiny; 1; } ) { return 1; } # Generate the data my $meta = $self->_write_mymeta_data or return 1; # Save as the MYMETA.yml file print "Writing MYMETA.yml\n"; YAML::Tiny::DumpFile('MYMETA.yml', $meta); } sub write_mymeta_json { my $self = shift; # We need JSON to write the MYMETA.json file unless ( eval { require JSON; 1; } ) { return 1; } # Generate the data my $meta = $self->_write_mymeta_data or return 1; # Save as the MYMETA.yml file print "Writing MYMETA.json\n"; Module::Install::_write( 'MYMETA.json', JSON->new->pretty(1)->canonical->encode($meta), ); } sub _write_mymeta_data { my $self = shift; # If there's no existing META.yml there is nothing we can do return undef unless -f 'META.yml'; # We need Parse::CPAN::Meta to load the file unless ( eval { require Parse::CPAN::Meta; 1; } ) { return undef; } # Merge the perl version into the dependencies my $val = $self->Meta->{values}; my $perl = delete $val->{perl_version}; if ( $perl ) { $val->{requires} ||= []; my $requires = $val->{requires}; # Canonize to three-dot version after Perl 5.6 if ( $perl >= 5.006 ) { $perl =~ s{^(\d+)\.(\d\d\d)(\d*)}{join('.', $1, int($2||0), int($3||0))}e } unshift @$requires, [ perl => $perl ]; } # Load the advisory META.yml file my @yaml = Parse::CPAN::Meta::LoadFile('META.yml'); my $meta = $yaml[0]; # Overwrite the non-configure dependency hashes delete $meta->{requires}; delete $meta->{build_requires}; delete $meta->{recommends}; if ( exists $val->{requires} ) { $meta->{requires} = { map { @$_ } @{ $val->{requires} } }; } if ( exists $val->{build_requires} ) { $meta->{build_requires} = { map { @$_ } @{ $val->{build_requires} } }; } return $meta; } 1; Statistics-R-0.34/inc/Module/Install/Base.pm0000644000175000017500000000214712611224732021031 0ustar floflooofloflooo#line 1 package Module::Install::Base; use strict 'vars'; use vars qw{$VERSION}; BEGIN { $VERSION = '1.16'; } # Suspend handler for "redefined" warnings BEGIN { my $w = $SIG{__WARN__}; $SIG{__WARN__} = sub { $w }; } #line 42 sub new { my $class = shift; unless ( defined &{"${class}::call"} ) { *{"${class}::call"} = sub { shift->_top->call(@_) }; } unless ( defined &{"${class}::load"} ) { *{"${class}::load"} = sub { shift->_top->load(@_) }; } bless { @_ }, $class; } #line 61 sub AUTOLOAD { local $@; my $func = eval { shift->_top->autoload } or return; goto &$func; } #line 75 sub _top { $_[0]->{_top}; } #line 90 sub admin { $_[0]->_top->{admin} or Module::Install::Base::FakeAdmin->new; } #line 106 sub is_admin { ! $_[0]->admin->isa('Module::Install::Base::FakeAdmin'); } sub DESTROY {} package Module::Install::Base::FakeAdmin; use vars qw{$VERSION}; BEGIN { $VERSION = $Module::Install::Base::VERSION; } my $fake; sub new { $fake ||= bless(\@_, $_[0]); } sub AUTOLOAD {} sub DESTROY {} # Restore warning handler BEGIN { $SIG{__WARN__} = $SIG{__WARN__}->(); } 1; #line 159 Statistics-R-0.34/inc/Module/Install/Can.pm0000644000175000017500000000615712611224732020665 0ustar floflooofloflooo#line 1 package Module::Install::Can; use strict; use Config (); use ExtUtils::MakeMaker (); use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.16'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } # check if we can load some module ### Upgrade this to not have to load the module if possible sub can_use { my ($self, $mod, $ver) = @_; $mod =~ s{::|\\}{/}g; $mod .= '.pm' unless $mod =~ /\.pm$/i; my $pkg = $mod; $pkg =~ s{/}{::}g; $pkg =~ s{\.pm$}{}i; local $@; eval { require $mod; $pkg->VERSION($ver || 0); 1 }; } # Check if we can run some command sub can_run { my ($self, $cmd) = @_; my $_cmd = $cmd; return $_cmd if (-x $_cmd or $_cmd = MM->maybe_command($_cmd)); for my $dir ((split /$Config::Config{path_sep}/, $ENV{PATH}), '.') { next if $dir eq ''; require File::Spec; my $abs = File::Spec->catfile($dir, $cmd); return $abs if (-x $abs or $abs = MM->maybe_command($abs)); } return; } # Can our C compiler environment build XS files sub can_xs { my $self = shift; # Ensure we have the CBuilder module $self->configure_requires( 'ExtUtils::CBuilder' => 0.27 ); # Do we have the configure_requires checker? local $@; eval "require ExtUtils::CBuilder;"; if ( $@ ) { # They don't obey configure_requires, so it is # someone old and delicate. Try to avoid hurting # them by falling back to an older simpler test. return $self->can_cc(); } # Do we have a working C compiler my $builder = ExtUtils::CBuilder->new( quiet => 1, ); unless ( $builder->have_compiler ) { # No working C compiler return 0; } # Write a C file representative of what XS becomes require File::Temp; my ( $FH, $tmpfile ) = File::Temp::tempfile( "compilexs-XXXXX", SUFFIX => '.c', ); binmode $FH; print $FH <<'END_C'; #include "EXTERN.h" #include "perl.h" #include "XSUB.h" int main(int argc, char **argv) { return 0; } int boot_sanexs() { return 1; } END_C close $FH; # Can the C compiler access the same headers XS does my @libs = (); my $object = undef; eval { local $^W = 0; $object = $builder->compile( source => $tmpfile, ); @libs = $builder->link( objects => $object, module_name => 'sanexs', ); }; my $result = $@ ? 0 : 1; # Clean up all the build files foreach ( $tmpfile, $object, @libs ) { next unless defined $_; 1 while unlink; } return $result; } # Can we locate a (the) C compiler sub can_cc { my $self = shift; my @chunks = split(/ /, $Config::Config{cc}) or return; # $Config{cc} may contain args; try to find out the program part while (@chunks) { return $self->can_run("@chunks") || (pop(@chunks), next); } return; } # Fix Cygwin bug on maybe_command(); if ( $^O eq 'cygwin' ) { require ExtUtils::MM_Cygwin; require ExtUtils::MM_Win32; if ( ! defined(&ExtUtils::MM_Cygwin::maybe_command) ) { *ExtUtils::MM_Cygwin::maybe_command = sub { my ($self, $file) = @_; if ($file =~ m{^/cygdrive/}i and ExtUtils::MM_Win32->can('maybe_command')) { ExtUtils::MM_Win32->maybe_command($file); } else { ExtUtils::MM_Unix->maybe_command($file); } } } } 1; __END__ #line 236 Statistics-R-0.34/inc/Module/Install/Win32.pm0000644000175000017500000000340312611224732021055 0ustar floflooofloflooo#line 1 package Module::Install::Win32; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.16'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } # determine if the user needs nmake, and download it if needed sub check_nmake { my $self = shift; $self->load('can_run'); $self->load('get_file'); require Config; return unless ( $^O eq 'MSWin32' and $Config::Config{make} and $Config::Config{make} =~ /^nmake\b/i and ! $self->can_run('nmake') ); print "The required 'nmake' executable not found, fetching it...\n"; require File::Basename; my $rv = $self->get_file( url => 'http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe', ftp_url => 'ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe', local_dir => File::Basename::dirname($^X), size => 51928, run => 'Nmake15.exe /o > nul', check_for => 'Nmake.exe', remove => 1, ); die <<'END_MESSAGE' unless $rv; ------------------------------------------------------------------------------- Since you are using Microsoft Windows, you will need the 'nmake' utility before installation. It's available at: http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe or ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe Please download the file manually, save it to a directory in %PATH% (e.g. C:\WINDOWS\COMMAND\), then launch the MS-DOS command line shell, "cd" to that directory, and run "Nmake15.exe" from there; that will create the 'nmake.exe' file needed by this module. You may then resume the installation process described in README. ------------------------------------------------------------------------------- END_MESSAGE } 1; Statistics-R-0.34/inc/Module/Install/External.pm0000644000175000017500000000354512611224732021744 0ustar floflooofloflooo#line 1 package Module::Install::External; # Provides dependency declarations for external non-Perl things use strict; use Module::Install::Base (); use vars qw{$VERSION $ISCORE @ISA}; BEGIN { $VERSION = '1.16'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } sub requires_xs { my $self = shift; # First check for the basic C compiler $self->requires_external_cc; # We need a C compiler that can build XS files unless ( $self->can_xs ) { print "Unresolvable missing external dependency.\n"; print "This package requires perl's header files.\n"; print STDERR "NA: Unable to build distribution on this platform.\n"; exit(0); } 1; } sub requires_external_cc { my $self = shift; # We need a C compiler, use the can_cc method for this unless ( $self->can_cc ) { print "Unresolvable missing external dependency.\n"; print "This package requires a C compiler.\n"; print STDERR "NA: Unable to build distribution on this platform.\n"; exit(0); } # Unlike some of the other modules, while we need to specify a # C compiler as a dep, it needs to be a build-time dependency. 1; } sub requires_external_bin { my ($self, $bin, $version) = @_; if ( $version ) { die "requires_external_bin does not support versions yet"; } # Load the package containing can_run early, # to avoid breaking the message below. $self->load('can_run'); # Locate the bin print "Locating bin:$bin..."; my $found_bin = $self->can_run( $bin ); if ( $found_bin ) { print " found at $found_bin.\n"; } else { print " missing.\n"; print "Unresolvable missing external dependency.\n"; print "Please install '$bin' seperately and try again.\n"; print STDERR "NA: Unable to build distribution on this platform.\n"; exit(0); } # Once we have some way to specify external deps, do it here. # In the mean time, continue as normal. 1; } 1; __END__ #line 171 Statistics-R-0.34/inc/Module/Install.pm0000644000175000017500000003021712611224732020156 0ustar floflooofloflooo#line 1 package Module::Install; # For any maintainers: # The load order for Module::Install is a bit magic. # It goes something like this... # # IF ( host has Module::Install installed, creating author mode ) { # 1. Makefile.PL calls "use inc::Module::Install" # 2. $INC{inc/Module/Install.pm} set to installed version of inc::Module::Install # 3. The installed version of inc::Module::Install loads # 4. inc::Module::Install calls "require Module::Install" # 5. The ./inc/ version of Module::Install loads # } ELSE { # 1. Makefile.PL calls "use inc::Module::Install" # 2. $INC{inc/Module/Install.pm} set to ./inc/ version of Module::Install # 3. The ./inc/ version of Module::Install loads # } use 5.006; use strict 'vars'; use Cwd (); use File::Find (); use File::Path (); use vars qw{$VERSION $MAIN}; BEGIN { # All Module::Install core packages now require synchronised versions. # This will be used to ensure we don't accidentally load old or # different versions of modules. # This is not enforced yet, but will be some time in the next few # releases once we can make sure it won't clash with custom # Module::Install extensions. $VERSION = '1.16'; # Storage for the pseudo-singleton $MAIN = undef; *inc::Module::Install::VERSION = *VERSION; @inc::Module::Install::ISA = __PACKAGE__; } sub import { my $class = shift; my $self = $class->new(@_); my $who = $self->_caller; #------------------------------------------------------------- # all of the following checks should be included in import(), # to allow "eval 'require Module::Install; 1' to test # installation of Module::Install. (RT #51267) #------------------------------------------------------------- # Whether or not inc::Module::Install is actually loaded, the # $INC{inc/Module/Install.pm} is what will still get set as long as # the caller loaded module this in the documented manner. # If not set, the caller may NOT have loaded the bundled version, and thus # they may not have a MI version that works with the Makefile.PL. This would # result in false errors or unexpected behaviour. And we don't want that. my $file = join( '/', 'inc', split /::/, __PACKAGE__ ) . '.pm'; unless ( $INC{$file} ) { die <<"END_DIE" } Please invoke ${\__PACKAGE__} with: use inc::${\__PACKAGE__}; not: use ${\__PACKAGE__}; END_DIE # This reportedly fixes a rare Win32 UTC file time issue, but # as this is a non-cross-platform XS module not in the core, # we shouldn't really depend on it. See RT #24194 for detail. # (Also, this module only supports Perl 5.6 and above). eval "use Win32::UTCFileTime" if $^O eq 'MSWin32' && $] >= 5.006; # If the script that is loading Module::Install is from the future, # then make will detect this and cause it to re-run over and over # again. This is bad. Rather than taking action to touch it (which # is unreliable on some platforms and requires write permissions) # for now we should catch this and refuse to run. if ( -f $0 ) { my $s = (stat($0))[9]; # If the modification time is only slightly in the future, # sleep briefly to remove the problem. my $a = $s - time; if ( $a > 0 and $a < 5 ) { sleep 5 } # Too far in the future, throw an error. my $t = time; if ( $s > $t ) { die <<"END_DIE" } Your installer $0 has a modification time in the future ($s > $t). This is known to create infinite loops in make. Please correct this, then run $0 again. END_DIE } # Build.PL was formerly supported, but no longer is due to excessive # difficulty in implementing every single feature twice. if ( $0 =~ /Build.PL$/i ) { die <<"END_DIE" } Module::Install no longer supports Build.PL. It was impossible to maintain duel backends, and has been deprecated. Please remove all Build.PL files and only use the Makefile.PL installer. END_DIE #------------------------------------------------------------- # To save some more typing in Module::Install installers, every... # use inc::Module::Install # ...also acts as an implicit use strict. $^H |= strict::bits(qw(refs subs vars)); #------------------------------------------------------------- unless ( -f $self->{file} ) { foreach my $key (keys %INC) { delete $INC{$key} if $key =~ /Module\/Install/; } local $^W; require "$self->{path}/$self->{dispatch}.pm"; File::Path::mkpath("$self->{prefix}/$self->{author}"); $self->{admin} = "$self->{name}::$self->{dispatch}"->new( _top => $self ); $self->{admin}->init; @_ = ($class, _self => $self); goto &{"$self->{name}::import"}; } local $^W; *{"${who}::AUTOLOAD"} = $self->autoload; $self->preload; # Unregister loader and worker packages so subdirs can use them again delete $INC{'inc/Module/Install.pm'}; delete $INC{'Module/Install.pm'}; # Save to the singleton $MAIN = $self; return 1; } sub autoload { my $self = shift; my $who = $self->_caller; my $cwd = Cwd::getcwd(); my $sym = "${who}::AUTOLOAD"; $sym->{$cwd} = sub { my $pwd = Cwd::getcwd(); if ( my $code = $sym->{$pwd} ) { # Delegate back to parent dirs goto &$code unless $cwd eq $pwd; } unless ($$sym =~ s/([^:]+)$//) { # XXX: it looks like we can't retrieve the missing function # via $$sym (usually $main::AUTOLOAD) in this case. # I'm still wondering if we should slurp Makefile.PL to # get some context or not ... my ($package, $file, $line) = caller; die <<"EOT"; Unknown function is found at $file line $line. Execution of $file aborted due to runtime errors. If you're a contributor to a project, you may need to install some Module::Install extensions from CPAN (or other repository). If you're a user of a module, please contact the author. EOT } my $method = $1; if ( uc($method) eq $method ) { # Do nothing return; } elsif ( $method =~ /^_/ and $self->can($method) ) { # Dispatch to the root M:I class return $self->$method(@_); } # Dispatch to the appropriate plugin unshift @_, ( $self, $1 ); goto &{$self->can('call')}; }; } sub preload { my $self = shift; unless ( $self->{extensions} ) { $self->load_extensions( "$self->{prefix}/$self->{path}", $self ); } my @exts = @{$self->{extensions}}; unless ( @exts ) { @exts = $self->{admin}->load_all_extensions; } my %seen; foreach my $obj ( @exts ) { while (my ($method, $glob) = each %{ref($obj) . '::'}) { next unless $obj->can($method); next if $method =~ /^_/; next if $method eq uc($method); $seen{$method}++; } } my $who = $self->_caller; foreach my $name ( sort keys %seen ) { local $^W; *{"${who}::$name"} = sub { ${"${who}::AUTOLOAD"} = "${who}::$name"; goto &{"${who}::AUTOLOAD"}; }; } } sub new { my ($class, %args) = @_; delete $INC{'FindBin.pm'}; { # to suppress the redefine warning local $SIG{__WARN__} = sub {}; require FindBin; } # ignore the prefix on extension modules built from top level. my $base_path = Cwd::abs_path($FindBin::Bin); unless ( Cwd::abs_path(Cwd::getcwd()) eq $base_path ) { delete $args{prefix}; } return $args{_self} if $args{_self}; $args{dispatch} ||= 'Admin'; $args{prefix} ||= 'inc'; $args{author} ||= ($^O eq 'VMS' ? '_author' : '.author'); $args{bundle} ||= 'inc/BUNDLES'; $args{base} ||= $base_path; $class =~ s/^\Q$args{prefix}\E:://; $args{name} ||= $class; $args{version} ||= $class->VERSION; unless ( $args{path} ) { $args{path} = $args{name}; $args{path} =~ s!::!/!g; } $args{file} ||= "$args{base}/$args{prefix}/$args{path}.pm"; $args{wrote} = 0; bless( \%args, $class ); } sub call { my ($self, $method) = @_; my $obj = $self->load($method) or return; splice(@_, 0, 2, $obj); goto &{$obj->can($method)}; } sub load { my ($self, $method) = @_; $self->load_extensions( "$self->{prefix}/$self->{path}", $self ) unless $self->{extensions}; foreach my $obj (@{$self->{extensions}}) { return $obj if $obj->can($method); } my $admin = $self->{admin} or die <<"END_DIE"; The '$method' method does not exist in the '$self->{prefix}' path! Please remove the '$self->{prefix}' directory and run $0 again to load it. END_DIE my $obj = $admin->load($method, 1); push @{$self->{extensions}}, $obj; $obj; } sub load_extensions { my ($self, $path, $top) = @_; my $should_reload = 0; unless ( grep { ! ref $_ and lc $_ eq lc $self->{prefix} } @INC ) { unshift @INC, $self->{prefix}; $should_reload = 1; } foreach my $rv ( $self->find_extensions($path) ) { my ($file, $pkg) = @{$rv}; next if $self->{pathnames}{$pkg}; local $@; my $new = eval { local $^W; require $file; $pkg->can('new') }; unless ( $new ) { warn $@ if $@; next; } $self->{pathnames}{$pkg} = $should_reload ? delete $INC{$file} : $INC{$file}; push @{$self->{extensions}}, &{$new}($pkg, _top => $top ); } $self->{extensions} ||= []; } sub find_extensions { my ($self, $path) = @_; my @found; File::Find::find( sub { my $file = $File::Find::name; return unless $file =~ m!^\Q$path\E/(.+)\.pm\Z!is; my $subpath = $1; return if lc($subpath) eq lc($self->{dispatch}); $file = "$self->{path}/$subpath.pm"; my $pkg = "$self->{name}::$subpath"; $pkg =~ s!/!::!g; # If we have a mixed-case package name, assume case has been preserved # correctly. Otherwise, root through the file to locate the case-preserved # version of the package name. if ( $subpath eq lc($subpath) || $subpath eq uc($subpath) ) { my $content = Module::Install::_read($subpath . '.pm'); my $in_pod = 0; foreach ( split /\n/, $content ) { $in_pod = 1 if /^=\w/; $in_pod = 0 if /^=cut/; next if ($in_pod || /^=cut/); # skip pod text next if /^\s*#/; # and comments if ( m/^\s*package\s+($pkg)\s*;/i ) { $pkg = $1; last; } } } push @found, [ $file, $pkg ]; }, $path ) if -d $path; @found; } ##################################################################### # Common Utility Functions sub _caller { my $depth = 0; my $call = caller($depth); while ( $call eq __PACKAGE__ ) { $depth++; $call = caller($depth); } return $call; } # Done in evals to avoid confusing Perl::MinimumVersion eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@; sub _read { local *FH; open( FH, '<', $_[0] ) or die "open($_[0]): $!"; binmode FH; my $string = do { local $/; }; close FH or die "close($_[0]): $!"; return $string; } END_NEW sub _read { local *FH; open( FH, "< $_[0]" ) or die "open($_[0]): $!"; binmode FH; my $string = do { local $/; }; close FH or die "close($_[0]): $!"; return $string; } END_OLD sub _readperl { my $string = Module::Install::_read($_[0]); $string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg; $string =~ s/(\n)\n*__(?:DATA|END)__\b.*\z/$1/s; $string =~ s/\n\n=\w+.+?\n\n=cut\b.+?\n+/\n\n/sg; return $string; } sub _readpod { my $string = Module::Install::_read($_[0]); $string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg; return $string if $_[0] =~ /\.pod\z/; $string =~ s/(^|\n=cut\b.+?\n+)[^=\s].+?\n(\n=\w+|\z)/$1$2/sg; $string =~ s/\n*=pod\b[^\n]*\n+/\n\n/sg; $string =~ s/\n*=cut\b[^\n]*\n+/\n\n/sg; $string =~ s/^\n+//s; return $string; } # Done in evals to avoid confusing Perl::MinimumVersion eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@; sub _write { local *FH; open( FH, '>', $_[0] ) or die "open($_[0]): $!"; binmode FH; foreach ( 1 .. $#_ ) { print FH $_[$_] or die "print($_[0]): $!"; } close FH or die "close($_[0]): $!"; } END_NEW sub _write { local *FH; open( FH, "> $_[0]" ) or die "open($_[0]): $!"; binmode FH; foreach ( 1 .. $#_ ) { print FH $_[$_] or die "print($_[0]): $!"; } close FH or die "close($_[0]): $!"; } END_OLD # _version is for processing module versions (eg, 1.03_05) not # Perl versions (eg, 5.8.1). sub _version { my $s = shift || 0; my $d =()= $s =~ /(\.)/g; if ( $d >= 2 ) { # Normalise multipart versions $s =~ s/(\.)(\d{1,3})/sprintf("$1%03d",$2)/eg; } $s =~ s/^(\d+)\.?//; my $l = $1 || 0; my @v = map { $_ . '0' x (3 - length $_) } $s =~ /(\d{1,3})\D?/g; $l = $l . '.' . join '', @v if @v; return $l + 0; } sub _cmp { _version($_[1]) <=> _version($_[2]); } # Cloned from Params::Util::_CLASS sub _CLASS { ( defined $_[0] and ! ref $_[0] and $_[0] =~ m/^[^\W\d]\w*(?:::\w+)*\z/s ) ? $_[0] : undef; } 1; # Copyright 2008 - 2012 Adam Kennedy. Statistics-R-0.34/Makefile.PL0000644000175000017500000000174612611155776016206 0ustar floflooofloflooouse inc::Module::Install 1.04; use lib 'lib'; if ( $^O =~ m/^(?:.*?win32|dos)$/i ) { require Statistics::R::Win32; } name 'Statistics-R'; all_from 'lib/Statistics/R.pm'; resources homepage 'http://search.cpan.org/search?query=statistics%3A%3AR&mode=dist'; bugtracker 'http://rt.cpan.org/Dist/Display.html?Name=Statistics-R'; repository 'git@github.com:bricas/statistics-r.git'; build_requires 'Test::More' => '0.47'; requires 'IPC::Run' => '0.1'; # availability of $self->{STATE} requires 'Regexp::Common' => 0; requires 'Text::Balanced' => '1.97'; requires 'Text::Wrap' => 0; requires 'version' => '0.77'; requires_external_bin 'R'; WriteAll; if ( -e 'MANIFEST.SKIP' ) { generate_readme( 'lib/Statistics/R.pm', 'README' ); } sub generate_readme { my ($in, $out) = @_; `pod2text $in $out`; warn "Warning: Could not generate $out.\n$!\n" if $? == -1; return $?; # exit status } Statistics-R-0.34/Changes0000644000175000017500000001225012611224712015502 0ustar flofloooflofloooRevision history for Perl extension Statistics::R. 0.34 2015-10-19 - Fixed obscure issue in DESTROY (reported by Pär Larsson, RT #107246) 0.33 2014-08-28 - Better way to set large arrays (patch by Ken Yamaguchi, RT #97359) - Properly handle the quit() command (reported by tecolo, Github #5) - Prefer using the 'bin' constructor instead of 'r_bin' - Method version() to get the version of R - Better handling of R internationalization 0.32 2013-12-18 - Fixed POD error (reported by Srividya Vaidyanathan, RT #91438) 0.31 2013-02-07 - Simplification and speedup of communications with R - Handle multiple locales when looking for errors (patch by Jean Véronis and Brian Cassidy) 0.30 2012-11-15 - Skip tests that hang on Windows (thanks Clifford Sobchuk and Gisbert W. Selke, RT #77761) - Automatically destroy the R bridge when Statistics::R goes out of scope (unless running in shared mode) 0.29 2012-11-07 - Fixed cross-platform filename problem in run_from_file (thanks Clifford Sobchuk, RT #77761) 0.28 2012-11-06 - Fixed packaging issue by repackaging with Module::Install version 1.06 - Fixed character causing failure of POD test 0.27 2012-03-22 - Better handling of R line length limits - Better quoting of strings passed to R - Optimizations 0.26 2012-01-28 - Support more R installation paths in Windows (patch by Adam Kennedy) 0.25 2011-12-21 - Fixed a bug in the get() method (reported by Manuel A. Alonso Tarajano, patched by Brian Cassidy) 0.24 2011-11-09 - Require Text::Balanced >= 0.97 to prevent bad surprises (reported by Ryan Golhar) 0.23 2011-10-28 - Arrays of number-containing strings are now handled properly (RT bug #71988, patch by dheiman) 0.22 2011-10-09 - The run() method now accepts an array of strings as input - New run_from_file() method to read and execute commands from an R file - Better detection of R errors by using the R exception system (issue reported by Mike Imelfort) - Updated error handling mechanism to detect R syntax errors in addition to R runtime errors - Tests now work for different locales (issue reported by Knut Behrends) 0.21 2011-09-04 - Tweaked the regular expressions that parse the R output stream for added speed and robustness 0.20 2011-08-31 - Refactored the entire R communication bridge to avoid writing and reading files. All data is now stored in memory and passed by pipes. This fixes bug RT #11309, #11918, #66190 and #70314 - Refactored the communications in shared mode - Put platform-specific code and legacy code in separate modules 0.10 2011-08-27 - Refactoring to remove old code doing platform-specific operations. - Lots of code cleanup - Removed the now useless r_dir and tmp_dir options of new() - Fix for change of dir bug (RT #6724). Also fixes missing synopsis file (RT #70307) - More subtle cleanup procedure (RT #70392) 0.09 2011-08-23 - Changes in the new() method: * it automatically calls start() * it has the 'shared' option to start a shared bridge - More portable filenames (RT #70391) - Added convenience methods: * run() replaces send() and read() and checks for errors (RT #70361) * get() fetches the values in an R vector (RT #70361) * set() assigns values to an R vector - Fixed a bug in the unlock() method - Removed the R() and error() methods and renamed some other. These changes should be transparent and backward compatible - Maintenance: many more unit tests, synopsis clarification, POD work, script touchups, small code cleanups, version numbering, better README generation, Git and bug tracker URLs 0.08 2011-03-01 - Pass options in new() to Statistics::R::Bridge constructor (RT #63906) 0.07 2010-11-08 - Tidy up SYNOPSIS (RT #62776) - Fix undef warning on Win32 (RT #62776) - Fix is_started() method (RT #62776) 0.06 2010-09-17 - Fix error() when used as an accessor (RT #61335) - Silence DESTROY() when R is not found - Fix "uninitialized value" warning in read_processR() (RT #61414) 0.05 2010-09-13 - Major code refactor: - strict + warnings wherever possible - Removed some layers of abstraction - Win32/Linux classes are now simple subs - Basic syntax tidying - POD fix, plus pod test - Skip tests if R is not available 0.04 2010-08-28 - Basic code cleanup with the intention of doing major refactoring by-and-by - Fix the test suite 0.03 2008-08-16 - Fixed RT Bug #23948: bug in Statistics::R - Fixed --gui - RT Bug #17925: R --slave --vanilla --gui=none is now R --slave --vanilla --gui=X11 - RT Bug #20515: Fwd: Delivery Status Notification (Failure) - RT Bug #14324: error message with recent versions of R We used the patch from barry.moore since it correctly identifies that we probably don't want the GUI. - Fixed RT Bug #17956: Win32: log_dir is not in tmp_dir by default as advertised 0.02 2004-02-23 - Just minor changes and POD fix. 0.01 2004-01-29 23:04:46 - original version; Statistics-R-0.34/lib/0000755000175000017500000000000012611225004014750 5ustar flofloooflofloooStatistics-R-0.34/lib/Statistics/0000755000175000017500000000000012611225004017102 5ustar flofloooflofloooStatistics-R-0.34/lib/Statistics/R.pm0000644000175000017500000005420612611224600017651 0ustar floflooofloflooopackage Statistics::R; =head1 NAME Statistics::R - Perl interface with the R statistical program =head1 DESCRIPTION I is a module to controls the R interpreter (R project for statistical computing: L). It lets you start R, pass commands to it and retrieve their output. A shared mode allows several instances of I to talk to the same R process. The current I implementation uses pipes (stdin, stdout and stderr) to communicate with R. This implementation is more efficient and reliable than that in versions < 0.20, which relied on reading and writing intermediary files. As before, this module works on GNU/Linux, MS Windows and probably many more systems. I has been tested with R version 2 and 3. =head1 SYNOPSIS use Statistics::R; # Create a communication bridge with R and start R my $R = Statistics::R->new(); # Run simple R commands my $output_file = "file.ps"; $R->run(qq`postscript("$output_file", horizontal=FALSE, width=500, height=500)`); $R->run(q`plot(c(1, 5, 10), type = "l")`); $R->run(q`dev.off()`); # Pass and retrieve data (scalars or arrays) my $input_value = 1; $R->set('x', $input_value); $R->run(q`y <- x^2`); my $output_value = $R->get('y'); print "y = $output_value\n"; $R->stop(); =head1 METHODS =over 4 =item new() Build a I bridge object connecting Perl and R. Available options are: =over 4 =item bin Specify the full path to the R executable, if it is not automatically found. See L. =item shared Start a shared bridge. When using a shared bridge, several instances of Statistics::R can communicate with the same unique R instance. Example: use Statistics::R; my $R1 = Statistics::R->new( shared => 1); my $R2 = Statistics::R->new( shared => 1); $R1->set( 'x', 'pear' ); my $x = $R2->get( 'x' ); print "x = $x\n"; $R1->stop; # or $R2->stop Note that in shared mode, you are responsible for calling the I method from one of your Statistics::R instances when you are finished. But be careful not to call the I method if you still have processes that need to interact with R! =back =item run() First, I R if it is not yet running. Then, execute R commands passed as a string and return the output as a string. If your commands failed to run in R, an error message will be displayed. Example: my $out = $R->run( q`print( 1 + 2 )` ); If you intend on runnning many R commands, it may be convenient to pass a list of commands or put multiple commands in an here-doc: # List of R commands: my $out1 = $R->run( q`a <- 2`, q`b <- 5`, q`c <- a * b`, q`print("ok")` ); # Here-doc with multiple R commands: my $cmds = <run($cmds); Alternatively, to run commands from a file, use the I method. The return value you get from I is a combination of what R would display on the standard output and the standard error, but the exact order may differ. When loading modules, some may write numerous messages on standard error. You can disable this behavior using the following R command: suppressPackageStartupMessages(library(library_to_load)) Note that older versions of R impose a limit on how many characters can be contained on a line: about 4076 bytes maximum. You will be warned if this occurs, with an error message stating: '\0' is an unrecognized escape in character string starting "... In this case, try to break down your R code into several smaller, more manageable statements. Alternatively, adding newline characters "\n" at strategic places in the R statements will work around the issue. =item run_from_file() Similar to I but reads the R commands from the specified file. Internally, this method converts the filename to a format compatible with R and then passes it to the R I command to read the file and execute the commands. =item result() Get the results from the last R command. =item set() Set the value of an R variable (scalar or vector). Example: # Create an R scalar $R->set( 'x', 'pear' ); or # Create an R list $R->set( 'y', [1, 2, 3] ); =item get() Get the value of an R variable (scalar or vector). Example: # Retrieve an R scalar. $x is a Perl scalar. my $x = $R->get( 'x' ); or # Retrieve an R list. $x is a Perl arrayref. my $y = $R->get( 'y' ); =item start() Explicitly start R. Most times, you do not need to do that because the first execution of I or I will automatically call I. =item stop() Stop a running instance of R. You need to call this method after running a shared bridge. For a simple bridge, you do not need to do this because I is automatically called when the Statistics::R object goes out of scope. =item restart() I and I R. =item bin() Get or set the path to the R executable. Note that the path will be available only after start() has been called. =item version() Get the version number of R. =item is_shared() Was R started in shared mode? =item is_started() Is R running? =item pid() Return the PID of the running R process =back =head1 INSTALLATION Since I relies on R to work, you need to install R first. See this page for downloads, L. If R is in your PATH environment variable, then it should be available from a terminal and be detected automatically by I. This means that you don't have to do anything on Linux systems to get I working. On Windows systems, in addition to the folders described in PATH, the usual suspects will be checked for the presence of the R binary, e.g. C:\Program Files\R. If I does not find where R is installed, your last recourse is to specify its full path when calling new(): my $R = Statistics::R->new( bin => $fullpath ); You also need to have the following CPAN Perl modules installed: =over 4 =item IPC::Run =item Regexp::Common =item Text::Balanced (>= 1.97) =item Text::Wrap =item version (>= 0.77) =back =head1 SEE ALSO =over 4 =item * L =item * L =item * The R-project web site: L =item * Statistics::* modules for Perl: L =back =head1 AUTHORS Florent Angly Eflorent.angly@gmail.comE (2011 rewrite) Graciliano M. P. Egm@virtuasites.com.brE (original code) =head1 MAINTAINERS Florent Angly Eflorent.angly@gmail.comE Brian Cassidy Ebricas@cpan.orgE =head1 COPYRIGHT & LICENSE This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 BUGS All complex software has bugs lurking in it, and this program is no exception. If you find a bug, please report it on the CPAN Tracker of Statistics::R: L Bug reports, suggestions and patches are welcome. The Statistics::R code is developed on Github (L) and is under Git revision control. To get the latest revision, run: git clone git://github.com/bricas/statistics-r.git =cut use 5.006; use strict; use warnings; use version; use Regexp::Common; use Statistics::R::Legacy; use IPC::Run qw( harness start pump finish ); use File::Spec::Functions qw(catfile splitpath splitdir); use Text::Balanced qw ( extract_delimited extract_multiple ); if ( $^O =~ m/^(?:.*?win32|dos)$/i ) { require Statistics::R::Win32; } our $VERSION = '0.34'; our ($SHARED_BRIDGE, $SHARED_STDIN, $SHARED_STDOUT, $SHARED_STDERR); use constant DEBUG => 0; # debugging messages use constant PROG => 'R'; # executable name... R use constant MAXLINELEN => 1023; # maximum line length for R < 2.5 use constant EOS => '\\1'; # indicate the end of R output with \1 use constant EOS_RE => qr/[${\(EOS)}]\n$/; # regexp to match end of R stream use constant NUMBER_RE => qr/^$RE{num}{real}$/; # regexp matching numbers use constant BLANK_RE => qr/^\s*$/; # regexp matching whitespaces use constant ILINE_RE => qr/^\s*\[\d+\] /; # regexp matching indexed line my $ERROR_STR_1 = 'Error: '; my $ERROR_STR_2 = 'Error in '; my $ERROR_RE; # regexp matching R errors my $WRAP_LINES = sub { return shift }; # function to wrap R commands sub new { # Create a new R communication object my ($class, %args) = @_; my $self = {}; bless $self, ref($class) || $class; $self->_initialize( %args ); return $self; } sub is_shared { # Get (or set) the whether or not Statistics::R is setup to run in shared mode my ($self, $val) = @_; if (defined $val) { $self->{is_shared} = $val; } return $self->{is_shared}; } { no warnings 'redefine'; sub start { my ($self, %args) = @_; my $status = 1; if (not $self->is_started) { # If shared mode option of start() requested, rebuild the bridge in shared # mode. Don't use this option though. It is only here to cater for the legacy # method start_shared() if ( exists($args{shared}) && ($args{shared} == 1) ) { $self->is_shared( 1 ); $self->_bridge( 1 ); } # Now, start R my $bridge = $self->_bridge; $status = $bridge->start or die "Error starting ".PROG.": $?\n"; $self->bin( $bridge->{KIDS}->[0]->{PATH} ); delete $self->{died}; print "DBG: Started R, ".$self->bin." (pid ".$self->pid.")\n" if DEBUG; # Generate regexp to catch R errors if (not defined $ERROR_RE) { $self->_generate_error_re; $self->_localize_error_str; $self->_generate_error_re; } # Set up a function to wrap lines for R < 2.5 if ( version->parse($self->version) < version->parse('2.5.0') ) { print "DBG: Need to wrap to ".MAXLINELEN."\n" if DEBUG; require Text::Wrap; $Text::Wrap::columns = MAXLINELEN; $Text::Wrap::break = ','; $Text::Wrap::huge = 'overflow'; $Text::Wrap::separator = ",\n"; $WRAP_LINES = sub { return Text::Wrap::wrap('', '', shift) }; } } return $status; } } sub stop { my ($self) = @_; my $status = 1; if ( $self->is_started ) { $status = $self->_bridge->finish or die "Error stopping ".PROG.": $?\n"; print "DBG: Stopped R\n" if DEBUG; } return $status; } sub restart { my ($self) = @_; return $self->stop && $self->start; } sub is_started { # Query whether or not R has been started and is still running - hackish. # See https://rt.cpan.org/Ticket/Display.html?id=70595 my ($self) = @_; my $is_started = 0; my $bridge = $self->_bridge; if (defined $bridge && not $self->{died}) { if (not exists $bridge->{STATE}) { die "Internal error: could not get STATE from IPC::Run\n"; } if ($bridge->{STATE} eq IPC::Run::_started && $bridge->pumpable) { $is_started = 1; } } return $is_started; } sub pid { # Get (or set) the PID of the running R process - hackish. # See https://rt.cpan.org/Ticket/Display.html?id=70595It # The PID is accessible only after the bridge has start()ed. my ($self) = @_; my $bridge = $self->_bridge; if ( not exists $bridge->{KIDS} ) { die "Internal error: could not get KIDS from IPC::Run\n"; } if ( not exists $bridge->{KIDS}->[0]->{PID} ) { die "Internal error: could not get PID from IPC::Run\n"; } return $bridge->{KIDS}->[0]->{PID}; } sub bin { # Get or set the full path to the R binary program to use. Unless you have set # the path yourself, it is accessible only after the bridge has start()ed my ($self, $val) = @_; if (defined $val) { $self->{bin} = $val; } return $self->{bin}; } sub version { # Get the version of R, e.g. '3.1.1' my ($self) = @_; return $self->run(q`write(paste(sep=".",R.Version()$major,R.Version()$minor), stdout())`); } sub run { # Pass the input and get the output my ($self, @cmds) = @_; # Need to start R now if it is not already running $self->start if not $self->is_started; # Process each command my $results = ''; for my $cmd (@cmds) { # Wrap command for execution in R print "DBG: Command is '$cmd'\n" if DEBUG; $self->_stdin( $self->wrap_cmd($cmd) ); print "DBG: stdin is '".$self->_stdin."'\n" if DEBUG; # Pass input to R and get its output my $bridge = $self->_bridge; while ( $self->_stdout !~ EOS_RE && $bridge->pumpable ) { $bridge->pump; } # Parse output, detect errors my $out = $self->_stdout; $out =~ s/${\(EOS_RE)}//; chomp $out; my $err = $self->_stderr; chomp $err; print "DBG: stdout is '$out'\n" if DEBUG; print "DBG: stderr is '$err'\n" if DEBUG; if ($err =~ $ERROR_RE) { # Catch errors on stderr. Leave warnings alone. print "DBG: Error\n" if DEBUG; $self->{died} = 1; # for proper cleanup after failed eval my $err_msg = "Error:\n".$1; if ( $err_msg =~ /unrecognized escape in character string/ && version->parse($self->version) < version->parse('2.5.0') ) { $err_msg .= "\nMost likely, the given R command contained lines ". "exceeding ".MAXLINELEN." characters."; } $self->_stdout(''); $self->_stderr(''); die "Problem while running this R command:\n$cmd\n\n$err_msg\n"; } # Save results and reinitialize $results .= "\n" if $results; $results .= $err.$out; $self->_stdout(''); $self->_stderr(''); } $self->result($results); return $results; } sub run_from_file { # Execute commands in given file: first, convert filepath to an R-compatible # format and then pass it to source(). my ($self, $filepath) = @_; if (not -f $filepath) { die "Error: '$filepath' does not seem to exist or is not a file.\n"; } # Split filepath my ($volume, $directories, $filename) = splitpath($filepath); my @elems; push @elems, $volume if $volume; # $volume is '' if unused push @elems, splitdir($directories); push @elems, $filename; # Use file.path to create an R-compatible filename (bug #77761), e.g.: # file <- file.path("E:", "DATA", "example.csv") # Then use source() to read file and execute the commands it contains # source(file) my $cmd = 'source(file.path('.join(',',map {'"'.$_.'"'}@elems).'))'; my $results = $self->run($cmd); return $results; } sub result { # Get / set result of last R command my ($self, $val) = @_; if (defined $val) { $self->{result} = $val; } return $self->{result}; } sub set { # Assign a variable or array of variables in R. Use undef if you want to # assign NULL to an R variable my ($self, $varname, $arr) = @_; # Start R now if it is not already running $self->start if not $self->is_started; # Check variable type, convert everything into an arrayref my $ref = ref $arr; if ($ref eq '') { # This is a scalar $arr = [ $arr ]; } elsif ($ref eq 'ARRAY') { # This is an array reference, nothing to do } else { die "Error: Import variable of type $ref is not supported\n"; } # Quote strings and nullify undef variables for my $i (0 .. scalar @$arr - 1) { if (defined $$arr[$i]) { if ( $$arr[$i] !~ NUMBER_RE ) { $$arr[$i] = _quote( $$arr[$i] ); } } else { $$arr[$i] = 'NULL'; } } # Build a variable assignment command and run it! my $cmd = $varname.'<-c('.join(',',@$arr).')'; $cmd = &$WRAP_LINES( $cmd ); $self->run( $cmd ); return 1; } sub get { # Get the value of an R variable my ($self, $varname) = @_; my $string = $self->run(qq`print($varname)`); # Parse R output my $value; if ($string eq 'NULL') { $value = undef; } elsif ($string =~ ILINE_RE) { # Vector: its string look like: # ' [1] 6.4 13.3 4.1 1.3 14.1 10.6 9.9 9.6 15.3 # [16] 5.2 10.9 14.4' my @lines = split /\n/, $string; for my $i (0 .. scalar @lines - 1) { $lines[$i] =~ s/${\(ILINE_RE)}//; } $value = join ' ', @lines; } else { my @lines = split /\n/, $string; if (scalar @lines == 2) { # String looks like: ' mean # 10.41111 ' # Extract value from second line $value = _trim( $lines[1] ); } else { $value = $string; } } # Clean my @arr; if (not defined $value) { @arr = ( undef ); } else { # Split string into an array, paying attention to strings containing spaces: # extract_delim should be enough but we use extract_delim + split because # of Text::Balanced bug #73416 if ($value =~ m{['"]}) { @arr = extract_multiple( $value, [sub { extract_delimited($_[0],q{'"}) },] ); my $nof_empty = 0; for my $i (0 .. scalar @arr - 1) { my $elem = $arr[$i]; if ($arr[$i] =~ BLANK_RE) { # Remove elements that are simply whitespaces later, in a single operation $nof_empty++; } else { # Trim and unquote $arr[$i-$nof_empty] = _unquote( _trim($elem) ); } } if ($nof_empty > 0) { splice @arr, -$nof_empty, $nof_empty; } } else { @arr = split( /\s+/, _trim($value) ); } } # Return either a scalar of an arrayref my $ret_val; if (scalar @arr == 1) { $ret_val = $arr[0]; } else { $ret_val = \@arr; } return $ret_val; } #---------- INTERNAL METHODS --------------------------------------------------# sub _initialize { my ($self, %args) = @_; # Full path of R binary specified by bin (r_bin or R_bin for backward # compatibility), or executable name (IPC::Run will find its full path later) $self->bin( $args{bin} || $args{r_bin} || $args{R_bin} || PROG ); # Using shared mode? if ( exists $args{shared} && $args{shared} == 1 ) { $self->is_shared( 1 ); } else { $self->is_shared( 0 ); } # Build the bridge $self->_bridge( 1 ); return 1; } sub _bridge { # Get or build the communication bridge and IOs with R my ($self, $build) = @_; my %params = ( debug => 0 ); if ($build) { my $cmd = [ $self->bin, '--vanilla', '--slave' ]; if (not $self->is_shared) { my ($stdin, $stdout, $stderr); $self->{stdin} = \$stdin; $self->{stdout} = \$stdout; $self->{stderr} = \$stderr; $self->{bridge} = harness $cmd, $self->{stdin}, $self->{stdout}, $self->{stderr}, %params; } else { $self->{stdin} = \$SHARED_STDIN ; $self->{stdout} = \$SHARED_STDOUT; $self->{stderr} = \$SHARED_STDERR; if (not defined $SHARED_BRIDGE) { # The first Statistics::R instance builds the bridge $SHARED_BRIDGE = harness $cmd, $self->{stdin}, $self->{stdout}, $self->{stderr}, %params; } $self->{bridge} = $SHARED_BRIDGE; } } return $self->{bridge}; } sub _stdin { # Get / set standard input string for R my ($self, $val) = @_; if (defined $val) { ${$self->{stdin}} = $val; } return ${$self->{stdin}}; } sub _stdout { # Get / set standard output string for R my ($self, $val) = @_; if (defined $val) { ${$self->{stdout}} = $val; } return ${$self->{stdout}}; } sub _stderr { # Get / set standard error string for R my ($self, $val) = @_; if (defined $val) { ${$self->{stderr}} = $val; } return ${$self->{stderr}}; } sub wrap_cmd { # Wrap a command to pass to R. Whether the command is successful or not, the # end of stream string will appear on stdout and indicate that R has finished # processing the data. Note that $cmd can be multiple R commands. my ($self, $cmd) = @_; chomp $cmd; $cmd =~ s/;$//; $cmd .= qq`; write("`.EOS.qq`",stdout())\n`; return $cmd; } sub _generate_error_re { # Generate a regular expression to catch R internal errors, e.g.: # Error: object 'zzz' not found" # Error in print(ASDF) : object 'ASDF' not found my ($self) = @_; $ERROR_RE = qr/^(?:$ERROR_STR_1|$ERROR_STR_2)\s*(.*)$/s; print "DBG: Regexp for catching errors is '$ERROR_RE'\n" if DEBUG; return 1; } sub _localize_error_str { # Find the translation for the R error strings. Internationalization is # present in R >=2.1, with Natural Language Support enabled. my ($self) = @_; my @strings; for my $error_str ($ERROR_STR_1, $ERROR_STR_2) { my $cmd = qq`write(ngettext(1, "$error_str", "", domain="R"), stdout())`; $self->set('cmd', $cmd); # Try to translate string, return '' if not possible my $str = $self->run(q`tryCatch( eval(parse(text=cmd)) , error=function(e){write("",stdout())} )`); $str ||= $error_str; push @strings, $str; } ($ERROR_STR_1, $ERROR_STR_2) = @strings; return 1; } sub DESTROY { # The bridge to R is not automatically bombed when Statistics::R instances # get out of scope. Do it now (unless running in shared mode)! my ($self) = @_; if (not $self->is_shared) { $self->stop; } } #---------- HELPER SUBS -------------------------------------------------------# sub _trim { # Remove flanking whitespaces my ($str) = @_; $str =~ s{^\s+}{}; $str =~ s{\s+$}{}; return $str; } sub _quote { # Quote a string for use in R. We use double-quotes because the documentation # Quotes {base} R documentation states that this is preferred over single- # quotes. Double-quotes inside the string are escaped. my ($str) = @_; # Escape " by \" , \" by \\\" , ... $str =~ s/ (\\*) " / '\\' x (2*length($1)+1) . '"' /egx; # Surround by " $str = qq("$str"); return $str; } sub _unquote { # Opposite of _quote my ($str) = @_; # Remove surrounding " $str =~ s{^"}{}; $str =~ s{"$}{}; # Interpolate (de-escape) \\\" to \" , \" to " , ... $str =~ s/ ((?:\\\\)*) \\ " / '\\' x (length($1)*0.5) . '"' /egx; return $str; } 1; Statistics-R-0.34/lib/Statistics/R/0000755000175000017500000000000012611225004017303 5ustar flofloooflofloooStatistics-R-0.34/lib/Statistics/R/Legacy.pm0000644000175000017500000000631712374674530021076 0ustar floflooofloflooopackage Statistics::R::Legacy; use strict; use warnings; use base qw( Statistics::R ); use vars qw{@ISA @EXPORT}; BEGIN { @ISA = 'Exporter'; @EXPORT = qw{ startR stopR restartR Rbin start_sharedR start_shared read receive is_blocked is_locked lock unlock send error clean_up }; } =head1 NAME Statistics::R::Legacy - Legacy methods for Statistics::R =head1 DESCRIPTION B instead.> This module contains legacy methods for I. They are provided solely so that code that uses older versions of I does not crash with recent version. Do not use these methods in new code! Some of these legacy methods simply had their name changed, but some others were changed to do nothing and return only single value because it did not make sense to keep these methods as originally intended anymore. =head1 METHODS =over 4 =item startR() This is the same thing as start(). =item stopR() This is the same thing as stop(). =item restartR() This is the same thing as restart(). =item Rbin() This is the same thing as bin(). =item start_sharedR() / start_shared() Use the shared option of new() instead. =item send / read() / receive() Use run() instead. =item lock() Does nothing anymore. =item unlock() Does nothing anymore. =item is_blocked() / is_locked() Return 0. =item error() Return the empty string. =item clean_up() Does nothing anymore. =back =head1 SEE ALSO =over 4 =item * L =back =head1 AUTHORS Florent Angly Eflorent.angly@gmail.comE (2011 rewrite) Graciliano M. P. Egm@virtuasites.com.brE (original code) =head1 MAINTAINERS Florent Angly Eflorent.angly@gmail.comE Brian Cassidy Ebricas@cpan.orgE =head1 COPYRIGHT & LICENSE This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 BUGS All complex software has bugs lurking in it, and this program is no exception. If you find a bug, please report it on the CPAN Tracker of Statistics::R: L Bug reports, suggestions and patches are welcome. The Statistics::R code is developed on Github (L) and is under Git revision control. To get the latest revision, run: git clone git@github.com:bricas/statistics-r.git =cut { # Prevent "Name XXX used only once" warnings in this block no warnings 'once'; *startR = \&Statistics::R::start; *stopR = \&Statistics::R::stop; *restartR = \&Statistics::R::restart; *Rbin = \&Statistics::R::bin; *receive = \&Statistics::R::result; *start_sharedR = \&start_shared; *read = \&receive; *is_blocked = \&is_locked; } sub start_shared { my $self = shift; $self->start( shared => 1 ); } sub lock { return 1; } sub unlock { return 1; } sub is_locked { return 0; } sub send { # Send a command to R. Do not return the output. my ($self, $cmd) = @_; $self->run($cmd); return 1; } sub error { return ''; } sub clean_up { return 1; } 1; Statistics-R-0.34/lib/Statistics/R/Win32.pm0000644000175000017500000001007312254276203020556 0ustar floflooofloflooopackage Statistics::R::Win32; use strict; use warnings; use File::Spec (); use File::DosGlob (); use Env qw( @PATH $PROGRAMFILES ); use vars qw{@ISA @EXPORT}; BEGIN { @ISA = 'Exporter'; @EXPORT = qw{ win32_path_adjust win32_space_quote win32_space_escape win32_double_bs }; } our $PROG = 'R'; =head1 NAME Statistics::R::Win32 - Helper functions for Statistics::R on MS Windows platforms =head1 DESCRIPTION B instead.> Helper functions to deal with environment variables and escape file paths on MS Windows platforms. =head1 SYNOPSIS if ( $^O =~ m/^(?:.*?win32|dos)$/i ) { require Statistics::R::Win32; } =head1 METHODS =over 4 =item win32_path_adjust( ) Looks for paths where R could be installed, e.g. C:\Program Files (x86)\R-2.1\bin and add it to the PATH environment variable. =item win32_space_quote( ) Takes a path and return a path that is surrounded by double-quotes if the path contains whitespaces. Example: C:\Program Files\R\bin\x64 becomes "C:\Program Files\R\bin\x64" =item win32_space_escape( ) Takes a path and return a path where spaces have been escaped by a backslash. contains whitespaces. Example: C:\Program Files\R\bin\x64 becomes C:\Program\ Files\R\bin\x64 =item win32_double_bs Takes a path and return a path where each backslash was replaced by two backslashes. Example: C:\Program Files\R\bin\x64 becomes C:\\Program Files\\R\\bin\\x64 =back =head1 SEE ALSO =over 4 =item * L =back =head1 AUTHORS Florent Angly Eflorent.angly@gmail.comE (2011 rewrite) Graciliano M. P. Egm@virtuasites.com.brE (original code) =head1 MAINTAINERS Florent Angly Eflorent.angly@gmail.comE Brian Cassidy Ebricas@cpan.orgE =head1 COPYRIGHT & LICENSE This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 BUGS All complex software has bugs lurking in it, and this program is no exception. If you find a bug, please report it on the CPAN Tracker of Statistics::R: L Bug reports, suggestions and patches are welcome. The Statistics::R code is developed on Github (L) and is under Git revision control. To get the latest revision, run: git clone git@github.com:bricas/statistics-r.git =cut # Adjust PATH environment variable when this module is loaded. win32_path_adjust(); # Find potential R directories in the Windows Program Files folder and # add them to the PATH environment variable. sub win32_path_adjust { # Find potential R directories, e.g. C:\Program Files (x86)\R-2.1\bin # or C:\Program Files\R\bin\x64 my @prog_file_dirs; if (defined $PROGRAMFILES) { push @prog_file_dirs, $PROGRAMFILES; # e.g. C:\Program Files (x86) my ($programfiles_2) = ($PROGRAMFILES =~ m/^(.*) \(/); # e.g. C:\Program Files if ( defined $programfiles_2 and $programfiles_2 ne $PROGRAMFILES ) { push @prog_file_dirs, $programfiles_2; } } # Append R directories to PATH push @PATH, grep { -d $_ } map { # Order is important File::Spec->catdir( $_, 'bin', 'x64' ), File::Spec->catdir( $_, 'bin' ), $_, } map { File::DosGlob::glob( win32_space_escape( win32_double_bs($_) ) ) } map { File::Spec->catdir( $_, $PROG, "$PROG-*" ), File::Spec->catdir( $_, "$PROG-*" ), File::Spec->catdir( $_, $PROG ), } grep { -d $_ } @prog_file_dirs; return 1; } sub win32_space_quote { # Quote a path if it contains whitespaces my $path = shift; $path = '"'.$path.'"' if $path =~ /\s/; return $path; } sub win32_space_escape { # Escape spaces with a single backslash my $path = shift; $path =~ s/ /\\ /g; return $path; } sub win32_double_bs { # Double the backslashes my $path = shift; $path =~ s/\\/\\\\/g; return $path; } 1; Statistics-R-0.34/MANIFEST0000644000175000017500000000110312377542315015346 0ustar flofloooflofloooChanges inc/Module/Install.pm inc/Module/Install/Base.pm inc/Module/Install/Can.pm inc/Module/Install/External.pm inc/Module/Install/Fetch.pm inc/Module/Install/Makefile.pm inc/Module/Install/Metadata.pm inc/Module/Install/Win32.pm inc/Module/Install/WriteAll.pm lib/Statistics/R.pm lib/Statistics/R/Legacy.pm lib/Statistics/R/Win32.pm Makefile.PL MANIFEST This list of files META.yml MYMETA.json MYMETA.yml README t/00-load.t t/01-pod.t t/02-legacy.t t/03-run.t t/04-start-stop.t t/05-shared.t t/06-get-set.t t/07-robust.t t/08-errors.t t/data/script.R t/FlawedStatisticsR.pm Statistics-R-0.34/MYMETA.json0000644000175000017500000000266712611224732016113 0ustar floflooofloflooo{ "abstract" : "Perl interface with the R statistical program", "author" : [ "Florent Angly (2011 rewrite)" ], "dynamic_config" : 0, "generated_by" : "Module::Install version 1.16, CPAN::Meta::Converter version 2.150005", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Statistics-R", "no_index" : { "directory" : [ "inc", "t" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "6.59", "Test::More" : "0.47" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "requires" : { "IPC::Run" : "0.1", "Regexp::Common" : "0", "Text::Balanced" : "1.97", "Text::Wrap" : "0", "perl" : "5.006", "version" : "0.77" } } }, "release_status" : "stable", "resources" : { "bugtracker" : { "web" : "http://rt.cpan.org/Dist/Display.html?Name=Statistics-R" }, "homepage" : "http://search.cpan.org/search?query=statistics%3A%3AR&mode=dist", "license" : [ "http://dev.perl.org/licenses/" ] }, "version" : "0.33", "x_serialization_backend" : "JSON::PP version 2.27203" } Statistics-R-0.34/t/0000755000175000017500000000000012611225004014445 5ustar flofloooflofloooStatistics-R-0.34/t/02-legacy.t0000644000175000017500000000137112254276203016331 0ustar floflooofloflooo#! perl use strict; use warnings; use Test::More; use Statistics::R; my $R; my $file = "file.ps"; ok $R = Statistics::R->new(); ok $R->startR(); ok $R->restartR(); ok $R->send(qq`postscript("$file" , horizontal=FALSE , width=500 , height=500 , pointsize=1)`); ok $R->send( q`plot(c(1, 5, 10), type = "l")` ); ok $R->send( qq`x = 123 \n print(x)` ); my $ret = $R->read(); ok $ret =~ /^\[\d+\]\s+123\s*$/; ok $R->send( qq`x = 456 \n print(x)` ); $ret = $R->read(); ok $ret =~ /^\[\d+\]\s+456\s*$/; ok $R->lock; ok $R->unlock; is $R->is_blocked, 0; is $R->is_locked, 0; ok $R->clean_up(); ok $R->Rbin() =~ /\S+/; ok $R->stopR(); is $R->error(), ''; ok $R->start_shared(); ok $R->start_sharedR(); ok $R->stop(); unlink $file; done_testing; Statistics-R-0.34/t/data/0000755000175000017500000000000012611225004015356 5ustar flofloooflofloooStatistics-R-0.34/t/data/script.R0000644000175000017500000000066412254276203017025 0ustar floflooofloflooopostscript("file2.ps" , horizontal=FALSE , width=500 , height=500 , pointsize=1) plot(c(1, 5, 10), type = "l") dev.off() unlink("file2.ps") for (j in 1:3) { cat("loop iteration: "); print(j); } write("Some innocuous message on stdout\n", stdout()) write("Some innocuous message on stderr\n", stderr()) x <- 123 print(x) x <- 456 ; write.table(x, file="", row.names=FALSE, col.names=FALSE) a <- 2 b <- 5 c <- a * b print('ok') Statistics-R-0.34/t/07-robust.t0000644000175000017500000000131212377527036016414 0ustar floflooofloflooo#! perl use strict; use warnings; use Test::More; use Statistics::R; my ($R, $input); ok $R = Statistics::R->new(); # Test that we can recover from a R quit() command is $R->run(q`quit()`), '', 'Handle quit()'; is $R->run(q`cat("foo")`), 'foo'; # Test that large arrays can be read ok $R->set('y', [1 .. 100_000]), 'Large arrays'; is $R->get('y')->[-1], 100_000; # Test that the IOs are well-oiled. In Statistics::R version 0.20, a slight # imprecision in the regular expression to parse the output stream caused a # problem that was apparent only once every few thousands times ok $R->set('z', $input), 'Smooth IO'; for my $i (1 .. 10_000) { is $R->get('z'), undef; } ok $R->stop(); done_testing; Statistics-R-0.34/t/01-pod.t0000644000175000017500000000026412254276203015646 0ustar floflooofloflooo#! perl use strict; use warnings; use Test::More; eval 'use Test::Pod 1.00'; plan skip_all => 'Test::Pod 1.00 required for testing POD' if $@; all_pod_files_ok(); done_testing; Statistics-R-0.34/t/00-load.t0000644000175000017500000000026112254276203015777 0ustar floflooofloflooo#! perl use strict; use warnings; use Test::More; BEGIN { use_ok 'Statistics::R'; } diag( "Testing Statistics::R $Statistics::R::VERSION, Perl $], $^X" ); done_testing; Statistics-R-0.34/t/05-shared.t0000644000175000017500000000163312254276203016337 0ustar floflooofloflooo#! perl use strict; use warnings; use Test::More; use Statistics::R; my ($R1, $R2, $R3, $R4); ok $R1 = Statistics::R->new( shared => 1 ), 'Starting in shared mode'; ok $R2 = Statistics::R->new( shared => 1 ); ok $R3 = Statistics::R->new( shared => 1 ); ok $R4 = Statistics::R->new( shared => 1 ); is $R1->is_shared, 1; is $R2->is_shared, 1; is $R3->is_shared, 1; is $R4->is_shared, 1; ok $R2->start; ok $R4->start; is $R1->is_started, 1; is $R2->is_started, 1; is $R3->is_started, 1; is $R4->is_started, 1; ok $R1 =~ m/\d+/, 'PIDs'; is $R1->pid, $R2->pid; is $R1->pid, $R3->pid; is $R1->pid, $R4->pid; ok $R1->set( 'x', "string" ), 'Sharing data'; ok $R2->set( 'y', 3 ); is $R2->get( 'x' ), "string"; ok $R3->set( 'z', 10 ); is $R4->run( q`a <- y / z` ), ''; is $R4->get( 'a' ), 0.3; ok $R3->stop(); is $R1->is_started, 0; is $R2->is_started, 0; is $R3->is_started, 0; is $R4->is_started, 0; done_testing; Statistics-R-0.34/t/03-run.t0000644000175000017500000000434712374656505015712 0ustar floflooofloflooo#! perl use strict; use warnings; use Test::More; use File::Copy; use File::Temp; use Statistics::R; use File::Spec::Functions; my ($R, $expected, $bin, $version); my $file = 'file.ps'; ok $R = Statistics::R->new(); ok $bin = $R->bin(); ok $bin =~ /\S+/, 'Executable name'; $expected = ''; is $R->run( ), $expected; ok $bin = $R->bin(); ok $bin =~ /\S+/, 'Executable path'; ok $version = $R->version(); ok $version =~ /^\d+\.\d+\.\d+$/, 'Version'; diag "R version $version found at $bin\n"; $expected = ''; is $R->run( qq`postscript("$file" , horizontal=FALSE , width=500 , height=500 , pointsize=1)`), $expected, 'Basic'; $expected = ''; is $R->run( q`plot(c(1, 5, 10), type = "l");` ), $expected; $expected = 'null device 1 '; is $R->run( q`dev.off()` ), $expected; # RT bug #66190 ok -e $file; # RT bug #70307 unlink $file; $expected = 'loop iteration 1 loop iteration 2 loop iteration 3'; is $R->run( q`for (j in 1:3) { cat("loop iteration "); cat(j); cat("\n") }` ), $expected; $expected = 'Some innocuous message on stderr'; is $R->run( q`write("Some innocuous message on stderr", stderr())` ), $expected, 'IO'; $expected = 'Some innocuous message on stdout'; is $R->run( q`write("Some innocuous message on stdout", stdout())` ), $expected; $expected = '[1] 123'; is $R->run( qq`x <- 123 \n print(x)` ), $expected, 'Multi-line commands'; $expected = '456'; my $cmd1 = 'x <- 456 ; write.table(x, file="", row.names=FALSE, col.names=FALSE)'; is $R->run( $cmd1 ), $expected; # RT bug #70314 my $cmd2 = <run( $cmd2 ), $expected, 'Heredoc commands'; $expected = '456 [1] "ok"'; is $R->run( $cmd1, $cmd2 ), $expected, 'Multiple commands'; $expected = 'Some innocuous message on stderr loop iteration: [1] 1 loop iteration: [1] 2 loop iteration: [1] 3 Some innocuous message on stdout [1] 123 456 [1] "ok"'; $file = catfile('t', 'data', 'script.R'); is $R->run_from_file( $file ), $expected, 'Command from file (relative path)'; my $absfile = File::Temp->new( UNLINK => 1 )->filename; copy($file, $absfile) or die "Error: Could not copy file $file to $absfile: $!\n"; is $R->run_from_file( $absfile ), $expected, 'Commands from file (absolute path)'; done_testing; Statistics-R-0.34/t/08-errors.t0000644000175000017500000000202412611156356016406 0ustar floflooofloflooo#! perl use strict; use warnings; use Test::More; use Statistics::R; SKIP: { skip 'because tests hang on Win32 (bug #81159)', 1 if $^O =~ /^(MS)?Win32$/; ok my $R = Statistics::R->new(bin => '/foo/ba/R'); eval { $R->run( qq`print("Hello");` ); }; #diag "Diagnostic: \n".$@."\n"; ok $@, 'Executable not found'; ok $R = Statistics::R->new(); is $R->run(q`a <- 1;`), ''; eval { $R->run( qq`print("Hello");\nprint(ASDF)` ); }; #diag "Diagnostic: \n".$@."\n"; ok $@, 'Runtime error'; is $R->run(q`a <- 1;`), ''; ok $R = Statistics::R->new(); eval { $R->run( qq`print("Hello");\nprint "ASDF"` ); }; #diag "Diagnostic: \n".$@."\n"; ok $@, 'Syntax error'; # Actual error message varies depending on locale is $R->run(q`a <- 1;`), ''; use_ok 't::FlawedStatisticsR'; ok $R = t::FlawedStatisticsR->new(); eval { $R->run( qq`print("Hello");\ncolors<-c("red")` ); }; #diag "Diagnostic: \n".$@."\n"; ok $@, 'Internal error'; }; done_testing; Statistics-R-0.34/t/06-get-set.t0000644000175000017500000000576012254276203016447 0ustar floflooofloflooo#! perl use strict; use warnings; use Test::More; use Statistics::R; my ($R, $input, $output); ok $R = Statistics::R->new(); $input = undef; ok $R->set('x', $input), 'undef'; is $R->get('x'), undef; $input = 123; ok $R->set('x', $input); ok $output = $R->get('x'), 'integer'; is ref($output), ''; is $output, 123; # R default number of digits is 7 $input = 0.93945768644; ok $R->set('x', $input), 'real number'; ok $output = $R->get('x'); is ref($output), ''; is $output, sprintf("%.7f", $input); $input = "apocalypse"; ok $R->set('x', $input), 'string'; ok $output = $R->get('x'); is ref($output), ''; is $output, "apocalypse"; $input = "a string"; ok $R->set('x', $input), 'string with witespace'; ok $output = $R->get('x'); is ref($output), ''; is $output, "a string"; $input = 'gi|57116681|ref|NC_000962.2|'; ok $R->set('x', $input), 'number-containing string'; ok $output = $R->get('x'); is ref($output), ''; is $output, 'gi|57116681|ref|NC_000962.2|'; # Mixed arrays are considered as string arrays by R, thus there is no digit limit $input = [123, "a string", 'two strings', 0.93945768644]; ok $R->set('x', $input), 'mixed array'; ok $output = $R->get('x'); is ref($output), 'ARRAY'; is $$output[0], 123; is $$output[1], "a string"; is $$output[2], "two strings"; is $$output[3], 0.93945768644; # RT bug #71988 $input = [ q{statistics-r-0.22}, "abc 123 xyz", 'gi|57116681|ref|NC_000962.2|']; ok $R->set('x', $input), 'array of number-containing strings'; ok $output = $R->get('x'); is ref($output), 'ARRAY'; is $$output[0], q{statistics-r-0.22}; is $$output[1], "abc 123 xyz"; is $$output[2], 'gi|57116681|ref|NC_000962.2|'; $input = [123,142,147,153,145,151,165,129,133,150,142,154,131,146,151,136,147,156,141,155,147,165,168,146,148,146,142,145,161,157,154,137,130,161,130,156,140,145,154]; ok $R->set('x', $input), 'large array of integers'; ok $output = $R->get('x'); is ref($output), 'ARRAY'; for (my $i = 0; $i < scalar @$input; $i++) { is $$output[$i], $$input[$i]; } $input = [1, 2, 3]; ok $R->set('x', $input), 'data frame'; is $R->run(q`a <- data.frame(first=x)`), ''; ok $output = $R->get('a$first'); is ref($output), 'ARRAY'; is $$output[0], 1; is $$output[1], 2; is $$output[2], 3; # Bug reported by Manuel A. Alonso Tarajano is $R->run(q`mydat = seq(1:4)`), ''; ok $output = $R->get('mydat'); is $$output[0], 1; is $$output[1], 2; is $$output[2], 3; is $$output[3], 4; # Strings containing quotes and escaped quotes $input = q{He said: "Let's go \"home\" now!\n"}; ok $R->set('x', $input), 'string'; ok $output = $R->get('x'); is ref($output), ''; is $output, q{He said: "Let's go \"home\" now!\n"}; $input = q{He said: "Let's go \\\\\\\\\\\\\"home\\\\\\\\\\\\\" now!\n"}; # because \ is a special char that needs to be escaped, this string really is: # He said: "Let's go \\\\\\\"home\\\\\\\" now!\n ok $R->set('x', $input), 'string'; ok $output = $R->get('x'); is ref($output), ''; is $output, q{He said: "Let's go \\\\\\\\\\\\\"home\\\\\\\\\\\\\" now!\n"}; ok $R->stop(); done_testing; Statistics-R-0.34/t/FlawedStatisticsR.pm0000644000175000017500000000046412254276203020420 0ustar floflooofloflooopackage t::FlawedStatisticsR; use Statistics::R; use base qw(Statistics::R); my $eos = 'Statistics::R::EOS'; # Override the wrap_cmd() method of Statistics::R with a faulty one sub wrap_cmd { my ($self, $cmd) = @_; $cmd = qq`zzzzzzzzzzzzzzz; write("$eos",stdout())\n`; return $cmd; } 1; __END__ Statistics-R-0.34/t/04-start-stop.t0000644000175000017500000000100112602227736017201 0ustar floflooofloflooo#! perl use strict; use warnings; use Test::More; use Statistics::R; use Cwd; my $R; my $initial_dir = cwd; ok $R = Statistics::R->new(); is $R->is_started, 0; is $R->is_shared, 0; ok $R->stop(); ok $R->stop(); ok $R->start(); is $R->is_started, 1; is $R->is_shared, 0; ok $R->start(); is cwd, $initial_dir; # Bug RT #6724 and #70307 ok $R->restart(); ok $R->stop(); ok $R->start( shared => 1); is $R->is_shared, 1; ok $R->stop(); is cwd, $initial_dir; # Bug RT #6724 and #70307 done_testing; Statistics-R-0.34/META.yml0000644000175000017500000000156312611224732015467 0ustar floflooofloflooo--- abstract: 'Perl interface with the R statistical program' author: - 'Florent Angly (2011 rewrite)' build_requires: ExtUtils::MakeMaker: 6.59 Test::More: '0.47' configure_requires: ExtUtils::MakeMaker: 6.59 distribution_type: module dynamic_config: 1 generated_by: 'Module::Install version 1.16' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: Statistics-R no_index: directory: - inc - t requires: IPC::Run: '0.1' Regexp::Common: 0 Text::Balanced: '1.97' Text::Wrap: 0 perl: 5.6.0 version: '0.77' resources: bugtracker: http://rt.cpan.org/Dist/Display.html?Name=Statistics-R homepage: http://search.cpan.org/search?query=statistics%3A%3AR&mode=dist license: http://dev.perl.org/licenses/ repository: git@github.com:bricas/statistics-r.git version: '0.34' Statistics-R-0.34/README0000644000175000017500000001755712611224732015110 0ustar flofloooflofloooNAME Statistics::R - Perl interface with the R statistical program DESCRIPTION *Statistics::R* is a module to controls the R interpreter (R project for statistical computing: ). It lets you start R, pass commands to it and retrieve their output. A shared mode allows several instances of *Statistics::R* to talk to the same R process. The current *Statistics::R* implementation uses pipes (stdin, stdout and stderr) to communicate with R. This implementation is more efficient and reliable than that in versions < 0.20, which relied on reading and writing intermediary files. As before, this module works on GNU/Linux, MS Windows and probably many more systems. *Statistics::R* has been tested with R version 2 and 3. SYNOPSIS use Statistics::R; # Create a communication bridge with R and start R my $R = Statistics::R->new(); # Run simple R commands my $output_file = "file.ps"; $R->run(qq`postscript("$output_file", horizontal=FALSE, width=500, height=500)`); $R->run(q`plot(c(1, 5, 10), type = "l")`); $R->run(q`dev.off()`); # Pass and retrieve data (scalars or arrays) my $input_value = 1; $R->set('x', $input_value); $R->run(q`y <- x^2`); my $output_value = $R->get('y'); print "y = $output_value\n"; $R->stop(); METHODS new() Build a *Statistics::R* bridge object connecting Perl and R. Available options are: bin Specify the full path to the R executable, if it is not automatically found. See "INSTALLATION". shared Start a shared bridge. When using a shared bridge, several instances of Statistics::R can communicate with the same unique R instance. Example: use Statistics::R; my $R1 = Statistics::R->new( shared => 1); my $R2 = Statistics::R->new( shared => 1); $R1->set( 'x', 'pear' ); my $x = $R2->get( 'x' ); print "x = $x\n"; $R1->stop; # or $R2->stop Note that in shared mode, you are responsible for calling the *stop()* method from one of your Statistics::R instances when you are finished. But be careful not to call the *stop()* method if you still have processes that need to interact with R! run() First, *start()* R if it is not yet running. Then, execute R commands passed as a string and return the output as a string. If your commands failed to run in R, an error message will be displayed. Example: my $out = $R->run( q`print( 1 + 2 )` ); If you intend on runnning many R commands, it may be convenient to pass a list of commands or put multiple commands in an here-doc: # List of R commands: my $out1 = $R->run( q`a <- 2`, q`b <- 5`, q`c <- a * b`, q`print("ok")` ); # Here-doc with multiple R commands: my $cmds = <run($cmds); Alternatively, to run commands from a file, use the *run_from_file()* method. The return value you get from *run()* is a combination of what R would display on the standard output and the standard error, but the exact order may differ. When loading modules, some may write numerous messages on standard error. You can disable this behavior using the following R command: suppressPackageStartupMessages(library(library_to_load)) Note that older versions of R impose a limit on how many characters can be contained on a line: about 4076 bytes maximum. You will be warned if this occurs, with an error message stating: '\0' is an unrecognized escape in character string starting "... In this case, try to break down your R code into several smaller, more manageable statements. Alternatively, adding newline characters "\n" at strategic places in the R statements will work around the issue. run_from_file() Similar to *run()* but reads the R commands from the specified file. Internally, this method converts the filename to a format compatible with R and then passes it to the R *source()* command to read the file and execute the commands. result() Get the results from the last R command. set() Set the value of an R variable (scalar or vector). Example: # Create an R scalar $R->set( 'x', 'pear' ); or # Create an R list $R->set( 'y', [1, 2, 3] ); get() Get the value of an R variable (scalar or vector). Example: # Retrieve an R scalar. $x is a Perl scalar. my $x = $R->get( 'x' ); or # Retrieve an R list. $x is a Perl arrayref. my $y = $R->get( 'y' ); start() Explicitly start R. Most times, you do not need to do that because the first execution of *run()* or *set()* will automatically call *start()*. stop() Stop a running instance of R. You need to call this method after running a shared bridge. For a simple bridge, you do not need to do this because *stop()* is automatically called when the Statistics::R object goes out of scope. restart() *stop()* and *start()* R. bin() Get or set the path to the R executable. Note that the path will be available only after start() has been called. version() Get the version number of R. is_shared() Was R started in shared mode? is_started() Is R running? pid() Return the PID of the running R process INSTALLATION Since *Statistics::R* relies on R to work, you need to install R first. See this page for downloads, . If R is in your PATH environment variable, then it should be available from a terminal and be detected automatically by *Statistics::R*. This means that you don't have to do anything on Linux systems to get *Statistics::R* working. On Windows systems, in addition to the folders described in PATH, the usual suspects will be checked for the presence of the R binary, e.g. C:\Program Files\R. If *Statistics::R* does not find where R is installed, your last recourse is to specify its full path when calling new(): my $R = Statistics::R->new( bin => $fullpath ); You also need to have the following CPAN Perl modules installed: IPC::Run Regexp::Common Text::Balanced (>= 1.97) Text::Wrap version (>= 0.77) SEE ALSO * Statistics::R::Win32 * Statistics::R::Legacy * The R-project web site: * Statistics::* modules for Perl: AUTHORS Florent Angly (2011 rewrite) Graciliano M. P. (original code) MAINTAINERS Florent Angly Brian Cassidy COPYRIGHT & LICENSE This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. BUGS All complex software has bugs lurking in it, and this program is no exception. If you find a bug, please report it on the CPAN Tracker of Statistics::R: Bug reports, suggestions and patches are welcome. The Statistics::R code is developed on Github () and is under Git revision control. To get the latest revision, run: git clone git://github.com/bricas/statistics-r.git