File Coverage

blib/lib/Web/Dash/DeeModel.pm
Criterion Covered Total %
statement 16 18 88.8
branch n/a
condition n/a
subroutine 6 6 100.0
pod n/a
total 22 24 91.6


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__