File Coverage

blib/lib/MarpaX/Repa/Actions.pm
Criterion Covered Total %
statement 23 48 47.9
branch 3 12 25.0
condition 1 3 33.3
subroutine 7 14 50.0
pod 8 9 88.8
total 42 86 48.8


line stmt bran cond sub pod time code
1 1     1   16 use 5.010; use strict; use warnings;
  1     1   3  
  1     1   39  
  1         5  
  1         1  
  1         28  
  1         4  
  1         2  
  1         73  
2              
3             package MarpaX::Repa::Actions;
4              
5             =head1 NAME
6              
7             MarpaX::Repa::Actions - set of actions to begin with
8              
9             =head1 DESCRIPTION
10              
11             Some actions to start with that just present rules as various
12             perl structures. Just to help you concentrate on grammar at the
13             beginning.
14              
15             =head1 METHODS
16              
17             =head2 import
18              
19             Marpa at the moment doesn't use inheritance to lookup actions, so instead
20             of subclassing this module exports all actions and new method, but only
21             if '-base' is passed:
22              
23             package MyActions;
24             use MarpaX::Repa::Actions '-base';
25              
26             =cut
27              
28             sub import {
29 1     1   2 my $class = shift;
30 1         4 my $into = scalar caller;
31 1 50       303 return unless grep $_ eq '-base', @_;
32              
33              
34 1     1   5 no strict 'refs';
  1         2  
  1         569  
35 0         0 foreach my $name (grep /^new$|^do_/, keys %{$class."::"}) {
  0         0  
36 0         0 my $src = $class .'::'. $name;
37 0         0 my $dst = $into.'::'.$name;
38 0 0       0 next if defined &$dst;
39 0         0 *$dst = *$src;
40             }
41             }
42              
43             =head2 new
44              
45             Just returns a new hash based instance of the class. See 'action_object'
46             in L.
47              
48             =cut
49              
50             sub new {
51 4     4 1 2140 my $self = shift;
52 4   33     34 return bless {}, ref($self)||$self;
53             }
54              
55             =head2 do_what_I_mean
56              
57             Returns:
58              
59             { rule => 'rule name', value => $child || \@children }
60              
61             =cut
62              
63             sub do_what_I_mean {
64 4     4 1 611 shift;
65 4         12 my $grammar = $Marpa::R2::Context::grammar;
66 4         18 my ($lhs) = $grammar->rule( $Marpa::R2::Context::rule );
67 4         206 my @children = grep defined, @_;
68 4 100       19 my $ret = { rule => $lhs, value => scalar @children > 1 ? \@children : shift @children };
69 4         13 return $ret;
70             }
71              
72             sub do_rule_list {
73 0     0 0   shift;
74 0           my $grammar = $Marpa::R2::Context::grammar;
75 0           my ($lhs) = $grammar->rule( $Marpa::R2::Context::rule );
76 0           return { rule => $lhs, value => [grep defined, @_] };
77             }
78              
79             =head2 do_join_children
80              
81             Returns:
82              
83             { rule => 'rule name', value => join '', @children }
84              
85             =cut
86              
87             sub do_join_children {
88 0     0 1   shift;
89 0           my $grammar = $Marpa::R2::Context::grammar;
90 0           my ($lhs) = $grammar->rule($Marpa::R2::Context::rule);
91 0           return { rule => $lhs, value => join '', grep defined, @_ };
92             }
93              
94             =head2 do_join
95              
96             Returns:
97              
98             join '', @children
99              
100             =cut
101              
102             sub do_join {
103 0     0 1   shift;
104 0           return join '', grep defined, @_;
105             }
106              
107             =head2 do_list
108              
109             Returns:
110              
111             \@children
112              
113             =cut
114              
115             sub do_list {
116 0     0 1   shift;
117 0           return [ grep defined, @_ ];
118             }
119              
120             =head2 do_scalar_or_list
121              
122             Returns:
123              
124             $child || \@children
125              
126             =cut
127              
128             sub do_scalar_or_list {
129 0     0 1   shift;
130 0           @_ = grep defined, @_;
131 0 0         return @_>1? \@_ : shift;
132             }
133              
134             =head2 do_flat_to_list
135              
136             Returns (pseudo code):
137              
138             [ map @$_||%$_||$_, grep defined, @_ ]
139              
140             =cut
141              
142             sub do_flat_to_list {
143 0     0 1   shift;
144 0 0         return [ map { ref $_ eq 'ARRAY'? @$_ : ref $_ eq 'HASH'? %$_ : $_ } grep defined, @_ ];
  0 0          
145             }
146              
147             =head2 do_ignore
148              
149             Returns:
150              
151             undef
152              
153             =cut
154              
155 0     0 1   sub do_ignore { undef }
156              
157             1;