line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package RPi::RTC::DS3231; |
2
|
|
|
|
|
|
|
|
3
|
14
|
|
|
14
|
|
5857
|
use strict; |
|
14
|
|
|
|
|
73
|
|
|
14
|
|
|
|
|
264
|
|
4
|
14
|
|
|
14
|
|
44
|
use warnings; |
|
14
|
|
|
|
|
17
|
|
|
14
|
|
|
|
|
613
|
|
5
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
our $VERSION = '0.01'; |
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
require XSLoader; |
9
|
|
|
|
|
|
|
XSLoader::load('RPi::RTC::DS3231', $VERSION); |
10
|
|
|
|
|
|
|
|
11
|
14
|
|
|
14
|
|
57
|
use Carp qw(croak); |
|
14
|
|
|
|
|
17
|
|
|
14
|
|
|
|
|
935
|
|
12
|
|
|
|
|
|
|
|
13
|
14
|
|
|
14
|
|
58
|
use constant DS3231_ADDR => 0x68; |
|
14
|
|
|
|
|
27
|
|
|
14
|
|
|
|
|
16449
|
|
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
sub new { |
16
|
0
|
|
|
0
|
1
|
|
my ($class, $rtc_addr) = @_; |
17
|
|
|
|
|
|
|
|
18
|
0
|
0
|
|
|
|
|
$rtc_addr = DS3231_ADDR if ! defined $rtc_addr; |
19
|
|
|
|
|
|
|
|
20
|
0
|
|
|
|
|
|
my $self = bless {}, $class; |
21
|
0
|
|
|
|
|
|
$self->_fd($rtc_addr); |
22
|
0
|
|
|
|
|
|
return $self; |
23
|
|
|
|
|
|
|
} |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
# misc methods |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
sub temp { |
28
|
0
|
|
|
0
|
1
|
|
my ($self, $output) = @_; |
29
|
0
|
|
|
|
|
|
my $celcius = getTemp($self->_fd); |
30
|
0
|
0
|
0
|
|
|
|
return defined $output && $output eq 'f' ? $celcius * 9/5 + 32 : $celcius; |
31
|
|
|
|
|
|
|
} |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
# time/date methods |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
sub year { |
36
|
0
|
|
|
0
|
1
|
|
my ($self, $year) = @_; |
37
|
0
|
0
|
|
|
|
|
if (defined $year){ |
38
|
0
|
|
|
|
|
|
setYear($self->_fd, $year); |
39
|
|
|
|
|
|
|
} |
40
|
0
|
|
|
|
|
|
return getYear($self->_fd); |
41
|
|
|
|
|
|
|
} |
42
|
|
|
|
|
|
|
sub month { |
43
|
0
|
|
|
0
|
1
|
|
my ($self, $month) = @_; |
44
|
0
|
0
|
|
|
|
|
if (defined $month){ |
45
|
0
|
|
|
|
|
|
setMonth($self->_fd, $month); |
46
|
|
|
|
|
|
|
} |
47
|
0
|
|
|
|
|
|
return getMonth($self->_fd); |
48
|
|
|
|
|
|
|
} |
49
|
|
|
|
|
|
|
sub mday { |
50
|
0
|
|
|
0
|
1
|
|
my ($self, $mday) = @_; |
51
|
0
|
0
|
|
|
|
|
if (defined $mday){ |
52
|
0
|
|
|
|
|
|
setDayOfMonth($self->_fd, $mday); |
53
|
|
|
|
|
|
|
} |
54
|
0
|
|
|
|
|
|
return getDayOfMonth($self->_fd); |
55
|
|
|
|
|
|
|
} |
56
|
|
|
|
|
|
|
sub day { |
57
|
0
|
|
|
0
|
1
|
|
my ($self, $wday) = @_; |
58
|
0
|
0
|
|
|
|
|
if (defined $wday){ |
59
|
0
|
|
|
|
|
|
setDayOfWeek($self->_fd, $wday); |
60
|
|
|
|
|
|
|
} |
61
|
0
|
|
|
|
|
|
return getDayOfWeek($self->_fd); |
62
|
|
|
|
|
|
|
} |
63
|
|
|
|
|
|
|
sub hour { |
64
|
0
|
|
|
0
|
1
|
|
my ($self, $hour) = @_; |
65
|
0
|
0
|
|
|
|
|
if (defined $hour){ |
66
|
0
|
|
|
|
|
|
setHour($self->_fd, $hour); |
67
|
|
|
|
|
|
|
} |
68
|
|
|
|
|
|
|
|
69
|
0
|
|
|
|
|
|
return getHour($self->_fd); |
70
|
|
|
|
|
|
|
} |
71
|
|
|
|
|
|
|
sub min { |
72
|
0
|
|
|
0
|
1
|
|
my ($self, $min) = @_; |
73
|
0
|
0
|
|
|
|
|
if (defined $min){ |
74
|
0
|
|
|
|
|
|
setMinutes($self->_fd, $min); |
75
|
|
|
|
|
|
|
} |
76
|
0
|
|
|
|
|
|
return getMinutes($self->_fd); |
77
|
|
|
|
|
|
|
} |
78
|
|
|
|
|
|
|
sub sec { |
79
|
0
|
|
|
0
|
1
|
|
my ($self, $sec) = @_; |
80
|
0
|
0
|
|
|
|
|
if (defined $sec){ |
81
|
0
|
|
|
|
|
|
setSeconds($self->_fd, $sec); |
82
|
|
|
|
|
|
|
} |
83
|
0
|
|
|
|
|
|
return getSeconds($self->_fd); |
84
|
|
|
|
|
|
|
} |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
# auxillary time/date methods |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
sub am_pm { |
89
|
0
|
|
|
0
|
1
|
|
my ($self, $meridien) = @_; |
90
|
|
|
|
|
|
|
|
91
|
0
|
0
|
|
|
|
|
if (defined $meridien) { |
92
|
0
|
0
|
0
|
|
|
|
if ($meridien ne 'AM' && $meridien ne 'PM'){ |
93
|
0
|
|
|
|
|
|
croak("am_pm() requires either 'AM' or 'PM' as a param\n"); |
94
|
|
|
|
|
|
|
} |
95
|
0
|
0
|
|
|
|
|
if ($meridien eq 'AM') { |
96
|
0
|
|
|
|
|
|
$meridien = 0; |
97
|
|
|
|
|
|
|
} |
98
|
|
|
|
|
|
|
else { |
99
|
0
|
|
|
|
|
|
$meridien = 1; |
100
|
|
|
|
|
|
|
} |
101
|
0
|
|
|
|
|
|
setMeridien($self->_fd, $meridien); |
102
|
|
|
|
|
|
|
} |
103
|
0
|
0
|
|
|
|
|
return getMeridien($self->_fd) ? 'PM' : 'AM'; |
104
|
|
|
|
|
|
|
} |
105
|
|
|
|
|
|
|
sub clock_hours { |
106
|
0
|
|
|
0
|
1
|
|
my ($self, $value) = @_; |
107
|
0
|
0
|
|
|
|
|
if (defined $value){ |
108
|
0
|
0
|
0
|
|
|
|
if ($value !~ /\d+/ || ($value != 12 && $value != 24)){ |
|
|
|
0
|
|
|
|
|
109
|
0
|
|
|
|
|
|
croak "clock_hours() requires either 12 or 24 as a parameter\n"; |
110
|
|
|
|
|
|
|
} |
111
|
0
|
0
|
|
|
|
|
$value = $value == 12 ? 1 : 0; |
112
|
0
|
|
|
|
|
|
setMilitary($self->_fd, $value); |
113
|
|
|
|
|
|
|
} |
114
|
0
|
0
|
|
|
|
|
return getMilitary($self->_fd) ? 12 : 24; |
115
|
|
|
|
|
|
|
} |
116
|
|
|
|
|
|
|
sub hms { |
117
|
0
|
|
|
0
|
1
|
|
my ($self) = @_; |
118
|
|
|
|
|
|
|
|
119
|
0
|
|
|
|
|
|
my $h = _stringify(getHour($self->_fd)); |
120
|
0
|
|
|
|
|
|
my $m = _stringify(getMinutes($self->_fd)); |
121
|
0
|
|
|
|
|
|
my $s = _stringify(getSeconds($self->_fd)); |
122
|
|
|
|
|
|
|
|
123
|
0
|
|
|
|
|
|
my $hms = "$h:$m:$s"; |
124
|
|
|
|
|
|
|
|
125
|
0
|
0
|
|
|
|
|
$hms = "$hms " . $self->am_pm if $self->clock_hours == 12; |
126
|
|
|
|
|
|
|
|
127
|
0
|
|
|
|
|
|
return $hms; |
128
|
|
|
|
|
|
|
} |
129
|
|
|
|
|
|
|
sub date_time { |
130
|
0
|
|
|
0
|
1
|
|
my ($self, $datetime) = @_; |
131
|
|
|
|
|
|
|
|
132
|
0
|
0
|
|
|
|
|
if (defined $datetime){ |
133
|
0
|
|
|
|
|
|
my @dt; |
134
|
|
|
|
|
|
|
|
135
|
0
|
0
|
|
|
|
|
if (@dt = |
136
|
|
|
|
|
|
|
$datetime =~ /(\d{4})-(\d{2})-(\d{2})\s+(\d{2}):(\d{2}):(\d{2})/) |
137
|
|
|
|
|
|
|
{ |
138
|
0
|
|
|
|
|
|
my $ch = $self->clock_hours; |
139
|
|
|
|
|
|
|
|
140
|
0
|
0
|
|
|
|
|
$self->clock_hours(24) if $ch == 12; |
141
|
|
|
|
|
|
|
|
142
|
0
|
|
|
|
|
|
$self->year($dt[0]); |
143
|
0
|
|
|
|
|
|
$self->month($dt[1]); |
144
|
0
|
|
|
|
|
|
$self->mday($dt[2]); |
145
|
|
|
|
|
|
|
|
146
|
0
|
|
|
|
|
|
$self->hour($dt[3]); |
147
|
0
|
|
|
|
|
|
$self->min($dt[4]); |
148
|
0
|
|
|
|
|
|
$self->sec($dt[5]); |
149
|
|
|
|
|
|
|
|
150
|
0
|
0
|
|
|
|
|
$self->clock_hours(12) if $ch == 12; |
151
|
|
|
|
|
|
|
} |
152
|
|
|
|
|
|
|
else { |
153
|
0
|
|
|
|
|
|
croak( |
154
|
|
|
|
|
|
|
"datetime parameter must be in the format " . |
155
|
|
|
|
|
|
|
"'yyyy-mm-dd hh:mm:ss'. You supplied '$datetime'\n" |
156
|
|
|
|
|
|
|
); |
157
|
|
|
|
|
|
|
} |
158
|
|
|
|
|
|
|
} |
159
|
0
|
|
|
|
|
|
my $y = getYear($self->_fd); |
160
|
0
|
|
|
|
|
|
my $mon = _stringify(getMonth($self->_fd)); |
161
|
0
|
|
|
|
|
|
my $day = _stringify(getDayOfMonth($self->_fd)); |
162
|
|
|
|
|
|
|
|
163
|
0
|
|
|
|
|
|
my $h; |
164
|
|
|
|
|
|
|
|
165
|
0
|
0
|
|
|
|
|
if ($self->clock_hours == 12){ |
166
|
0
|
|
|
|
|
|
$self->clock_hours(24); |
167
|
0
|
|
|
|
|
|
$h = _stringify(getHour($self->_fd)); |
168
|
0
|
|
|
|
|
|
$self->clock_hours(12); |
169
|
|
|
|
|
|
|
} |
170
|
|
|
|
|
|
|
else { |
171
|
0
|
|
|
|
|
|
$h = _stringify(getHour($self->_fd)); |
172
|
|
|
|
|
|
|
} |
173
|
|
|
|
|
|
|
|
174
|
0
|
|
|
|
|
|
my $m = _stringify(getMinutes($self->_fd)); |
175
|
0
|
|
|
|
|
|
my $s = _stringify(getSeconds($self->_fd)); |
176
|
|
|
|
|
|
|
|
177
|
0
|
|
|
|
|
|
return "$y-$mon-$day $h:$m:$s"; |
178
|
|
|
|
|
|
|
} |
179
|
|
|
|
|
|
|
sub dt_hash { |
180
|
0
|
|
|
0
|
1
|
|
my ($self) = @_; |
181
|
|
|
|
|
|
|
|
182
|
0
|
|
|
|
|
|
my %dt; |
183
|
|
|
|
|
|
|
|
184
|
0
|
|
|
|
|
|
$dt{year} = getYear($self->_fd); |
185
|
0
|
|
|
|
|
|
$dt{month} = _stringify(getMonth($self->_fd)); |
186
|
0
|
|
|
|
|
|
$dt{day} = _stringify(getDayOfMonth($self->_fd)); |
187
|
|
|
|
|
|
|
|
188
|
0
|
0
|
|
|
|
|
if ($self->clock_hours == 12){ |
189
|
0
|
|
|
|
|
|
$self->clock_hours(24); |
190
|
0
|
|
|
|
|
|
$dt{hour} = _stringify(getHour($self->_fd)); |
191
|
0
|
|
|
|
|
|
$self->clock_hours(12); |
192
|
|
|
|
|
|
|
} |
193
|
|
|
|
|
|
|
else { |
194
|
0
|
|
|
|
|
|
$dt{hour} = _stringify(getHour($self->_fd)); |
195
|
|
|
|
|
|
|
} |
196
|
|
|
|
|
|
|
|
197
|
0
|
|
|
|
|
|
$dt{minute} = _stringify(getMinutes($self->_fd)); |
198
|
0
|
|
|
|
|
|
$dt{second} = _stringify(getSeconds($self->_fd)); |
199
|
|
|
|
|
|
|
|
200
|
0
|
|
|
|
|
|
return %dt; |
201
|
|
|
|
|
|
|
} |
202
|
|
|
|
|
|
|
|
203
|
|
|
|
|
|
|
# operation methods |
204
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
sub close { |
206
|
0
|
|
|
0
|
1
|
|
my ($self) = @_; |
207
|
0
|
|
|
|
|
|
_close($self->_fd); |
208
|
|
|
|
|
|
|
} |
209
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
# internal methods |
211
|
|
|
|
|
|
|
|
212
|
|
|
|
|
|
|
sub _get_register { |
213
|
|
|
|
|
|
|
# retrieve the contents of an entire 8-bit register |
214
|
0
|
|
|
0
|
|
|
my ($self, $reg) = @_; |
215
|
0
|
|
|
|
|
|
return getRegister($self->_fd, $reg); |
216
|
|
|
|
|
|
|
} |
217
|
|
|
|
|
|
|
sub _fd { |
218
|
|
|
|
|
|
|
# initializes the I2C communications |
219
|
0
|
|
|
0
|
|
|
my ($self, $rtc_addr) = @_; |
220
|
|
|
|
|
|
|
|
221
|
0
|
0
|
|
|
|
|
if (! exists $self->{fd}){ |
222
|
0
|
|
|
|
|
|
$self->{fd} = getFh($rtc_addr); |
223
|
|
|
|
|
|
|
} |
224
|
0
|
|
|
|
|
|
return $self->{fd}; |
225
|
|
|
|
|
|
|
} |
226
|
|
|
|
|
|
|
sub _stringify { |
227
|
|
|
|
|
|
|
# left-pads with a zero any integer with only a single digit |
228
|
0
|
|
|
0
|
|
|
my ($int) = @_; |
229
|
|
|
|
|
|
|
|
230
|
0
|
0
|
0
|
|
|
|
if (! defined $int || $int !~ /\d+/){ |
231
|
0
|
|
|
|
|
|
croak "as_string() requires an integer to check/convert to str\n"; |
232
|
|
|
|
|
|
|
} |
233
|
|
|
|
|
|
|
|
234
|
0
|
0
|
|
|
|
|
return length($int) < 2 ? "0$int" : $int; |
235
|
|
|
|
|
|
|
} |
236
|
|
|
|
|
|
|
|
237
|
|
|
|
0
|
|
|
sub __vim {}; |
238
|
|
|
|
|
|
|
|
239
|
|
|
|
|
|
|
1; |
240
|
|
|
|
|
|
|
__END__ |