File Coverage

blib/lib/Circle/CommandInvocation.pm
Criterion Covered Total %
statement 28 38 73.6
branch 2 12 16.6
condition n/a
subroutine 10 12 83.3
pod 0 7 0.0
total 40 69 57.9


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   20 use strict;
  4         7  
  4         151  
8 4     4   20 use warnings;
  4         8  
  4         129  
9              
10 4     4   39 use Scalar::Util qw( weaken );
  4         5  
  4         2393  
11              
12             sub new
13             {
14 5     5 0 58 my $class = shift;
15 5         11 my ( $text, $connection, $invocant ) = @_;
16              
17 5         25 $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 5         21 my $self = bless [ $text, $connection, $invocant ], $class;
22 5         36 weaken( $self->[1] );
23 5         17 return $self;
24             }
25              
26             sub nest
27             {
28 0     0 0 0 my $self = shift;
29 0         0 my ( $text ) = @_;
30 0         0 return (ref $self)->new( $text, $self->connection, $self->invocant );
31             }
32              
33             sub connection
34             {
35 14     14 0 24 my $self = shift;
36 14         68 return $self->[1];
37             }
38              
39             sub invocant
40             {
41 19     19 0 28 my $self = shift;
42 19         196 return $self->[2];
43             }
44              
45             sub peek_token
46             {
47 0     0 0 0 my $self = shift;
48              
49 0 0       0 if( $self->[0] =~ m/^"/ ) {
50 0 0       0 $self->[0] =~ m/^"(.*)"/ and return $1;
51             }
52             else {
53 0 0       0 $self->[0] =~ m/^(\S+)/ and return $1;
54             }
55              
56 0         0 return undef;
57             }
58              
59             sub pull_token
60             {
61 15     15 0 26 my $self = shift;
62              
63 15 50       53 if( $self->[0] =~ m/^"/ ) {
64 0 0       0 $self->[0] =~ s/^"(.*)"\s*// and return $1;
65             }
66             else {
67 15 50       169 $self->[0] =~ s/^(\S+)\s*// and return $1;
68             }
69              
70 0         0 return undef;
71             }
72              
73             sub peek_remaining
74             {
75 21     21 0 24 my $self = shift;
76 21         105 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   25 no strict 'refs';
  4         8  
  4         323  
87 5     5   21 *$method = sub { shift->invocant->$method( @_ ) };
88             }
89              
90             0x55AA;