File Coverage

blib/lib/PJob/Client.pm
Criterion Covered Total %
statement 27 92 29.3
branch 3 26 11.5
condition n/a
subroutine 8 23 34.7
pod 4 4 100.0
total 42 145 28.9


line stmt bran cond sub pod time code
1             package PJob::Client;
2             our $VERSION = '0.41';
3              
4 2     2   26683 use Any::Moose;
  2         38836  
  2         20  
5 2     2   6294 use Term::ANSIColor qw/:constants/;
  2         19921  
  2         2703  
6 2     2   23 use Carp qw/carp croak/;
  2         5  
  2         116  
7 2     2   1259 use POE qw/Component::Client::TCP/;
  2         56126  
  2         18  
8              
9             $| = 1;
10             my $yellow = YELLOW;
11             my $bold = BOLD;
12             my $red = RED;
13             my $blue = BLUE;
14             my $reset = RESET;
15             my $green = GREEN;
16              
17             has 'server' => (
18             is => 'rw',
19             isa => 'Str',
20             required => 1,
21             );
22              
23             has 'port' => (
24             is => 'rw',
25             isa => 'Int',
26             );
27              
28             has 'job' => (
29             is => 'rw',
30             isa => 'ArrayRef',
31             default => sub { [] },
32             );
33              
34             has '_cqueue' => (
35             is => 'rw',
36             isa => 'ArrayRef',
37             default => sub { [] },
38             );
39              
40             sub BUILD {
41 1     1 1 2 my $self = shift;
42 1         7 $self->{_queued} = 0;
43             }
44              
45             sub run {
46 0     0 1 0 shift->_run;
47             }
48              
49             sub run_queue {
50 0     0 1 0 my $self = shift;
51 0         0 $self->{_queued} = 1;
52 0         0 $self->_run;
53             }
54              
55             sub queue_command {
56 2     2 1 495 my $self = shift;
57 2         3 push @{$self->_cqueue}, @_;
  2         10  
58 2         6 return $self;
59             }
60              
61             sub _run {
62 0     0   0 my $self = shift;
63 0     0   0 my $sub_for_input = sub { $self->_get_input_interactive(@_) };
  0         0  
64 0     0   0 $sub_for_input = sub { $self->_get_input_queue(@_) }
65 0 0       0 if $self->{_queued};
66 0         0 my ($server, $port) = $self->_get_remote;
67             $self->{_session} = POE::Component::Client::TCP->new(
68             RemoteAddress => $server,
69             RemotePort => $port,
70 0     0   0 Connected => sub { $self->_connected(@_) },
71 0     0   0 Disconnected => sub { $self->_disconnected(@_) },
72 0     0   0 ServerError => sub { $self->_server_error(@_) },
73 0         0 ServerInput => $sub_for_input,
74             );
75 0         0 POE::Kernel->run();
76 0         0 return $self;
77             }
78              
79             sub _get_remote {
80 2     2   1638 my $self = shift;
81              
82 2         10 my ($server, $port) = split ':', $self->server, 2;
83              
84 2 100       10 if (!$self->port) {
85 1 50       3 carp "no port specified\n" if !$port;
86 1         13 $self->port($port);
87             }
88 2         9 return ($server, $self->port);
89             }
90              
91             sub _connected {
92 0     0     my $self = shift;
93 0           my ($peer_addr, $peer_port) = @_[ARG1, ARG2];
94 0           print "Connected at ${peer_addr}:${peer_port}\n";
95             }
96              
97             sub _get_input_interactive {
98 0     0     my $self = shift;
99 0           my $input = $_[ARG0];
100 0 0         if ($input eq '.') {
101 0           print _($bold, $yellow, ">");
102 0           my $k = <>;
103 0           chomp $k;
104 0           $_[HEAP]{server}->put($k);
105             }
106             else {
107 0           $self->_format_and_output($input);
108             }
109             }
110              
111             sub _get_input_queue {
112 0     0     my $self = shift;
113 0           my ($input, $heap) = @_[ARG0, HEAP];
114 0 0         if ($input eq '.') {
115 0 0         if (!scalar @{$self->_cqueue}) {
  0            
116 0           $heap->{server}->put('quit');
117 0           return;
118             }
119 0           my $command = shift @{$self->_cqueue};
  0            
120 0           chomp $command;
121 0 0         return unless $command;
122 0           $heap->{server}->put($command);
123             }
124             else {
125 0           print $input, "\n";
126             }
127             }
128              
129             sub _disconnected {
130 0     0     my $self = shift;
131              
132 0           print "Server Disconnected, shutting down.....\n";
133 0           $_[KERNEL]->yield('shutdown');
134             }
135              
136             sub _server_error {
137 0     0     my $self = shift;
138 0           my ($oper, $nexit, $sexit) = @_[ARG0, ARG1, ARG2];
139 0 0         return if $nexit == 0;
140 0           print "Server Error:\n";
141 0           print "\toperation\t$oper\n";
142 0           print "\t Reason\t$sexit\n";
143 0           $_[KERNEL]->yield('shutdown');
144             }
145              
146             sub _ {
147 0     0     push @_, $reset;
148 0           return @_;
149             }
150              
151             sub _format_and_output {
152 0     0     my ($self, $input) = @_;
153 0 0         if ($input =~ /^Usage:(.*)$/) {
    0          
    0          
    0          
    0          
154 0           print _("Usage:", $bold, $blue, $1, "\n");
155 0           return;
156             }
157             elsif ($input =~ /^Job\s+(.*?)\s+:::(\d+)\sstarted\.$/) {
158 0           print _("Job ", $bold, $green, $1, ' :::', $2, $reset, " started\n");
159 0           return;
160             }
161             elsif ($input =~ /Out\t(.*)$/) {
162 0           print _($1, "\n");
163 0           return;
164             }
165             elsif ($input =~ /Err\t(.*)$/) {
166 0           print _($yellow, '[stderr] ', $reset, $1, "\n");
167 0           return;
168             }
169             elsif ($input =~ /^Job\s+(.*?)\s+:::(\d+)(.*?)(\d+)$/) {
170 0           print _(
171             "Job ", $bold, $green, $1, ' :::', $2,
172             $reset, $3, $red, $bold, $4, "\n"
173             );
174 0           return;
175             }
176             else {
177 0           print $input, "\n";
178             }
179             }
180              
181 2     2   159877 no Any::Moose;
  2         6  
  2         20  
182             __PACKAGE__->meta->make_immutable;
183             1;
184              
185             __END__