File Coverage

blib/lib/Circle/CommandInvocation.pm
Criterion Covered Total %
statement 12 38 31.5
branch 0 12 0.0
condition n/a
subroutine 4 12 33.3
pod 0 7 0.0
total 16 69 23.1


line stmt bran cond sub pod time code
1             # You may distribute under the terms of the GNU General Public License
2             #
3             # (C) Paul Evans, 2008-2010 -- leonerd@leonerd.org.uk
4              
5             package Circle::CommandInvocation;
6              
7 4     4   13 use strict;
  4         5  
  4         88  
8 4     4   10 use warnings;
  4         5  
  4         88  
9              
10 4     4   23 use Scalar::Util qw( weaken );
  4         5  
  4         1383  
11              
12             sub new
13             {
14 0     0 0   my $class = shift;
15 0           my ( $text, $connection, $invocant ) = @_;
16              
17 0           $text =~ s/^\s+//;
18              
19             # Weaken the connection to ensure that this object doesn't hold on to the
20             # connection longer than required
21 0           my $self = bless [ $text, $connection, $invocant ], $class;
22 0           weaken( $self->[1] );
23 0           return $self;
24             }
25              
26             sub nest
27             {
28 0     0 0   my $self = shift;
29 0           my ( $text ) = @_;
30 0           return (ref $self)->new( $text, $self->connection, $self->invocant );
31             }
32              
33             sub connection
34             {
35 0     0 0   my $self = shift;
36 0           return $self->[1];
37             }
38              
39             sub invocant
40             {
41 0     0 0   my $self = shift;
42 0           return $self->[2];
43             }
44              
45             sub peek_token
46             {
47 0     0 0   my $self = shift;
48              
49 0 0         if( $self->[0] =~ m/^"/ ) {
50 0 0         $self->[0] =~ m/^"(.*)"/ and return $1;
51             }
52             else {
53 0 0         $self->[0] =~ m/^(\S+)/ and return $1;
54             }
55              
56 0           return undef;
57             }
58              
59             sub pull_token
60             {
61 0     0 0   my $self = shift;
62              
63 0 0         if( $self->[0] =~ m/^"/ ) {
64 0 0         $self->[0] =~ s/^"(.*)"\s*// and return $1;
65             }
66             else {
67 0 0         $self->[0] =~ s/^(\S+)\s*// and return $1;
68             }
69              
70 0           return undef;
71             }
72              
73             sub peek_remaining
74             {
75 0     0 0   my $self = shift;
76 0           return $self->[0];
77             }
78              
79             # delegate these to invocant
80             foreach my $method (qw(
81             respond
82             respondwarn
83             responderr
84             respond_table
85             )) {
86 4     4   15 no strict 'refs';
  4         10  
  4         220  
87 0     0     *$method = sub { shift->invocant->$method( @_ ) };
88             }
89              
90             0x55AA;