# modulos
use warnings;
use strict;
use Win32::IPConfig;
use Net::NBName;
use Net::NetSend qw(:all);
use Win32::Console;

# variables
my $version = '4.3';
my %chatconfig;

my $console = new Win32::Console(STD_OUTPUT_HANDLE);

# reading config file
open(CONFIG,"<chat.conf") or error("Cannot read configuration file chat.conf: $!");

# small file, throw everything into memory is faster
my @content = <CONFIG>;
close(CONFIG);

my @temp;

foreach ( @content ) {

    next if $_ =~ /#/;
    next if $_ =~ /^\n$/;
    chomp;
    $_ =~ s/\s//g;
    @temp = split(/=/,$_);
    $chatconfig{$temp[0]} = $temp[1];
    @temp = ();

}	
@content = ();

$console->Title('Seo Creysson Messenger');

$chatconfig{char_color} = color_code( $chatconfig{char_color}, 'FG' );
$chatconfig{bg_color} = color_code( $chatconfig{bg_color}, 'BG' );

$console->Attr( $chatconfig{char_color} | $chatconfig{bg_color} );

$console->Cls();

my $userdb = $chatconfig{userdb};

open(FILE,"<$userdb") or error( "Cannot read $userdb file: $!" );
@content = <FILE>;
close(FILE);

# criando a lista de usuários
my $owner;
# lista de usuários temporária, sem ordenação
my %temp_list;

foreach ( @content ) {
	
    next if $_ =~ /#/;
    next unless ($_ =~ /:/);
    chomp;
# LOGIN:apelido    
    @temp = split(/:/,$_);
    
# o usuário que esta rodando o
# programa não deve ser incluído no mesmo
    if ( $temp[0] eq $ENV{username} ) {

        $owner = $temp[1];
        next;

    }
# apelido:login - para poder ordernar    
    $temp_list{$temp[1]} = $temp[0];

}

undef @temp;

$owner = $ENV{username}." (insira seu apelido no arquivo $userdb)" unless( defined( $owner ) );

# @user_list is a array of arrays (bidimensional)
# position 0 is for login
# position 1 is for alias
# position 2 is for hostname
my @user_list = create_list(\%temp_list);
undef %temp_list;

# creates the menu
my $index;
my $option;

my $start_count;
my $end_count;

while (0 < 1) {

$start_count = time;

print <<BLOCK;
----------------------------------------------------------
Programa de envio de mensagens do Seo Creysson versao $version

Ola $owner.
Escolha o sujeito para quem voce quer mandar uma mensagem:
BLOCK


    for ( $index = 1; $index < @user_list; $index++ ) {
	
        print $index, '. ', $user_list[$index]->[1], "\n";
    
    }

    my $broadcast = $index;
    my $end = ++$index;
    
    print $broadcast, '. Broadcast para los hermanos',"\n";
    print $end, '. Sair',"\n";
    print 'Use i<identificador numerico> para obter informacoes de um membro da lista',"\n";
    print 'Opcao selecionada: ';

    $option = <STDIN>;
   
    unless ( defined( $option ) ) {
    
        invalid_operation( "Digite um identificador numerico valido entre 1 e $end." );
        next;
    
    }

    chomp $option;

# teste de entrada de dados
    if ( $option =~ /^\d+$/ ) {

        unless ( $option >= 1 and $option <= $end ) {

            invalid_operation( "Digite um identificador numerico valido entre 1 e $end." );
            next;

        }
        
    } else {
    
         if ( $option =~ /^i\d+$/ ) {

             my $user = substr( $option,1,1 );         
# checando se o usuario nao tenta pegar informacoes de BROADCAST
# ou outro indice invalido
             my $max = @user_list - 1;

             if ( ( $user > 0 ) and ( $user <= $max ) ) {         

format STDOUT =

 +------------------+-------------+--------------------+
 | APELIDO          | LOGIN       | IP DO COMPUTADOR   |
 +------------------+-------------+--------------------+
 |~@<<<<<<<<<<<<<<<<|~@<<<<<<<<<<<|@||||||||||||||||||~|
 $user_list[$user]->[1],$user_list[$user]->[0],$user_list[$user]->[2]
 +------------------+-------------+--------------------+

Pressione ENTER para voltar ao menu 
.
                 write;
                 $user = <STDIN>;
                 $console->Cls();
                 next;
                 
             } else {
             
                 invalid_operation( "Digite um identificador numerico entre 1 e $max." );
                 next;
             
             }
           
         
         } else {
         
             invalid_operation();
             next;
         
         }
    
    
    }

# saída do programa

    if ($end == $option) {

        $console->Cls();

print <<BLOCK;        
Firma cara. Falouz.
------------------------------------------------------------------
                      Copyleft: Alceu (glasswalk3r\@yahoo.com.br)
BLOCK
	    sleep 1;
	    exit;

    }


# definindo confirmacao e a mensagem

    unless ( $broadcast == $option ) {
    
        if ( $user_list[$option]->[2] eq 'unavailable' ) {

            invalid_operation( "Ao que parece $user_list[$option]->[1] nao efetuou logon na rede ainda...\nNao posso enviar uma mensagem a ele" );
            next;
            
        }
        
    }
    
    my $destinatario;
        
    ( $broadcast == $option ) ? ( $destinatario = 'BROADCAST' ) : ( $destinatario = $user_list[$option]->[1] );
    print "Legal, agora digite a mensagem para > $destinatario <. Quando acabar, digite ENTER.\n";
    print "Se quiser abortar o envio, nao digite nada e pressione ENTER.\n\n";
    print "Mensagem: ";

    my $message = <STDIN>;
    
    unless ( defined( $message ) ) {
        
        invalid_operation('Me recuso a enviar uma mensagem nula.');
        next;
        
    }

    if ( $message =~ /^\n$/ ) {
	
	    $console->Cls();
	    print "A mensagem NAO foi enviada.\n";
	    next;

    }
        
    chomp($message);
    
    $end_count = time - $start_count;
    $console->Cls();

    if ($broadcast == $option) {
               
# ignores zero position (since it has no one)
        my $position;
       
        for ( $position = 1; $position < @user_list; $position++ ) {

            send_message( $position, \@user_list, $owner, "[broadcast]: $message", \$end_count );
      
        }

        next;

    } else {
	
        send_message( $option, \@user_list, $owner, $message, \$end_count );

    }
 

# fim do while
}



