view release on metacpan or  search on metacpan

lib/Repository/Simple/Engine/FileSystem.pm  view on Meta::CPAN

    if ($action eq $SET_PROPERTY && $ustat_props{$pname} && -w $dir_path) {
        return 1;
    }

    if ($action eq $SET_PROPERTY && $pname eq 'fs:content' && -w $par_path) {
        return 1;
    }

    if ($action eq $REMOVE && -e $real_path && -w $par_path) {
        return 1;
    }

    if ($action eq $READ && $pname eq 'fs:content' && -r $par_path) {
        return 1;
    }

    if ($action eq $READ && -d $real_path && -r $real_path && -x $real_path) {
        return 1;
    }

    if ($action eq $READ && -e $real_path && -r $real_path) {
        return 1;
    }

    if ($action eq $READ && defined $stat_names{$pname} && -r $dir_path) {
        return 1;
    }

    return 0;
}

sub set_scalar {
    my ($self, $path, $value) = @_;

    my $basename = basename($path);
    my $dirname  = dirname($path);

    my $real_path = $self->real_path($dirname);

    $self->check_real_path($real_path, $dirname);

    if ($basename eq 'fs:content') {
        unless (-f $real_path) {
            croak qq(no "fs:content" property associated with node at ),
                  qq("$dirname");
        }

        my $handle = $self->_get_handle($dirname, $real_path, '>');
        print $handle $value;
        close $handle;
    }

    elsif ($basename eq 'fs:mode') {
        chmod $value, $real_path
            or croak qq(Failed to change "$path" to "$value": $!);
    }

    elsif ($basename eq 'fs:uid') {
        my $gid = $self->_get_scalar($real_path, 'fs:gid');
        chown $value, $gid, $real_path
            or croak qq(Failed to change "$path" to "$value": $!);
    }

    elsif ($basename eq 'fs:gid') {
        my $uid = $self->_get_scalar($real_path, 'fs:uid');
        chown $uid, $value, $real_path
            or croak qq(Failed to change "$path" to "$value": $!);
    }

    elsif ($basename eq 'fs:atime') {
        my $mtime = $self->_get_scalar($real_path, 'fs:mtime');
        utime $value, $mtime, $real_path
            or croak qq(Failed to change "$path" to "$value": $!);
    }

    elsif ($basename eq 'fs:mtime') {
        my $atime = $self->_get_scalar($real_path, 'fs:atime');
        utime $atime, $value, $real_path
            or croak qq(Failed to change "$path" to "$value": $!);
    }

    else {
        croak qq(property "$basename" is static or does not exist for ),
              qq("$dirname" );
    }
}

sub set_handle {
    my ($self, $path, $handle) = @_;

    # TODO This is cheating and should be done better
    my $value = join '', readline($handle);
    $self->set_scalar($path, $value);
}

sub save_property {
    my ($self, $path) = @_;

    my $dirname = dirname($path);

    # Check for a file handle at the given path; close it if found
    if (defined $self->{handles}{$dirname}) {
        my $handle = delete $self->{handles}{$dirname};
        close $handle;
    }
}

=head1 SEE ALSO

L<Repository::Simple>

=head1 AUTHOR

Andrew Sterling Hanenkamp, E<lt>hanenkamp@cpan.orgE<gt>

=head1 LICENSE AND COPYRIGHT

Copyright 2006 Andrew Sterling Hanenkamp E<lt>hanenkamp@cpan.orgE<gt>.  All 
Rights Reserved.

This module is free software; you can redistribute it and/or modify it under
the same terms as Perl itself. See L<perlartistic>.

This program is distributed in the hope that it will be useful, but WITHOUT
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
FOR A PARTICULAR PURPOSE.