File Coverage

blib/lib/Device/Chip/PCF8563.pm
Criterion Covered Total %
statement 56 56 100.0
branch 3 6 50.0
condition 1 3 33.3
subroutine 13 13 100.0
pod 2 3 66.6
total 75 81 92.5


line stmt bran cond sub pod time code
1             # You may distribute under the terms of either the GNU General Public License
2             # or the Artistic License (the same terms as Perl itself)
3             #
4             # (C) Paul Evans, 2016 -- leonerd@leonerd.org.uk
5              
6 2     2   110918 use v5.26;
  2         30  
7 2     2   1059 use Object::Pad 0.19;
  2         14405  
  2         11  
8              
9             package Device::Chip::PCF8563 0.02;
10             class Device::Chip::PCF8563
11 2     2   1314 extends Device::Chip::Base::RegisteredI2C;
  2         19097  
  2         109  
12              
13 2     2   445 use utf8;
  2         5  
  2         11  
14              
15 2     2   71 use Carp;
  2         4  
  2         135  
16              
17 2     2   550 use Future::AsyncAwait;
  2         884  
  2         11  
18              
19 2     2   108 use constant DEFAULT_ADDR => 0xA2 >> 1;
  2         5  
  2         374  
20              
21             =encoding UTF-8
22              
23             =head1 NAME
24              
25             C - chip driver for a F
26              
27             =head1 SYNOPSIS
28              
29             use Device::Chip::PCF8563;
30             use Future::AsyncAwait;
31              
32             use POSIX qw( mktime strftime );
33              
34             my $chip = Device::Chip::PCF8563->new;
35             await $chip->mount( Device::Chip::Adapter::...->new );
36              
37             printf "The current time on this chip is ",
38             await strftime( "%Y-%m-%d %H:%M:%S", localtime mktime $chip->read_time );
39              
40             =head1 DESCRIPTION
41              
42             This L subclass provides specific communication to a
43             F F chip attached to a computer via an I²C adapter.
44              
45             =cut
46              
47             method I2C_options
48 1     1 0 723 {
49             return (
50 1         8 addr => DEFAULT_ADDR,
51             max_bitrate => 100E3,
52             );
53             }
54              
55             use constant {
56 2         1528 REG_CTRL1 => 0x00,
57             REG_CTRL2 => 0x01,
58             REG_VLSECONDS => 0x02,
59 2     2   15 };
  2         3  
60              
61 6     6   11 sub _unpack_bcd ( $v ) { ( $v >> 4 )*10 + ( $v % 16 ) }
  6         8  
  6         10  
  6         39  
62 7     7   11 sub _pack_bcd ( $v ) { int( $v / 10 ) << 4 | ( $v % 10 ) }
  7         9  
  7         9  
  7         66  
63              
64             =head1 METHODS
65              
66             The following methods documented in an C expression return L
67             instances.
68              
69             =cut
70              
71             =head2 read_time
72              
73             @tm = await $chip->read_time;
74              
75             Returns a 7-element C-compatible list of values by reading the
76             timekeeping registers, suitable for passing to C, etc... Note
77             that the returned list does not contain the C or C fields.
78              
79             Because the F only stores a 2-digit year number plus a single century
80             bit, the year is presumed to be in the range C<2000>-C<2199>.
81              
82             This method presumes C-compatible semantics for the C field
83             stored on the chip; i.e. that 0 is Sunday.
84              
85             This method performs an atomic reading of all the timekeeping registers as a
86             single I²C transaction, so is preferrable to invoking multiple calls to
87             individual read methods.
88              
89             =cut
90              
91 1         2 async method read_time ()
  1         2  
92 1         5 {
93 1         11 my ( $bcd_sec, $bcd_min, $bcd_hour, $bcd_mday, $wday, $bcd_mon, $bcd_year ) =
94             unpack "C7", await $self->read_reg( REG_VLSECONDS, 7 );
95              
96 1 50       1265 die "VL bit is set; time is unreliable" if $bcd_sec & 0x80;
97              
98 1         3 my $century = $bcd_mon & 0x80;
99              
100             return (
101 1 50       4 _unpack_bcd( $bcd_sec ),
102             _unpack_bcd( $bcd_min & 0x7F ),
103             _unpack_bcd( $bcd_hour & 0x3F ),
104             _unpack_bcd( $bcd_mday & 0x3F ),
105             _unpack_bcd( $bcd_mon & 0x1F ) - 1,
106             _unpack_bcd( $bcd_year ) + 100 + ( $century ? 100 : 0 ),
107             $wday & 0x07,
108             );
109 1     1 1 13180 }
110              
111             =head2 write_time
112              
113             await $chip->write_time( @tm );
114              
115             Writes the timekeeping registers from a 7-element C-compatible list
116             of values. This method ignores the C and C fields, if present.
117              
118             Because the F only stores a 2-digit year number and a century bit,
119             the year must be in the range C<2000>-C<2199> (i.e. numerical values of C<100>
120             to C<299>).
121              
122             This method performs an atomic writing of all the timekeeping registers as a
123             single I²C transaction, so is preferrable to invoking multiple calls to
124             individual write methods.
125              
126             =cut
127              
128 1         2 async method write_time ( $sec, $min, $hour, $mday, $mon, $year, $wday )
  1         4  
  1         2  
  1         2  
  1         25  
  1         5  
  1         2  
  1         1  
  1         2  
129 1         4 {
130 1 50 33     11 $year >= 100 and $year <= 299 or croak "Invalid year ($year)";
131              
132 1         3 my $century = $year >= 200;
133 1         3 $year %= 100;
134              
135 1         4 await $self->write_reg( REG_VLSECONDS, pack "C7",
136             _pack_bcd( $sec ),
137             _pack_bcd( $min ),
138             _pack_bcd( $hour ),
139             _pack_bcd( $mday ),
140             _pack_bcd( $wday ),
141             _pack_bcd( $mon + 1 ) | ( $century ? 0x80 : 0 ),
142             _pack_bcd( $year ),
143             );
144 1     1 1 357 }
145              
146             =head1 AUTHOR
147              
148             Paul Evans
149              
150             =cut
151              
152             0x55AA;