Foro - Perl en Español

use Socket;
#Aquí hay código que no quiero poner...
while ( accept(CLIENT, SERVER) ) { # Cuando se acepte la conexión.
    # Procesamos al cliente, ya sea vía fork() o
    # si es nonblocking que sería bueno en este caso.
}
 

################
#package server#
################
package MyWebServer;
use base qw(HTTP::Server::Simple::CGI);
sub handle_request {
        my ($self, $cgi) = @_;
        if ($signal eq 0){
                lock($signal);
                $signal = 1;
                print "signal server: $signal \n";
        }    
        $countSignals++;
        print "contador señales: $countSignals";
        my $timerequest = `date '+%d/%m/%y%H%M%S'`;    
        print "\n $timerequest receiving signal";                                      
}
1;

######
#main#
######

my $httpPublisher = threads->new(\&listenToSignal);
my $httpConsumer = threads->new(\&updateCube);

my @returned_data_http = $httpPublisher->join;
my @returned_data_update = $httpConsumer->join;

#################
#subroutines for threads#
#################


sub listenToSignal{
        MyWebServer->new(8084)-> run();

}#end sub

sub updateCube{
        $updateCube = 0;
        ############
        #control of signal#
        ############
        while ('para siempre') {
                if ($signal > 0){
                        $updateCube = 1;
                        lock($signal);
                        $signal = 0;    
                        print "signal update cube: $signal \n";
                }
                if ($updateCube == 1){ 
                        $updateCube = 0;       
                                  # do work.....}

                }
}

#!/usr/bin/env perl
use strict;

package MyServer;
use strict;
use Socket;
use POSIX;

our $MaxClients = 50;
our $Clientes   = 0; # Clientes en linea...
our $eol        = "\015\012";

$SIG{CHLD} = \&ExitChild;

sub ExitChild {
    my $pid;
    while ( ( $pid = waitpid( -1, WNOHANG ) ) > 0 ) {
        $Clientes--;
    }
    $SIG{CHLD} = \&ExitChild;
}

sub new {
    my ( $pkg, $tarea ) = @_;
    my $self = {};
    socket( my $server, AF_INET, SOCK_STREAM, getprotobyname('tcp') )
        or die "Socket error: $!\n";
    setsockopt( $server, SOL_SOCKET, SO_REUSEADDR, 1 )
        or die "setsockopt error: $!\n";

    bind( $server, sockaddr_in( 80, INADDR_ANY ) ) or die "bind: $!\n";
    listen( $server, ( SOMAXCONN ) ) or die "listen: $!\n";

    $self->{Socket} = $server;
    $self->{Tarea}  = $tarea;
    bless $self, $pkg;
    return $self;
}

sub run {
    my $self = shift;
    while ( accept(CLIENT, $self->{Socket}) ) {
        $Clientes += 1;
        if ( $Clientes == $MaxClients ) { # Si exede los 50 usuarios...
            print CLIENT ( "HTTP/1.1 509 Bandwidth Limit Exceeded" . $eol );
            print CLIENT ( "DATE: " . scalar( gmtime() ) . " GMT$eol" );
            print CLIENT ( "Connection: close" . $eol );
            print CLIENT $eol;
            print CLIENT "Bandwidth limit exceeded";
            shutdown( CLIENT, 2 ); # no acepta al cliente.
        }

        my $pid = fork(); # Si, decidi hacerlo con fork...
        if ( not $pid ) {
            #Timeout
            POSIX::sigaction( SIGALRM,
            POSIX::SigAction->new( sub { shutdown( CLIENT, 2 ); exit; } ) )
                or die "Error setting SIGALRM: $!\n";
            alarm( 20 );

            select( ( select(CLIENT), $| = 1 )[0] );

            while ( my $cl = <CLIENT> ){print $cl; last if $cl eq $eol;}
            alarm 120; # timeout 2 min.
            print CLIENT ( "HTTP/1.1 200 OK" . $eol );
            print CLIENT ( "DATE: " . scalar( gmtime() ) . "GMT$eol" );
            print CLIENT ( "Content-Type: text/html" . $eol );
            print CLIENT ( "Content-Length: 25" . $eol );
            print CLIENT ( "Connection: Keep-Alive" . "$eol$eol" ); # Para saber si interesado.
            print CLIENT ( "Hello Dave, I am HAL 9000" . $eol );
            $self->{Tarea}() or print "$@\n";
        }
    }
}

package main;
sub Tarea {
    print "Usuarios conectados: $MyServer::Clientes\n";
}
my $servidor = MyServer->new( \&Tarea );
$servidor->run();