Archivists note: The format statement at or about line 408 of this scripts has been commented. The dot on the line by itself screws up the retrieval for some clients. #!/usr/local/bin/perl # # # gee - gopher environment editor (Version 1.0) # usage: # gee [-t toplevel] [-p port] [-l default_linkfile_name] [-g dirname_file] # Use the -t option to specify toplevel directory # Use the -p option to specify default port # Use the -l option to specify default link file name # Use the -g option to reindex the heirarchy's directories # # copyright (c) Bill Middleton, 1993 All rights reserved # wjm@feenix.metronet.com # # Absolutely No Warranty expressed or implied. Use with care. # Freely redistributable under the same terms as perl. # Send comments, suggestions, and fixes to me please. # # # Initial improvements suggested by Randy Bush, randy@psg.com # More help from moose@sunet.se, and jdc@selway.umt.edu. # Many thanks to these and others who have sent commentary. # To get on the discussion list, drop me a line here at feenix. # # RCS'ed by moose to keep track of things $RCSID = '$Id: gee,v 3.4 93/09/28 23:44:03 wjm Exp $'; # # $Log: gee,v $ # Revision 3.4.1.1 93/09/29 03:12:51 03:12:51 wjm (Bill Middleton) # Last checkin before announcement to the mailing list. One slight # modification to the prompt change mentioned in 3.4, to make it # agree with the actual number of items in the cwd. # # Revision 3.4 93/09/29 02:48:26 02:48:26 wjm (Bill Middleton) # Major fix to the directory selection routine, select_dir(). Reworked # most of moose's fixes to round out the routine nicely. Added a # reference to the main prompt, to the current item number, of the total items # in the cwd. # # Revision 3.3 93/09/27 02:03:14 02:03:14 wjm (Bill Middleton) # small bug in parsef which didnt display correct path on remote # links. fixed. # # Revision 3.2.2.2 93/09/27 01:28:03 01:28:03 wjm (Bill Middleton) # Fixed up file installation to allow the current .cap or .link to # be installed along with the file. If neither exists yet, then # allow creation of one. Deletion of files requires system() without # a list, apparantly because of the argument to rm. Fixed. # # Revision 3.2.2.1 93/09/26 15:21:23 15:21:23 wjm (Bill Middleton) # Fixed nasty little bug getting the type of the item # # Revision 3.2.1.2 93/09/25 03:31:57 03:31:57 wjm (Bill Middleton) # added a little more checking to mv'ing, copying, or linking files to other # directories. Stripped out the descriptor creation code and made it a # subroutine. Fixed most of the system() calls to use a list. # # Revision 3.2.1.1 93/09/24 20:43:01 20:43:01 wjm (Bill Middleton) # Many bugs fixed, and features/options refined. Several new configuration # variables added to deal with gdbm, link entry delimitation, and parsing the # gopherd.conf file. Most of moose's changes left intact, or slightly altered. # Indentation via tabs removed, however. Resolution of link file name for # file/dir in cwd fixed. Otherwise full path displayed. Fixed nuke_cache() # to get .cache+ files too. # # Revision 3.2 93/09/10 13:04:46 13:04:46 wjm (Bill Middleton) # Checked in as 3.2 from 3.1.1.7 # # Revision 3.1.1.7 93/08/26 20:44:03 moose # Implemented simple data entry. Changed subs delete_file and mv_file # so .cap files got the same treatment as the regular file. # Also changed redisplay features of view_lead and related code. # # Revision 3.1.1.6 93/08/25 18:07:48 moose # Made calls to editor prepend full path name, quoted so that # filenames with spaces was kept as one argument. # # Revision 3.1.1.5 93/08/19 12:17:58 moose # merged most edits from 3.1.1.4.1.1, especially the parts # that got commented at last 8^) # # Revision 3.1.1.4 93/08/18 16:22:55 moose # stomped bugs in select_dir: no more paging past start or end, # no hardcoded pagelengths, no 17 lines "End of listing ..." # # Revision 3.1.1.3 93/08/18 14:41:34 moose # stomped link file parsing bug (entries with same path hides each other, # multiple comment lines yielding bogus null entries) # # Revision 3.1.1.2 93/08/17 18:50:50 moose # solved `hostname` problem (chop trailing \n 8^) # # Revision 3.1.1.1 93/08/17 17:54:49 moose # merged 2.2.1.4 with 3.1, one issue remains to be solved. # Also select dir (new 3.1 code) has problems. # # Revision 3.1 93/08/17 14:00:22 wjm # I've done some more work on the Gopher Environment Editor. It needs some # testing tho. I feel pretty good about it, but i wanted to get some testing # before i make it the new default. # Heres a short summary of the fixes: # Now using dbm file for getdirs, and the getdirs code is builtin. # View info for an item now loops until or change info. # Directory selection continues until selection or [Qq]. # Add John's patch, in the form of a call to getopt.pl, to allow command # line parameters for port, toplevel, default link file name, and the # name of the directory-name database. # Shorten some command lines when necessary. (path too long) # Added an option to not view dot-files. # # Revision 2.2.1.4 93/08/13 20:29:14 moose # make read_links parse all link file entries (link file syntax # deduced from gopherd sources: comments are lines starting with a '#' # and link entries are separated by comments. # # Revision 2.2.1.3 93/08/12 22:32:32 moose # Find, read & parse gopherd.conf, ignore suffixes, set types, hostalias. # Hostname equality comparison now recognizes aliases as equal. # # Revision 2.2.1.2 93/08/12 16:57:05 moose # Directorys sorted the same order as gopher (sub bygroup). # Don't show dotfiles, '..' or '.'. Since '..' can't be # selected if it isn't shown, U is added as "select parent dir". # # Revision 2.2.1.1 93/08/10 22:50:52 moose # create branch for my own hacks # # Revision 2.2 93/08/10 17:30:09 wjm # First round tidying up indentation. # # require 'ctime.pl'; require 'getopt.pl'; # Configure Here for your site/preferences $toplevel="/usr/pub/"; # make this your toplevel gopher dir #$thishost='feenix.metronet.com'; # make this your host chop($thishost=`hostname`); # your host knows it's name $plen = 19; # this page length works for 23-24 line terms $ed='/usr/bin/vi'; # or whatever $pager='/usr/local/bin/less'; # or whatever $mv='/bin/mv'; # path to mv $cp='/bin/cp'; # how we copy $rm='/bin/rm -i'; # safe rm $ln='/bin/ln '; # how we link $mkdir='/bin/mkdir '; # how we create directories $rmdir='/bin/rmdir '; # how we delete directories $def_port=70; # default port $using_dir_list=1; # set this if using list of directories $names='.names'; # default .link file, might be .whatever $dirfilename="/admin/info/perldirs"; # opt. dbm file with list of directories $using_gdbm=0; # probably regular [n]dbm $templatefile=".gee/template"; # file with template to fill in for new text $newfileprefix="gee"; # prefix of filename for new entries $dont_show_dotfiles=0; # dont show dot-files $link_delimiter=""; # some use blank lines, others use pound-sign $ignore_files=1; # set to ignore gopherd.conf IGNORE: files $configfile="/usr/etc/gopherd.conf"; # Or wherever your Makefile.config puts it # End configure # get options &Getopt('gtpl'); (defined $opt_t )&&($toplevel=$opt_t); ($toplevel =~/\/$/) || ($toplevel.='/'); (defined $opt_p )&&($def_port=$opt_p); (defined $opt_l )&&($names=$opt_l); (defined $opt_g) &&($dirfilename=$opt_g); # using builtin getdirs if($using_dir_list){ require ("win.pl"); # and an ansi knowledgable term require ("find.pl"); } # get some user stuff (defined $ENV{'EDITOR'}) && ($ed = $ENV{'EDITOR'}); (defined $ENV{'PAGER'})&&($pager = $ENV{'PAGER'}); (defined $ENV{'GOPHERTREE'})&&($toplevel = $ENV{'GOPHERTREE'}); (defined $ENV{'GOPHERCONFIG'})&&($configfile = $ENV{'GOPHERCONFIG'}); &parseconfig; # NEW: config file info system "clear"; $dir='.'; print "Welcome GopherMeister...\n"; if($using_dir_list){ print "Re-Index archive directories for $toplevel? (y|n) > "; $ans=; if($ans=~/^[Yy]/){ if($using_gdbm){ unlink $dirfilename || die "cant unlink old dirfile\n"; }else{ unlink "$dirfilename.pag" || die "cant unlink old dirfile\n"; unlink "$dirfilename.dir" || die "cant unlink old dirfile\n"; } dbmopen(%dirs2,"$dirfilename",0644)||die "cant open $dirfilename"; $findtop=$toplevel; &find($findtop); }else{ dbmopen(%dirs2,"$dirfilename",0666)||die "cant open $dirfilename"; } print "Select starting directory? (y|n) > "; $ans=; if($ans=~/^[Yy]/){ $firstdir=&select_dir; @stack=split('/',$firstdir); $dir = '.'; } } while($dir ne 'last'){ %files=%links=%caps=%cache=%all=(); ($dir eq "..") ? pop(@stack):(($dir ne '.') && push(@stack,$dir)); $ltmpdir=$realdir; $newdir=join('/',@stack); $realdir="$toplevel"."$newdir"; if(!(-d "$realdir")){ print "Bad directory selection, returning to previous directory\n"; $realdir=$ltmpdir; pop(@stack); } chdir $realdir || die "real trouble\n"; $dir=&read_em; } dbmclose(%dirs2); sub parseconfig { # NEW: config file info if((-T $configfile)&&(-r $configfile)){ # if text && readable open(CFG,"<$configfile"); while(){ next if (/(^\s*\#)|(^\s*$)/); # blank or comment ignored chop; if (!/:/) { print sprintf("Bad line: %s", $_); } else { ($token, $rest) = split(/:\s*/); if ($token =~ /^\s*HOSTALIAS\s*$/i) { $thishost = $rest; } elsif ($token =~ /^\s*((VIEW)|())EXT\s*$/i) { ($ext, $chr, @rest) = split(/\s+/, $rest); $gdcType{$ext} = $chr; } elsif ($token =~ /^\s*IGNORE\s*$/i) { push(@gdcIgnore, $rest); } } } close(CFG); } } sub samehost { # NEW: better hostname comparison local($hosta, $hostb)=@_; local($h_namea, $h_nameb, $aliases, $addrtype, $len, $addrs); ($h_namea, $aliases, $addrtype, $len, $addrs) = gethostbyname($hosta); ($h_nameb, $aliases, $addrtype, $len, $addrs) = gethostbyname($hostb); $h_namea eq $h_nameb; } sub bygroup{ local($namea,$typea,$patha,$hosta,$porta,$numba,$statusa)=split('#,#',$all{$a}); local($nameb,$typeb,$pathb,$hostb,$portb,$numbb,$statusb)=split('#,#',$all{$b}); if($numba eq $numbb) { if($namea lt $nameb){ return -1; }elsif($namea gt $nameb){ return 1; }else{ return 0; } }elsif($numba eq ""){ return 1; }elsif($numbb eq ""){ return -1; }elsif($numba < $numbb){ return -1; }else{ return 1; } } sub pause{ 1; } sub read_em{ local($i,$j); local($name,$type,$path,$host,$port,$numb,$status); local(@parse); %files = &read_files; (-d ".cap") && (%caps = &read_caps); %links = &read_links; &pause; for (keys(%files)){ ($name,$type,$path,$host,$port,$numb,$status)=&parsef($_); $path=~s/.*\///; if(defined $links{$_}){ @parse=&parse($_,$links{$_},$name,$type,$path,$host,$port,$numb,$status); $all{$_}=join('#,#',@parse); }elsif(defined $caps{$_}){ @parse=&parse($_,$caps{$_},$name,$type,$path,$host,$port,$numb,$status); $all{$_}=join('#,#',@parse); }else{ next if (/^\.\w/ && $dont_show_dotfiles); $all{$_}=join('#,#',($name,$type,$path,$host,$port,$numb,$status)); } } for (keys(%links)){ next if (defined $all{$_} ); $type=$path=$host='undefined'; $name=$_; $status="OK"; @parse=&parse($_,$links{$_},$name,$type,$path,$host,$port,$numb,$status); $all{$_}=join('#,#',@parse); } for (keys(%caps)){ next if (defined($all{$_})); $type=$path=$host='undefined'; $name=$_; $status="OK"; @parse=&parse($_,$caps{$_},$name,$type,$path,$host,$port,$numb,$status); $all{$_}=join('#,#',@parse); } @keys=sort bygroup keys(%all); system "clear"; for(;;){ if($i>$plen){ # if at bottom of page $l = length($realdir); ($l>44) ? ($c_dir=substr($realdir,$l-43)):($c_dir=$realdir); ($j>$#keys) ? ($tmpj=$#keys+1) : ($tmpj=$j); $tmpk=$#keys+1; print "\ncwd: $c_dir [$tmpj of $tmpk] (h for help) > "; chop($num=); if($num =~ /^[Ff]/){ # forward a page $j += ($plen+1) unless ($j>=$#keys); }elsif($num =~ /^[Bb]/){ # back a page $j -= ($plen+1) unless ($j<=($plen+1)); }elsif($num =~ /^\!(.*)/){ # start a command in cwd system "$1"; print " Carriage Return to continue > "; chop($num=); $dir = '.'; last; }elsif($num =~ /^[Cc]/){ # change directory print "Enter number of directory to change to "; if($using_dir_list){ print ", or a ? to use directory selector > "; chop($c=); }else{ print "> "; chop($c=); } if($using_dir_list){ if($c =~ /^\s*[?]/){ ($c=&select_dir) && ($c=~s/^\/(.*)\/?$/$1/); ($c !~ /\.$/) && (@stack=split('/',$c)); # change the stack $dir='.'; }else{ defined($keys[$c]) ? ($dir=$keys[$c]) : ($dir = '.'); } }else{ defined($keys[$c]) ? ($dir=$keys[$c]) : ($dir = '.'); } last; }elsif($num =~ /^[Hh]/){ # help 'em out &give_a_clue1; }elsif($num =~ /^[Nn]/){ # data entry &edit_new_entry; last; }elsif($num =~ /[Uu]/){ # go up to parent directory $dir='..'; last; }elsif($num =~ /[Qq]/){ # quit $dir='last'; last; }elsif(($num =~/^\d/) && ($num <= $#keys)){ # see details about item $num = &view_lead($keys[$num]); $dir='.'; last if ($num == -1); } $j-=($plen+1); system "clear"; $- = 0; $i=0; next; }else{ # else print next item on current page $t="$j>"; ($j==0 )&&($t='0>'); if($j > $#keys) { $t=undef; @a=(""); } else { @a = split('#,#',$all{$keys[$j]}); } write; $i++; $j++; } } $- = 0; # reset top of page, for header $dir; # return the directory } #format STDOUT = #@<<< @<<<<<<<<<<<<<<<<<<<< @| @||||||||||||||| @<<<<<<<<<<<<<< @>>> @||| @>>>>> #$t,$a[0],$a[1],$a[2],$a[3],$a[4],$a[5],$a[6] #. # #format STDOUT_TOP = #Num Name Type Path Host Port Numb Status #------------------------------------------------------------------------------- #. sub read_caps{ local(%tmp,@files); # read the .caps files corresponding to the current dir opendir(CURDIR,".cap") || return; @files = grep(!/^\.\.?$/, readdir(CURDIR)); $/=""; for (@files){ @stat=stat(".cap/$_"); if((-T _)&&(-r _)&&(-e $_)){ if(!((($stat[2] >> 6) & 04)&&(($stat[2] >> 3) & 04)&&($stat[2] & 04))){ $tmp{$_}.=".cap/$_ : not world readable\n"; }else{ $tmp{$_}.=".cap/$_: world readable\n"; } open(CAP,"<.cap/$_"); $entry =; close CAP; $tmp{$_} .= "$entry"; }else{ $tmp{".cap/$_"} .= "ERROR in .cap/$_,\n not a regular text file, or not readable,\nor corresponding $_ does not exist\n"; } } $/="\n"; %tmp; } sub read_links{ local(%tmp,@files,$i); local($name,$type,$path,$host,$status,$counter); # read the .link(s) files corresponding to the cwd opendir(CURDIR,"."); @files = grep(/^\.\w.*$/, readdir(CURDIR)); $/=$link_delimiter; $i=$counter=1; for $f (@files){ next if ($f =~ /.cache/); next if (-d "./$f"); if((-T $f)&&(-r $f)){ open(LINK,"<$f"); while(){ ($name,$type,$path,$host,$port,$numb,$status)=&parse($f,$_); if($status ne "VOID") { (defined $tmp{$path}) && ($path.=$counter++); # handle multiplicity $tmp{$path} ="$f\n$_"; } } close(LINK); }else{ $tmp{$f} = "Not a regular .link or .names file,\n or not readable."; } } $/="\n"; %tmp; } sub read_files{ local (%tmp); local($i); local(@files); opendir(CURDIR,"."); @files = grep(!/^\./, readdir(CURDIR)); closedir CURDIR; FILENAME: for (@files){ if($ignore_files){ for $ext (@gdcIgnore) { if (/$ext$/) { next FILENAME; } } } $tmp{$_}=join('/',grep(/[\S]/,@stack))."/$_"; @stat=stat($_); $r = ((($stat[2] >> 6) & 04)&&(($stat[2] >> 3) & 04)&&($stat[2] & 04)); $x = ((($stat[2] >> 6) & 01)&&(($stat[2] >> 3) & 01)&&($stat[2] & 01)); if(-d _){ $tmp{$_}.=" : Dir"; (!$x) && ($tmp{$_}.= ": NOT world scannable"); $tmp{$_}.="\n"; } if(-f _){ (-T _) ? ($tmp{$_}.=" : Text\n"):($tmp{$_}.=" : NoTxt\n"); } if(!(-r _)){ $tmp{$_}.="ERROR not readable:"; }elsif(!$r){ $tmp{$_}.="Not world readable :"; }else{ $tmp{$_}.="World readable :"; } if(-l "$_"){ $realname=readlink($_); $tmp{$_}.=" symlink to $realname\n"; }elsif((-f _)||(-d _)){ $tmp{$_}.=" regular file or dir\n"; }else{ $tmp{$_}.=" not regular file or dir\n"; } $tmp{$_}.="Owner: ".getpwuid($stat[4])." Group: ".getgrgid($stat[5])."\n"; $tmp{$_}.="atime: ".&ctime($stat[8]); $tmp{$_}.="ctime: ".&ctime($stat[10]); } %tmp } sub give_a_clue1{ local ($ans); system "clear"; print <<"HelpEnd"; Gopher Environment Editor - Main Menu Help All commands must be followed by a carriage return At the main menu of items you can enter the following commands: [number] view item stat info and .cap/.link/.name info, if any c change to directory [entry number] u change to parent directory h This help section n make a new entry (edit a template in your favourite editor) f forward page or same page at end b back a page or same page at beginning q quit !command execute command in current dir HelpEnd print "\n to continue >"; $ans=; } sub edit_new_entry { # NEW: data entry $tmp = $newfileprefix . time; print "Edit a new entry as a plain text file.\n"; while ($tmp ne "") { $newfilename = $tmp; print "Filename OK? or change name ($newfilename) > "; chop($tmp=); } if (defined($templatefile) && $templatefile ne "") { print "Start with a fill-in-the-blanks template\n" . "copied from $templatefile\n"; system "$cp","$templatefile","$realdir/$newfilename"; } system "$ed","$realdir/$newfilename"; $files{$newfilename} = "$newfilename:T\nfoo\n"; &change_display($newfilename); return -1; } sub view_lead{ local($key) = @_; local(@text)=(); local($done)=1; local($ans)=1; defined($files{$key}) ? (@finfo=split(/\n/,$files{$key})):(@finfo=("None")); $l = length($files[0]); ($l>58) && ($files[0]=substr($files[0],$l-57)); defined($caps{$key}) ? (@cinfo=split(/\n/,$caps{$key})):(@cinfo=("None")); defined($links{$key}) ? (@linfo=split(/\n/,$links{$key})):(@linfo=("None")); @lines=("Stat info: ",@finfo,'', ".cap file info:",@cinfo,'',".link or .name file info:",@linfo); while($done > 0){ system "clear"; local($i,$tmp); $header=substr($key,0,30); print "Displayed Info: $header\n\n"; for (@lines){ print "$_\n"; } print "\nEnter key, or h for help, to return to main menu > "; chop($ans=); last if !(length($ans)); $done = &do_sumthin($ans,$key); } return $done; } sub do_sumthin{ local($ans,$key)=@_; local($status); if($ans =~ /^[Dd]/){ ($status = &delete_file($key)) && return $status; }elsif($ans =~ /^[Ee]/){ ($status = &change_display($key,$realdir)) && return $status; }elsif($ans =~ /^[Hh]/){ &give_a_clue2; }elsif($ans =~ /^[Mm]/){ ($status = &mv_file($key)) && return $status; }elsif($ans =~ /^[Vv]/){ &view_file($key); }else{ print "\nBad Option\n"; sleep 1; } 1; } sub view_file{ local ($key)=@_; system "$pager","$key"; } sub mv_file{ local ($key)=@_; local(@tmp,$i,$d,$newdir); system "clear"; print "\n\nThe following selections are available:\n\n"; print "1> $mv $key to another directory\n"; print "2> $cp $key to another directory\n"; print "3> $ln $key to another directory\n"; print "4> Forget about this altogther.\n\n"; print "Select the number of your choice > "; chop($ans=); (($ans>3)||($ans <1)) && (print "aborting\n") && (return); ($ans==1) && ($com = $mv); ($ans==2) && ($com = $cp); ($ans==3) && ($com = $ln); if(-T $key){ print "View file $key now? (y|n) > "; chop($tmp=); ($tmp=~/^[Yy]/) && &view_file($key); } print "Enter new dir for $key from toplevel"; ($using_dir_list) ? (print ", ? to use selector\n > "):(print "\n > "); chop($d=); ($d =~ /^\s*[?]/) && (($d=&select_dir) && ($d=~s/^\/?(.*)\/?$/$1/)); $newdir=$toplevel.$d; system "clear"; print "\n$com $key to $newdir ? (y|n) > "; $ans=; ($ans=~/^[Nn]/) && return; if(-d $newdir){ (system "$com","$key","$newdir") && (warn "That didnt work") && return; if (defined $caps{$key}){ print "\nInstall old .cap file? (y|n) > "; $ans=; ($ans=~/^[Nn]/) && return; if (! -d "$newdir/.cap") { system "$mkdir","$newdir/.cap"; } (system "$com",".cap/$key","$newdir/.cap/$key"); print "\nVerify installation of item in $newdir? (y|n) > "; $ans=; ($ans=~/^[Nn]/) && return; chdir $newdir; &change_display($key,$newdir); chdir $realdir; }elsif(defined $links{$key}){ print "\nAppend current link entry to $newdir/$names? (y|n) > "; $ans=; ($ans=~/^[Nn]/) && return; open(LINK,">>$newdir/$names")|| (print "Aak!") && (sleep 1) && return; @tmp=split('\n',$links{$key}); print LINK "$link_delimiter\n"; for($i=1;$i<=$#tmp;$i++){ print LINK "$tmp[$i]\n"; } close LINK; print "\nVerify installation of item in $newdir? (y|n) > "; $ans=; ($ans=~/^[Nn]/) && return; chdir $newdir; &change_display($key,$newdir); chdir $realdir; }else{ print "\nCreate new descriptor for $newdir/$names? (y|n) > "; $ans=; ($ans=~/^[Nn]/) && return; chdir $newdir; &change_display($key,$newdir); chdir $realdir; } return -1; # dir has changed }else{ print "Dir $d does not exist\n"; } 1; } sub delete_file{ local ($key)=@_; system "clear"; local($summary,$done); print "Are you sure you want to delete this file? (Y|N) >"; $summary=; if($summary=~/^[Yy]/){ $! = ""; # CHANGED: this tripped the logic sometimes system("$rm $key"); $! && ((print"not deleted ($!)\n"), sleep 1, return); if (-w ".cap/$key") { # NEW: care for .cap files too system("$rm ./.cap/$key"); $! && ((print "corresponding .cap file not deleted ($!)\n"), sleep 1, return); } print "deleted...\n" ; sleep 1; return -1; # dir has changed } print "not deleted...\n"; sleep 1; } sub give_a_clue2{ local ($ans); system "clear"; print <<"HelpEnd"; Gopher Environment Editor - File Info Help All commands must be followed by a carriage return While viewing info on an item you can enter the following commands: d delete this file from the archive e change/create displayed info for this item h This help section v view this file m mv, cp, or ln this file somewhere else [use dir list] HelpEnd print "\n to continue >"; $ans=; } sub change_display{ local($f,$realdir)=@_; local($name,$type,$path,$host,$port,$numb,$status); if(-T $f){ print "View file $f now? (y|n) > "; chop($tmp=); ($tmp=~/^[Yy]/) && &view_file($f); } if(defined($links{$f})){ ($file)=split('\n',$links{$f}); print "Edit the link $f in $file now? (y|n) > "; $ans=; $ans =~ /[Nn]/ && return; system "$ed" , "$realdir/$file"; # CHANGED: some editors doesn't take $CWD print "Did you make changes? (y|n) > "; # plus filenames may contain spaces $ans=; $ans =~ /[Nn]/ && return; &nuke_cache || die "cant nuke the .cache file\n"; return -1; # dir has changed }else{ ($name,$type,$path,$host,$port,$numb,$status)=&parsef($f); if(defined($caps{$f})){ ($name,$type,$path,$host,$port,$numb,$status)= &parse($f,$caps{$f},$name,$type,$path,$host,$port,$numb,$status); print "File already has a .cap entry, overwrite? (y|n) > "; chop($ans=); if($ans =~ /^[Nn]/){ print "Edit the .cap file for $f? (y|n) > "; chop($ans=); $ans =~ /^[Nn]/ && return; system "$ed" , "$realdir/.cap/$f"; print "Did you make changes? (y|n) > "; $ans=; $ans =~ /[Nn]/ && return; &nuke_cache || die "cant nuke the .cache file\n"; return -1; # dir has changed } } $ans="n"; $entry=&create_descriptor($f,$name,$type,$path,$host,$port,$numb); system "clear"; print $entry."\n\n\n"; print "1> Create this .cap file\n"; print "2> Append this entry to $names file\n"; print "3> Forget this entry\n"; print "Select the number of your choice > "; chop($ans=); if($ans==1){ &nuke_cache || die "cant nuke the .cache file\n"; (-d ".cap") || mkdir(".cap",0755) || die "cant create .cap dir\n"; open(CAP,">.cap/$f")||die "cant open the .cap file"; print CAP $entry; close CAP; return -1; # dir has changed }elsif($ans==2){ &nuke_cache || die "cant nuke the .cache file\n"; open(NAMES,">>$names")||die "cant open $names\n"; print NAMES "\n$entry\n"; close NAMES; return -1; # dir has changed } } } sub parsef{ local($name)=@_; local(@l,$type,$path,$host,$port,$numb,$status); $status='OK'; $numb=undef; $port=$def_port; @l=split('\n',$files{$name}); ($path,$type) = split(':',$l[0]); $type=&get_type($type,$name); $path=~s/\s*$//; $host=$thishost; $files{$name} =~ /(ERROR)/ && ($status=$1); ($name,$type,$path,$host,$port,$numb,$status); } sub parse{ local($actname,$entry,$name,$type,$path,$host,$port,$numb,$status)=@_; local($gotit, $gotany); $entry =~ /\nName=(.*)\s*\n{1,1}/ && ($name=$1, $gotany=1); $entry =~ /\nType=(.*)\s*\n{1,1}/ && ($type=$1, $gotany=1); $entry =~ /\nPath=([\dm])?(.*)\s*\n{1,1}/ && ($type=$1, $gotany=1,$path=$2,$gotit=1); $entry =~ /\nHost=(.*)\s*\n{1,1}/ && ($host=$1, $gotany=1); $entry =~ /\nPort=(.*)\s*\n{1,1}/ && ($port=$1, $gotany=1); $entry =~ /\nNumb=(.*)\s*\n{1,1}/ && ($numb=$1, $gotany=1); if((! defined $host)||($host eq "+")||($host eq $thishost)||(&samehost($host, $thishost))){ $tmp = $path; $tmp =~s/.*\///; if(length $tmp){ (-e "./$tmp") && $gotit && ($path=$tmp); $type=&get_type($type,$path); } }else{ $type=&get_type($type,$actname); } if ($entry =~ /(ERROR)/) { $status=$1; } elsif (!$gotany) { $status="VOID"; } ($name,$type,$path,$host,$port,$numb,$status); } sub nuke_cache{ (-f ".cache") && (unlink(".cache") || return 0); (-f ".cache+") && (unlink(".cache+") || return 0); return 1; } sub do_new_cache{ (-f ".cache") && unlink(".cache") || die "you cant do that"; } sub get_type{ local($type,$name)=@_; local(@dots,$tmp); @dots = split('\.', $name); # handle type conversions ((-d $name)||($type=~/^\s*[D1]/)) && ($tmp=1); ((-T $name)||($type=~/^\s*[T0]/)) && ($tmp=0); (defined $gdcType{".$dots[$#dots]"}) && ($tmp = $gdcType{".$dots[$#dots]"}); (defined $tmp)||($tmp=$type); $tmp; } sub select_dir{ system("clear"); local(@b); local(@text)=(); local($key); $title='Select preferred directory'; $footer='b = back a page, q = quit, /[keyword] = search'; local($i,$j); local(@win)=(1,22,79,1,0,7,$title,$footer); &win'title(@win); &win'footer(@win); @b= sort(keys(%dirs2)); for ($i=0,$j=0;;$i++,$j++){ if($j==$plen){ # buffer full, refresh screen &win'refresh(scalar(@text),@text,scalar(@win),@win); ($i>$#b) ? ( $tmp=&win'getdata(1,$plen+4,"select dir number or B to go back >",7) ):( $tmp=&win'getdata(1,$plen+4,"select dir number or for more >",7) ); ($tmp=~/^[Qq]/) && last; ($tmp =~ /^\d/) && (defined($b[$tmp])) && (return($b[$tmp])); if(($tmp =~ /^\/(.*)\n?$/) && ($key = $1)){ $tmp2=$i; for(;$i <= $#b;$i++){ last if ($b[$i] =~ /$key/); if($i>=$#b){ &win'getdata(1,$plen+4,"Not Found, to continue >",7); $i=$tmp2; last; } } }elsif($tmp =~ /^[Bb]/){ $i -= (2*$plen); ($i<0) && ($i=0); } ($i>$#b) && ($i-=$plen); $j=0; ($i>$#b) ? ($text[$j] = "") : ($text[$j] = "$i> $b[$i]"); }else{ if($i>$#b){ $text[$j]=""; }else{ $text[$j] = "$i> $b[$i]"; } } } return ('.'); } sub wanted{ local($tmp)=$name; if(-d "$tmp"){ ($tmp =~ /\.cap/) && return; # comment this to keep .cap dirs in list ($tmp =~ /\.index\/?/) && return; # comment this to keep .index dirs in list $tmp =~ s/^$toplevel\/?(.*)$/$1/; # must get rid of $toplevel in full path return unless (length($tmp)); $dirs2{$tmp}=1; } } sub create_descriptor{ local($f,$name,$type,$path,$host,$port,$numb)=@_; while($ans !~ /^[Yy]/){ print "Enter Displayed name for item: [$name] \n> "; chop($tmp=); (length($tmp) > 0) && ($name=$tmp); if(defined($numb)){ print "Enter Numb for file: [$numb]\n> "; chop($tmp=); (length($tmp) > 0) && ($numb=$tmp); } print "Enter Type for file: [$type]\n> "; chop($tmp=); (length($tmp) > 0) && ($type=$tmp); print "Use a \"Host=\" entry for this item? (y|n) > "; $tmpH=; if($tmpH=~/^[Yy]/){ print "Enter Host for file: [$host]\n> "; chop($tmp=); (length($tmp) > 0) && ($host=$tmp); } print "Use a \"Port=\" entry for this item? (y|n) > "; $tmpPo=; if($tmpPo=~/^[Yy]/){ print "Enter Port for file: [$port]\n> "; chop($tmp=); (length($tmp) > 0) && ($port=$tmp); } print "Use a \"Path=\" entry for this item? (y|n) > "; $tmpPa=; if($tmpPa=~/^[Yy]/){ $path="./$f"; print "Enter Path for file: [./$f]\n> "; chop($p=); (length($p) > 0) && ($path=$p); $path=~s/\s*$//; } $entry="Name=$name\n"; if(defined($numb)){ $entry.="Numb=$numb\n"; } $entry.="Type=$type\n"; if($tmpH=~/^[Yy]/){ $entry.="Host=$host\n"; } if($tmpPo=~/^[Yy]/){ $entry.="Port=$port\n"; } if($tmpPa=~/^[Yy]/){ $entry.="Path=$path\n"; } print "\n$entry\n\n"."This look ok? (y|n) > "; $ans=; } $entry; }