Front page | perl.perl5.porters |
Postings from August 2001
[PATCH op.c op.h pp_sys.c t/op/local.t pod/perlfunc.pod] local chdir()
Thread Next
From:
Michael G Schwern
Date:
August 31, 2001 16:38
Subject:
[PATCH op.c op.h pp_sys.c t/op/local.t pod/perlfunc.pod] local chdir()
Message ID:
20010831193810.C8039@blackrider
Here it is. A complete, documented C<local chdir($dir)> based on
crab's code patch.
I plan to do similar things to single-arg select() and umask().
Scream now or forever hold your peace.
--- op.h 2001/08/31 23:07:41 1.1
+++ op.h 2001/08/31 23:09:00
@@ -172,6 +172,9 @@
#define OPpCONST_BARE 64 /* Was a bare word (filehandle?). */
#define OPpCONST_WARNING 128 /* Was a $^W translated to constant. */
+/* Private for OP_CHDIR */
+#define OPpCWD_SAVE 8 /* Save the cwd before chdir. */
+
/* Private for OP_FLIP/FLOP */
#define OPpFLIP_LINENUM 64 /* Range arg potentially a line num. */
--- op.c 2001/08/31 23:07:36 1.1
+++ op.c 2001/08/31 23:12:55
@@ -1669,6 +1669,10 @@
if (type != OP_LEAVESUBLV)
goto nomod;
break; /* mod()ing was handled by ck_return() */
+
+ case OP_CHDIR:
+ o->op_private |= OPpCWD_SAVE;
+ break;
}
if (type != OP_LEAVESUBLV)
o->op_flags |= OPf_MOD;
--- pod/perlfunc.pod 2001/08/31 23:29:32 1.1
+++ pod/perlfunc.pod 2001/08/31 23:31:43
@@ -566,6 +566,15 @@
set, C<chdir> does nothing. It returns true upon success, false
otherwise. See the example under C<die>.
+If local is prepended, the chdir()'s effect is dynamically scoped.
+
+ chdir("foo"); # out here, we're in foo/
+ {
+ local chdir("bar"); # in here, it's foo/bar
+ }
+ # now we're back in foo/
+
+
=item chmod LIST
Changes the permissions of a list of files. The first element of the
@@ -2356,6 +2365,9 @@
block, file, or eval. If more than one value is listed, the list must
be placed in parentheses. See L<perlsub/"Temporary Values via local()">
for details, including issues with tied arrays and hashes.
+
+local also works on certain ops like chdir() to localize their effect.
+See the individual op documentation for details.
=item localtime EXPR
--- pp_sys.c~ Mon Aug 27 10:25:14 2001
+++ pp_sys.c Fri Aug 31 19:14:04 2001
@@ -3368,6 +3368,16 @@
/* File calls. */
+static void
+restore_wdir(pTHXo_ void *wd)
+{
+ char *dir = SvPVX((SV *)wd);
+
+ if (PerlDir_chdir(dir) < 0)
+ Perl_croak(aTHX_ "Can't chdir to %s", dir);
+ sv_free((SV *)wd);
+}
+
PP(pp_chdir)
{
dSP; dTARGET;
@@ -3396,6 +3406,13 @@
tmps = SvPV(*svp, n_a);
}
#endif
+
+ if (PL_op->op_private & OPpCWD_SAVE) {
+ SV *cwd = newSVpv("", 0);
+ getcwd_sv(cwd);
+ SAVEDESTRUCTOR_X(restore_wdir, cwd);
+ }
+
TAINT_PROPER("chdir");
PUSHi( PerlDir_chdir(tmps) >= 0 );
#ifdef VMS
--- t/op/local.t 2001/08/31 23:20:39 1.1
+++ t/op/local.t 2001/08/31 23:37:16
@@ -1,6 +1,6 @@
#!./perl
-print "1..71\n";
+print "1..78\n";
sub foo {
local($a, $b) = @_;
@@ -243,3 +243,38 @@
print "not " if exists $x{c};
print "ok 71\n";
}
+
+
+# Temporary measure until the above tests are cleaned up.
+my $test = 72;
+sub ok {
+ my($ok, $name) = @_;
+
+ # You have to do it this way or VMS will get confused.
+ print $ok ? "ok $test - $name\n" : "not ok $test - $name\n";
+
+ printf "# Failed test at line %d\n", (caller)[2] unless $ok;
+
+ $test++;
+ return $ok;
+}
+
+
+print "# Testing local chdir.\n";
+use File::Spec::Functions qw(updir);
+
+{
+ ok( local chdir("t"), 'local chdir() returns properly' );
+ ok( -r 'op', 'local chdir() works' );
+
+ ok( local chdir("op"), ' still returning properly' );
+ ok( -r "local.t", ' twice in the same block' );
+
+ {
+ ok( local chdir(updir), ' returns right' );
+ ok( -r 'op', ' in an inner block' );
+ }
+}
+ok( -r 't' && !-r 'local.t', ' and the cwd restores itself' );
--
Michael G. Schwern <schwern@pobox.com> http://www.pobox.com/~schwern/
Perl6 Quality Assurance <perl-qa@perl.org> Kwalitee Is Job One
AY! The ground beef, she is burning my groin!
http://sluggy.com/d/990105.html
Thread Next
-
[PATCH op.c op.h pp_sys.c t/op/local.t pod/perlfunc.pod] local chdir()
by Michael G Schwern