line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
# vim: set ts=4 sw=4 tw=78 et si: |
2
|
|
|
|
|
|
|
# |
3
|
|
|
|
|
|
|
package GeNUScreen::Config::Diff; |
4
|
|
|
|
|
|
|
|
5
|
2
|
|
|
2
|
|
14
|
use warnings; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
65
|
|
6
|
2
|
|
|
2
|
|
11
|
use strict; |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
36
|
|
7
|
2
|
|
|
2
|
|
9
|
use Carp; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
109
|
|
8
|
|
|
|
|
|
|
|
9
|
2
|
|
|
2
|
|
1036
|
use version; our $VERSION = qv('v0.0.11'); |
|
2
|
|
|
|
|
4144
|
|
|
2
|
|
|
|
|
11
|
|
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
my $re_cfgval = qr/\S.*/; |
12
|
|
|
|
|
|
|
my $re_cfgvar = qr/[0-9a-z_]+/i; |
13
|
|
|
|
|
|
|
my $re_cfgpath = qr/$re_cfgvar(?:\.$re_cfgvar)*/; |
14
|
|
|
|
|
|
|
my $re_marker = qr/[a-z]+/i; |
15
|
|
|
|
|
|
|
|
16
|
2
|
|
|
2
|
|
1906
|
use Class::Std; |
|
2
|
|
|
|
|
25904
|
|
|
2
|
|
|
|
|
11
|
|
17
|
|
|
|
|
|
|
{ |
18
|
|
|
|
|
|
|
# storage for attributes |
19
|
|
|
|
|
|
|
my %diff : ATTR; |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
sub BUILD { |
22
|
1
|
|
|
1
|
0
|
57
|
my ($self, $ident, $args_ref) = @_; |
23
|
|
|
|
|
|
|
|
24
|
1
|
|
|
|
|
5
|
$diff{ident $self} = {}; |
25
|
|
|
|
|
|
|
} # BUILD() |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
sub compare { |
28
|
1
|
|
|
1
|
1
|
3
|
my ($self,$this,$that) = @_; |
29
|
|
|
|
|
|
|
|
30
|
1
|
|
|
|
|
2
|
my %d; |
31
|
1
|
|
|
|
|
2
|
my %all_keys = (); |
32
|
|
|
|
|
|
|
|
33
|
1
|
|
|
|
|
3
|
foreach my $k ($this->get_keys()) {$all_keys{$k} = 1}; |
|
262
|
|
|
|
|
422
|
|
34
|
1
|
|
|
|
|
14
|
foreach my $k ($that->get_keys()) {$all_keys{$k} = 1}; |
|
262
|
|
|
|
|
353
|
|
35
|
|
|
|
|
|
|
|
36
|
1
|
|
|
|
|
31
|
foreach my $k (keys %all_keys) { |
37
|
262
|
|
|
|
|
507
|
my $thisval = $this->get_value($k); |
38
|
262
|
|
|
|
|
501
|
my $thatval = $that->get_value($k); |
39
|
|
|
|
|
|
|
|
40
|
262
|
50
|
66
|
|
|
1763
|
unless ((not defined $thisval and not defined $thatval) |
|
|
|
33
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
|
66
|
|
|
|
|
41
|
|
|
|
|
|
|
or (defined $thisval and defined $thatval |
42
|
|
|
|
|
|
|
and $thisval eq $thatval) |
43
|
|
|
|
|
|
|
) { |
44
|
0
|
|
|
|
|
0
|
$d{$k}->{this} = $thisval; |
45
|
0
|
|
|
|
|
0
|
$d{$k}->{that} = $thatval; |
46
|
|
|
|
|
|
|
} |
47
|
|
|
|
|
|
|
} |
48
|
1
|
|
|
|
|
55
|
$diff{ident $self} = \%d; |
49
|
|
|
|
|
|
|
} # compare() |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
sub get_keys { |
52
|
0
|
|
|
0
|
1
|
0
|
my ($self) = @_; |
53
|
|
|
|
|
|
|
|
54
|
0
|
|
|
|
|
0
|
return keys %{$diff{ident $self}}; |
|
0
|
|
|
|
|
0
|
|
55
|
|
|
|
|
|
|
} # get_keys() |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
sub get_that_value { |
58
|
0
|
|
|
0
|
1
|
0
|
my ($self,$key) = @_; |
59
|
|
|
|
|
|
|
|
60
|
0
|
|
|
|
|
0
|
return $diff{ident $self}->{$key}->{that}; |
61
|
|
|
|
|
|
|
} # get_that_value() |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
sub get_this_value { |
64
|
0
|
|
|
0
|
1
|
0
|
my ($self,$key) = @_; |
65
|
|
|
|
|
|
|
|
66
|
0
|
|
|
|
|
0
|
return $diff{ident $self}->{$key}->{this}; |
67
|
|
|
|
|
|
|
} # get_this_value() |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
sub is_empty { |
70
|
1
|
|
|
1
|
1
|
15
|
my ($self) = @_; |
71
|
|
|
|
|
|
|
|
72
|
1
|
|
|
|
|
2
|
return 0 == scalar keys %{$diff{ident $self}}; |
|
1
|
|
|
|
|
23
|
|
73
|
|
|
|
|
|
|
} |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
} # package GeNUScreen::Config::Diff |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
1; # Magic true value required at end of module |
78
|
|
|
|
|
|
|
__END__ |