view release on metacpan or  search on metacpan

lib/Net/FSP.pm  view on Meta::CPAN

sub _send {
	my ($self, $request) = @_;
	send $self->{socket}, $request, 0 or _check_fatal('Could not send');
	return;
}

sub _replies_pending {
	my $self = shift;
	my $delay = shift || 0;
	return scalar select my $rout = $self->{rin}, undef, undef, $delay;
}

sub _unpack_response {
	my ($self, $response) = @_;
	my %fields;
	@fields{ 'command', 'checksum', 'key', 'message_id', 'length', 'pos', 'fulldata' } = unpack 'CCnnnN a*', $response;
	@fields{ 'data', 'extra' } = unpack "a[$fields{length}]a*", $fields{fulldata};
	return %fields;
}

sub _response_is_correct {
	my ($self, $value_for, $response, $send_command, $send_pos) = @_;
	vec($response, 1, 8) = 0;
	return
	      $value_for->{checksum} == _checksum($response, 0)
	  and length $value_for->{fulldata} >= $value_for->{length}
	  and ($value_for->{command} == $code_for{$send_command} || $value_for->{command} == $code_for{err})
	  and not($pos_must_match_for{ $value_for->{command} } && $send_pos != $value_for->{pos});
}

# the main networking function, known as interact() in the C library.
sub _send_receive {
	my ($self, $send_command, $send_pos, $send_data, $send_extra) = @_;
	$send_extra = '' if not defined $send_extra;

	my $request = $self->_pack_request($send_command, $send_pos, $send_data, $send_extra);
	ATTEMPT:
	for (my $delay = $self->{min_delay} ; $delay < $self->{max_delay} ; $delay *= $self->{delay_factor}) {
		if (not $self->_replies_pending) {
			$self->_send($request);
			next ATTEMPT if not $self->_replies_pending($delay);
		}
		next ATTEMPT if not $self->_receive(\my $response);
		next ATTEMPT if length $response < $HEADER_SIZE;
		my %response = $self->_unpack_response($response);
		next ATTEMPT if not $self->_response_is_correct(\%response, $response, $send_command, $send_pos);
		$self->{key} = $response{key};
		redo ATTEMPT if $response{message_id} != $self->{message_id};

		croak sprintf 'Received error from server: %s', unpack 'Z*', $response{data} if $response{command} == $code_for{err};
		return wantarray ? @response{ 'data', 'extra' } : $response{data};
	}
	croak 'Remote server not responding';
}

#the rest...

sub _make_remote {
	my ($self, $name) = @_;
	my @current = $name =~ m{ \A / }xms ? () : split m{ / }x, $self->{current_dir};
	my @future = grep { !/ \A \.? \z /xms } split m{ / }x, $name;
	for my $step (@future) {
		if ($step eq '..') {
			croak 'Can\'t go outside of root directory' if @current == 0;
			pop @current;
		}
		else {
			push @current, $step;
		}
	}
	return join '/', @current;
}

sub _convert_filename {
	my ($self, $filename, $escaped) = @_;
	my $path = defined $escaped ? $filename : $self->_make_remote($filename);
	return sprintf "%s%s\0", $path, defined $self->{password} ? "\n" . $self->{password} : '';
}

sub _connected {
	my $self = shift;
	return $self->{key} != 0;
}

sub DESTROY {
	my $self = shift;
	$self->say_bye if $self->_connected;
	close $self->{socket} or croak "Couldn't close socket?!: $!";
	return;
}

sub current_dir {
	my $self = shift;
	return $self->{current_dir};
}

sub change_dir {
	my ($self, $newdir) = @_;
	$newdir = $self->_make_remote($newdir);
	$self->_send_receive('get_pro', $NO_POS, $self->_convert_filename($newdir, 1));
	my $olddir = $self->{current_dir};
	$self->{current_dir} = Net::FSP::Dir->new($self, $self->{current_dir}, %{ $self->stat_file($newdir, 1) });
	return $olddir;
}

sub say_bye {
	my $self = shift;
	$self->_send_receive('say_bye', $NO_POS, '');
	$self->{key} = 0;
	return;
}

sub server_version {
	my $self = shift;
	my $version = unpack 'Z*', scalar $self->_send_receive('version', $NO_POS, '');
	chomp $version;
	return $version;
}

sub server_config {
	my $self = shift;