user admin server v0.0.2-rc15

use strict;
use IO::Socket;

##things that need to be first
my $CNAME = $ENV{COMPUTERNAME}; #our name
my $GET = sub {
  my $listen = new IO::Socket::INET (
    LocalHost => $CNAME,
    LocalPort => '7070',
    Proto     => 'tcp',
    Listen    => 1,
    Timeout   => 10,
  );
  death('$GET: Unable to listen.') unless $listen;
  my $data;
  my $sock = $listen->accept();
  while (<$sock>) {
    $data .= $_;
  }  
  close($sock) or note('\$GET: Sock not open.') and return 0; #close sock
  note("\$GET: Data: @{[ $data ? $data : 'No data.']}");
  return split(/::/,$data); #and return
};
my $SND = sub {
  my $peer = shift or death('$SND: No one to talk to.'); #die if no peer is given
  my $say = new IO::Socket::INET (
    PeerAddr => $peer,
    PeerPort => '7070',
    Proto    => 'tcp',
    Timeout  => 10,
  ); #open sock (out)
  death('$SND: Unable to speak.') unless $say; #die if we failed
  print $say shift or death('$SND: Nothing to say.'); #die if there's nothing to send
  my @remainder = split(/\s+/,shift);
  foreach my $item (@remainder) {
    print $say '::', $item;
  } #if there's anything else, send it too
  close($say); #close sock
  return 1;
};

##constants
my %PEERS;

##command hash
my %cmnd = (
  'intro' => \&intro,
  'help'  => \&help,
  'get'   => \&cmd_get,
#  'set'   => \&cmd_set,
  'exit'  => sub {
    note('Thanks for playing.');
    exit 1;
  }
);

##progrum
my $input = 'intro';
while ($input !~ /exit/i) {
  foreach my $regex (sort keys %cmnd) {
    if ($input =~ /^\s*($regex)(?:\s+(.*))?/i) {
      $input = $cmnd{$1}->($2);
    }
  }
  next if $input =~ /help/i;
  print curti(), ' > ';
  chomp($input = <STDIN>);
}

##command functions
sub cmd_get {
  my ($peer,$what) = split(/\s+/,shift,2);
  death('cmd_get: Nothing to get.') unless $what;
  note('The "get all" command isn\'t supported at this time.') and return 1 if $peer =~ /all/i;
  note('Only "get <peer> users" is supported at this time.') and return 1 if $what !~ /users/i;
  $SND->($peer,'get',$what);
#  my @reply = $GET->();
#  print @reply; #in testing mode right now, server just dies
     exit 1;
}

##core functions


##micro functions
sub death {
  print curti(), ' - ', shift, "\n";
  exit 0;
}

sub note {
  print curti(), ' - ', shift, "\n";
  return 1;
}

sub curti {
  my @time = @{[ gmtime ]}[2,1,0];
  $time[0] = $time[0]-6 < 0 ? $time[0]+6 : $time[0]-6;
  return sprintf('%02d:%02d:%02d', @time);
}

##information
sub intro {
  note('Dean\'s multibox user admin server starting up.');
  note('Awaiting instructions...');
  return 'help';
}

sub help {
  note('Help not yet written.');
  return 1;
}