#!/usr/bin/perl -w
#
# Perl/Tk Sftp Client
#     Cliente  para secure ftp (sftp) em Perl usando interface gráfica
# Tk.
#
# Versões (http://cascavel.pm.org/~frighetti/):
#  0.1_01 - 16/01/2004 - Planejado interface.
#
# Copyright 2003 Fabiano Reese Righetti <frighetti@cascavel.pm.org>
# All rights reserved.
#
# English (http://www.gnu.org/licenses/gpl.txt):
#     This  program  is  free software; you can redistribute it and/or
# modify  it  under  the  terms  of  the GNU General Public License as
# published  by  the Free Software Foundation; either version 2 of the
# License, or (at your option) any later version.
#    This  program  is distributed in the hope that it will be useful,
# but  WITHOUT  ANY  WARRANTY;  without  even  the implied warranty of
# MERCHANTABILITY  or  FITNESS  FOR A PARTICULAR PURPOSE.  See the GNU
# General Public License for more details.
#
# Português (http://www.magnux.org/doc/GPL-pt_BR.txt):
#     Este programa é um software livre; você pode redistribuí-lo e/ou 
# modificá-lo  dentro  dos  termos  da  Licença Pública Geral GNU como 
# publicada  pela  Fundação  do  Software  Livre (FSF); na versão 2 da 
# Licença, ou (na sua opinião) qualquer versão.
#    Este programa é distribuído na esperança que possa ser  útil, mas
# SEM  NENHUMA  GARANTIA;  sem  uma  garantia implícita de ADEQUAÇÂO a
# qualquer  MERCADO ou APLICAÇÃO EM PARTICULAR. Veja a Licença Pública
# Geral GNU para maiores detalhes.

use strict;
use Tk 800.000;
#use Net::SFTP;

my $maxX    = 500;
my $maxY    = 330;
my %Frames  = ();
my %Entrys  = ();
my %Values  = (
               'local'  => $ENV{HOME},
               'remoto' => '/',
			   'status' => '',
              );
my %Listas  = ();
my %Labels  = ();
my %Buttons = ();

my $main = MainWindow->new(
                           title => "Perl/Tk Sftp Client",
                          );

$main->geometry($maxX.'x'.$maxY);

&interface;

MainLoop;

sub interface
{
	&topo;

	&meio;

	&abaixo;
}

sub topo
{
	$Frames{topo} = $main->Frame();

	&descricao;

	&dados;

	$Frames{topo}->pack(-pady => 15);
}

sub descricao
{
	$Frames{descricao} = $Frames{topo}->Frame();

	$Labels{host} = $Frames{descricao}->Label(
	                                          -text  => 'Host',
	                                          -width => 25,
	                                        )->pack(-side => 'left');

	$Labels{porta} = $Frames{descricao}->Label(
	                                           -text  => 'Porta',
	                                           -width => 6,
	                                          )->pack(-side => 'left', -padx => 6);

	$Labels{usuario} = $Frames{descricao}->Label(
	                                             -text  => 'Usuário',
	                                             -width => 14,
	                                            )->pack(-side => 'left', -padx => 6);

	$Labels{senha} = $Frames{descricao}->Label(
	                                           -text  => 'Senha',
	                                           -width => 14,
	                                          )->pack(-side => 'left');

	$Frames{descricao}->pack();
}

sub dados
{
	$Frames{dados} = $Frames{topo}->Frame();

	$Values{host} = '';
	$Entrys{host} = $Frames{dados}->Entry(
										  -textvariable => \$Values{host},
										  -background   => 'gray',
										  -width        => 25,
										 )->pack(-side => 'left');

	$Values{porta} = '';
	$Entrys{porta} = $Frames{dados}->Entry(
										   -textvariable => \$Values{porta},
										   -background   => 'gray',
										   -width        => 6,
										  )->pack(-side => 'left', -padx => 6);
	$Entrys{porta}->insert('end', '22');

	$Values{usuario} = '';
	$Entrys{usuario} = $Frames{dados}->Entry(
											 -textvariable => \$Values{usuario},
											 -background   => 'gray',
											 -width        => 14,
										    )->pack(-side => 'left', -padx => 6);

	$Values{senha} = '';
	$Entrys{senha} = $Frames{dados}->Entry(
										   -textvariable => \$Values{senha},
										   -background => 'gray',
										   -width => 14,
										   -show => '*',
										  )->pack(-side => 'left');

	$Frames{dados}->pack();
}

sub meio
{
	$Frames{meio} = $main->Frame(-borderwidth => 2);

	&local;

	&remoto;

	&controle;

	$Frames{meio}->pack(-side => 'top', -padx => 3, -fill => 'x');
}

sub local
{
	$Frames{local} = $Frames{meio}->Frame();

	$Labels{local} = $Frames{local}->Label(
	                                       -textvariable => \$Values{local},
	                                       -relief       => 'groove',
	                                       -width        => 20,
								          )->pack(pady => 3, -fill => "x");

	$Listas{local} = $Frames{local}->Scrolled(
											  "Listbox",
											  -scrollbars => "osoe",
											 )->pack();

	$Listas{local}->bind('<Double-ButtonRelease-1>' => sub { &local_click($Listas{local}->get('active')) } );

	&list_dir_local($Values{local});

	$Frames{local}->pack(-side => "left", -anchor => 'nw', padx => 3);
}

