line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Web::Dash::DeeModel; |
2
|
1
|
|
|
1
|
|
3008
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
33
|
|
3
|
1
|
|
|
1
|
|
4
|
use warnings; |
|
1
|
|
|
|
|
8
|
|
|
1
|
|
|
|
|
22
|
|
4
|
1
|
|
|
1
|
|
4
|
use Carp; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
55
|
|
5
|
1
|
|
|
1
|
|
5
|
use Future::Q; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
21
|
|
6
|
1
|
|
|
1
|
|
4
|
use Scalar::Util qw(looks_like_number); |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
42
|
|
7
|
1
|
|
|
1
|
|
312
|
use Web::Dash::Util qw(future_dbus_call); |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
use Encode (); |
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
sub new { |
11
|
|
|
|
|
|
|
my ($class, %args) = @_; |
12
|
|
|
|
|
|
|
croak "parameter bus is mandatory" if not defined $args{bus}; |
13
|
|
|
|
|
|
|
croak "parameter service_name is mandatory" if not defined $args{service_name}; |
14
|
|
|
|
|
|
|
croak "parameter schema is mandatory" if not defined $args{schema}; |
15
|
|
|
|
|
|
|
my $self = bless { |
16
|
|
|
|
|
|
|
dbus_obj => undef, |
17
|
|
|
|
|
|
|
schema => $args{schema}, |
18
|
|
|
|
|
|
|
}, $class; |
19
|
|
|
|
|
|
|
my $service_name = $args{service_name}; |
20
|
|
|
|
|
|
|
$self->{dbus_obj} = |
21
|
|
|
|
|
|
|
$args{bus}->get_service($service_name)->get_object(_model_object_from_service($service_name), 'com.canonical.Dee.Model'); |
22
|
|
|
|
|
|
|
return $self; |
23
|
|
|
|
|
|
|
} |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
sub _model_object_from_service { |
26
|
|
|
|
|
|
|
my ($model_service_name) = @_; |
27
|
|
|
|
|
|
|
my $name = $model_service_name; |
28
|
|
|
|
|
|
|
$name =~ s|\.|/|g; |
29
|
|
|
|
|
|
|
return "/com/canonical/dee/model/$name"; |
30
|
|
|
|
|
|
|
} |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
sub _extract_valid_values { |
33
|
|
|
|
|
|
|
my ($row_schema, $row_data) = @_; |
34
|
|
|
|
|
|
|
my $field_num = int(@$row_schema); |
35
|
|
|
|
|
|
|
return [] if !$field_num; |
36
|
|
|
|
|
|
|
my @values = grep { @$_ == $field_num } @$row_data; |
37
|
|
|
|
|
|
|
return \@values; |
38
|
|
|
|
|
|
|
} |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
sub _row_to_hashref { |
41
|
|
|
|
|
|
|
my ($self, $row) = @_; |
42
|
|
|
|
|
|
|
my $schema = $self->{schema}; |
43
|
|
|
|
|
|
|
my %converted = (); |
44
|
|
|
|
|
|
|
foreach my $key_index (keys %$schema) { |
45
|
|
|
|
|
|
|
my $key_name = $schema->{$key_index}; |
46
|
|
|
|
|
|
|
my $value = $row->[$key_index]; |
47
|
|
|
|
|
|
|
if(defined $value) { |
48
|
|
|
|
|
|
|
if(looks_like_number($value)) { |
49
|
|
|
|
|
|
|
$value += 0; ## numerify |
50
|
|
|
|
|
|
|
}else { |
51
|
|
|
|
|
|
|
$value = Encode::decode('utf8', $value); |
52
|
|
|
|
|
|
|
} |
53
|
|
|
|
|
|
|
} |
54
|
|
|
|
|
|
|
$converted{$key_name} = $value; |
55
|
|
|
|
|
|
|
} |
56
|
|
|
|
|
|
|
return \%converted; |
57
|
|
|
|
|
|
|
} |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
sub get { |
60
|
|
|
|
|
|
|
my ($self, $exp_seqnum) = @_; |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
## --- Get current value of the Dee Model |
63
|
|
|
|
|
|
|
## By calling "Clone" method on a Dee Model object, we can obtain |
64
|
|
|
|
|
|
|
## current value of the Dee Model object. |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
## Alternatively, we can listen on "Commit" signal to keep track of |
67
|
|
|
|
|
|
|
## changes made on the Dee Model. That way, we can collect every value |
68
|
|
|
|
|
|
|
## the Model has ever had. However, here we use "Clone" method to obtain |
69
|
|
|
|
|
|
|
## the Model's value for ease of implementation. |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
return future_dbus_call($self->{dbus_obj}, "Clone")->then(sub { |
72
|
|
|
|
|
|
|
my ($swarm_name, $row_schema, $row_data, $positions, $change_types, $seqnum_before_after) = @_; |
73
|
|
|
|
|
|
|
## -- Obtain the raw data, convert it into a list of hash-refs |
74
|
|
|
|
|
|
|
## Dee Model's data model is similar to spreadsheets or RDB. |
75
|
|
|
|
|
|
|
## $row_schema is an array of strings, each of which indicates the data |
76
|
|
|
|
|
|
|
## type of the column. The string format is in DBus-way, I guess. |
77
|
|
|
|
|
|
|
## $row_data is an array of arrays, each of which represents a data row. |
78
|
|
|
|
|
|
|
## A data row may be empty, which I guess is some kind of placeholder from |
79
|
|
|
|
|
|
|
## the previous state of the Model. Otherwise, a data row has the same |
80
|
|
|
|
|
|
|
## number of data as the $row_schema. |
81
|
|
|
|
|
|
|
## $seqnum_before_after is an array with two elements. Its first element |
82
|
|
|
|
|
|
|
## is the previous sequence number of the Model and the second element |
83
|
|
|
|
|
|
|
## is the current sequence number. |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
if(defined($exp_seqnum)) { |
86
|
|
|
|
|
|
|
my $result_seqnum = $seqnum_before_after->[1]; |
87
|
|
|
|
|
|
|
if($result_seqnum != $exp_seqnum) { |
88
|
|
|
|
|
|
|
die "This seqnum is not expected.\n"; |
89
|
|
|
|
|
|
|
} |
90
|
|
|
|
|
|
|
} |
91
|
|
|
|
|
|
|
return map { $self->_row_to_hashref($_) } @{_extract_valid_values($row_schema, $row_data)}; |
92
|
|
|
|
|
|
|
}); |
93
|
|
|
|
|
|
|
} |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
our $VERSION = "0.031"; |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
1; |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
__END__ |