selectServerAndClient7.pl

#! /usr/bin/env perl

use warnings;
use strict;
use utf8;
use feature qw<say>;

use Getopt::Long;
use IO::Select;
use IO::Socket::INET;

sub box_string {
    my ($str) = @_;
    my $line = sprintf "|-%s-|", '-' x length($str);
    say $line;
    say "| $str |";
    say $line;
}

GetOptions (
    "Port|P=i" => \my $port,
    "Addr|A=s" => \my $addr
) || die "Invalid command line options '$!'";

do {
    say "Must call $0 --Port|P=1234 --Addr|A=127.0.0.1";
    exit (1);
} unless $port && $addr;

box_string("Server on: $addr:($port)");

print "Start server(y/n)? ";

do {
    say "Exiting $0";
    exit (0);
} unless <STDIN> =~ /^y$/;

my $socket = IO::Socket::INET->new(
    LocalPort => $port,
    LocalAddr => $addr,
    Listen => 5,
    ReuseAddr => SO_REUSEADDR,
    Proto => 'tcp'
) || die "Invalid server '$!'";

box_string("Server active on: $addr:($port)");

say "Server running...";

my $sel = IO::Select->new;
$sel->add([$socket, "Server Socket"]);

my @read_handles;
my @write_handles;

while (@read_handles = $sel->can_read) {
    for my $handle (@read_handles) {
        if ($handle->[0] == $socket) {
            $sel->add([scalar($socket->accept), "Client Socket"]);
            say "Server accepted new client";
        }else {
            @write_handles = grep {
                ($_->[0] != $socket) && ($_->[0] != $handle->[0])
            } $sel->can_write(0);

            #check filehandle for eof
            do {
                say "Client: ", $handle->[1], " exited";
                $sel->remove($handle->[0]);
                $handle->[0]->close;
                do {
                    print {$_->[0]} "Client: ", $handle->[1], " exited\r\n";
                    print {$_->[0]} "<<DONE>>\r\n";
                } for @write_handles;
                next;
            } if $handle->[0]->eof;

            #get the message from filehandle
            my $msg = do {
                local $/ = "\r\n";
                my $h = $handle->[0];
                chomp(my $m = <$h>);
                $m;
            };

            #do something with msg
            if ($msg =~ /m-/) {
                do {
                    print {$_->[0]} "Client: ", $handle->[1], " sent: $msg\r\n";
                    print {$_->[0]} "<<DONE>>\r\n";
                } for @write_handles;
                say "Client: ", $handle->[1], " sent: $msg";
            }elsif ($msg =~ /x-/) {
                do {
                    print {$_->[0]} "Client: ", $handle->[1], " exited\r\n";
                    print {$_->[0]} "<<DONE>>\r\n";
                } for @write_handles;
                say "Client: ", $handle->[1], " exited";
                $sel->remove($handle->[0]);
                $handle->[0]->close;
            }elsif ($msg =~ /t-/) {
                $handle->[1] = $msg;
                do {
                    print {$_->[0]} "Client: ", $handle->[1], " name change\r\n";
                    print {$_->[0]} "<<DONE>>\r\n";
                } for @write_handles;
                say "Client: ", $handle->[1], " name change";
            }elsif ($msg =~ /h-/) {
                print {$handle->[0]} "x- to exit\r\n";
                print {$handle->[0]} "l- list active users\r\n";
                print {$handle->[0]} "m-'message' send message to all users\r\n";
                print {$handle->[0]} "t-'UserName' to change user name\r\n";
                print {$handle->[0]} "h- display this help message\r\n";
                print {$handle->[0]} "<<DONE>>\r\n";
                say "Client: ", $handle->[1], " requested help";
            }elsif ($msg =~ /l-/) {
                do {
                    print {$handle->[0]} "Client: ", $_->[1], "\r\n";
                } for @write_handles;
                print {$handle->[0]} "<<DONE>>\r\n";
                say "Client: ", $handle->[1], " listing";
            }else {
                say "Client: ", $handle->[1], " unknown request: $msg";
            }
        }
    }
}

$socket->close;

exit(0);

##############################################################

#! /usr/bin/env perl

use warnings;
use strict;
use utf8;
use feature qw<say>;

use Getopt::Long;
use IO::Select;
use IO::Socket::INET;

sub box_string {
    my ($str) = @_;
    my $line = sprintf "|-%s-|", '-' x length($str);
    say $line;
    say "| $str |";
    say $line;
}

GetOptions (
    "Port|P=i" => \my $port,
    "Addr|A=s" => \my $addr,
    "User|U=s" => \my $user
) || die "Invalid command line options '$!'";

do {
    say "Must call $0 with --Port|P=1234 --Addr|A=127.0.0.1 --User|U=Username";
    exit (1);
} unless $port && $addr && $user;

box_string("Client($user) on: $addr:($port)");

print "Start client(y/n)? ";

do {
    say "Exiting $0";
    exit (0);
} unless <STDIN> =~ /^y$/;

my $client = IO::Socket::INET->new(
    PeerAddr => $addr,
    PeerPort => $port,
    Proto => 'tcp'
) || die "Client failed '$!'";

box_string("Client($user) active: $addr:($port)");

say "Client running....";

my $sel = IO::Select->new;

$sel->add(\*STDIN);
$sel->add($client);

print {$client} "t-$user\r\n";

my @read_handles;

while (@read_handles = $sel->can_read) {
    for my $handle (@read_handles) {
        if ($handle == $client) {
            do {
                say "Connection problems! Exiting";
                $client->close;
                exit(1);
            } if $client->eof;

            while (<$client>) {
            local $/ = "\r\n";
            last if /<<DONE>>/;
            chomp;
            say "$_";
            }
        }else {
            chomp(my $msg = <STDIN>);
            do {
                print {$client} "$msg\r\n";
                say "Exiting client";
                $client->close;
                exit (0);
            } if $msg =~ /x-/;
            print {$client} "$msg\r\n";
        }
    }
}

exit (0);