File Coverage

blib/lib/Wurm/let.pm
Criterion Covered Total %
statement 71 71 100.0
branch 8 14 57.1
condition 4 6 66.6
subroutine 22 22 100.0
pod 19 19 100.0
total 124 132 93.9


line stmt bran cond sub pod time code
1             package Wurm::let;
2              
3 3     3   13186 use strict;
  3         3  
  3         66  
4 3     3   8 use warnings;
  3         3  
  3         1920  
5              
6             sub new {
7 4     4 1 265 my ($class, $bulk) = @_;
8              
9 4   100     15 $bulk //= { };
10 4 50       9 die "mangled grub bulk\n"
11             unless 'HASH' eq ref $bulk;
12 4         19 return bless {bulk => $bulk}, $class;
13             }
14              
15             sub _at {
16 22 50   22   45 die "mangled code\n" unless 'CODE' eq ref $_[-1];
17 22         32 return @_;
18             }
19              
20 4     4 1 703 sub molt {return $_[0]->{bulk}}
21              
22             sub case {
23 1     1 1 3 my ($self, $code) = _at(@_);
24 1         2 $self->{bulk}{case} = $code;
25 1         2 return $self;
26             }
27              
28             sub pore {
29 1     1 1 233 my ($self, $code) = _at(@_);
30 1         2 $self->{bulk}{pore} = $code;
31 1         1 return $self;
32             }
33              
34             sub gate {
35 2     2 1 236 my ($self, $code) = _at(@_);
36 2         7 $self->{bulk}{gate} = $code;
37 2         7 return $self;
38             }
39              
40             sub tube {
41 1     1 1 650 my ($self, $name, $wurm) = @_;
42              
43 1 50       4 die "tube with no name\n" unless defined $name;
44              
45 1   50     2 $wurm //= { };
46              
47 1         3 $self->{bulk}{tube}{$name} = $wurm;
48 1         1 return $self;
49             }
50              
51             sub grub {
52 1     1 1 216 my ($self, $name, $grub) = @_;
53              
54 1 50       13 die "grub with no name\n" unless defined $name;
55              
56 1   50     2 $grub //= { };
57 1 50       5 $grub = Wurm::let->new($grub)
58             if 'HASH' eq ref $grub;
59              
60 1         2 $self->{bulk}{tube}{$name} = $grub->molt;
61 1         2 return $grub;
62             }
63              
64             sub neck {
65 1     1 1 226 my ($self, $code) = _at(@_);
66 1         2 $self->{bulk}{neck} = $code;
67 1         2 return $self;
68             }
69              
70             sub body {
71 2     2 1 228 my ($self, $methods, $code) = _at(@_);
72              
73 2 100       7 $methods = [$methods] if '' eq ref $methods;
74 2 50       5 die "\n" unless 'ARRAY' eq ref $methods;
75             $self->{bulk}{body}{$_} = $code
76 2         6 for @$methods;
77              
78 2         3 return $self;
79             }
80              
81             sub get {
82 2     2 1 231 my ($self, $code) = _at(@_);
83 2         17 $self->{bulk}{body}{get} = $code;
84 2         5 return $self;
85             }
86              
87             sub head {
88 1     1 1 228 my ($self, $code) = _at(@_);
89 1         2 $self->{bulk}{body}{head} = $code;
90 1         2 return $self;
91             }
92              
93             sub post {
94 2     2 1 224 my ($self, $code) = _at(@_);
95 2         5 $self->{bulk}{body}{post} = $code;
96 2         5 return $self;
97             }
98              
99             sub put {
100 2     2 1 248 my ($self, $code) = _at(@_);
101 2         5 $self->{bulk}{body}{put} = $code;
102 2         5 return $self;
103             }
104              
105             sub delete {
106 2     2 1 228 my ($self, $code) = _at(@_);
107 2         3 $self->{bulk}{body}{delete} = $code;
108 2         26 return $self;
109             }
110              
111             sub trace {
112 1     1 1 230 my ($self, $code) = _at(@_);
113 1         3 $self->{bulk}{body}{trace} = $code;
114 1         1 return $self;
115             }
116              
117             sub options {
118 1     1 1 222 my ($self, $code) = _at(@_);
119 1         3 $self->{bulk}{body}{options} = $code;
120 1         2 return $self;
121             }
122              
123             sub connect {
124 1     1 1 225 my ($self, $code) = _at(@_);
125 1         3 $self->{bulk}{body}{connect} = $code;
126 1         1 return $self;
127             }
128              
129             sub patch {
130 2     2 1 226 my ($self, $code) = _at(@_);
131 2         5 $self->{bulk}{body}{patch} = $code;
132 2         5 return $self;
133             }
134              
135             sub tail {
136 1     1 1 225 my ($self, $code) = _at(@_);
137 1         2 $self->{bulk}{tail} = $code;
138 1         1 return $self;
139             }
140              
141             '.oOo.' # in wurm i trust
142             __END__