Foro - Perl en Español

#!/usr/bin/perl -w
use Tk;
use IO::Socket;
use Net::hostent;

my $mw=MainWindow->new;
$mw->minsize(200,100);
$mw->title("AVISO!!");
my $server=IO::Socket::INET->new(Proto=>"tcp",LocalPort=>"5800",Listen=>"1");

#die "no puede configurar servidor" unless $server;
#print "Server $0 aceptando clientes";

while($cliente=$server->accept()){
  $cliente->autoflush(1);
  while(defined($line=<$cliente>)){
    #print $line;
   
    $mw->Label(-text=>$line)->pack;
    $mw->Button(-text=>Aceptar,-command=>sub{},-width=>10,-height=>1.90)->pack(-side=>'left',-padx=>15);
    $mw->Button(-text=>Cancelar,-command=>sub{exit},-width=>10,-height=>1.90)->pack(-side=>'left',-padx=>15);
    MainLoop;
  }
  close $server;
}

print $line;
Label(-text=>"$line")->pack();

#!/usr/bin/perl
use strict;
use warnings;
use diagnostics;

## Conexión
use IO::Select;
use IO::Socket;

$|++; # no caché

my $lsn = new IO::Socket::INET(
    Blocking => 0,
    Listen => 1,
    LocalPort => 1234,
    PeerAddr => 'localhost',
);
die if !$lsn;
my $sel = new IO::Select( $lsn );


## Entorno gráfico
use Tk;

my @ojitos = qw[ 0.0 v.v ^.^ ];
my $ojitos = 1;

my $mw = MainWindow->new;
$mw->minsize(300,100);
$mw->title("Recepcion");

my $ETIQUETA = $mw->Label( -text => "Esperando..." );
my $EYES     = $mw->Label( -text => $ojitos[1] );
my $MENSAJE  = $mw->Label( -text => '' );

$ETIQUETA->pack;
$EYES    ->pack;
$MENSAJE ->pack;

# Botón de salida
$mw->Button(
    -text    => 'Salir',
    -command => \&cierra,
    -width   => 10,
    -height  => 1.90,
)->pack();

# Temporizador
$mw->repeat(1000, \&mira);

sub mira {
    $EYES->configure( -text => $ojitos[++$ojitos % 2] );

    # ¿Hay algo qué leer?
    while( my @ready = $sel->can_read(0)) {

        # Para todos los canales abiertos
        foreach my $fh (@ready) {

            # Si es nuestro socket...
            if ($fh == $lsn) {
                my $new = $lsn->accept;         # Aceptamos la conexión
                $sel->add($new);                # Añadimos la conexión al select
                print "Se ha recibido algo\n";
                $ETIQUETA->configure( -text => 'Recibiendo...' );
                $EYES->configure( -text => $ojitos[2] );
            }
            else {
                print "El mensaje: ";

                # Procesamos el socket
                if ( my $linea = <$fh> ) {
                    $linea =~ s/[\r\n]+$//;
                    $MENSAJE->configure( -text => $linea );
                    print "[$linea]\n";
                }

                # Cerramos el canal
                else {
                    print "Canal cerrado\n";
                    $ETIQUETA->configure( -text => 'Cerrando...' );
                    $sel->remove($fh);
                    $fh->close;
                    $EYES->configure( -text => $ojitos[2] );
                    $MENSAJE->configure( -text => '' );
                }
            }
        }
    }
}

sub cierra {
    print "Lo cerramos\n";
    $lsn->close;
    exit;
}

## Programa
MainLoop;

__END__