File Coverage

blib/lib/Config/Model/Backend/Xorg.pm
Criterion Covered Total %
statement 37 37 100.0
branch 2 4 50.0
condition 1 2 50.0
subroutine 7 7 100.0
pod 4 4 100.0
total 51 54 94.4


line stmt bran cond sub pod time code
1             #
2             # This file is part of Config-Model-Xorg
3             #
4             # This software is Copyright (c) 2007-2016 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             package Config::Model::Backend::Xorg ;
11             $Config::Model::Backend::Xorg::VERSION = '1.113';
12              
13 1     1   2515 use Mouse ;
  1         1  
  1         8  
14 1     1   499 use Carp ;
  1         1  
  1         83  
15 1     1   6 use Log::Log4perl qw(get_logger :levels);
  1         2  
  1         8  
16              
17             extends 'Config::Model::Backend::Any';
18              
19             with 'Config::Model::Backend::Xorg::Read';
20             with 'Config::Model::Backend::Xorg::Write';
21              
22             my $logger = get_logger("Backend::Xorg") ;
23              
24 15     15 1 5393746 sub suffix { return 'conf' ; }
25              
26 10     10 1 197 sub annotation { return 0 ;}
27              
28              
29             sub read {
30 10     10 1 4467 my $self = shift ;
31 10         80 my %args = @_ ;
32              
33             # args are:
34             # object => $obj, # Config::Model::Node object
35             # root => './my_test', # fake root directory, userd for tests
36             # config_dir => /etc/foo', # absolute path
37             # file => 'foo.conf', # file name
38             # file_path => './my_test/etc/foo/foo.conf'
39             # io_handle => $io # IO::File object
40             # check => yes|no|skip
41              
42 10 50       111 return 0 unless defined $args{io_handle} ; # no file to read
43 10   50     44 my $check = $args{check} || 'yes' ;
44              
45 10         260 my @lines = $args{io_handle}->getlines ;
46              
47 10         1000 my $idx = 0 ;
48             # store also input line number
49 10         25 map {s/#.*$//; s/^\s*//; s/\s+$//; $_ = [ "line ".$idx++ ,$_ ]} @lines ;
  1151         1454  
  1151         1910  
  1151         2182  
  1151         2397  
50 10         20 my @raw_xorg_conf = grep { $_->[1] !~ /^\s*$/ ;} @lines;
  1151         1699  
51 10         232 chomp @raw_xorg_conf ;
52              
53             #print Dumper(\@raw_xorg_conf); exit ;
54 10         52 my $data = parse_raw_xorg(\@raw_xorg_conf) ;
55              
56             #return $data if $test ;
57             #print Dumper($data); exit ;
58              
59 10         61 parse_all($data, $args{object}) ;
60 10         907 return 1;
61             }
62              
63             sub write {
64 5     5 1 2450 my $self = shift ;
65 5         31 my %args = @_ ;
66              
67             # args are:
68             # object => $obj, # Config::Model::Node object
69             # root => './my_test', # fake root directory, userd for tests
70             # config_dir => /etc/foo', # absolute path
71             # file => 'foo.conf', # file name
72             # file_path => './my_test/etc/foo/foo.conf'
73             # io_handle => $io # IO::File object
74             # check => yes|no|skip
75              
76 5         18 my $ioh = $args{io_handle} ;
77 5         12 my $node = $args{object} ;
78              
79 5 50       26 croak "Undefined file handle to write" unless defined $ioh;
80              
81 5         36 my $a_ref = write_all( $args{object} ) ;
82 5         19 $ioh->say( map {"$_\n"} @$a_ref ) ;
  582         974  
83            
84 5         435 return 1;
85             }
86              
87              
88             1;
89              
90             __END__