#FUNCOES

# função para envio de mensagens

sub send_message {

# has the array index for the menu member
    my $ID = shift;
    my $destiny_ref = shift;
    my $source_netbios_name = shift;
    my $message = shift;
    my $counter_ref = shift;
    
    my $target_ip;
# improving performance avoiding new request to WINS Server
    ( $$counter_ref < $chatconfig{refresh_value} ) ? 
        ( $target_ip = $destiny_ref->[$ID][2] ) : 
        ( $target_ip = search_name( $destiny_ref->[$ID][1] ) );

    my $target_netbios_name;
    my $debug = 0;
    my $success;
    
    unless ( $target_ip eq 'unavailable' ) {

        $target_netbios_name = getNbName( $target_ip, $debug );
  
        if ( ( defined( $target_netbios_name ) ) and ( $target_netbios_name ne '0' ) ) {

            $success = sendMsg($target_netbios_name, $source_netbios_name, $target_ip, $message, $debug);
            
            if ( $success ) {
            
                print "Mensagem entregue com sucesso para $destiny_ref->[$ID][1]\n";
                
            } else {
            
                invalid_operation( "Ocorreu um erro na entrega da mensagem para $destiny_ref->[$ID][1]." );
# debug $@                
              
            }
                       
        } else {
        
            invalid_operation( "Ocorreu um erro na entrega da mensagem para $destiny_ref->[$ID][1]." );
# debug No NETBIOS name found: $@
          
        }
            
    } else {
    
        print "Ao que parece $destiny_ref->[$ID][1] nao efetuou logon na rede ainda...\n";
    
    }
    
}

# checa se o computador possui ao menos um servidor WINS configurado para evitar broadcast
# deveria permitir o uso de mais um adaptador (usar o chat.conf para determinar qual) e
# retornar uma lista de servidores WINS ao invés de somente o primeiro
sub check_wins {

    my $host = Win32::IPConfig->new();
    my @adapters = $host->get_adapters; 
    my @wins_servers;

# lets work with just the first adapter  
    @wins_servers = $adapters[0]->get_wins();
    
    ( @wins_servers > 0 ) ? return $wins_servers[0] : 0;

}

# queries thru WINS server or broadcast for machine name giving username
sub search_name {

    my $login = shift;
    $login =~ tr/[a-z]/[A-Z]/;
    
    my $query = Net::NBName->new();
    my $wins_server;
    my $suffix = hex 3;
    my $host;
    
    $wins_server = check_wins() if ( $chatconfig{use_wins} eq 'yes' );
    
    if ( defined( $wins_server ) ) {

# debug
#        printf "querying %s for %s<%02X>...\n", $wins_server, $login, $suffix;
        $host = $query->name_query( $wins_server, $login, $suffix );
    

# no WINS available, trying     
    } else {

# debug   
#        printf "broadcasting for %s<%02X>...\n", $login, $suffix;
        $host = $query->name_query(undef, $login, $suffix);
    
    }

# ugly, but the module doesn't give me a clear interface
    my @list;
    if ( defined( $host ) ) {
    
        @list = $host->addresses;
        
        ( @list > 0 ) ? return $list[0]->{address} : return 'unavailable';
        
    } else {
    
        return 'unavailable';
    
    }

}

sub create_list {

# reference to an hash list
    my $list_ref = shift;
    my $index = 1;
    my $host;
    my @user_list;
    my $alias;

# ordenando os nomes da lista por apelidos (ordem crescente)
    foreach $alias( sort( keys( %{ $list_ref } ) ) ) {

# procurando informações sobre a máquina aonde o login
# está logado no momento
        $host = search_name( $list_ref->{$alias} );

# forçando o array a começar do índice 1, já que faz mais sentido usar esse numero no menu
        $user_list[$index] = [ $list_ref->{$alias}, $alias, $host ];
        $index++;
        $host = '';

    }

    return @user_list;

}


sub invalid_operation {

    my $msg = shift;
    
    print '----------------------',"\n";
    
    $console->Attr( $main::FG_RED | $chatconfig{bg_color} );

    print "ERRO\n";
    print "$msg\n" if ( defined( $msg ) );
    print 'Pressione ENTER para encerrar essa mensagem';
    my $dummy = <STDIN>;
    
    $console->Attr( $chatconfig{char_color} | $chatconfig{bg_color} );    
    $console->Cls();

}

sub error {

    my $msg = shift;
    invalid_operation($msg);
    exit(1);

}

sub color_code {

    my $var = shift;
    my $mode = shift;
    $var = '$::'.$mode.'_'.$var;
    
    return ( eval "$var" );

}