view release on metacpan or  search on metacpan

lib/No/Worries/Stat.pm  view on Meta::CPAN

    my($option, $message) = @_;
    my($mode, $action, $number);

    $mode = $option->{mode};
    return unless defined($mode);
    if ($mode =~ /^([\+\-])?(\d+)$/) {
        $action = $1 || "";
        $number = substr($2, 0, 1) eq "0" ? oct($2) : ($2+0);
        # use the canonical form for the message
        $mode = sprintf("%s%05o", $action, $number);
        if ($action eq "+") {
            # check that at least these bits are set
            $option->{mode_set} = $number;
            $option->{mode_clear} = 0;
        } elsif ($action eq "-") {
            # check that at least these bits are cleared
            $option->{mode_set} = 0;
            $option->{mode_clear} = $number;
        } else {
            # check that these bits are exactly the ones set
            $option->{mode_set} = $number;
            $option->{mode_clear} = _IMODE;
        }
    } else {
        dief("invalid mode: %s", $mode);
    }
    $message->{mode} = "mode($mode)";
}

#
# check the mtime option and set message accordingly
#

sub _check_mtime ($$) {
    my($option, $message) = @_;
    my($mtime);

    $mtime = $option->{mtime};
    return unless defined($mtime);
    $message->{mtime} = "mtime($mtime)";
}

#
# ensure proper ownership
#

sub _ensure_owner ($$$$) {
    my($path, $stat, $option, $message) = @_;
    my(@todo);

    @todo = ();
    if ($message->{user} and $stat->[ST_UID] != $option->{uid}) {
        $stat->[ST_UID] = $option->{uid};
        push(@todo, $message->{user});
    }
    if ($message->{group} and $stat->[ST_GID] != $option->{gid}) {
        $stat->[ST_GID] = $option->{gid};
        push(@todo, $message->{group});
    }
    return(0) unless @todo and $option->{callback}->($path, "@todo");
    chown($stat->[ST_UID], $stat->[ST_GID], $path)
        or dief("cannot chown(%d, %d, %s): %s",
                $stat->[ST_UID], $stat->[ST_GID], $path, $!);
    return(1)
}

#
# ensure proper permissions
#

sub _ensure_mode ($$$$) {
    my($path, $stat, $option, $message) = @_;
    my($mode);

    $mode = $stat->[ST_MODE] & _IMODE;
    $mode &= ~$option->{mode_clear};
    $mode |=  $option->{mode_set};
    return(0) if ($stat->[ST_MODE] & _IMODE) == $mode;
    return(0) unless $option->{callback}->($path, $message->{mode});
    chmod($mode, $path)
        or dief("cannot chmod(%05o, %s): %s", $mode, $path, $!);
    return(1)
}

#
# ensure proper modification time
#

sub _ensure_mtime ($$$$) {
    my($path, $stat, $option, $message) = @_;

    return(0) if $stat->[ST_MTIME] == $option->{mtime};
    return(0) unless $option->{callback}->($path, $message->{mtime});
    utime($stat->[ST_ATIME], $option->{mtime}, $path)
        or dief("cannot utime(%d, %d, %s): %s",
                $stat->[ST_ATIME], $option->{mtime}, $path, $!);
    return(1);
}

#
# make sure the the file status is what is expected
#

my %stat_ensure_options = (
    user     => { optional => 1, type => SCALAR, regex => qr/^[\w\-]+$/ },
    group    => { optional => 1, type => SCALAR, regex => qr/^[\w\-]+$/ },
    mode     => { optional => 1, type => SCALAR, regex => qr/^[\+\-]?\d+$/ },
    mtime    => { optional => 1, type => SCALAR, regex => qr/^\d+$/ },
    follow   => { optional => 1, type => BOOLEAN },
    callback => { optional => 1, type => CODEREF },
);

sub stat_ensure ($@) {
    my($path, %option, %message, @stat, $changed);

    $path = shift(@_);
    %option = validate(@_, \%stat_ensure_options) if @_;
    _check_user(\%option, \%message);
    _check_group(\%option, \%message);
    _check_mode(\%option, \%message);
    _check_mtime(\%option, \%message);
    $option{callback} ||= sub { return(1) };

lib/No/Worries/Stat.pm  view on Meta::CPAN

=item C<ST_UID>

user ID of owner

=item C<ST_GID>

group ID of owner

=item C<ST_RDEV>

device ID (if special file)

=item C<ST_SIZE>

total size, in bytes

=item C<ST_ATIME>

time of last access

=item C<ST_MTIME>

time of last modification

=item C<ST_CTIME>

time of last status change

=item C<ST_BLKSIZE>

blocksize for filesystem I/O

=item C<ST_BLOCKS>

number of 512B blocks allocated

=back

In addition, it also optionally exports all the ":mode" constants from L<Fcntl>.

This way, all the stat() related constants can be imported in a uniform way.

=head1 FUNCTIONS

This module provides the following functions (none of them being
exported by default):

=over

=item stat_type(MODE)

given the file mode (C<ST_MODE> field), return the file type as a string;
possible return values are: "block device", "character device", "directory",
"door", "event port", "network file", "pipe", "plain file", "socket",
"symlink", "unknown" and "whiteout".

=item stat_ensure(PATH[, OPTIONS])

make sure the given path has the expected file "status" (w.r.t. stat()) and
call chown(), chmod() or utime() if needed, returning the number of changes
performed; supported options:

=over

=item * C<user>: expected user name or uid

=item * C<group>: expected group name or gid

=item * C<mode>: expected mode specification (see below)

=item * C<mtime>: expected modification time

=item * C<follow>: follow symbolic links (default is to skip them)

=item * C<callback>: code to be executed before changing something (see below)

=back

=back

The C<mode> option of stat_ensure() can be given:

=over

=item I<NUMBER>

an absolute value like 0755, meaning that mode must be equal to it

=item +I<NUMBER>

a list of bits that must be set, e.g. "+0111" for "executable for all"

=item -I<NUMBER>

a list of bits that must be clear, e.g. "-022" for not writable by group or
other

=back

Note: the number after "+" or "-" will be interpreted as being octal only if
it starts with "0". You should therefore use "+0111" or "+".oct(111) to
enable the executable bits but not "+111" which is the same as "+0157".

The C<callback> option of stat_ensure() will receive the given path and a
string describing what is about to be changed. It must return true to tell
stat_ensure() to indeed perform the changes.

Here is for insatnce how a "noaction" option could be implemented:

  sub noaction ($$) {
      my($path, $change) = @_;
  
      printf("did not change %s of %s\n", $change, $path);
      return(0);
  }
  foreach my $path (@paths) {
      stat_ensure($path, user => "root", mode => 0755, callback => \&noaction);
  }

=head1 SEE ALSO