File Coverage

blib/lib/Filesys/Virtual/Async.pm

Criterion	Covered	Total	%
statement	9	72	12.5
branch	0	24	0.0
condition	0	14	0.0
subroutine	3	36	8.3
pod	31	31	100.0
total	43	177	24.2

package Filesys::Virtual::Async;

use strict;
use warnings;

use Carp qw( croak );
our $VERSION = '0.02';


sub new {
    my $class = shift;
    bless( {
        cwd => '/',
        root => '/',
        @_
    }, ref $class || $class );
}

sub open {
    croak 'subclass didn\'t define open';
}

sub close {
    croak 'subclass didn\'t define close';
}

sub read {
    croak 'subclass didn\'t define read';
}

sub write {
    croak 'subclass didn\'t define write';
}

sub sendfile {
    croak 'subclass didn\'t define sendfile';
}

sub readahead {
    croak 'subclass didn\'t define readahead';
}

sub stat {
    croak 'subclass didn\'t define stat';
}

sub lstat {
    croak 'subclass didn\'t define lstat';
}

sub utime {
    croak 'subclass didn\'t define utime';
}

sub chown {
    croak 'subclass didn\'t define chown';
}

sub truncate {
    croak 'subclass didn\'t define truncate';
}

sub chmod {
    croak 'subclass didn\'t define chmod';
}

sub unlink {
    croak 'subclass didn\'t define unlink';
}

sub mknod {
    croak 'subclass didn\'t define mknod';
}

sub link {
    croak 'subclass didn\'t define link';
}

sub symlink {
    croak 'subclass didn\'t define symlink';
}

sub readlink {
    croak 'subclass didn\'t define readlink';
}

sub rename {
    croak 'subclass didn\'t define rename';
}

sub mkdir {
    croak 'subclass didn\'t define mkdir';
}

sub rmdir {
    croak 'subclass didn\'t define rmdir';
}

sub readdir {
    croak 'subclass didn\'t define readdir';
}

sub load {
    croak 'subclass didn\'t define load';
}

sub copy {
    croak 'subclass didn\'t define copy';
}

sub move {
    croak 'subclass didn\'t define move';
}

sub scandir {
    croak 'subclass didn\'t define scandir';
}

sub rmtree {
    croak 'subclass didn\'t define rmtree';
}

sub fsync {
    croak 'subclass didn\'t define fsync';
}

sub fdatasync {
    croak 'subclass didn\'t define fdatasync';
}

sub cwd {
    my ( $self, $cwd, $callback ) = @_;

    return $callback->( $self->{cwd} = $cwd )
        if ( defined $cwd && defined $callback );

    return $self->{cwd} = ( $cwd ) ? $cwd : '/';
}

sub root {
    my $self = shift;

    if (@_) {
        my $root = shift;
        $root =~ s/\/$//;
        $self->{root} = $root;
    }

    return $self->{root};
}

sub _path_from_root {
    my $self = shift;

    return $self->{root}.$self->_resolve_path(@_);
}

# resolve a path from the current path
sub _resolve_path {
    my ( $self, $path ) = @_;

    # could be a file handle, return it
    # XXX wth?
    return $path if ( ref $path );

    $path ||= '';

    my $cwd = $self->{cwd};
    my $path_out = '';

    if ($path eq '') {
        $path_out = $cwd;
    } elsif ($path eq '/') {
        $path_out = '/';
    } else {
        my @real = split(/\//, $cwd);
        if ($path =~ m/^\//) {
            @real = ();
        }

        my @paths = split( /\//,$path );

        if (@paths && $paths[0] eq '~' && $self->{home_path}) {
            @real = split(/\//, $self->{home_path});
            shift @paths;
        }

        foreach (@paths) {
            if ($_ eq '..') {
                pop(@real) if ($#real);
            } elsif ($_ eq '.') {
                next;
            } else {
                push(@real, $_);
            }
        }
        $path_out = join('/', @real);
    }

    return (substr($path_out, 0, 1) eq '/') ? $path_out : '/'.$path_out;
}

1;

__END__