sub remoto
{
	$Frames{remoto} = $Frames{meio}->Frame();

	$Labels{remoto} = $Frames{remoto}->Label(
	                                         -textvariable => \$Values{remoto},
	                                         -relief       => 'groove',
	                                         -width        => 20,
	                                        )->pack(pady => 3, -fill => "x");

	$Listas{remoto} = $Frames{remoto}->Scrolled(
												"Listbox",
												-scrollbars => "osoe",
											   )->pack();

	$Frames{remoto}->pack(-side => "right", -anchor => 'ne', padx => 3);
}

sub controle
{
	$Frames{controle} = $Frames{meio}->Frame();

	$Buttons{sair} = $Frames{controle}->Button(
	                                           -text => "Sair",
	                                           -command => sub { exit },
	                                          )->pack(-side => 'bottom', -fill => 'x');
	&bind_message($Buttons{sair}, 'Click para sair do programa');

	$Buttons{desconectar} = $Frames{controle}->Button(
	                                                  -text => "Desconectar",
	                                                  -command => sub {  },
	                                                 )->pack(-side => 'bottom', -fill => 'x', -pady => 5);
	&bind_message($Buttons{desconectar}, 'Desconectar do host remoto');

	$Buttons{conectar} = $Frames{controle}->Button(
	                                               -text => "Conectar",
	                                               -command => sub {  },
	                                              )->pack(-side => 'bottom', -fill => 'x');
	&bind_message($Buttons{conectar}, 'Conectar ao host remoto');

	$Buttons{put} = $Frames{controle}->Button(
	                                          -text => "------------>",
	                                          -command => sub {  },
	                                         )->pack(-side => 'bottom', -fill => 'x', -pady => 5);
	&bind_message($Buttons{put}, 'Enviar arquivo ou diretório');

	$Buttons{get} = $Frames{controle}->Button(
	                                          -text => "<------------",
	                                          -command => sub {  },
	                                         )->pack(-side => 'bottom', -fill => 'x');
	&bind_message($Buttons{get}, 'Baixar arquivo ou diretório');

	$Frames{controle}->pack(-side => 'bottom', -padx => 3, -fill => 'x');
}

sub abaixo
{
	$Frames{abaixo} = $main->Frame();

	&status;

	$Frames{abaixo}->pack(-side => 'bottom', -fill => 'x');
}

sub status
{
	$Frames{status} = $Frames{abaixo}->Frame();
	
	$Labels{status} = $Frames{status}->Label(
											 -textvariable => \$Values{status},
	                                         -relief       => 'groove',
											 -width        => $maxX,
	                                        )->pack();

	$Frames{status}->pack(-side => 'bottom');
}

# Função adaptada do livro:
#
# O'Reilly - Mastering Perl/Tk by Steve Lidie and Nancy Walsh
# ISBN 1-56592-716-8
# First Edition, published January 2002.
sub bind_message {
	my ($widget, $msg) = @_;

	$widget->bind('<Enter>', [ sub { $Values{status} = $_[1]; }, $msg ]);
	$widget->bind('<Leave>',   sub { $Values{status} = '';    }        );
}

# NAME
# 	list_dir_local
#
# SYNOPSIS
# 	void list_dir_local (string)
#
# FUNCTION
# 	Abre o diretorio passado por parâmetro e o lista na listbox "local".
#
# MODIFICATION HISTORY
# 	2003-01-13 v0.0a Fabiano Reese Righetti
#
# ATTRIBUTES
# 	string					-- nome do diretório
#
# SIDE EFFECTS
# 	$Listas{local} modificado.
#
# EXAMPLE
# 	&list_dir_local($Values{local});
#
# AUTHOR
# 	Fabiano Reese Righetti <frighetti@cascavel.pm.org>
sub list_dir_local
{
	my $diretorio = shift;

	opendir (DIR, $diretorio);
	
		my @temp = ();
	
		for my $arquivo (readdir (DIR))
		{
			push (@temp, $arquivo);
		}
	
		@temp = ('.', '..') if $#temp == -1;
		
		$Listas{local}->delete(0, 'end');
		$Listas{local}->insert(0, sort @temp);
	
	closedir (DIR);
}

# NAME
# 	local_click
#
# SYNOPSIS
# 	void local_click (string)
#
# FUNCTION
# 	Manipula a ação que deverá ser tomada após um click em qualquer
# elemento da listbox 'local'.
#
# MODIFICATION HISTORY
# 	2003-01-14 v0.0a Fabiano Reese Righetti
#
# ATTRIBUTES
# 	string					-- elemento selecionado na listbox.
#
# SIDE EFFECTS
# 	$Listas{local} modificado.
#
# EXAMPLE
# 	&local_click($Listas{local}->get('active'));
#
# AUTHOR
# 	Fabiano Reese Righetti <frighetti@cascavel.pm.org>
sub local_click
{
	my $arquivo = shift;

	if ($arquivo eq '..')
	{
		$Values{local} =~ s/\/[^\/]+$//;
		$Values{local} = '/' if ($Values{local} eq '');

		&list_dir_local($Values{local});
	}
	elsif ($arquivo ne '.')
	{
		if (-d $Values{local}.'/'.$arquivo)
		{
			$Values{local} .= '/'.$arquivo;
			$Values{local} =~ s/\/\//\//g;
			
			&list_dir_local($Values{local});
		}
	}
}