+sub sockport {
+ my $self = shift;
+ return $self->{_server_sock}->sockport;
+}
+
+
+package FTPPaths;
+
+use POSIX qw(strftime);
+
+# not a method
+sub final_component {
+ my $path = shift;
+
+ $path =~ s|.*/||;
+ return $path;
+}
+
+# not a method
+sub path_merge {
+ my ($a, $b) = @_;
+
+ return $a unless $b;
+
+ if ($b =~ m.^/.) {
+ $a = '';
+ $b =~ s.^/..;
+ }
+ $a =~ s./$..;
+
+ my @components = split('/', $b);
+
+ foreach my $c (@components) {
+ if ($c =~ /^\.?$/) {
+ next;
+ } elsif ($c eq '..') {
+ next if $a eq '';
+ $a =~ s|/[^/]*$||;
+ } else {
+ $a .= "/$c";
+ }
+ }
+
+ return $a;
+}
+
+sub new {
+ my ($this, @args) = @_;
+ my $class = ref($this) || $this;
+ my $self = {};
+ bless $self, $class;
+ $self->initialize(@args);
+ return $self;
+}
+
+sub initialize {
+ my ($self, $urls, $behavior) = @_;
+ my $paths = {_type => 'd'};
+
+ # From a path like '/foo/bar/baz.txt', construct $paths such that
+ # $paths->{'foo'}->{'bar'}->{'baz.txt'} is
+ # $urls->{'/foo/bar/baz.txt'}.
+ for my $path (keys %$urls) {
+ my @components = split('/', $path);
+ shift @components;
+ my $x = $paths;
+ for my $c (@components) {
+ unless (exists $x->{$c}) {
+ $x->{$c} = {_type => 'd'};
+ }
+ $x = $x->{$c};
+ }
+ %$x = %{$urls->{$path}};
+ $x->{_type} = 'f';
+ }
+
+ $self->{'_paths'} = $paths;
+ $self->{'_behavior'} = $behavior;
+}
+
+sub get_info {
+ my ($self, $path, $node) = @_;
+ $node = $self->{'_paths'} unless $node;
+ my @components = split('/', $path);
+ shift @components if @components && $components[0] eq '';
+
+ for my $c (@components) {
+ if ($node->{'_type'} eq 'd') {
+ $node = $node->{$c};
+ } else {
+ return undef;
+ }
+ }
+ return $node;
+}
+
+sub dir_exists {
+ my ($self, $path) = @_;
+ return $self->exists($path, 'd');
+}
+
+sub exists {
+ # type is optional, in which case we don't check it.
+ my ($self, $path, $type) = @_;
+ my $paths = $self->{'_paths'};
+
+ die "Invalid path $path (not absolute).\n" unless $path =~ m.^/.;
+ my $info = $self->get_info($path);
+ return 0 unless defined($info);
+ return $info->{'_type'} eq $type if defined($type);
+ return 1;
+}
+
+sub _format_for_list {
+ my ($self, $name, $info) = @_;
+
+ # XXX: mode should be specifyable as part of the node info.
+ my $mode_str;
+ if ($info->{'_type'} eq 'd') {
+ $mode_str = 'dr-xr-xr-x';
+ } else {
+ $mode_str = '-r--r--r--';
+ }
+
+ my $size = 0;
+ if ($info->{'_type'} eq 'f') {
+ $size = length $info->{'content'};
+ if ($self->{'_behavior'}{'bad_list'}) {
+ $size = 0;
+ }
+ }
+ my $date = strftime ("%b %e %H:%M", localtime);
+ return "$mode_str 1 0 0 $size $date $name";
+}
+
+sub get_list {
+ my ($self, $path, $no_hidden) = @_;
+ my $info = $self->get_info($path);
+ return undef unless defined $info;
+ my $list = [];
+
+ if ($info->{'_type'} eq 'd') {
+ for my $item (keys %$info) {
+ next if $item =~ /^_/;
+ # 2013-10-17 Andrea Urbani (matfanjol)
+ # I skip the hidden files if requested
+ if (($no_hidden) &&
+ (defined($info->{$item}->{'attr'})) &&
+ (index($info->{$item}->{'attr'}, "H")>=0))
+ {
+ # This is an hidden file and I don't want to see it!
+ print STDERR "get_list: Skipped hidden file [$item]\n";
+ }
+ else
+ {
+ push @$list, $self->_format_for_list($item, $info->{$item});
+ }
+ }
+ } else {
+ push @$list, $self->_format_for_list(final_component($path), $info);
+ }
+
+ return $list;
+}
+
+# 2013-10-17 Andrea Urbani (matfanjol)
+# It returns the behavior of the given name.
+# In this file I handle also the following behaviors:
+# list_dont_clean_path : if defined, the command
+# $path =~ s/^-[a-zA-Z0-9]+\s?//;
+# is not runt and the given path
+# remains the original one
+# list_empty_if_list_a : if defined, "LIST -a" returns an
+# empty content
+# list_fails_if_list_a : if defined, "LIST -a" returns an
+# error
+# list_no_hidden_if_list: if defined, "LIST" doesn't return
+# hidden files.
+# To define an hidden file add
+# attr => "H"
+# to the url files
+# syst_response : if defined, its content is printed
+# out as SYST response
+sub GetBehavior {
+ my ($self, $name) = @_;
+ return $self->{'_behavior'}{$name};
+}
+