view release on metacpan or  search on metacpan

eg/pftp  view on Meta::CPAN

#!/usr/bin/env perl
#
#       Copyright (c) 1997 Hiroo Hayashi.  All Rights Reserved.
#
#       This program is free software; you can redistribute it and/or
#       modify it under the same terms as Perl itself.

=head1 NAME

pftp - an ftp client with the GNU Readline support

=head1 SYNOPSIS

B<pftp> [B<-u>] [B<-g>] [B<-M>] [B<-h>] [B<-d>] [I<host>]

=head1 DESCRIPTION

This is an ftp client which has the GNU Readline support.  It can
complete not only local file name but also remote file name and host
name to which login.

This is a sample program of Perl Term::ReadLine::Gnu module.

=cut

use Term::ReadLine;
use strict;
use warnings;
use Net::Domain qw(hostdomain); # libnet
use Net::FTP;                   # libnet-1.05 or later is recommended
use File::Listing;              # libwww (for parse_dir)
use Getopt::Std;
use Cwd;                        # for getcwd

use vars qw($AUTOLOAD
            $opt_d $opt_u $opt_g $opt_M $opt_h);

sub usage {
    print STDERR <<"EOM";
usage : $0 [-d] [-i] [-u] [-g] [-M] [-h] host
        -d : debug mode
        -i : interactive mode (not implemented)
        -u : disable autologin
        -g : turn off glob
        -M : show manual page
        -h : show this message
EOM
    exit 0;
}

getopts('dugMh') or &usage;
&man if $opt_M;
&usage if $opt_h;

#
#       setup Term::ReadLine::GNU
#
my $HOSTFILE = ($ENV{HOME} || (getpwuid($<))[7]) . "/.pftp_hosts";

my $term = Term::ReadLine->new('PFTP');
my $attribs = $term->Attribs;
$term->ornaments('md,me,,');    # bold face prompt

#
#       read hostname to which login
#
my $host;
my @hosts = read_hosts($HOSTFILE);
if (@ARGV) {
    $host = shift;
} else {
    $attribs->{completion_word} = \@hosts;
    $attribs->{completion_append_character} = '';
    $attribs->{completion_entry_function} =
        $attribs->{'list_completion_function'};
    no warnings 'uninitialized'; # in case of typing ^D
    $host = $term->readline('hostname> ') . '';
    $host =~ s/^\s+//;
    $host =~ s/\s+$//;
    $attribs->{completion_append_character} = ' ';
    $attribs->{completion_entry_function} = undef;
}

#
#       make ftp connection
#
my $ftp = Net::FTP->new($host,
                        Debug => $opt_d);
die "$0: cannot connect \`$host\'\n" unless $ftp;

print STDERR $ftp->message;
write_hosts($HOSTFILE, $host, @hosts);

#
#       login
#
my $login = 'anonymous';
my $password = (getpwuid($<))[0] . '@' . hostdomain;
if ($opt_u) {
    $login = $term->readline('login name> ', $login);

    # mask typed characters for password
    $attribs->{redisplay_function} = $attribs->{shadow_redisplay};
    $password = $term->readline('password> ', $password);
    undef $attribs->{redisplay_function};
}

$ftp->login($login, $password) or die "$0: cannot login: " . $ftp->message;
print STDERR $ftp->message;

$ftp->binary;                   # default binary
print STDERR $ftp->message;

my $pwd = $ftp->pwd;
print STDERR $ftp->message;

#
#       setup completion function
#
my @ftp_cmd_list = qw(cwd cd pwd ls dir get mget put mput lcd help);

# completion_display_match_hook is supported by GNU Readline Library
# 4.0 and later.  Earlier versions ignore it.

$attribs->{attempted_completion_function} = sub {
    my ($text, $line, $start, $end) = @_;
    if (substr($line, 0, $start) =~ /^\s*$/) {
        $attribs->{completion_word} = \@ftp_cmd_list;
        undef $attribs->{completion_display_matches_hook};
        return $term->completion_matches($text,
                                         $attribs->{'list_completion_function'});
    } elsif ($line =~ /^\s*(ls|dir|get|mget)\s/) {
        $attribs->{completion_display_matches_hook} = \&ftp_display_match_list;
        return $term->completion_matches($text,
                                         \&ftp_filename_completion_function);
    } elsif ($line =~ /^\s*(cd|cwd)\s/) {
        $attribs->{completion_display_matches_hook} = \&ftp_display_match_list;
        return $term->completion_matches($text,
                                         \&ftp_dirname_completion_function);
    } else {                    # put mput lcd
        undef $attribs->{completion_display_matches_hook};
        return ();              # local file name completion
    }
};

#
#       Command loop
#
$SIG{INT} = 'IGNORE';           # ignore Control-C

while (defined($_ = $term->readline("$login\@$host:$pwd> "))) {
    no strict 'refs';
    next if /^\s*$/;
    my ($cmd, @args) = $term->history_tokenize($_);
    if ($cmd eq 'quit' || $cmd eq 'bye') {
        last;
    }
    my $func = "cmd_" . $cmd;