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 <CR> 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=<STDIN>;
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=<STDIN>;
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(<CFG>){
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=<STDIN>);
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=<STDIN>);
$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=<STDIN>);
}else{
print "> ";
chop($c=<STDIN>);
}
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 =<CAP>;
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(<LINK>){
($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<CR> to continue >";
$ans=<STDIN>;
}
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? <CR> or change name ($newfilename) > ";
chop($tmp=<STDIN>);
}
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, <CR> to return to main menu > ";
chop($ans=<STDIN>);
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=<STDIN>);
(($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=<STDIN>);
($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=<STDIN>);
($d =~ /^\s*[?]/) && (($d=&select_dir) && ($d=~s/^\/?(.*)\/?$/$1/));
$newdir=$toplevel.$d;
system "clear";
print "\n$com $key to $newdir ? (y|n) > ";
$ans=<STDIN>;
($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=<STDIN>;
($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=<STDIN>;
($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=<STDIN>;
($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=<STDIN>;
($ans=~/^[Nn]/) && return;
chdir $newdir;
&change_display($key,$newdir);
chdir $realdir;
}else{
print "\nCreate new descriptor for $newdir/$names? (y|n) > ";
$ans=<STDIN>;
($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=<STDIN>;
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<CR> to continue >";
$ans=<STDIN>;
}
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=<STDIN>);
($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=<STDIN>;
$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=<STDIN>;
$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=<STDIN>);
if($ans =~ /^[Nn]/){
print "Edit the .cap file for $f? (y|n) > ";
chop($ans=<STDIN>);
$ans =~ /^[Nn]/ && return;
system "$ed" , "$realdir/.cap/$f";
print "Did you make changes? (y|n) > ";
$ans=<STDIN>;
$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=<STDIN>);
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 <CR> 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, <CR> 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=<STDIN>);
(length($tmp) > 0) && ($name=$tmp);
if(defined($numb)){
print "Enter Numb for file: [$numb]\n> ";
chop($tmp=<STDIN>);
(length($tmp) > 0) && ($numb=$tmp);
}
print "Enter Type for file: [$type]\n> ";
chop($tmp=<STDIN>);
(length($tmp) > 0) && ($type=$tmp);
print "Use a \"Host=\" entry for this item? (y|n) > ";
$tmpH=<STDIN>;
if($tmpH=~/^[Yy]/){
print "Enter Host for file: [$host]\n> ";
chop($tmp=<STDIN>);
(length($tmp) > 0) && ($host=$tmp);
}
print "Use a \"Port=\" entry for this item? (y|n) > ";
$tmpPo=<STDIN>;
if($tmpPo=~/^[Yy]/){
print "Enter Port for file: [$port]\n> ";
chop($tmp=<STDIN>);
(length($tmp) > 0) && ($port=$tmp);
}
print "Use a \"Path=\" entry for this item? (y|n) > ";
$tmpPa=<STDIN>;
if($tmpPa=~/^[Yy]/){
$path="./$f";
print "Enter Path for file: [./$f]\n> ";
chop($p=<STDIN>);
(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=<STDIN>;
}
$entry;
}