File-lchown
view release on metacpan or search on metacpan
use v5;
use strict;
use warnings;
use Module::Build;
use ExtUtils::CChecker 0.03;
my $cc = ExtUtils::CChecker->new;
$cc->assert_compile_run(
diag => "no lchown()",
source => <<'EOF' );
#include <stdlib.h>
#include <unistd.h>
int main(int argc, char *argv[]) {
if(lchown(".", -1, -1) != 0)
exit(1);
exit(0);
}
EOF
$cc->try_compile_run(
define => "HAVE_LUTIMES",
source => <<'EOF' );
#include <stdlib.h>
#include <unistd.h>
#include <sys/time.h>
int main(int argc, char *argv[]) {
if(lutimes(".", NULL) != 0)
exit(1);
exit(0);
}
EOF
my $build = $cc->new_module_build(
module_name => 'File::lchown',
configure_requires => {
'ExtUtils::CChecker' => 0.03,
'Module::Build' => 0.4004,
},
requires => {
'Exporter' => '5.57',
},
build_requires => {
'Module::Build' => 0,
'Module::Build::Compat' => 0,
Revision history for File-lchown
0.03 2025-06-24
[CHANGES]
* Implement sub-second resolution of `lutimes()` function
* Much module style refresh
[BUGFIXES]
* Need to `#include <sys/time.h>` when probing for `lutimes()`
0.02 CHANGES:
.editorconfig
Build.PL
Changes
lib/File/lchown.pm
lib/File/lchown.xs
MANIFEST This list of files
t/00use.t
t/01lchown.t
t/02lutimes.t
t/99pod.t
README
LICENSE
META.yml
META.json
],
"dynamic_config" : 1,
"generated_by" : "Module::Build version 0.4234",
"license" : [
"perl_5"
],
"meta-spec" : {
"url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
"version" : 2
},
"name" : "File-lchown",
"prereqs" : {
"build" : {
"requires" : {
"ExtUtils::CBuilder" : "0",
"Module::Build" : "0",
"Module::Build::Compat" : "0",
"Test::More" : "0"
}
},
"configure" : {
}
},
"test" : {
"requires" : {
"Test2::V0" : "0",
"Time::HiRes" : "0"
}
}
},
"provides" : {
"File::lchown" : {
"file" : "lib/File/lchown.pm",
"version" : "0.03"
}
},
"release_status" : "stable",
"resources" : {
"license" : [
"http://dev.perl.org/licenses/"
]
},
"version" : "0.03",
Time::HiRes: '0'
configure_requires:
ExtUtils::CChecker: '0.03'
Module::Build: '0.4004'
dynamic_config: 1
generated_by: 'Module::Build version 0.4234, CPAN::Meta::Converter version 2.150010'
license: perl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
version: '1.4'
name: File-lchown
provides:
File::lchown:
file: lib/File/lchown.pm
version: '0.03'
requires:
Exporter: '5.57'
resources:
license: http://dev.perl.org/licenses/
version: '0.03'
x_serialization_backend: 'CPAN::Meta::YAML version 0.018'
NAME
File::lchown - modify attributes of symlinks without dereferencing them
SYNOPSIS
use File::lchown qw( lchown lutimes );
lchown $uid, $gid, $linkpath or die "Cannot lchown() - $!";
lutimes $atime, $mtime, $linkpath or die "Cannot lutimes() - $!";
DESCRIPTION
The regular chown system call will dereference a symlink and apply
ownership changes to the file at which it points. Some OSes provide
system calls that do not dereference a symlink but instead apply their
changes directly to the named path, even if that path is a symlink (in
much the same way that lstat will return attributes of a symlink rather
than the file at which it points).
FUNCTIONS
lchown
$count = lchown $uid, $gid, @paths;
Set the new user or group ownership of the specified paths, without
dereferencing any symlinks. Passing the value -1 as either the $uid or
$gid will leave that attribute unchanged. Returns the number of files
successfully changed.
lutimes
$count = lutimes $atime, $mtime, @paths;
Set the access and modification times on the specified paths, without
dereferencing any symlinks. Passing undef as both $atime and $mtime
will update the times to the current system time.
Note that for both lchown and lutimes, if more than one path is given,
if later paths succeed after earlier failures, then the value of $!
will not be reliable to indicate the nature of the failure. If you wish
to use $! to report on failures, make sure only to pass one path at a
time.
Since version 0.03 either time may be given as a fractional value, or
as an ARRAY reference containing at least two elements. In the latter
case, the [0] element should contain the integer seconds and [1] the
microseconds part of it; in the same style as Time::HiRes.
SEE ALSO
* lchown(2) - change ownership of a file
* lutimes(2) - change file timestamps
AUTHOR
Paul Evans <leonerd@leonerd.org.uk>
lib/File/lchown.pm view on Meta::CPAN
# You may distribute under the terms of either the GNU General Public License
# or the Artistic License (the same terms as Perl itself)
#
# (C) Paul Evans, 2010,2025 -- leonerd@leonerd.org.uk
package File::lchown 0.03;
use v5.14;
use warnings;
use Exporter 'import';
our @EXPORT_OK = qw(
lchown
lutimes
);
require XSLoader;
XSLoader::load( __PACKAGE__, our $VERSION );
=head1 NAME
C<File::lchown> - modify attributes of symlinks without dereferencing them
=head1 SYNOPSIS
=for highlighter language=perl
use File::lchown qw( lchown lutimes );
lchown $uid, $gid, $linkpath or die "Cannot lchown() - $!";
lutimes $atime, $mtime, $linkpath or die "Cannot lutimes() - $!";
=head1 DESCRIPTION
The regular C<chown> system call will dereference a symlink and apply
ownership changes to the file at which it points. Some OSes provide system
calls that do not dereference a symlink but instead apply their changes
directly to the named path, even if that path is a symlink (in much the same
way that C<lstat> will return attributes of a symlink rather than the file at
which it points).
=cut
=head1 FUNCTIONS
=cut
=head2 lchown
$count = lchown $uid, $gid, @paths;
Set the new user or group ownership of the specified paths, without
dereferencing any symlinks. Passing the value C<-1> as either the C<$uid> or
C<$gid> will leave that attribute unchanged. Returns the number of files
successfully changed.
=cut
=head2 lutimes
$count = lutimes $atime, $mtime, @paths;
Set the access and modification times on the specified paths, without
dereferencing any symlinks. Passing C<undef> as both C<$atime> and C<$mtime>
will update the times to the current system time.
Note that for both C<lchown> and C<lutimes>, if more than one path is given,
if later paths succeed after earlier failures, then the value of C<$!> will
not be reliable to indicate the nature of the failure. If you wish to use
C<$!> to report on failures, make sure only to pass one path at a time.
I<Since version 0.03> either time may be given as a fractional value, or as an
ARRAY reference containing at least two elements. In the latter case, the
C<[0]> element should contain the integer seconds and C<[1]> the microseconds
part of it; in the same style as L<Time::HiRes>.
=cut
=head1 SEE ALSO
=over 4
=item *
C<lchown(2)> - change ownership of a file
=item *
C<lutimes(2)> - change file timestamps
=back
=head1 AUTHOR
Paul Evans <leonerd@leonerd.org.uk>
lib/File/lchown.xs view on Meta::CPAN
croak("Expected an ARRAY reference of at least 2 elements");
tvp->tv_sec = SvUV(*av_fetch(av, 0, 0));
tvp->tv_usec = SvUV(*av_fetch(av, 1, 0));
}
else {
tvp->tv_sec = SvUV(sv);
tvp->tv_usec = 0;
}
}
MODULE = File::lchown PACKAGE = File::lchown
int
lchown(int uid, int gid, ...)
PREINIT:
int i;
CODE:
RETVAL = 0;
for(i = 2; i < items; i++) {
char *path = SvPV_nolen(ST(i));
if(lchown(path, uid, gid) == 0)
RETVAL++;
}
OUTPUT:
RETVAL
int
lutimes(SV *atime, SV *mtime, ...)
PREINIT:
struct timeval tv[2];
#!/usr/bin/perl
use v5.14;
use warnings;
use Test2::V0;
require File::lchown;
pass "Modules loaded";
done_testing;
t/01lchown.t view on Meta::CPAN
#!/usr/bin/perl
use v5.14;
use warnings;
use Test2::V0;
use File::lchown qw( lchown );
use POSIX qw( ENOENT );
my $testlink = "testlink";
unlink $testlink if -l $testlink;
my $missing = "notexist";
$missing .= "X" while -e $missing; # Just in case
is( lchown( $<, $(, $missing ), 0, 'lchown() a non-existent file returns 0' );
is( $!+0, ENOENT, 'lchown() a non-existent file sets \$! == ENOENT' );
# Hard to know for sure what I can do here, but hopefully I'm in at least 2
# groups so I should at least be able to lchown() a symlink into one of my
# supplimentary groups
SKIP: {
my @groups = grep { $_ != $( } split ' ', $);
skip "Not enough additional groups", 2 unless @groups;
symlink( "target", $testlink ) or die "Cannot symlink() - $!";
is( lchown( -1, $groups[0], $testlink ), 1, 'lchown() returns 1 success' );
is( ( lstat $testlink )[5], $groups[0], 'Symlink now has new group' );
}
unlink $testlink;
done_testing;
t/02lutimes.t view on Meta::CPAN
#!/usr/bin/perl
use v5.14;
use warnings;
use Test2::V0;
use File::lchown qw( lutimes );
use POSIX qw( ENOENT );
use Time::HiRes;
use constant HAVE_HIRES_LSTAT => $Time::HiRes::VERSION ge 1.9726;
defined eval { lutimes(undef,undef) } or plan skip_all => "No lutimes()";
my $testlink = "testlink";
unlink $testlink if -l $testlink;
( run in 1.746 second using v1.01-cache-2.11-cpan-71847e10f99 )