File Coverage

blib/lib/Config/Model/Backend/OpenSsh/Role/Writer.pm
Criterion Covered Total %
statement 70 73 95.8
branch 19 22 86.3
condition 3 5 60.0
subroutine 14 14 100.0
pod 0 5 0.0
total 106 119 89.0


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   2151 use strict;
  4         9  
  4         137  
11 4     4   22 use warnings;
  4         14  
  4         204  
12              
13             package Config::Model::Backend::OpenSsh::Role::Writer ;
14             $Config::Model::Backend::OpenSsh::Role::Writer::VERSION = '2.9.4.1';
15 4     4   29 use Mouse::Role ;
  4         48  
  4         28  
16              
17             with 'Config::Model::Backend::OpenSsh::Role::MatchBlock';
18              
19             requires qw(write_global_comments write_data_and_comments);
20              
21 4     4   1414 use 5.10.1;
  4         33  
22              
23 4     4   28 use Config::Model 2.128;
  4         68  
  4         203  
24              
25 4     4   28 use Carp ;
  4         9  
  4         227  
26 4     4   36 use IO::File ;
  4         7  
  4         663  
27 4     4   40 use Log::Log4perl 1.11;
  4         64  
  4         25  
28              
29             my $logger = Log::Log4perl::get_logger("Backend::OpenSsh");
30              
31             sub ssh_write {
32 13     13 0 45 my $self = shift ;
33 13         85 my %args = @_ ;
34              
35             my $config_root = $args{object}
36 13   33     90 || croak __PACKAGE__," ssh_write: undefined config root object";
37              
38 13         87 $logger->info("writing config file $args{file_path}");
39              
40 13         456 my $comment = $self->write_global_comment('#') ;
41              
42 13         912 my $result = $self->write_node_content($config_root,$args{ssh_mode});
43              
44 13 100       80 if ($result) {
45 11         129 $args{file_path}->spew_utf8($comment.$result);
46 11         10357 return 1;
47             }
48              
49 2         14 return 0;
50             }
51              
52              
53             sub write_line {
54 3200     3200 0 13584 my ($self, $k, $v, $note) = @_ ;
55 3200 100       12713 return '' unless length($v) ;
56 143         956 return $self->write_data_and_comments('#',sprintf("%-20s %s",$k,$v),$note) ;
57             }
58              
59             sub write_list {
60 316     316 0 727 my ($self,$name,$mode,$elt) = @_;
61 316         1034 my @r = map { $self->write_line($name,$_->fetch($mode), $_->annotation) ;} $elt->fetch_all() ;
  26         2583  
62 316         13988 return join('',@r) ;
63             }
64              
65              
66             sub write_list_in_one_line {
67 8     8 0 44 my ($self,$name,$mode,$elt) = @_;
68 8         41 my @v = $elt->fetch_all_values(mode => $mode) ;
69 8         1486 return $self->write_line($name,join(' ',@v)) ;
70             }
71              
72             # list there list element that must be written on one line with items
73             # separated by a white space
74             my %list_as_one_line = (
75             'AuthorizedKeysFile' => 1 ,
76             ) ;
77              
78             sub write_node_content {
79 36     36 0 92 my $self= shift ;
80 36         82 my $node = shift ;
81 36   100     155 my $mode = shift || '';
82              
83 36         87 my $result = '' ;
84 36         73 my $match = '' ;
85              
86 36         150 foreach my $name ($node->get_element_name() ) {
87 3539 50       75399 next unless $node->is_element_defined($name) ;
88 3539         34702 my $elt = $node->fetch_element($name) ;
89 3539         262446 my $type = $elt->get_type;
90 3539         14741 my $note = $elt->annotation ;
91              
92             #print "got $key type $type and ",join('+',@arg),"\n";
93 3539 100       37488 if ($name eq 'Match') {
    100          
    100          
    100          
    50          
    100          
    50          
94 13         190 $match .= $self->write_all_match_block($elt,$mode) ;
95             }
96             elsif ($name eq 'Host') {
97 9         61 $match .= $self->write_all_host_block($elt,$mode) ;
98             }
99             elsif ($name =~ /^(Local|Remote)Forward$/) {
100 56         215 foreach ($elt->fetch_all()) {
101 8         754 $result .= $self->write_forward($_,$mode);
102             }
103             }
104             elsif ($type eq 'leaf') {
105 3133         7679 my $v = $elt->fetch($mode) ;
106 3133         669049 $result .= $self->write_line($name,$v,$note);
107             }
108             elsif ($type eq 'check_list') {
109 0         0 my $v = $elt->fetch($mode) ;
110 0         0 $result .= $self->write_line($name,$v,$note);
111             }
112             elsif ($type eq 'list') {
113 324         1448 $result .= $self->write_data_and_comments('#', undef, $note) ;
114 324 100       6435 $result .= $list_as_one_line{$name} ? $self->write_list_in_one_line($name,$mode,$elt)
115             : $self->write_list($name,$mode,$elt) ;
116             }
117             elsif ($type eq 'hash') {
118 4         41 foreach my $k ( $elt->fetch_all_indexes ) {
119 2         79 my $o = $elt->fetch_with_id($k);
120 2         159 my $v = $o->fetch($mode) ;
121 2         461 $result .= $self->write_line($name,"$k $v", $o->annotation) ;
122             }
123             }
124             else {
125 0         0 die "OpenSsh::write did not expect $type for $name\n";
126             }
127             }
128              
129 36         630 return $result.$match ;
130             }
131              
132 4     4   3459 no Mouse;
  4         8  
  4         38  
133              
134             1;
135              
136             # ABSTRACT: Role to write OpenSsh config files
137              
138             __END__
139              
140             =pod
141              
142             =encoding UTF-8
143              
144             =head1 NAME
145              
146             Config::Model::Backend::OpenSsh::Role::Writer - Role to write OpenSsh config files
147              
148             =head1 VERSION
149              
150             version 2.9.4.1
151              
152             =head1 SYNOPSIS
153              
154             None. Consumed by L<Config::Model::Backend::OpenSsh::Ssh> and
155             L<Config::Model::Backend::OpenSsh::Sshd>.
156              
157             =head1 DESCRIPTION
158              
159             Write methods used by both L<Config::Model::Backend::OpenSsh::Ssh> and
160             L<Config::Model::Backend::OpenSsh::Sshd>.
161              
162             =head1 SEE ALSO
163              
164             L<cme>, L<Config::Model>, L<Config::Model::OpenSsh>
165              
166             =head1 AUTHOR
167              
168             Dominique Dumont
169              
170             =head1 COPYRIGHT AND LICENSE
171              
172             This software is Copyright (c) 2008-2022 by Dominique Dumont.
173              
174             This is free software, licensed under:
175              
176             The GNU Lesser General Public License, Version 2.1, February 1999
177              
178             =cut