line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
# Palm::DiabetesPilot.pm |
2
|
|
|
|
|
|
|
# |
3
|
|
|
|
|
|
|
# Palm::PDB helper for handling Diabetes Pilot databases |
4
|
|
|
|
|
|
|
# |
5
|
|
|
|
|
|
|
# Copyright (C) 2003 Christophe Beauregard |
6
|
|
|
|
|
|
|
# |
7
|
|
|
|
|
|
|
# $Id: DiabetesPilot.pm,v 1.8 2004/09/08 23:23:00 cpb Exp $ |
8
|
|
|
|
|
|
|
|
9
|
1
|
|
|
1
|
|
102177
|
use strict; |
|
1
|
|
|
|
|
5
|
|
|
1
|
|
|
|
|
149
|
|
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
package Palm::DiabetesPilot; |
12
|
|
|
|
|
|
|
|
13
|
1
|
|
|
1
|
|
7
|
use Palm::PDB; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
25
|
|
14
|
1
|
|
|
1
|
|
13471
|
use Palm::Raw(); |
|
1
|
|
|
|
|
494
|
|
|
1
|
|
|
|
|
20
|
|
15
|
1
|
|
|
1
|
|
424
|
use Palm::StdAppInfo(); |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
use vars qw( $VERSION @ISA ); |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
$VERSION = do { my @r = (q$Revision: 1.8 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
@ISA = qw( Palm::StdAppInfo Palm::Raw ); |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
=head1 NAME |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
Palm::DiabetesPilot - Handler for Diabetes Pilot databases |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
=head1 SYNOPSIS |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
use Palm::DiabetesPilot; |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
=head1 DESCRIPTION |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
Helper for reading Diabetes Pilot (www.diabetespilot.com) databases. |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
=head2 AppInfo block |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
The AppInfo block begins with standard category support. See |
37
|
|
|
|
|
|
|
L for details. Diabetes Pilot doesn't have any |
38
|
|
|
|
|
|
|
application-specific extensions here. |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
=head2 Records |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
$record = $pdb->{records}{$i} |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
$record->{year} |
45
|
|
|
|
|
|
|
$record->{month} |
46
|
|
|
|
|
|
|
$record->{day} |
47
|
|
|
|
|
|
|
$record->{hour} |
48
|
|
|
|
|
|
|
$record->{minute} |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
The time of the record entry. |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
$record->{type} |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
The type of record. This will be one of C, C, C, |
55
|
|
|
|
|
|
|
C, or C. |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
$record->{quantity} |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
The quantity associated with the record. For a glucose reading, this is the |
60
|
|
|
|
|
|
|
level (in the appropriate units). For a meal, it's a carb value. For the |
61
|
|
|
|
|
|
|
medication, it's whatever units are appropriate. For the exercise, it's |
62
|
|
|
|
|
|
|
associated with the specific exercise selection. |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
$record->{note} |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
Any record type can have a note associated with it. |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
$record->{med} |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
In a C record, this indicates the type of medication taken. Meds are |
71
|
|
|
|
|
|
|
just text strings. |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
$record->{exer} |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
In an C record, this is a comment describing the type of |
76
|
|
|
|
|
|
|
exercise and the quantity associated with it. |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
$record->{items} |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
In a C record, this is a reference to an array of individual meal |
81
|
|
|
|
|
|
|
items. Each item is a hash reference containing the following fields: |
82
|
|
|
|
|
|
|
C, C, C, C, C, C, C. |
83
|
|
|
|
|
|
|
C is the textual description of the item and also generally includes |
84
|
|
|
|
|
|
|
the serving size and units. |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
=cut |
87
|
|
|
|
|
|
|
#' |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
sub import |
90
|
|
|
|
|
|
|
{ |
91
|
|
|
|
|
|
|
&Palm::PDB::RegisterPDBHandlers( __PACKAGE__, [ "DGA1", "DATA" ], ); |
92
|
|
|
|
|
|
|
} |
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
sub new |
95
|
|
|
|
|
|
|
{ |
96
|
|
|
|
|
|
|
die( "Palm::DiabetesPilot does not support new databases" ); |
97
|
|
|
|
|
|
|
} |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
sub new_Record |
100
|
|
|
|
|
|
|
{ |
101
|
|
|
|
|
|
|
die( "Palm::DiabetesPilot does not support new records" ); |
102
|
|
|
|
|
|
|
} |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
sub ParseAppInfoBlock($$) |
105
|
|
|
|
|
|
|
{ |
106
|
|
|
|
|
|
|
my ($self,$data) = @_; |
107
|
|
|
|
|
|
|
$self->{'appinfo'} = {}; |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
&Palm::StdAppInfo::parse_StdAppInfo($self->{'appinfo'}, $data); |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
return $self->{'appinfo'}; |
112
|
|
|
|
|
|
|
} |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
sub PackAppInfoBlock |
115
|
|
|
|
|
|
|
{ |
116
|
|
|
|
|
|
|
die( "Palm::DiabetesPilot does not support writing appinfo" ); |
117
|
|
|
|
|
|
|
} |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
sub ParseRecord |
120
|
|
|
|
|
|
|
{ |
121
|
|
|
|
|
|
|
my $self = shift; |
122
|
|
|
|
|
|
|
my %record = @_; |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
# catch empty records |
125
|
|
|
|
|
|
|
return \%record unless length $record{'data'} >= 20; |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
my ($sec,$min,$hour,$day,$mon,$year,$type,$quantity,$data) |
128
|
|
|
|
|
|
|
= unpack( "nnnnnn x2 C x3 n a*", $record{'data'} ); |
129
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
# quantities are always multiplied by ten for storage |
131
|
|
|
|
|
|
|
$quantity /= 10.0; |
132
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
# notes are NUL terminated and follow quantities |
134
|
|
|
|
|
|
|
my $note = (split /\0/, $data)[0]; |
135
|
|
|
|
|
|
|
chomp($note); |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
$record{'second'} = $sec; |
138
|
|
|
|
|
|
|
$record{'minute'} = $min; |
139
|
|
|
|
|
|
|
$record{'hour'} = $hour; |
140
|
|
|
|
|
|
|
$record{'day'} = $day; |
141
|
|
|
|
|
|
|
$record{'month'} = $mon; |
142
|
|
|
|
|
|
|
$record{'year'} = $year; |
143
|
|
|
|
|
|
|
$record{'quantity'} = $quantity; |
144
|
|
|
|
|
|
|
$record{'note'} = $note if $note ne ""; |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
# type-specific structures seem to be appended, word aligned, right after |
147
|
|
|
|
|
|
|
# the note ends. We've already extracted what we need from $data. |
148
|
|
|
|
|
|
|
my $nl = length($note)+1; |
149
|
|
|
|
|
|
|
$data = substr( $data, $nl + $nl % 2 ); |
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
# type is a bitmask. |
152
|
|
|
|
|
|
|
if( $type & 0x1 ) { |
153
|
|
|
|
|
|
|
$record{'type'} = 'meal'; |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
# we think it's the size of the data section in bytes, although it |
156
|
|
|
|
|
|
|
# doesn't always jive. |
157
|
|
|
|
|
|
|
my ($dlen,$items) = unpack( "n n", $data ); |
158
|
|
|
|
|
|
|
my @servings = unpack( "n$items", substr($data,4) ); |
159
|
|
|
|
|
|
|
@servings = map { $_/10.0 } @servings; |
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
# skip the 4+2*items header |
162
|
|
|
|
|
|
|
$data = substr( $data, 4+($items*2) ); |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
my @items = (); |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
for( my ($i,$pos) = (0,0); $i < $items; $i ++ ) { |
167
|
|
|
|
|
|
|
# records are 34 bytes, followed by a text description. There's |
168
|
|
|
|
|
|
|
# a lot in the records we don't know about, although some will |
169
|
|
|
|
|
|
|
# probably be food classification (as per the database), some |
170
|
|
|
|
|
|
|
# might be extended nutritional info, etc. None exactly relevant |
171
|
|
|
|
|
|
|
# at the moment. |
172
|
|
|
|
|
|
|
# there's some really odd record alignment, too. All records are |
173
|
|
|
|
|
|
|
# word aligned, but there's always going to be at least one |
174
|
|
|
|
|
|
|
# non-data byte between consecutive records (the NUL string |
175
|
|
|
|
|
|
|
# terminator counts as data). |
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
my $item = substr( $data, $pos, 34 ); |
178
|
|
|
|
|
|
|
last if length $item < 34; |
179
|
|
|
|
|
|
|
my ($calories,$fat,$carbs,$fiber,$protein) |
180
|
|
|
|
|
|
|
= unpack( "x6 n x2 n x6 n n x2 n x8", $item ); |
181
|
|
|
|
|
|
|
$fat /= 10.0; |
182
|
|
|
|
|
|
|
$carbs /= 10.0; |
183
|
|
|
|
|
|
|
$fiber /= 10.0; |
184
|
|
|
|
|
|
|
$protein /= 10.0; |
185
|
|
|
|
|
|
|
$calories /= 10.0; |
186
|
|
|
|
|
|
|
|
187
|
|
|
|
|
|
|
my $name = substr( $data, 34 + $pos ); |
188
|
|
|
|
|
|
|
$name = (split /\0/, $name)[0]; |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
push @items, |
191
|
|
|
|
|
|
|
{ 'servings' => $servings[$i], |
192
|
|
|
|
|
|
|
'carbs' => $carbs, |
193
|
|
|
|
|
|
|
'fat' => $fat, |
194
|
|
|
|
|
|
|
'protein' => $protein, |
195
|
|
|
|
|
|
|
'fiber' => $fiber, |
196
|
|
|
|
|
|
|
'calories' => $calories, |
197
|
|
|
|
|
|
|
'name' => $name, |
198
|
|
|
|
|
|
|
}; |
199
|
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
my $nl = length($name)+1; |
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
# word aligned, but if the string ends on a word boundary the |
203
|
|
|
|
|
|
|
# following word is skipped. |
204
|
|
|
|
|
|
|
$nl += ($nl%2) ? 1 : 2; |
205
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
$pos += 34 + $nl; |
207
|
|
|
|
|
|
|
|
208
|
|
|
|
|
|
|
} |
209
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
$record{'items'} = \@items; |
211
|
|
|
|
|
|
|
|
212
|
|
|
|
|
|
|
} elsif( $type & 0x2 ) { |
213
|
|
|
|
|
|
|
$record{'type'} = 'gluc'; |
214
|
|
|
|
|
|
|
} elsif( $type & 0x4 ) { |
215
|
|
|
|
|
|
|
# dword length indicates the med string |
216
|
|
|
|
|
|
|
$record{'med'} = substr( $data, 2, unpack( "n", $data )-1 ); |
217
|
|
|
|
|
|
|
chomp( $record{'med'} ); |
218
|
|
|
|
|
|
|
|
219
|
|
|
|
|
|
|
$record{'type'} = 'med'; |
220
|
|
|
|
|
|
|
} elsif( $type & 0x8 ) { |
221
|
|
|
|
|
|
|
$record{'exercise'} = substr( $data, 2, unpack( "n", $data )-1 ); |
222
|
|
|
|
|
|
|
chomp( $record{'exercise'} ); |
223
|
|
|
|
|
|
|
|
224
|
|
|
|
|
|
|
$record{'type'} = 'exer'; |
225
|
|
|
|
|
|
|
} elsif( $type & 0x10 ) { |
226
|
|
|
|
|
|
|
delete $record{'quantity'}; # notes don't have valid quantities |
227
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
$record{'type'} = 'note'; |
229
|
|
|
|
|
|
|
} else { |
230
|
|
|
|
|
|
|
return undef; |
231
|
|
|
|
|
|
|
} |
232
|
|
|
|
|
|
|
|
233
|
|
|
|
|
|
|
delete $record{'offset'}; |
234
|
|
|
|
|
|
|
delete $record{'data'}; |
235
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
return \%record; |
237
|
|
|
|
|
|
|
} |
238
|
|
|
|
|
|
|
|
239
|
|
|
|
|
|
|
sub PackRecord |
240
|
|
|
|
|
|
|
{ |
241
|
|
|
|
|
|
|
die( "Palm::DiabetesPilot does not support writing records" ); |
242
|
|
|
|
|
|
|
} |
243
|
|
|
|
|
|
|
|
244
|
|
|
|
|
|
|
1; |
245
|
|
|
|
|
|
|
__END__ |