File Coverage

blib/lib/Net/LCDproc/Screen.pm
Criterion Covered Total %
statement 15 51 29.4
branch 0 8 0.0
condition n/a
subroutine 5 10 50.0
pod 1 4 25.0
total 21 73 28.7


line stmt bran cond sub pod time code
1             package Net::LCDproc::Screen;
2             $Net::LCDproc::Screen::VERSION = '0.104';
3             #ABSTRACT: represents an LCDproc screen
4              
5 1     1   13 use v5.10.2;
  1         15  
  1         140  
6 1     1   559 use Types::Standard qw/ArrayRef Bool Enum HashRef InstanceOf Int Str/;
  1         66764  
  1         19  
7 1     1   1860 use Log::Any qw($log);
  1         2025  
  1         7  
8 1     1   95 use Moo;
  1         3  
  1         12  
9 1     1   581 use namespace::clean;
  1         3  
  1         10  
10              
11             has id => (is => 'ro', isa => Str, required => 1);
12              
13             has name => (is => 'rwp', isa => Str);
14              
15             has [qw/width height duration timeout cursor_x cursor_y/] => (
16             is => 'rwp',
17             isa => Int,
18             );
19              
20             has priority => (
21             is => 'rwp',
22             isa => Enum([qw[hidden background info foreground alert input]]),
23             );
24              
25             has heartbeat => (
26             is => 'rwp',
27             isa => Enum([qw[on off open]]),
28             );
29              
30             has backlight => (
31             is => 'rwp',
32             isa => Enum([qw[on off open toggle blink flash ]]),
33             );
34              
35             has cursor => (
36             is => 'rwp',
37             isa => Enum([qw[on off under block]]),
38             );
39              
40             has widgets => (
41             is => 'rw',
42             isa => ArrayRef [InstanceOf ['Net::LCDproc::Widget']],
43             default => sub { [] },
44             );
45              
46             has is_new => (is => 'rw', isa => Bool, default => 1);
47              
48             has _lcdproc => (is => 'rw', isa => InstanceOf['Net::LCDproc']);
49              
50             has _state => (is => 'ro', isa => HashRef, default => sub {{}});
51              
52              
53             sub set {
54 0     0 1   my ($self, $attr, $val) = @_;
55              
56             # set the attribute
57 0           my $setter = "_set_$attr";
58 0           $self->$setter($val);
59              
60             # and record it is dirty
61 0           $self->_state->{$attr} = 1;
62 0           return 1;
63             }
64              
65             # updates the screen on the server
66             sub update {
67 0     0 0   my $self = shift;
68              
69 0 0         if ($self->is_new) {
70              
71             # screen needs to be added
72 0 0         if ($log->is_debug) { $log->debug('Adding ' . $self->id) }
  0            
73 0           $self->_lcdproc->_send_cmd('screen_add ' . $self->id);
74 0           $self->is_new(0);
75             }
76              
77             # even if the screen was new, we leave defaults up to the LCDproc server
78             # so nothing *has* to be set
79              
80 0           foreach my $attr (keys %{$self->_state}) {
  0            
81 0 0         $log->debug('Updating screen: ' . $self->id) if $log->is_debug;
82              
83 0           my $cmd_str = $self->_get_cmd_str_for($attr);
84              
85 0           $self->_lcdproc->_send_cmd($cmd_str);
86 0           delete $self->_state->{$attr};
87             }
88              
89             # now check the the widgets attached to this screen
90 0           foreach my $widget (@{$self->widgets}) {
  0            
91 0           $widget->update;
92             }
93 0           return 1;
94             }
95              
96             # TODO accept an arrayref of widgets
97             sub add_widget {
98 0     0 0   my ($self, $widget) = @_;
99 0           $widget->screen($self);
100 0           push @{$self->widgets}, $widget;
  0            
101 0           return 1;
102             }
103              
104             # removes screen from N::L, deletes from server, then cascades and kills its widgets (optionally not)
105             sub remove {
106 0     0 0   my ($self, $keep_widgets) = @_;
107              
108 0 0         if (!defined $keep_widgets) {
109 0           foreach my $widget (@{$self->widgets}) {
  0            
110 0           $widget->remove;
111             }
112             }
113 0           return 1;
114             }
115              
116             ### Private Methods
117              
118             sub _get_cmd_str_for {
119 0     0     my ($self, $attr) = @_;
120              
121 0           my $cmd_str = 'screen_set ' . $self->id;
122              
123 0           $cmd_str .= sprintf ' %s "%s"', $attr, $self->$attr;
124 0           return $cmd_str;
125             }
126              
127             1;
128              
129             __END__