#! perl -slw
use strict;
use IO::Socket::INET;
use threads;

my $noBlock = 1;

## Create an array of udp listeners
my @listeners = map{
    my $listener = IO::Socket::INET->new(
        LocalPort => $_,
        Proto => 'udp',
        Reuse => 1,
##        Blocking => 0, ## No apparent effect on Win32.
    ) or die $!, $^E;
    ioctl( $listener, 0x8004667e, \$noBlock ); ## non-blocking on Win32
    $listener;
} 10001 .. 10005;

## forever, but not too fast
while( sleep 1 ) {
    my( $msg, $client );

    ## iterate the listening ports
    for( 0 .. $#listeners ) {

        ## Read anything they have available
        ## Should check if there is more
        $client = $listeners[ $_ ]->recv( $msg, 1024, 0 )
            ## and skip on if nothing there
            or warn "Nothing from $_\n" and next;

        ## Work out who's talking to us
        my( $port, $x ) = sockaddr_in( $client );
        my $ip = inet_ntoa( $x );

        ## And do **WHATEVER** with their message.
        print "$ip:$port : $msg"
    }
}

##</code><code>##

#! perl -slw
use strict;
use IO::Socket;

use constant {
    HEARTBEAT       => 1, ## seconds
    AREYOUTHERE     => 'Er, hello?',
    IPS             => [
        map{
            scalar sockaddr_in( $_, inet_aton( '127.0.0.1' ) )
        } 10001..10005
    ],
};

my $s = IO::Socket::INET->new( Proto => 'udp' )
    or die $!, $^E;

## Forever, slowly until time to die
while( sleep HEARTBEAT ) {
    for my $client ( 0 .. $#{ IPS() } ) {
        $s->send( "$client: " . AREYOUTHERE, 0, IPS->[ $client ] )
    }
}


##</code><code>##

#!/usr/bin/perl
use Tk;
use Tie::File;

my $liste;
my $liste_font;
my $breite=100;
my $the_selectmode = "extended";
my $enter;
my @array_file;

my $mw = MainWindow->new();

my $frame1 = $mw->Frame( -width=>50, -height=>50, -bg=>"seashell" );
my $frame2 = $mw->Frame( -width=>5,  -height=>5,  -bg=>"grey80" );

$liste_font = $mw->fontCreate(-family=>"courier", -size=>7  );

my $liste = $frame1->ScrlListbox(
    -setgrid=>1,
    -scrollbars=>"se",
    -background=>"lemonchiffon3",
    -borderwidth=>3,
    -highlightthickness=>10,
    -height => 30,
    -selectforeground=>"blue",
    -selectbackground=>"green",
    -relief=>"ridge",
    -exportselection => 1
)->pack(-side=>"right", -expand=>1, -fill=>"both");

my $exitButton = $frame2->Button(
    -text=>"Schliessen" ,-
    command=>"exit" ,
    -bg=>"red" ,
    -activebackground=>"red",
    -activeforeground=>"cyan"
)->pack(
    -anchor=>"w",
    -padx=>10 ,
    -pady=>15 ,
    -ipady=>10,
    -fill=>"x"
);

$frame1->pack(-side => 'left' ,-expand=>1 ,-fill=>"both");
$frame2->pack(-side => 'right',-expand=>1 );
$frame2->pack(-expand=>1 ,-fill=>"both");

$mw->repeat(10, \&fill_with_tie );

MainLoop;

sub fill_from_file {
    my $file = "meinfile.txt";
    my $line;
    $liste->delete(0,"end");

    if ( -s $file ) {
        open(DATEI, "<$file") or die $!;
        while ($line = <DATEI>) {
            chomp $line;
            $liste->insert(0,$line);
        }
        close(DATEI);
    }
}

sub fill_with_tie {
    my $file = "meinfile.txt";
    my $line;
    my $elem;

    $liste->delete(0,"end");
    if ( -e $file ) {
        tie @array_file, "Tie::File", $file || die $!;

        foreach $elem (@array_file) {
            chomp $elem;
            $liste->insert(0,$elem);
        }
        untie @array_file;
    }
    else {
        print "Kann $file nicht oeffnen $!\n";
    }
}

##</code><code>##

#!/usr/bin/perl
use threads;
use threads::shared;

my $die :shared = 0;

