File Coverage

blib/lib/Config/Model/Backend/OpenSsh/Role/MatchBlock.pm
Criterion Covered Total %
statement 64 65 98.4
branch 5 6 83.3
condition 4 6 66.6
subroutine 13 13 100.0
pod 0 4 0.0
total 86 94 91.4


line stmt bran cond sub pod time code
1             #
2             # This file is part of Config-Model-OpenSsh
3             #
4             # This software is Copyright (c) 2008-2022 by Dominique Dumont.
5             #
6             # This is free software, licensed under:
7             #
8             # The GNU Lesser General Public License, Version 2.1, February 1999
9             #
10 4     4   1837 use strict;
  4         9  
  4         111  
11 4     4   18 use warnings;
  4         8  
  4         168  
12              
13             $Config::Model::Backend::OpenSsh::Role::MatchBlock::VERSION = '2.9.0.1';
14             use Mouse::Role ;
15 4     4   22  
  4         7  
  4         21  
16             requires qw(current_node write_node_content write_line);
17              
18             use Carp ;
19 4     4   1102 use IO::File ;
  4         8  
  4         315  
20 4     4   32 use Log::Log4perl;
  4         7  
  4         557  
21 4     4   24 use File::Copy ;
  4         5  
  4         30  
22 4     4   182 use File::Path ;
  4         7  
  4         169  
23 4     4   20  
  4         6  
  4         2254  
24             my $logger = Log::Log4perl::get_logger("Backend::OpenSsh");
25              
26             my ($self, $root, $key, $pairs, $comment, $check) = @_ ;
27             $logger->debug("match: @$pairs # $comment");
28 8     8 0 29 my $list_obj = $root->fetch_element('Match');
29 8         55  
30 8         71 # create new match block
31             my $nb_of_elt = $list_obj->fetch_size;
32             my $block_obj = $list_obj->fetch_with_id($nb_of_elt) ;
33 8         31742 $block_obj->annotation($comment) ;
34 8         68  
35 8         8553 while (@$pairs) {
36             my $criteria = shift @$pairs;
37 8         255 my $pattern = shift @$pairs;
38 15         13014 $block_obj->load(
39 15         32 steps => qq!Condition $criteria="$pattern"!,
40 15         83 check => $check,
41             );
42             }
43              
44             $self->current_node( $block_obj->fetch_element('Settings') );
45             }
46 8         21215  
47              
48             my $self = shift ;
49             my $match_elt = shift ;
50             my $mode = shift || '';
51 12     12 0 32  
52 12         28 my $result = '';
53 12   100     74 foreach my $elt ($match_elt->fetch_all($mode) ) {
54             $result .= $self->write_match_block($elt,$mode) ;
55 12         32 }
56 12         101  
57 4         325 return $result ;
58             }
59              
60 12         584 my $self = shift ;
61             my $match_elt = shift ;
62             my $mode = shift || '';
63              
64 4     4 0 7 my $match_line ;
65 4         8 my $match_body ;
66 4   50     23  
67             foreach my $name ($match_elt->get_element_name() ) {
68 4         12 my $elt = $match_elt->fetch_element($name) ;
69              
70             if ($name eq 'Settings') {
71 4         17 $match_body .= $self->write_node_content($elt,$mode)."\n" ;
72 8         400 }
73             elsif ($name eq 'Condition') {
74 8 100       493 $match_line = $self->write_line(
    50          
75 4         23 Match => $self->write_match_condition($elt,$mode) ,
76             $match_elt -> annotation
77             ) ;
78 4         17 }
79             else {
80             die "write_match_block: unexpected element: $name";
81             }
82             }
83              
84 0         0 return $match_line.$match_body ;
85             }
86              
87             my $self = shift ;
88 4         26 my $cond_elt = shift ;
89             my $mode = shift || '';
90              
91             my $result = '' ;
92 4     4 0 9  
93 4         7 foreach my $name ($cond_elt->get_element_name() ) {
94 4   50     21 my $elt = $cond_elt->fetch_element($name) ;
95             my $v = $elt->fetch($mode) ;
96 4         9 $result .= " $name $v" if defined $v;
97             }
98 4         13  
99 16         392 return $result ;
100 16         966 }
101 16 100       2745  
102             no Mouse;
103              
104 4         27 1;
105              
106             # ABSTRACT: Backend role for Ssh Match blocks
107 4     4   33  
  4         12  
  4         42  
108              
109             =pod
110              
111             =encoding UTF-8
112              
113             =head1 NAME
114              
115             Config::Model::Backend::OpenSsh::Role::MatchBlock - Backend role for Ssh Match blocks
116              
117             =head1 VERSION
118              
119             version 2.9.0.1
120              
121             =head1 SYNOPSIS
122              
123             None
124              
125             =head1 DESCRIPTION
126              
127             This class provides a backend role to read and write C<Match> blocks
128             in OpenSsh configuration files.
129              
130             =head1 SEE ALSO
131              
132             L<Config::Model::Backend::OpenSsh>,
133              
134             =head1 AUTHOR
135              
136             Dominique Dumont
137              
138             =head1 COPYRIGHT AND LICENSE
139              
140             This software is Copyright (c) 2008-2022 by Dominique Dumont.
141              
142             This is free software, licensed under:
143              
144             The GNU Lesser General Public License, Version 2.1, February 1999
145              
146             =cut