view release on metacpan or  search on metacpan

lib/AnyEvent/FTP/Server/Context/Memory.pm  view on Meta::CPAN

package AnyEvent::FTP::Server::Context::Memory;

use strict;
use warnings;
use 5.010;
use Moo;
use Path::Class::File;
use Path::Class::Dir;

extends 'AnyEvent::FTP::Server::Context';

# ABSTRACT: FTP Server client context class with full read/write access
our $VERSION = '0.20'; # VERSION


with 'AnyEvent::FTP::Server::Role::Auth';
with 'AnyEvent::FTP::Server::Role::Help';
with 'AnyEvent::FTP::Server::Role::Old';
with 'AnyEvent::FTP::Server::Role::Type';
with 'AnyEvent::FTP::Server::Role::TransferPrep';


sub store
{
  # The store for this class is global.
  # if you wanted each connection or user
  # to have their own store you could subclass
  # and redefine the store method as apropriate
  state $store = {};
  $store;
}


has cwd => (
  is      => 'rw',
  default => sub {
    Path::Class::Dir->new_foreign('Unix', '/');
  },
);


sub _first_index (&@)
{
  my $f = shift;
  foreach my $i ( 0 .. $#_ )
  {
    local *_ = \$_[$i];
    return $i if $f->();
  }
  return -1;
}

sub find
{
  my($self, $path) = @_;
  $path = Path::Class::Dir->new_foreign('Unix', $path) unless ref $path;
  $path = Path::Class::Dir->new_foreign('Unix', $self->cwd, $path)
    unless $path->is_absolute;

  my $store = $self->store;

  return $store if $path eq '/';

  my @list = $path->components;

  while(1)
  {
    my $i = _first_index { $_ eq '..' } @list;
    last if $i == -1;
    if($i > 1)
    {
      splice @list, $i-1, 2;
    }
    else
    {
      splice @list, $i, 1;
    }
  }

  shift @list; # shift off the root
  my $top = pop @list;

  foreach my $part (@list)
  {
    if(exists($store->{$part}) && ref($store->{$part}) eq 'HASH')