#!/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 => ": Site Management : Index : query : quit"; 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 (%$CONF)] , ); $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 => $attr[$_],); $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 /, ); } ###################################################################### # 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;