File: ActionSet.pm

package info (click to toggle)
libnet-cli-interact-perl 1.121640-1
  • links: PTS, VCS
  • area: main
  • in suites: wheezy
  • size: 368 kB
  • sloc: perl: 1,805; makefile: 2
file content (309 lines) | stat: -rw-r--r-- 8,713 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
package Net::CLI::Interact::ActionSet;
{
  $Net::CLI::Interact::ActionSet::VERSION = '1.121640';
}

use Moose;
use Net::CLI::Interact::Action;
with 'Net::CLI::Interact::Role::Iterator';

use Moose::Util::TypeConstraints;
subtype 'Net::CLI::Interact::ActionSet::CurrentMatchType'
    => as 'Maybe[ArrayRef[RegexpRef]]';
coerce 'Net::CLI::Interact::ActionSet::CurrentMatchType'
    => from 'RegexpRef' => via { [$_] };

has default_continuation => (
    is => 'rw',
    isa => 'Maybe[Net::CLI::Interact::ActionSet]',
    required => 0,
);

has current_match => (
    is => 'rw',
    isa => 'Net::CLI::Interact::ActionSet::CurrentMatchType',
    required => 0,
    coerce => 1,
);

has '+_sequence' => (
    isa => 'ArrayRef[Net::CLI::Interact::Action]',
);

sub BUILDARGS {
    my ($class, @rest) = @_;

    # accept single hash ref or naked hash
    my $params = (ref $rest[0] eq ref {} and scalar @rest == 1 ? $rest[0] : {@rest});

    if (exists $params->{actions} and ref $params->{actions} eq ref []) {
        foreach my $a (@{$params->{actions}}) {
            if (ref $a eq 'Net::CLI::Interact::ActionSet') {
                push @{$params->{_sequence}}, $a->_sequence;
                next;
            }

            if (ref $a eq 'Net::CLI::Interact::Action') {
                push @{$params->{_sequence}}, $a;
                next;
            }

            if (ref $a eq ref {}) {
                push @{$params->{_sequence}},
                    Net::CLI::Interact::Action->new($a);
                next;
            }

            confess "don't know what to do with a: '$a'\n";
        }
        delete $params->{actions};
    }

    return $params;
}

sub clone {
    my $self = shift;
    return Net::CLI::Interact::ActionSet->new({
        actions => [ map { $_->clone } $self->_sequence ],
        _callbacks => $self->_callbacks,
        default_continuation => $self->default_continuation,
        current_match => $self->current_match,
    });
}

# store params to the set, used when send is passed via sprintf
sub apply_params {
    my ($self, @params) = @_;

    $self->reset;
    while ($self->has_next) {
        my $next = $self->next;
        $next->params([splice @params, 0, $next->num_params]);
    }
}

has _callbacks => (
    is => 'rw',
    isa => 'ArrayRef[CodeRef]',
    required => 0,
    default => sub { [] },
);

sub register_callback {
    my $self = shift;
    $self->_callbacks([ @{$self->_callbacks}, shift ]);
}

sub execute {
    my $self = shift;

    $self->_pad_send_with_match;
    $self->_forward_continuation_to_match;
    $self->_do_exec;
    $self->_marshall_responses;
}

sub _do_exec {
    my $self = shift;

    $self->reset;
    while ($self->has_next) {
        $_->($self->next) for @{$self->_callbacks};
    }
}

# pad out the Actions with match Actions if needed between send pairs.
sub _pad_send_with_match {
    my $self = shift;
    my $match = Net::CLI::Interact::Action->new({
        type => 'match', value => $self->current_match,
    });

    $self->reset;
    while ($self->has_next) {
        my $this = $self->next;
        my $next = $self->peek or last; # careful...
        next unless $this->type eq 'send' and $next->type eq 'send';

        $self->insert_at($self->idx + 1, $match->clone);
    }

    # always finish on a match
    if ($self->last->type ne 'match') {
        $self->insert_at($self->count, $match->clone);
    }
}

# carry-forward a continuation beacause it's the match which really does the
# heavy lifting.
sub _forward_continuation_to_match {
    my $self = shift;

    $self->reset;
    while ($self->has_next) {
        my $this = $self->next;
        my $next = $self->peek or last; # careful...
        my $cont = ($this->continuation || $self->default_continuation);
        next unless $this->type eq 'send'
            and $next->type eq 'match'
            and defined $cont;

        $next->continuation($cont);
    }
}

