File Coverage

blib/lib/Empire.pm

Criterion	Covered	Total	%
statement	22	24	91.6
branch			n/a
condition			n/a
subroutine	8	8	100.0
pod			n/a
total	30	32	93.7

package Empire;

use 5.006;
use strict;
use warnings;

our $VERSION;

use Socket 1.3;
use Carp;
use IO::Socket;
use Net::Cmd;
use Lingua::EN::Numericalize;
use Exporter;

$VERSION = '0.121';

our @ISA = qw(Net::Cmd IO::Socket::INET Empire::Commands Exporter);
our @EXPORT_OK = qw($C_CMDOK $C_DATA $C_INIT $C_EXIT
		    $C_FLUSH $C_NOECHO $C_PROMPT $C_ABORT
		    $C_REDIR $C_PIPE $C_CMDERR $C_BADCMD
		    $C_EXECUTE $C_FLASH $C_INFORM $C_SYNC);
our $C_CMDOK   = '0';
our $C_DATA    = '1';
our $C_INIT    = '2';
our $C_EXIT    = '3';
our $C_FLUSH   = '4';
our $C_NOECHO  = '5';
our $C_PROMPT  = '6';
our $C_ABORT   = '7';
our $C_REDIR   = '8';
our $C_PIPE    = '9';
our $C_CMDERR  = 'a';
our $C_BADCMD  = 'b';
our $C_EXECUTE = 'c';
our $C_FLASH   = 'd';
our $C_INFORM  = 'e';
our $C_SYNC    = 'f';


