#!/usr/local/bin/perl
#
# Copyright (C) 1992 by Gustaf Neumann, Stefan Nusser
#
#      Wirtschaftsuniversitaet Wien,
#      Abteilung fuer Wirtschaftsinformatik
#      Augasse 2-6,
#      A-1090 Vienna, Austria
#      neumann@wu-wien.ac.at, nusser@wu-wien.ac.at
#
# Permission to use, copy, modify, and distribute this software and its
# documentation for any purpose and without fee is hereby granted, provided
# that the above copyright notice appears in all copies and that both that
# copyright notice and this permission notice appear in all supporting
# documentation.  This software is provided "as is" without expressed or
# implied warranty.
#
# adapted for newer ftp.pl by Wayne Scott <wscott@ichips.intel.com>
#
# Date: Mon, Apr 13 1992
# Author: Gustaf Neumann
# Version: 0.96
#


$WafeLib = $ENV{'WAFELIB'} || "/usr/lib/X11/wafe";
require "$WafeLib/perl/wafe.pl";
require 'ftp.pl';

@ftpServers = (
		  'ftp.wu-wien.ac.at',
		  'wuarchive.wustl.edu',
		  'ftp.uu.net',
		  'gatekeeper.dec.com',
		  'prep.ai.mit.edu',
		  'export.lcs.mit.edu',
);

# &ftp'debug(1);

$incoming = "$ENV{'HOME'}/incoming";
$CurrentSortMode = 'default';
$CurrentOrderMode = 'ascending';
$CurrentFTPMode = 'as Guessed';
$user = $ENV{'USER'} || chop($user = `/usr/bin/whoami`) && $user;

$tmpfile = &wafe'tmpFile("ftp");

@FileTypes = (
	'^.*\.(Z|arc|ARC|zip|ZIP|zoo|ZOO|lzh|LZH|tar|F|hqx|gz|z|taz|tgz)$', "compressed",
	'^.*(\.gif|\.jpg)$', "graphic",
	'^.*(\.exe|\.com|core|a\.out|\.o)$', "exec",
	'.*', "text",
);

$DATE = '/bin/date';

$LastFtpMode = "";
$server="";

#
# various  utilities
#
sub bynumkey { $keys[$a] <=> $keys[$b]; }
sub byanumkey { $keys[$a] cmp $keys[$b]; }

# date and time conversion
@MonthCorr = ( 0, 0, 3, 3, 4, 4, 5, 5, 5, 6, 6, 7 );
%Months = ('Jan',0, 'Feb',1, 'Mar',2, 'Apr',3, 'May',4, 'Jun',5, 'Jul',6,
                    'Aug',7, 'Sep',8, 'Oct',9, 'Nov',10, 'Dec',11);

sub days_since_70 {
    local($d,$m,$y,$hour,$min) = @_;
    return (($y-1970)*365 + int(($y-1972)/4) + $m*31 +$d - 1 - $MonthCorr[$m])
	+$hour/24+$min/(60*24);
}

($ThisMonth,$ThisDay,$ThisYear) = (split(" ",`$DATE +'%m %d %y'`));
$ThisYear += ($ThisYear>91 ? 1900 : 2000);
$Now = &days_since_70($ThisDay,$ThisMonth,$ThisYear,0,0);

$top = "top chainTop bottom chainTop";
$bot = "top chainBottom bottom chainBottom";
$left = "left chainLeft right chainLeft";
$topfield = "$backGround borderWidth 0";
$brightBackGround = "background $1" if $roColors =~ /background\s+(\S+)/;
$threeDV = "vertDistance 6" if $threeD;

