ext/ByteLoader/byterun.h Header for byterun.c
ext/ByteLoader/hints/sunos.pl Hints for named architecture
ext/ByteLoader/Makefile.PL Bytecode loader makefile writer
+ext/Cwd/Changes Cwd extension Changelog
ext/Cwd/Cwd.xs Cwd extension external subroutines
ext/Cwd/Makefile.PL Cwd extension makefile maker
ext/Cwd/t/cwd.t See if Cwd works
'CPAN' => 1,
},
+ 'Cwd' =>
+ {
+ 'MAINTAINER' => 'kwilliams',
+ 'FILES' => q[ext/Cwd lib/Cwd.pm],
+ 'CPAN' => 1,
+ },
+
'Data::Dumper' =>
{
'MAINTAINER' => 'ilyam', # Not gsar.
#endif
}
+#ifndef getcwd_sv
+// Taken from perl 5.8's util.c
+int getcwd_sv(pTHX_ register SV *sv)
+{
+#ifndef PERL_MICRO
+
+#ifndef INCOMPLETE_TAINTS
+ SvTAINTED_on(sv);
+#endif
+
+#ifdef HAS_GETCWD
+ {
+ char buf[MAXPATHLEN];
+
+ /* Some getcwd()s automatically allocate a buffer of the given
+ * size from the heap if they are given a NULL buffer pointer.
+ * The problem is that this behaviour is not portable. */
+ if (getcwd(buf, sizeof(buf) - 1)) {
+ STRLEN len = strlen(buf);
+ sv_setpvn(sv, buf, len);
+ return TRUE;
+ }
+ else {
+ sv_setsv(sv, &PL_sv_undef);
+ return FALSE;
+ }
+ }
+
+#else
+
+ Stat_t statbuf;
+ int orig_cdev, orig_cino, cdev, cino, odev, oino, tdev, tino;
+ int namelen, pathlen=0;
+ DIR *dir;
+ Direntry_t *dp;
+
+ (void)SvUPGRADE(sv, SVt_PV);
+
+ if (PerlLIO_lstat(".", &statbuf) < 0) {
+ SV_CWD_RETURN_UNDEF;
+ }
+
+ orig_cdev = statbuf.st_dev;
+ orig_cino = statbuf.st_ino;
+ cdev = orig_cdev;
+ cino = orig_cino;
+
+ for (;;) {
+ odev = cdev;
+ oino = cino;
+
+ if (PerlDir_chdir("..") < 0) {
+ SV_CWD_RETURN_UNDEF;
+ }
+ if (PerlLIO_stat(".", &statbuf) < 0) {
+ SV_CWD_RETURN_UNDEF;
+ }
+
+ cdev = statbuf.st_dev;
+ cino = statbuf.st_ino;
+
+ if (odev == cdev && oino == cino) {
+ break;
+ }
+ if (!(dir = PerlDir_open("."))) {
+ SV_CWD_RETURN_UNDEF;
+ }
+
+ while ((dp = PerlDir_read(dir)) != NULL) {
+#ifdef DIRNAMLEN
+ namelen = dp->d_namlen;
+#else
+ namelen = strlen(dp->d_name);
+#endif
+ /* skip . and .. */
+ if (SV_CWD_ISDOT(dp)) {
+ continue;
+ }
+
+ if (PerlLIO_lstat(dp->d_name, &statbuf) < 0) {
+ SV_CWD_RETURN_UNDEF;
+ }
+
+ tdev = statbuf.st_dev;
+ tino = statbuf.st_ino;
+ if (tino == oino && tdev == odev) {
+ break;
+ }
+ }
+
+ if (!dp) {
+ SV_CWD_RETURN_UNDEF;
+ }
+
+ if (pathlen + namelen + 1 >= MAXPATHLEN) {
+ SV_CWD_RETURN_UNDEF;
+ }
+
+ SvGROW(sv, pathlen + namelen + 1);
+
+ if (pathlen) {
+ /* shift down */
+ Move(SvPVX(sv), SvPVX(sv) + namelen + 1, pathlen, char);
+ }
+
+ /* prepend current directory to the front */
+ *SvPVX(sv) = '/';
+ Move(dp->d_name, SvPVX(sv)+1, namelen, char);
+ pathlen += (namelen + 1);
+
+#ifdef VOID_CLOSEDIR
+ PerlDir_close(dir);
+#else
+ if (PerlDir_close(dir) < 0) {
+ SV_CWD_RETURN_UNDEF;
+ }
+#endif
+ }
+
+ if (pathlen) {
+ SvCUR_set(sv, pathlen);
+ *SvEND(sv) = '\0';
+ SvPOK_only(sv);
+
+ if (PerlDir_chdir(SvPVX(sv)) < 0) {
+ SV_CWD_RETURN_UNDEF;
+ }
+ }
+ if (PerlLIO_stat(".", &statbuf) < 0) {
+ SV_CWD_RETURN_UNDEF;
+ }
+
+ cdev = statbuf.st_dev;
+ cino = statbuf.st_ino;
+
+ if (cdev != orig_cdev || cino != orig_cino) {
+ Perl_croak(aTHX_ "Unstable directory path, "
+ "current directory changed unexpectedly");
+ }
+
+ return TRUE;
+#endif
+
+#else
+ return FALSE;
+#endif
+}
+
+#endif
+
+
MODULE = Cwd PACKAGE = Cwd
PROTOTYPES: ENABLE
#!./perl
+use Cwd;
BEGIN {
chdir 't' if -d 't';
- @INC = '../lib';
}
use Config;
-use Cwd;
use strict;
use warnings;
use File::Spec;
#!./perl -Tw
# Testing Cwd under taint mode.
+use Cwd;
BEGIN {
chdir 't' if -d 't';
- unshift @INC, '../lib';
}
use strict;
-use Cwd;
use Test::More tests => 16;
use Scalar::Util qw/tainted/;
no strict 'refs';
my $cwd;
eval { $cwd = &{'Cwd::'.$func} };
- is( $@, '', "$func() does not explode under taint mode" );
- ok( tainted($cwd), "its return value is tainted" );
+ is( $@, '', "$func() should not explode under taint mode" );
+ ok( tainted($cwd), "its return value should be tainted" );
}
package Cwd;
-use 5.006;
=head1 NAME
=cut
use strict;
+use Exporter;
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
-our $VERSION = '2.08';
+$VERSION = '2.12';
-use base qw/ Exporter /;
-our @EXPORT = qw(cwd getcwd fastcwd fastgetcwd);
-our @EXPORT_OK = qw(chdir abs_path fast_abs_path realpath fast_realpath);
+@ISA = qw/ Exporter /;
+@EXPORT = qw(cwd getcwd fastcwd fastgetcwd);
+@EXPORT_OK = qw(chdir abs_path fast_abs_path realpath fast_realpath);
# sys_cwd may keep the builtin command
# there is no sense to process the rest of the file.
# The best choice may be to have this in BEGIN, but how to return from BEGIN?
-if ($^O eq 'os2' && defined &sys_cwd && defined &sys_abspath) {
+if ($^O eq 'os2') {
local $^W = 0;
- *cwd = \&sys_cwd;
- *getcwd = \&cwd;
- *fastgetcwd = \&cwd;
- *fastcwd = \&cwd;
- *abs_path = \&sys_abspath;
- *fast_abs_path = \&abs_path;
- *realpath = \&abs_path;
- *fast_realpath = \&abs_path;
+
+ *cwd = defined &sys_cwd ? \&sys_cwd : \&_os2_cwd;
+ *getcwd = \&cwd;
+ *fastgetcwd = \&cwd;
+ *fastcwd = \&cwd;
+
+ *fast_abs_path = \&sys_abspath if defined &sys_abspath;
+ *abs_path = \&fast_abs_path;
+ *realpath = \&fast_abs_path;
+ *fast_realpath = \&fast_abs_path;
+
return 1;
}
}
}
+# Lazy-load Carp
+sub _carp { require Carp; Carp::carp(@_) }
+sub _croak { require Carp; Carp::croak(@_) }
+
# The 'natural and safe form' for UNIX (pwd may be setuid root)
sub _backtick_pwd {
local @ENV{qw(PATH IFS CDPATH ENV BASH_ENV)};
unless (@cst = stat( $start ))
{
- require Carp;
- Carp::carp ("stat($start): $!");
+ _carp("stat($start): $!");
return '';
}
$cwd = '';
local *PARENT;
unless (opendir(PARENT, $dotdots))
{
- require Carp;
- Carp::carp ("opendir($dotdots): $!");
+ _carp("opendir($dotdots): $!");
return '';
}
unless (@cst = stat($dotdots))
{
- require Carp;
- Carp::carp ("stat($dotdots): $!");
+ _carp("stat($dotdots): $!");
closedir(PARENT);
return '';
}
{
unless (defined ($dir = readdir(PARENT)))
{
- require Carp;
- Carp::carp ("readdir($dotdots): $!");
+ _carp("readdir($dotdots): $!");
closedir(PARENT);
return '';
}
($cwd) = $cwd =~ /(.*)/;
if (!CORE::chdir($path)) {
- require Carp;
- Carp::croak ("Cannot chdir to $path: $!");
+ _croak("Cannot chdir to $path: $!");
}
my $realpath = getcwd();
if (! ((-d $cwd) && (CORE::chdir($cwd)))) {
- require Carp;
- Carp::croak ("Cannot chdir back to $cwd: $!");
+ _croak("Cannot chdir back to $cwd: $!");
}
$realpath;
}
my $path = VMS::Filespec::pathify($_[0]);
if (! defined $path)
{
- require Carp;
- Carp::croak("Invalid path name $_[0]")
+ _croak("Invalid path name $_[0]")
}
return VMS::Filespec::rmsexpand($path);
}
*abs_path = \&fast_abs_path;
*realpath = \&fast_abs_path;
}
- elsif ($^O eq 'os2') {
- # sys_cwd may keep the builtin command
- *cwd = defined &sys_cwd ? \&sys_cwd : \&_os2_cwd;
- *getcwd = \&cwd;
- *fastgetcwd = \&cwd;
- *fastcwd = \&cwd;
- *abs_path = \&fast_abs_path;
- }
elsif ($^O eq 'dos') {
*cwd = \&_dos_cwd;
*getcwd = \&_dos_cwd;
*fastgetcwd = \&cwd;
*fastcwd = \&cwd;
*abs_path = \&fast_abs_path;
+ *realpath = \&abs_path;
}
elsif ($^O eq 'epoc') {
*cwd = \&_epoc_cwd;
projects / platform / upstream / perl.git / commitdiff