# Preloaded methods go here.
sub new {

    my $self = shift;
    my $class = ref($self) || $self;
    my %param = @_;
    my $emp = {};

    if (! $param{-user}) {
	$param{-user} = $ENV{USER};
    }
    if (defined $param{-full} && $param{-full}) {
	use Empire::Commands;
	$emp = new Empire::Commands;
	use Empire::Ship;
	use Empire::Sector;
	use Empire::SectorType;
	use Empire::ProductType;
	use Empire::Nation;
	use Empire::Land;
	use Empire::Plane;
	use Empire::EConfig;
    }
    else {
	$emp = {};
    }
    print "Using Empire.pm v$VERSION\n";
    $emp->{HOST} = $param{-host};
    $emp->{PORT} = $param{-port};
    if ($param{-country} && $param{-player}) {
	if ($param{-player}) {
	    $emp->{COUNTRY} = $param{-country};
	    $emp->{PLAYER} = $param{-player};
	}
    }
    else {
	$emp->{COUNTRY} = 'visitor';
	$emp->{PLAYER} = 'visitor';
	carp "No country name supplied, logging as visitor\n";
    }
    if ($param{-user}) {
	 $emp->{USER} = $param{-user};
    }
    if ($param{-kill}) {
	$emp->{KILL} = $param{-kill};
    }
    else {
	$emp->{KILL} = 'ask';
    }
    if ($param{-name}) {
        $emp->{NAME} = $param{-name};
    }
    else {
        $emp->{NAME} = 'Empire';
    }
    bless $emp,$class;
    $emp->empconnect($class);
}
sub empconnect {

    my $emp = shift;
    my $class = shift;
    $emp->{SOCKET} = $class->SUPER::new(PeerAddr => $emp->{HOST},
					PeerPort => $emp->{PORT},
					Proto    => 'tcp',
					Timeout  => 120,
				      );
    unless (defined $emp->{SOCKET}) {
	$emp->{RESPONSE} = "Failed to Connect to $emp->{HOST} port $emp->{PORT}\n";
	$emp->{EMPSTATUS}   = 'NOT CONNECTED';
	return $emp;
    }
    my $welcome = $emp->{SOCKET}->getline;
    my ($proto,$response) = ($welcome =~ /^(\S)\s+(\S.*)$/);
    if ($proto != $C_INIT) {
	carp "Mysterious server welcome!\n";
	$emp->{SOCKET}->close;
	$emp->{RESPONSE} = 'Mysterious server welcome';
	$emp->{EMPSTATUS}   = 'NOT CONNECTED';
	return $emp;
    }
    unless ($emp->login()) {
	carp "Login failed!\n";
	$emp->{SOCKET}->close;
	$emp->{EMPSTATUS} = 'NOT CONNECTED';
	return $emp;
    }
}
sub login {

    my $emp = shift;

    my ($proto,$response);
    ($proto,$response) = $emp->coun($emp->{COUNTRY});
    if ($proto ne $C_CMDOK) {
	$emp->{SOCKET}->close;
	$emp->{EMPSTATUS} = 'NOT CONNECTED';
	$emp->{RESPONSE} = $response;
	return 0;
    }
    ($proto,$response) = $emp->pass($emp->{PLAYER});
    if ($proto ne $C_CMDOK) {
	$emp->{SOCKET}->close;
	$emp->{RESPONSE} = $response;
	$emp->{EMPSTATUS} = 'NOT CONNECTED';
	return 0;
    }
    if ($emp->{USER}) {
	($proto,$response) = $emp->user($emp->{USER});
	if ($proto ne $C_CMDOK) {
	    $emp->{SOCKET}->close;
	    $emp->{RESPONSE} = "$response";
	    $emp->{EMPSTATUS}   = 'NOT CONNECTED';
	    return 0;
	}
    }
    ($proto,$response) = $emp->play();
    if ($proto eq $C_EXIT) {
	my $kill_resp;
	if ($emp->{KILL} eq 'no') {
	    $emp->{RESPONSE} = $response;
	    $emp->{EMPSTATUS} = 'NOT CONNECTED';
	    return 0;
	}
	elsif ($emp->{KILL} eq 'yes') {
	    $emp->killit();
	}
	else {
	    print "Country in use! Kill? (y/n)";
	    $kill_resp = ; chomp $kill_resp;
	    if ($kill_resp eq 'y') {
		$emp->killit();
	    }
	    else {
		$emp->{SOCKET}->close;
		$emp->{RESPONSE} = "Exit requested by user";
		$emp->{EMPSTATUS} = 'NOT CONNECTED';
		print "Exit requested by user!\n";
		return 0;
	    }
	}
    }
    if ($proto ne $C_INIT) {
	carp "Mysterious welcome\n";
	$emp->{SOCKET}->close;
	$emp->{RESPONSE} = $response;
	$emp->{EMPSTATUS} = 'NOT CONNECTED';
	return 0;
    }
    $emp->{BUFFER} = '';
    $emp->{ECHO} = 1;
    $emp->{RESPONSE} = 'Logged in';
    $emp->{EMPSTATUS}   = 'CONNECTED';
    $emp->{MAP} = {};
    $emp->{FLASH} = '';
    $emp->{INFORM} = '';
    $emp->{ANNO} = 0;
    $emp->{TELE} = 0;
    ($proto,$response) = $emp->empreadline('update');
    return $emp;
}
sub coun {

    my $emp = shift;
    my $coun = shift;
    my $cmd = "coun $coun";

    $emp->empcmd($cmd);
    if ($emp->{SOCKET}) {
	$_ = $emp->{SOCKET}->getline();
	s/\r//g;
	/^(\S)\s+(\S.*)$/;
	return ($1,$2);
    }
}
sub pass {

    my $emp = shift;
    my $play = shift;
    my $cmd = "pass $play";

    $emp->empcmd($cmd);
    if ($emp->{SOCKET}) {
	$_ = $emp->{SOCKET}->getline();
	s/\r//g;
	/^(\S)\s+(\S.*)$/;
	return ($1,$2);
    }
}
sub user {

    my $emp = shift;
    my $user = shift;
    my $cmd = "user $user";

    $emp->empcmd($cmd);
    if ($emp->{SOCKET}) {
	$_ = $emp->{SOCKET}->getline();
	s/\r//g;
	/^(\S)\s+(\S.*)$/;
	return ($1,$2);
    }

}
sub play {

    my $emp = shift;
    my $cmd = "play";

    $emp->empcmd($cmd);
    if ($emp->{SOCKET}) {
	$_ = $emp->{SOCKET}->getline();
	s/\r//g;
	/^(\S)\s+(\S.*)$/;
	return ($1,$2);
    }
}
sub empkill {

    my $emp = shift;
    my $cmd = "kill";

    $emp->empcmd($cmd);
    if ($emp->{SOCKET}) {
	$_ = $emp->{SOCKET}->getline();
	s/\r//g;
	/^(\S)\s+(\.*)$/;
	return ($1,$2);
    }
}
sub killit {

    my $emp = shift;

    my ($proto,$response) = $emp->empkill();
    if ($proto == $C_EXIT) {
	($proto,$response) = $emp->play();
	if ($proto == $C_EXIT) {
	    $emp->{SOCKET}->close;
	    carp "Country still in use! Alert the deity!";
	    $emp->{RESPONSE} = $response;
	    $emp->{EMPSTATUS} = 'NOT CONNECTED';
	    return 0;
	}
    }
    else {
	$emp->{SOCKET}->close;
	carp "Unknown kill error!";
	$emp->{RESPONSE} = $response;
	$emp->{EMPSTATUS} = 'NOT CONNECTED';
	return 0;
    }
}
sub empstatus {

    my $emp = shift;
    my %empstatus;

    $empstatus{EMPSTATUS} = $emp->{EMPSTATUS};
    $empstatus{RESPONSE} = $emp->{RESPONSE};
    return %empstatus;
}
sub empreadline {

    my $emp = shift;
    my $cmd = shift;
    my $response;
    my $data = '';
    my $annos;
    my $teles;

    $response = $emp->{SOCKET}->getline();
    $response =~ s/\r//;
    ($emp->{EMPSTATUS},$emp->{RESPONSE}) = ($response =~ /^(\S) (.*)/);
    if ($cmd eq 'void') {
	if ($emp->{EMPSTATUS} eq $C_FLASH) {
	    if ($emp->{RESPONSE} eq 'Server shutting down...') {
		$emp->{EMPSTATUS} = $C_EXIT;
	    }
	    else {
		$emp->{FLASH} .= $emp->{RESPONSE} . "\n";
	    }
	}
	elsif ($emp->{EMPSTATUS} eq $C_INFORM) {
	    $emp->{INFORM} .= $emp->{RESPONSE};
	    chomp $emp->{INFORM};
	}
	return($emp->{EMPSTATUS},'');
    }
    while ($emp->{EMPSTATUS} ne $C_PROMPT &&
	   $emp->{EMPSTATUS} ne $C_FLUSH &&
	   $emp->{EMPSTATUS} ne $C_EXIT) {
	if ($emp->{EMPSTATUS} eq $C_DATA) {
	    if ($emp->{RESPONSE} =~ /You have (.*) new announcement/) {
		$emp->{ANNO} = $emp->{RESPONSE};
	    }
	    elsif ($emp->{RESPONSE} =~ /You have (.*) new telegram/) {
		$emp->{TELE} = $emp->{RESPONSE};
	    }
	}
	elsif ($emp->{EMPSTATUS} eq $C_FLASH) {
	    $emp->{FLASH} .= $emp->{RESPONSE} . "\n";
	}
	elsif ($emp->{EMPSTATUS} eq $C_INFORM) {
	    $emp->{INFORM} .= $emp->{RESPONSE};
	    chomp $emp->{INFORM};
	}
	$response = $emp->{SOCKET}->getline;
	$response =~ s/\r//;
	chomp $response;
	($emp->{EMPSTATUS},$emp->{RESPONSE}) = ($response =~ /^(\S) (.*)/);
    }
    $emp->{DATA}->{$cmd} = $data;
    if ($emp->{EMPSTATUS} eq $C_PROMPT) {
	my($min,$btu) = ($emp->{RESPONSE} =~ /(\d+)\s+(\d+)/);
	$emp->{BTU} = $btu;
	$emp->{MINUTES} = $min;
    }
    elsif ($emp->{EMPSTATUS} eq $C_FLUSH) {
	$emp->{SUBPROMPT} = $emp->{RESPONSE};
    }
    elsif ($emp->{EMPSTATUS} eq $C_EXIT) {
	$emp->{DATA}->{$cmd} .= $emp->{RESPONSE};
	close $emp->{SOCKET};
    }
    return ($emp->{EMPSTATUS},$emp->{DATA}->{$cmd});
}
sub empcmd {

    my $emp = shift;
    my $cmd = shift;

    chomp $cmd;
    $emp->{SOCKET}->datasend($cmd . "\n");

    return;
}
sub empbuffer {

    my $emp = shift;
    my $cont = shift;

    if (!defined $cont) {
	return $emp->{BUFFER};
    }
    elsif ($cont eq 'VOID') {
	$emp->{BUFFER} = '';
    }
    else {
	$emp->{BUFFER} = $cont;
    }
}
sub country {

    my $self = shift;
    my $coun = shift;

    $self->{COUNTRY} = $coun if defined $coun;
    return $self->{COUNTRY};
}
sub player {

    my $self = shift;
    my $play = shift;

    $self->{PLAYER} = $play if defined $play;
    return $self->{PLAYER};
}
sub port {

    my $self = shift;
    my $port = shift;

    $self->{PORT} = $port if defined $port;
    return $self->{HOST};
}
sub host {

    my $self = shift;
    my $host = shift;

    $self->{HOST} = $host if defined $host;
    return $self->{HOST};
}
sub name {

    my $self = shift;
    my $name = shift;

    $self->{NAME} = $name if defined $name;
    return $self->{NAME};
}
sub minutes {

    my $self = shift;

    return $self->{MINUTES};
}
sub btu {

    my $self = shift;
    return $self->{BTU};
}
sub hasflash {

    my $self = shift;
    return $self->{FLASH};
}
sub clearflash {

    my $self = shift;

    $self->{FLASH} = '';
}
sub hasinform {

    my $self = shift;
    return $self->{INFORM};
}
sub clearinform {

    my $self = shift;

    $self->{INFORM} = '';
}
sub hastele {

    my $self = shift;

    return $self->{TELE};
}
sub cleartele {

    my $self = shift;

    $self->{TELE} = 0;
}
sub hasanno {

    my $self = shift;

    return $self->{ANNO};
}
sub clearanno {

    my $self = shift;

    $self->{ANNO} = 0;
}
sub subprompt {

    my $self = shift;

    return $self->{SUBPROMPT};
}
sub disconnect {

    my $self = shift;

    $self->{SOCKET}->close();
    delete $self->{SOCKET};
}
1;
__END__