Beefy Boxes and Bandwidth Generously Provided by pair Networks
Come for the quick hacks, stay for the epiphanies.
 
PerlMonks  

ftpsearch.pl

by xern (Beadle)
on Aug 22, 2002 at 17:43 UTC ( [id://192101]=sourcecode: print w/replies, xml ) Need Help??
Category: FTP stuff
Author/Contact Info xern
Description: ftp-(index|query) w/ Curse::UI Some variables are not well named. :-/ 


#!/usr/bin/perl
use strict;
use Curses::UI;
use Data::Dumper;
use OurNet::FuzzyIndex;
use Net::FTP;

######################################################################
# It's for localization                                               
######################################################################
use constant FS_PREFIX   => "$ENV{HOME}/.ftpsearch";                  
use constant CONFIGFILE   => FS_PREFIX.'/ftp-config';
use constant PROGNAME     => 'FTPsearch';            
use constant YES          => 'Yes';      
use constant NO           => 'No'; 
use constant EXIT_TITLE   => 'EXIT';
use constant EXIT_MSG     => 'Sure to exit?';
use constant SAVE_TITLE   => 'SAVE';         
use constant DELETE_TITLE => 'DELETE';
use constant DELETE_BUTT  => DELETE_TITLE;
use constant UPDATE_BUTT  => 'UPDATE';    
use constant SW_TITLE     => 'Site Management';
use constant IW_TITLE     => 'Index';          
use constant QW_TITLE     => 'Query';
use constant IS_TITLE     => 'Indexing Status';
use constant SLB_TITLE    => 'Sites';          
use constant ILB_TITLE    => 'Sites';
use constant NS_PROMPT    => 'NEW A SITE';
use constant QUERY_PROMPT => 'QUERY:';    
use constant DATA_CORRUPT => 'DATA CORRUPTION';
use constant ANONYMOUS    => 'anonymous';      
use constant ANONYMEMAIL  => 'q@q.q';    
use constant YESORNO      => [       
                              {-label=>YES,-value => 1},
                              {-label=>NO, -value => 0},
                              ];                        
use constant HINT         =>    
"<CTRL+S>: Site Management <CTRL+X>: Index <CTRL+Q>: query <CTRL+C>: q
+uit";
use constant MATCH_STYLE  => $MATCH_EXACT;                            
+     


######################################################################
# Loading Configuration
######################################################################
$Data::Dumper::Terse++;
mkdir FS_PREFIX;
my $CONF = do( CONFIGFILE);
die "CONFIG ERROR" if $@;


######################################################################
# Build up windows
######################################################################

my $cui = new Curses::UI;
my $win1 = $cui->add('win1','Window',
                     -title => PROGNAME, -y => -4, -border => 1,);
my $whints = $cui->add('hints', 'Window', -border => 0,  -y => -1,);
$whints->add(undef, 'Label', -y => -1, -text => HINT,);

my %wttl = ('S' => SW_TITLE, 'I' => IW_TITLE, 'Q' => QW_TITLE);
my %w=();
for(keys %wttl){
    $w{$_} =
        $cui->add($_, 'Window', -title => $wttl{$_},
                  -padtop  => 2, -padbottom => 3, -ipad => 1,
                  );
}


######################################################################
# Index
######################################################################
my $s2i = $w{I}->add('sites', 'Listbox', -title => ILB_TITLE,
                     -x => 0, -y => 0, -width => 20,-padbottom => 5,
                     -border => 1,-multi => 1, -values => [ keys (%$CO
+NF)] ,
                     );
$w{I}->add('indexlist', 'Buttonbox',  -y => -3,
           -buttons => [{-label => "< Index >",
                         -onpress => 
                             sub{
                                 my $this = shift;
                                 my $s= $this->parent->getobj('sites')
+;
                                 ftp_index($s->get());
                             }},
                        ],
           );

my $indexstat =
    $w{I}->add('indexstat', 'TextEditor',
               -title => IS_TITLE,
               -x=>26, -y=>0,-border=>1, -readonly=>1,
               -padright => 5, -padbottom=>5, -padtop => 1,
               );


######################################################################
# Site Management
######################################################################

my@attr = qw/SITE PORT USER PASS ROOT/;
my $s2m =
 $w{S}->add(
            'sites', 'Listbox',     -title => SLB_TITLE,
            -x => 2, -y => 2, -width => 20, -padbottom => 3,
            -border => 1,
            -values    => [keys (%$CONF), '', NS_PROMPT],
            -onChange =>
            sub{
                my $this = shift;
                my $abbrv = $this->get();
                if( $abbrv eq NS_PROMPT){
                    $this->parent->getobj("ABBRV")->text('');
                    $this->parent->getobj($_)->text('') for@attr;
                    $this->parent->getobj("ABBRV")->focus;
                }
                elsif( $abbrv && $CONF->{$abbrv}){
                    $this->parent->getobj("ABBRV")->text($abbrv);
                    $this->parent->getobj($_)->text($CONF->{$abbrv}->{
+$_})
                        for@attr;
                }
                else{
                    $this->parent->getobj("ABBRV")->text('');
                    $this->parent->getobj($_)->text('') for@attr;
                }

            },
           );

$w{S}->add("labelABBRV", 'Label', -x=>30, -y=>3, -text=>'ABBR');
$w{S}->add("ABBRV", 'TextEntry', -x=>35, -y=>3, -width=>30, -sbborder=
+>1);

for(0..4){
    $w{S}->add("label$_", 'Label', -x => 30, -y=>(5+$_), -text => $att
+r[$_],);
    $w{S}->add("$attr[$_]", 'TextEntry',
               -x => 35, -y=>(5+$_), -width => 30, -sbborder => 1,
               );
}

sub check_save{
    my $this = shift;
    my $s= $this->parent->getobj("sites")->get();
    my($corrupt, %data);
    $data{$_} = $this->parent->getobj($_)->get() for(@attr);
    $data{ABBR} = $this->parent->getobj("ABBRV")->get();
    $corrupt = 1 unless $s;
    $corrupt = 1 if $data{PORT} !~ /^\d+$/o;
    $data{USER} = ANONYMOUS unless $data{USER};
    $data{PASS} = ANONYMEMAIL if $data{USER} eq ANONYMOUS;
    $data{ROOT} = '/' unless $data{ROOT};
    if( $corrupt){
        $cui->status(DATA_CORRUPT);
        sleep 1;
        $cui->nostatus;
        return;
    }
    $s = $data{ABBR};
    $CONF->{$s} = \%data;
    my $stdata = join qq/\n/,map {"$_ => $data{$_}"} sort keys %data;
    delete $data{ABBR};
    my $save =
        $cui->dialog(-title   => SAVE_TITLE,
                     -buttons => YESORNO,
                     -message => $stdata,);
    if($save){
        open F, ">", CONFIGFILE or die;
        print F Dumper $CONF;
        close F;
    }
    $s2m->{-values} = [keys (%$CONF), '', NS_PROMPT];
    $this->parent->getobj("sites")->draw();
    $this->parent->getobj("sites")->focus;
    $w{I}->getobj("sites")->{-values} = [keys (%$CONF)];
    $w{I}->getobj("sites")->intellidraw;
}

sub check_delete{
    my $this = shift;
    my $abbr = $this->parent->getobj("sites")->get();
    return unless $abbr;

    my $save =
        $cui->dialog(
                     -title   => DELETE_TITLE,
                     -buttons => YESORNO,
                     -message => DELETE_TITLE." <$abbr>?",
                     );
    if($save){
        delete $CONF->{$abbr};
        open F, ">", CONFIGFILE or die;
        print F Dumper $CONF;
        close F;
    }
    $s2m->{-values} = [keys (%$CONF), '', NS_PROMPT];
    $this->parent->getobj("sites")->draw();
    $this->parent->getobj("sites")->focus;

    $w{I}->getobj("sites")->{-values} = [keys (%$CONF)];
    $w{I}->getobj("sites")->intellidraw;
}

$w{S}->add('modify', 'Buttonbox', -x=> 30, -y => 11,
           -buttons => [
                        {-label => '< '.UPDATE_BUTT.' >',
                         -onpress => \&check_save},
                        {-label => '< '.DELETE_BUTT.' >',
                         -onpress => \&check_delete},
                        ],
           );

######################################################################
# QUERY
######################################################################

my $qres=
$w{Q}->add('qres', 'TextEditor', -border => 0, -x => 0, -y => -6,
           -readonly => 1, -vscrollbar => 1, );
$w{Q}->add(undef, 'Label', -y => -3, -text => QUERY_PROMPT, );

my $queryentry =
    $w{Q}->add('query', 'TextEntry', -y => -2, -x => 10,  -border => 1
+,
               -padright=>5, -onBlur => sub{ftp_query(shift()->get())}
+,
               );


######################################################################
# Core
######################################################################
sub isd { 1 if $_[0] =~ /^[dl]/o }

sub name{
    my $t= $_[0];
    $t=~s/^(?:.+?\s+){8}(.+)$/$1/o;
    $t = $1 if $_[0] =~ /^l/o && $t=~/->\s*(.+)$/o;
    $t;
}

sub ftp_index{
    my ($stat, @result);
    my @abbrs=@_;
    my$pfd;

    $SIG{CHLD} = 'IGNORE';

    foreach my $abbr (@abbrs){
        my $r = $CONF->{$abbr};
        my $idxfile  = FS_PREFIX."/ftpidx-$abbr.idx";
        my ($ftp);
        pipe ($pfd->{$abbr}->{rd}, $pfd->{$abbr}->{wd});

        my $pid = fork;
        
        close $pfd->{$abbr}->{wd} if $pid;
        unless ($pid){
            close $pfd->{$abbr}->{rd};
            $ftp = Net::FTP->new($r->{SITE}, Port => $r->{PORT}, Debug
+ => 0);
            $ftp->login($r->{USER},$r->{PASS}) or exit;
        
            unlink $idxfile if -e $idxfile;
            my $db = OurNet::FuzzyIndex->new($idxfile, undef, undef, 0
+);
        
            my @queue = ($r->{ROOT});
            my $c=0;
            for my $p (@queue){
                for($ftp->dir($p)){
                    my$n=name($_);
                    next if $n =~ /^\.\.?/o;
                    (my$t =join '/', $p, $n) =~ s/\/+/\//o;
                    $c++;
                    $stat =join qq/\n/, @result,
                    (qw~/ | \ -~)[$c%4]." <$abbr> $c : $n";
                    (isd $_) ?  push (@queue,$t ) :
                                print {$pfd->{$abbr}->{wd}} "$stat\n";
                    $db->insert($t,$t);
                }
            }
            $ftp->quit;
            exit;
        }
    }
    while(1){
        my $text = undef;
        for(@abbrs){ my $p=$pfd->{$_}->{rd};   $text .= <$p>; }
        return unless $text;
        $indexstat->text($text);
        $indexstat->draw;
    }
}


sub ftp_query{
    my $t;
    foreach my $abbr (sort keys %$CONF){
        my $idxfile  = FS_PREFIX."/ftpidx-$abbr.idx";
        my $db = OurNet::FuzzyIndex->new($idxfile, undef, undef, 0);
        my %result = $db->query($_[0], MATCH_STYLE);
        $t .= "<$abbr> ".$db->getkey($_)."\n" for sort keys %result ;
    }
    $qres->text($t);

}


######################################################################
# Dialogues
######################################################################
sub exit_dialog()
{
    my $return =
        $cui->dialog(-title=>EXIT_TITLE,
                     -message=>EXIT_MSG,
                     -buttons=>YESORNO,
                     );

    exit(0) if $return;
}
sub about_dialog(){
    $cui->dialog(-title => 'About FTPsearch',
                 -message => q/Copyright by xern <b88045@csie.ntu.edu.
+tw>/,
                 );
}



######################################################################
# Key Bindings
######################################################################
$cui->set_binding(\&exit_dialog,           "\cC");
$cui->set_binding(sub{$win1->focus},       "\cW");
$cui->set_binding(sub{$s2m->focus},        "\cS");
$cui->set_binding(sub{$w{I}->focus},       "\cX");
$cui->set_binding(sub{$queryentry->focus}, "\cQ");
$cui->set_binding(\&about_dialog,          "\cZ");

######################################################################

$cui->mainloop;

Back to Code Catacombs

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?

www.com | www.net | www.org
Node Status?
node history
Node Type: sourcecode [id://192101]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? • Last hour • Other CB clients
Other Users?
Others chilling in the Monastery: (7)
As of 2024-04-18 03:03 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found