dougm 01/12/07 13:39:02
Modified: perl-framework/Apache-Test/lib/Apache TestUtil.pm
Log:
new function to chown a file or directory to the test User/Group
noop if chown is unsupported
Revision Changes Path
1.17 +33 -0
httpd-test/perl-framework/Apache-Test/lib/Apache/TestUtil.pm
Index: TestUtil.pm
===================================================================
RCS file:
/home/cvs/httpd-test/perl-framework/Apache-Test/lib/Apache/TestUtil.pm,v
retrieving revision 1.16
retrieving revision 1.17
diff -u -r1.16 -r1.17
--- TestUtil.pm 2001/11/20 03:52:01 1.16
+++ TestUtil.pm 2001/12/07 21:39:02 1.17
@@ -93,6 +93,32 @@
File::Path::rmtree((@_ > 1 ? [EMAIL PROTECTED] : $_[0]), 0, 1);
}
+#chown a file or directory to the test User/Group
+#noop if chown is unsupported
+
+sub chown {
+ my $file = shift;
+ my $config = Apache::Test::config();
+ my($uid, $gid);
+
+ eval {
+ #XXX cache this lookup
+ ($uid, $gid) = (getpwnam($config->{vars}->{user}))[2,3];
+ };
+
+ if ($@) {
+ if ($@ =~ /^The getpwnam function is unimplemented/) {
+ #ok if unsupported, e.g. win32
+ return 1;
+ }
+ else {
+ die $@;
+ }
+ }
+
+ CORE::chown($uid, $gid, $file) || die "chown $file: $!";
+}
+
# $string = struct_as_string($indent_level, $var);
#
# return any nested datastructure via Data::Dumper or ala Data::Dumper
@@ -336,6 +362,13 @@
t_rmtree() deletes the whole directories trees passed in I<@dirs>.
This function is exported by default.
+
+=item chown()
+
+ Apache::TestUtil::chown($file);
+
+Change ownership of $file to the test User/Group. This function is noop
+on platforms where chown is unsupported (e.g. Win32).
=item t_is_equal()