sub server {
##    require IO::Socket; IO::Socket->import( qw[ :DEFAULT :crlf ] );
    ## This attempts to defer the use until runtime
    ## and so limit the scope of the imports
    ## I'm not sure if it actually works.
    ## require would be better, but getting the imports
    ## to happen after the require doesn't always seem to work.
    ## Maybe someone watching can tell me how it should be done?
    eval { use IO::Socket::INET qw[ :DEFAULT :crlf ]; };

    local $/ = CRLF;

    my $noBlock = 1;

    ## Create an array of udp listeners
    my @listeners = map{
        my $listener = IO::Socket::INET->new(
            LocalPort => $_,
            Proto => 'udp',
            Reuse => 1,
##            Blocking => 0, ## No apparent effect on Win32.
        ) or die $!, $^E;
        ioctl( $listener, 0x8004667e, \$noBlock ); ## non-blocking on Win32
        $listener;
    } 10001 .. 10005;

    ## forever, but not too fast
    while( sleep 1 and not $die ) {
        my( $msg, $client );

        ## iterate the listening ports
        for( 0 .. $#listeners ) {

            ## Read anything they have available
            ## Should check if there is more
            $client = $listeners[ $_ ]->recv( $msg, 1024, 0 )
                ## and skip on if nothing there
                or warn "Nothing from $_\n" and next;

            ## Work out who's talking to us
            my( $port, $x ) = sockaddr_in( $client );
            my $ip = inet_ntoa( $x );

            ## And do *WHATEVER* with their message.
            print "$ip:$port : $msg" . CRLF;
        }
    }

}

sub heartbeat {
##    require IO::Socket; IO::Socket->import( qw[ :DEFAULT :crlf ] );
    eval{ use IO::Socket qw[ :DEFAULT :crlf ]; };

    local $/ = CRLF;

    use constant {
        HEARTBEAT       => 5, ## seconds
        AREYOUTHERE     => 'Er, hello?',
        
        ## You would vary the ips, ratehr than the ports here.
        ## I have it talking back to itself for demo purposes.
        IPS             => [
            map{
                scalar sockaddr_in( $_, inet_aton( '127.0.0.1' ) )
            } 10001..10005
        ],
    };

    my $s = IO::Socket::INET->new( Proto => 'udp' )
        or die $!, $^E;

    ## Forever, slowly until time to die
    while( sleep HEARTBEAT and not $die ) {
        for my $client ( 0 .. $#{ IPS() } ) {
            $s->send( "$client: " . AREYOUTHERE, 0, IPS->[ $client ] )
        }
    }
}

## start the threads.
my $server = async \&server;
my $heartbeat = async \&heartbeat;

## Require Tk so it doesn't get loaded into the threads above.
require Tk; Tk->import;
require Tie::File;

my $liste_font;
my $breite=100;
my $the_selectmode = "extended";
my $enter;
my @array_file;

my $mw = MainWindow->new();

my $frame1 = $mw->Frame( -width=>50, -height=>50, -bg=>"seashell" );
my $frame2 = $mw->Frame( -width=>5,  -height=>5,  -bg=>"grey80" );

$liste_font = $mw->fontCreate(-family=>"courier", -size=>7  );

my $liste = $frame1->ScrlListbox(
    -setgrid=>1,
    -scrollbars=>"se",
    -background=>"lemonchiffon3",
    -borderwidth=>3,
    -highlightthickness=>10,
    -height => 30,
    -selectforeground=>"blue",
    -selectbackground=>"green",
    -relief=>"ridge",
    -exportselection => 1
)->pack(-side=>"right", -expand=>1, -fill=>"both");

my $exitButton = $frame2->Button(
    -text=>"Schliessen" ,-
    command=> sub {
        ## Clean up the threads
        $die = 1; ## Tell them to commit hari kari
        $_->join for $heartbeat, $server; ## And wait tile they do
        exit;
    },
    -bg=>"red" ,
    -activebackground=>"red",
    -activeforeground=>"cyan"
)->pack(
    -anchor=>"w",
    -padx=>10 ,
    -pady=>15 ,
    -ipady=>10,
    -fill=>"x"
);

$frame1->pack(-side => 'left' ,-expand=>1 ,-fill=>"both");
$frame2->pack(-side => 'right',-expand=>1 );
$frame2->pack(-expand=>1 ,-fill=>"both");

$mw->repeat(10, \&fill_with_tie );

## Use the class method as the sub was not imported because we required Tk.
$mw ->MainLoop;

sub fill_from_file {
    my $file = "meinfile.txt";
    my $line;
    $liste->delete(0,"end");

    if ( -s $file ) {
        open(DATEI, "<$file") or die $!;
        while ($line = <DATEI>) {
            chomp $line;
            $liste->insert(0,$line);
        }
        close(DATEI);
    }
}

sub fill_with_tie {
    my $file = "meinfile.txt";
    my $line;
    my $elem;

    $liste->delete(0,"end");
    if ( -e $file ) {
        tie @array_file, "Tie::File", $file || die $!;

        foreach $elem (@array_file) {
            chomp $elem;
            $liste->insert(0,$elem);
        }
        untie @array_file;
    }
    else {
        print "Kann $file nicht oeffnen $!\n";
    }
}