&Xui( <<"__");
if {\$XVERSION<"R5"} {
   puts stderr "To exploit the full functionality of this program,
                wafe needs to be compiled with R5 libraries!"}

proc simpleButton {name father res} {
    eval Command \$name \$father $buttonAtts "\$res callback {echo %w}"}

proc simpleMenue {name father label default vert horiz hlabel} {
    eval MenuButton \$name \$father label \$label $top $right $topfield \\
       fromVert \$vert \$horiz menuName \${name}modes $boldFont $threeDNarrow
    Label \${name}mode \$father {
       label \$default width 115 $top $right $topfield 
       justify left fromVert \$vert fromHoriz \$hlabel $normalFont $twoD
    }
    SimpleMenu \${name}modes \$name $menueAtts
}


Form form topLevel width 620 $backGround

    Label info form label {} width 620 $top $normalFont $infoColors

    MenuButton serverLabel form label {FTP-Server:} $top $right $topfield \\
        menuName servers fromVert info $boldFont $threeD
    Text server form  editType edit width 300 $topfield $top $left \\
        fromHoriz serverLabel fromVert info $threeDV $normalFont \\
        translations {#override
           <Key>Return : exec(sendvalue server server)
           <Enter> : exec(sV server $highLight)
           <Leave> : exec(sV server $backGround)
        }
    SimpleMenu servers serverLabel $menueAtts

    Label dir form label {Directory:} $top $left $topfield $boldFont \\
        fromVert serverLabel $threeDNarrow
    Text dirText form editType edit width 300 $topfield $top $left \\
        fromHoriz serverLabel fromVert serverLabel $threeDV \\
        sensitive false displayCaret false $normalFont \\
        translations {#override
           <Key>Return : exec(sendvalue dirText dir)
           <Enter> : exec(sV dirText $highLight)
           <Leave> : exec(sV dirText $backGround)
	}

   simpleButton up form \\
               {fromVert serverLabel fromHoriz dirText $top sensitive false}

   simpleMenue FTP form {FTP-Mode:} {$CurrentFTPMode} dir {} FTP
   simpleMenue sort form {Sort-Mode:} {$CurrentSortMode} dir {fromHoriz FTPmode} sort
   simpleMenue order form {Order:} {$CurrentOrderMode} dir {fromHoriz sortmode} order

   Viewport vp form {
      allowVert true height 200 forceBars true fromVert sort
      top chainTop bottom chainBottom
   }
   sV vp.vertical $sbColors
   Box sb vp height 200  vSpace 0 width 620 height 200 $brightBackGround

    simpleButton quit form {fromVert vp $bot}
    simpleButton ftp form {fromVert vp fromHoriz quit sensitive false $bot}



    TransientShell READMEshell form
    callback READMEshell popupCallback position form

       Form READMEform READMEshell $backGround
          Text README READMEform {
               width 590 height 300 
               type file string /dev/null
               scrollVertical always $textFont $roColors
	  }
          Command cancel READMEform {
               $buttonAtts callback {popdown READMEshell} 
	       fromVert README
	  }

proc labelLine {i line} {
  Command l\$i sb unmanaged {
     label \$line borderWidth 0 width 605 
     justify left $roColors callback "echo read \$i"
  }
  action l\$i override "\\
     <Btn3Up>:    exec(echo up)
     <Key>Return: exec(echo read \$i)
     <Key>Down:   exec(sL +)
     <Key>Up:     exec(sL -)
     <Key>Next:   exec(sP +)
     <Key>Prior:  exec(sP -)"
}
__
############### the following section does not contain Perl variables
&Xui(<<'__');
proc sendvalue {w text} {
    echo $text [gV $w string]
}

proc sL {pm} {
    set rel [expr 0$pm[gV l1 height].0/[gV sb height]]
    set pos [expr [gV vertical topOfThumb]+$rel]
    XawScrollbarSetThumb vertical $pos -1.0
    callCallbacks vertical jumpProc float $pos
}

proc sP {pm} {
    set lHeight [gV l1 height]
    set rel [expr 0$pm$lHeight.0/[gV sb height]]
    set lines [expr [gV  vp height]/$lHeight]
    set pos [expr [gV vertical topOfThumb]+$rel*$lines]
    XawScrollbarSetThumb vertical $pos -1.0
    callCallbacks vertical jumpProc float $pos
}
__


&wafe'applyActions("README",@textActions);

sub refreshDir {
&Xui(<<"__");
    sV ftp sensitive false
    sV dirText string {$_[0]} editType edit
    callActionProc dirText {} end-of-line
__
}

sub fatal {
    local($text) = @_;

    &info("$text, aborting");
    undef @Labels;
    &newLabelBox($CurrentSortMode,$CurrentOrderMode);
    $server = "";
    &editDirField("false");
    &Xui("sV up sensitive false");
    $CurrentDir = "";
    &refreshDir($CurrentDir);
}



sub connect {
    local($server) = $_[0];
    local($conn,$succ,$result);

    if (&ftp'open($server, 21, 0, 1) != 1) {
	&info("cannt open connection to $server");
        return "";
    }	
    1;
}

sub login {
    local($conn) = @_;
    local($succ,$result);

    $succ = &ftp'login("anonymous", "$user@$ENV{'HOST'}"); #'

    &info($result) if !$succ;
}

sub dir {
    local($_,$typeflag,$size,$month,$day,$time,$name,$readflag);

    &ftpMode("ascii") || return 0;
    &info("reading directory $CurrentDir on $server");
    if ( !&ftp'dir_open() ) { #'
       &fatal("cannot read directory $CurrentDir on $server");
       return 0;
    }

    undef @Labels; undef @Type; undef @Name; undef @Selected; undef @order;
    while (<ftp'NS>) {
       chop; chop;
       if (m/^(\S)......(\S)\S+\s+\d+\s+\S+\s+\S+\s+(\d+)\s+(\S+)\s+(\d+)\s+(\S+)\s+(.*)\s*$/o ||
            m/^(\S)......(\S)\S+\s+\d+\s+\S+\s+(\d+)\s+(\S+)\s+(\d+)\s+(\S+)\s+(.*)\s*$/o) {
	   ($typeflag,$readflag,$size,$month,$day,$time,$name) = ($1,$2,$3,$4,$5,$6,$7);

	   next if $readflag ne 'r';

          push(@Labels,sprintf("%8d %s %2d %-5s %s",$size,$month,$day,$time,$name));

	  TYPE: {
             $Type = "folder", last TYPE if $typeflag =~ /[Dd]/;
             $Type = "folder", $name=$1, last TYPE if $name =~ m/(.*) \-\>.*/;

             # we want to process an associative array in the order the elements are defined
             for ($_= $[;  $_<$#FileTypes;   $_ += 2) {
                if ($name =~ m/^$FileTypes[$_]$/) {  $Type = $FileTypes[$_+1];  last; }
             }
          }

          push(@Type,$Type);
          push(@Name,$name);
       }
    }
    &ftp'dir_close;
    &info("directory $CurrentDir on $server contains ".($#Labels+1)." entries");
    &newLabelBox($CurrentSortMode,$CurrentOrderMode);
}


sub changeTo {
    local($dir) = @_;
    local($lastdir);

    if ($dir ne $CurrentDir) {
           $lastdir = $CurrentDir;

           if (!&ftp'cwd($dir)) {
              &info("cannot change to directory $dir");
           } else {
	       $CurrentDir = $dir;
               &dir();
           }
           &refreshDir($CurrentDir);
           &Xui("sV up sensitive true") if length($CurrentDir > 1);
    }
}


%FTPmode = (
	    "ascii", "A",
	    "binary", "I",
	    );

# set the FTP mode if necessary
sub ftpMode {
    local($mode) = @_;
    if ($mode ne $LastFtpMode) {
#	print "set mode to $mode\n";
	unless (&ftp'type($FTPmode{$mode})) {
           &info("cannot set transfer mode to $mode");
           return 0;
        }
        $LastFtpMode = $mode;
    }
    return 1;
}

sub ftp {
    local($source,$target,$mode) = @_;

    &ftpMode($mode) || return 0;
    &info("starting transfer of $source");
    $strip_cr = ($mode eq "ascii");
    if( ! &ftp'get($source, "$target", 0 )) { #'
       &info("cannot ftp $source into $incoming, reason: $reason");
       return 0;
    } else {
       &info("transfer of $source into $target done");
       return 1;
    }
}



sub setLabelAttributes {
    local($i) = @_;
    local($bitmap,$background);
    $bitmap = "$Type[$i].xbm";
    $background = $Selected[$i] ? "$highLight $highLightTextFont" : "$roColors $textFont";
    &Xui("sV l$i width 605 leftBitmap $bitmap $background");
}

sub setLabelActions {
    local($i) = @_;
    &Xui("action l$i override {<Btn2Down>: exec(echo readme $i)}")
	if $Type[$i] eq "text" || ($Name[$i] =~ /\.Z$/);
}


sub setListLabelsBox {
    local($low,$high,$up) = @_;
    local(@range);
    local( $toManage) =  "";

    @range = $up ?
	 defined(@order) ? @order[$low .. $high] : ($low .. $high) :
	 defined(@order) ? reverse(@order[$low..$high]) : reverse($low .. $high);

#    print "range has $#range elements, $low, $high\n";

     for (@range) {
	if ($Created[$_] != 1) {
 	    &Xui("labelLine $_ {$Labels[$_]}");
	    $Created[$_] = 1;
            $toManage .= "l$_ ";
	}

        &setLabelAttributes($_);
        &setLabelActions($_);
    }
    &Xui("manageChild $toManage") if $toManage;
}


sub reverseLookup {
    local($entry) = @_;
    if (defined(@order)) {
	local($_);
	for ($[ .. $#order) {
	    if ($entry == $order[$_]) { $entry = $_;  last; }
	}
    }
    return $entry;
}






sub newLabelBox {
    local($SortMode,$OrderMode) = @_;
    local($k);

    &Xui("destroyWidget sb; Box sb vp vSpace 0 width 620 height 200 $brightBackGround");
    undef @Created;

    undef @order;
    if ($SortMode ne "default") {
	undef @keys;
	if ($SortMode eq "by Size") {
	    for (@Labels) { push(@keys,(split(" ",$_))[0]); }
	    @order = sort bynumkey $[ .. $#Labels;
	}
	if ($SortMode eq "by Name") {
	    for (@Labels) {
		($k = (split(" ",$_))[4]) =~ tr/a-z/A-Z/;
		push(@keys,$k);
	    }
	    @order = sort byanumkey $[ .. $#Labels;
	}
	if ($SortMode eq "by Age") {
	    local($day,$month,$year,$hour,$min);
	    for (@Labels) {
		($month,$day,$year) = (split(" ",$_))[1,2,3];
		$month = $Months{$month};
                if ($year =~ /(\d+):(\d+)/) {
		    if (($k = &days_since_70($day,$month,$ThisYear,$1,$2))-$Now > 1) {
#			print "k = $k, now = $Now, must have been last year\n";
			$k = &days_since_70($day,$month,$ThisYear-1,$1,$2);
		    }
		}  else {
		    $k = &days_since_70($day,$month,$year,0,0);
		}
		push(@keys,-$k);
	    }
	    @order = sort bynumkey $[ .. $#Labels;
	}
    }
    $CurrentSortMode = $SortMode;
    $CurrentOrderMode = $OrderMode;
    &setListLabelsBox($[,$#Labels,($CurrentOrderMode eq 'ascending'));
}


sub editDirField {
    &Xui("sV dirText sensitive $_[0] displayCaret $_[0]");
}

&Xui('realize; deleteWindowProtocol quit');
&info('no ftp-server selected');

&simpleMenue("servers","server","string",@ftpServers);
&simpleMenue("sortmodes","sortmode","label",
	     ("default","by Size","by Name","by Age"));
&simpleMenue("FTPmodes","FTPmode","label",("as Guessed","ascii","binary"));
&simpleMenue("ordermodes","ordermode","label",("ascending","descending"));


while ($_=&wafe'read) {

    if (/^server\s+(\S+)/) {
        next if $1 eq $server;   # we are already connected
        &ftp'quit if $server ne "";

        $server = $1;
	&info("trying to connect to $server ...");
        if ($conn = &connect($server)) {

           &info("connection to $server established");
           &login($conn);
           &info("login performed");
           &editDirField("true");
  	   &Xui("sV up sensitive false");
	   $CurrentDir = "/";
           &refreshDir($CurrentDir);
           &dir();
        } else {
           &fatal("cannot connect to $server");
        }
    }

    if (/^read (\d+)/) {
	$entry = $1;
	if ( $Type[$entry] eq "folder" ) {
	   $CurrentDir .= "$Name[$entry]/";
           &ftp'cwd($CurrentDir);
           &refreshDir($CurrentDir);
           &Xui("sV up sensitive true");
           &dir();
        } else {
	    $Selected[$entry] = !$Selected[$entry];
	    $display = &reverseLookup($entry);
#	    print "selected = ",grep(($_==1),@Selected), "\n";
	    &Xui("sV ftp sensitive ". (grep(($_==1),@Selected)>0 ?
				       "true" : "false"));
	    &setListLabelsBox($display,$display,
			      ($CurrentOrderMode eq 'ascending'));
        }
    }

    if (/^dir\s*(\S*)/) {
	$entry = $1;
        $entry .= "/" if substr($entry,length($entry)-1,1) ne "/";
        &changeTo($entry);
    }

    &changeTo(substr($CurrentDir,0,
		     rindex($CurrentDir,'/',length($CurrentDir)-2))."/")
	if /^up/;


    if (/^sortmode\s+(.+)/) {
	&newLabelBox($1,$CurrentOrderMode) if $CurrentSortMode ne $1;
    }
    if (/^ordermode\s+(.+)/) {
	&newLabelBox($CurrentSortMode,$1) if $CurrentOrderMode ne $1;
    }
    if (/^FTPmode\s+(.+)/) {
	$CurrentFTPMode = $1;
#	print "CurrentFTPMode set to $1\n";
    }


   if (/^ftp/) {
       local($_,$mode,$display) = ();
       for ($[ .. $#Selected) {
	   if ($Selected[$_]) {
	       $mode = $CurrentFTPMode eq "as Guessed" ?
		           ($Type[$_] eq "text" ? "ascii" : "binary") :
			   $CurrentFTPMode;

               # create the incoming directory if necessary
               unless((-d $incoming) || mkdir($incoming,0755)) {
                      &info("cannot create incoming directory $incoming");
                      last;
               }

               # transfer the file
               if (&ftp($Name[$_], "$incoming/$Name[$_]", $mode)) {
	           $Selected[$_] = ! $Selected[$_];
                   $display = &reverseLookup($_);
                   &setListLabelsBox($display,$display,($CurrentOrderMode eq 'ascending'));
               }
	   }
       }
       &Xui("sV ftp sensitive false");
   }


   if (/^readme\s+(.*)/) {
       local($name,$Z,$mode)=($1,"","ascii");
       ($Z,$mode) = (".Z","binary") if $Name[$name]=~/\.Z$/;
       if (&ftp($Name[$name], $tmpfile.$Z, $mode)) {
	   &info("Cannot uncompress the file $tmpfile.$Z")
	       if $Z && (unlink($tmpfile)||1) &&
		   !system("uncompress", $tmpfile.$Z) &&
		       unlink $tmpfile.$Z;
	   &Xui("sV README string $tmpfile; popup READMEshell none")
	       if -T $tmpfile;
	   &info("the file $Name[$name] cannot be viewed, does not appear to be a text file")
	       if -B $tmpfile;
       }
   }


   if (/^quit/) {
      &ftp'quit;
      &wafe'cleanup();
   }

#   print "RECEIVED: $_";
}

