#!/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;
|