# marshall the responses so as to move data from match to send
sub _marshall_responses {
    my $self = shift;

    $self->reset;
    while ($self->has_next) {
        my $send = $self->next;
        my $match = $self->peek or last; # careful...
        next unless $match->type eq 'match';

        # remove echoed command from the beginning
        my $cmd = quotemeta( $send->value );
        (my $output = $match->response_stash) =~ s/^$cmd\s*//;
        $send->response($output);
    }
}

1;

# ABSTRACT: Conversation of Send and Match Actions


__END__
=pod

=head1 NAME

Net::CLI::Interact::ActionSet - Conversation of Send and Match Actions

=head1 VERSION

version 1.121640

=head1 DESCRIPTION

This class is used internally by L<Net::CLI::Interact> and it's unlikely that
an end-user will need to make use of ActionSet objects directly. The interface
is documented here as a matter of record.

An ActionSet comprises a sequence (usefully, two or more) of
L<Actions|Net::CLI::Interact::Action> which describe a conversation with a
connected network device. Actions will alternate between type C<send> and
C<match>, perhaps not in their original
L<Phrasebook|Net::CLI::Interact::Phrasebook> definition, but certainly by the
time they are used.

If the first Action is of type C<send> then the ActionSet is a normal sequence
of "send a command" then "match a response", perhaps repeated. If the first
Action is of type C<match> then the ActionSet represents a C<continuation>,
which is the method of dealing with paged output.

=head1 INTERFACE

=head2 default_continuation

An ActionSet (C<match> then C<send>) which will be available for use on all
commands sent from this ActionSet. An alternative to explicitly describing the
Continuation sequence within the Phrasebook.

=head2 current_match

A stash for the current Prompt (regular expression reference) which
L<Net::CLI::Interact> expects to see after each command. This is passed into
the constructor and is used when padding Match Actions into the ActionSet (see
C<execute>, below).

=head2 clone

Returns a new ActionSet which is a shallow clone of the existing one. All the
reference based slots will share data, but you can add (for example) a
C<current_match> without affecting the original ActionSet. Used when preparing
to execute an ActionSet which has been retrieved from the
L<Phrasebook|Net::CLI::Interact::Phrasebook>.

=head2 apply_params

Accepts a list of parameters which will be used when C<sprintf> is called on
each Send Action in the set. You must supply sufficient parameters as a list
for I<all> Send Actions in the set, and they will be popped off and stashed
with the Action(s) according to how many are required.

=head2 register_callback

Allows the L<Transport|Net::CLI::Interact::Transport> to be registered
such that when the ActionSet is executed, commands are sent to the registered
callback subroutine. May be called more than once, and on execution each of
the callbacks will be run, in turn and in order.

=head2 execute

The business end of this class, where the sequence of Actions is prepared for
execution and then control passed to the Transport. This process is split into
a number of phases:

=over 4

=item Pad C<send> with C<match>

The Phrasebook allows missing out of the Match statements between Send
statements, when they are expected to be the same as the C<current_match>.
This phase inserts Match statements to restore a complete ActionSet
definition.

=item Forward C<continuation> to C<match>

In the Phrasebook a user defines a Continuation (C<match>, then C<send>)
following a Send statement (because it deals with the response to the sent
command). However they are actually used by the Match, as it's the Match which
captures output.

This phase copies Continuation ActionSets from Send statements to following
Match statements in the ActionSet. It also performs a similar action using the
C<default_continuation> if one is set and there's no existing Continuation
configured.

=item Callback(s)

Here the registered callbacks are executed (i.e. data is sent to the
Transport).

=item Marshall Responses

Finally, responses which are stashed in the Match Actions are copied back to
the Send actions, as more logically they are responses to commands sent. The
ActionSet is now ready for access to retrieve the C<last_response> from the
device.

=back

=head1 COMPOSITION

See the following for further interface details:

=over 4

=item *

L<Net::CLI::Interact::Role::Iterator>

=back

=head1 AUTHOR

Oliver Gorwits <oliver@cpan.org>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2012 by Oliver Gorwits.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut