view release on metacpan or  search on metacpan

lib/Filesys/POSIX/Real/Inode.pm  view on Meta::CPAN

    my $inode = $class->new( $path, %opts )->update(@st);

    if ( S_IFMT( $st[2] ) == S_IFDIR ) {
        $inode->{'directory'} = Filesys::POSIX::Real::Directory->new( $path, $inode );
    }

    return $inode;
}

sub child {
    my ( $self, $name, $mode ) = @_;
    my $directory = $self->directory;

    throw &Errno::EINVAL if $name =~ /\//;
    throw &Errno::EEXIST if $directory->exists($name);

    my $path = "$self->{'path'}/$name";

    my %data = (
        'dev'    => $self->{'dev'},
        'sticky' => $self->{'sticky'},
        'parent' => $directory->get('.')
    );

    if ( ( $mode & $S_IFMT ) == $S_IFREG ) {
        sysopen(
            my $fh, $path,
            O_CREAT | O_EXCL | O_WRONLY,
            Filesys::POSIX::Bits::System::convertModeToSystem($mode)
        ) or Carp::confess("$!");
        close($fh);
    }
    elsif ( ( $mode & $S_IFMT ) == $S_IFDIR ) {
        mkdir( $path, $mode ) or Carp::confess("$!");
    }

    my $inode;

    if ( ( $mode & $S_IFMT ) == $S_IFLNK ) {
        throw &Errno::EPERM unless $self->{'sticky'};

        $inode = Filesys::POSIX::Mem::Inode->new( %data, 'mode' => $mode );
    }
    else {
        my $class = ref $self;
        $inode = $class->from_disk( $path, %data );
    }

    return $directory->set( $name, $inode );
}

sub taint {
    my ($self) = @_;

    $self->{'dirty'} = 1;

    return $self;
}

sub update {
    my ( $self, @st ) = @_;

    if ( $self->{'sticky'} && $self->{'dirty'} ) {
        @{$self}{qw(rdev size atime mtime ctime)} = @st[ 6 .. 10 ];
    }
    else {
        $self->SUPER::update(@st);
    }

    return $self;
}

sub open {
    my ( $self, $flags ) = @_;

    sysopen(
        my $fh, $self->{'path'},
        Filesys::POSIX::Bits::System::convertFlagsToSystem($flags)
    ) or Carp::confess("$!");

    return Filesys::POSIX::IO::Handle->new($fh);
}

sub chown {
    my ( $self, $uid, $gid ) = @_;

    unless ( $self->{'sticky'} ) {
        CORE::chown( $uid, $gid, $self->{'path'} ) or Carp::confess("$!");
    }

    @{$self}{qw(uid gid)} = ( $uid, $gid );

    return $self->taint;
}

sub chmod {
    my ( $self, $mode ) = @_;
    my $format = $self->{'mode'} & $S_IFMT;
    my $perm = $mode & ( $S_IPERM | $S_IPROT );

    unless ( $self->{'sticky'} ) {
        CORE::chmod( $perm, $self->{'path'} ) or Carp::confess("$!");
    }

    $self->{'mode'} = $format | $perm;

    return $self->taint;
}

sub readlink {
    my ($self) = @_;

    unless ( $self->{'dest'} ) {
        $self->{'dest'} = CORE::readlink( $self->{'path'} ) or Carp::confess("$!");
    }

    return $self->{'dest'};
}

sub symlink {