File Coverage

blib/lib/Palm/Address.pm
Criterion Covered Total %
statement 70 128 54.6
branch 21 50 42.0
condition 0 3 0.0
subroutine 7 11 63.6
pod 6 6 100.0
total 104 198 52.5


line stmt bran cond sub pod time code
1             package Palm::Address;
2             #
3             # ABSTRACT: Handler for Palm OS AddressBook databases
4             #
5             # Copyright (C) 1999, 2000, Andrew Arensburger.
6             #
7             # This program is free software; you can redistribute it and/or modify
8             # it under the same terms as Perl itself.
9             #
10             # This program is distributed in the hope that it will be useful,
11             # but WITHOUT ANY WARRANTY; without even the implied warranty of
12             # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See either the
13             # GNU General Public License or the Artistic License for more details.
14              
15 2     2   6447 use strict;
  2         4  
  2         59  
16 2     2   880 use Palm::Raw();
  2         4765  
  2         32  
17 2     2   752 use Palm::StdAppInfo();
  2         4  
  2         42  
18              
19 2         2649 use vars qw( $VERSION @ISA
20             $numFieldLabels $addrLabelLength @phoneLabels @countries
21 2     2   9 %fieldMapBits );
  2         3  
22              
23             # One liner, to allow MakeMaker to work.
24             $VERSION = '1.015';
25             # This file is part of Palm 1.015 (February 14, 2015)
26              
27             @ISA = qw( Palm::StdAppInfo Palm::Raw );
28              
29             # AddressDB records are quite flexible and customizable, and therefore
30             # a pain in the ass to deal with correctly.
31              
32             #'
33              
34             $addrLabelLength = 16;
35             $numFieldLabels = 22;
36              
37             @phoneLabels = (
38             "Work",
39             "Home",
40             "Fax",
41             "Other",
42             "E-mail",
43             "Main",
44             "Pager",
45             "Mobile",
46             );
47              
48             @countries = (
49             "Australia",
50             "Austria",
51             "Belgium",
52             "Brazil",
53             "Canada",
54             "Denmark",
55             "Finland",
56             "France",
57             "Germany",
58             "Hong Kong",
59             "Iceland",
60             "Ireland",
61             "Italy",
62             "Japan",
63             "Luxembourg",
64             "Mexico",
65             "Netherlands",
66             "New Zealand",
67             "Norway",
68             "Spain",
69             "Sweden",
70             "Switzerland",
71             "United Kingdom",
72             "United States",
73             );
74              
75             # fieldMapBits
76             # Each Address record contains a flag record ($fieldMap, in
77             # &PackRecord) that indicates which fields exist in the record. This
78             # hash defines these flags' values.
79             %fieldMapBits = (
80             name => 0x0001,
81             firstName => 0x0002,
82             company => 0x0004,
83             phone1 => 0x0008,
84             phone2 => 0x0010,
85             phone3 => 0x0020,
86             phone4 => 0x0040,
87             phone5 => 0x0080,
88             address => 0x0100,
89             city => 0x0200,
90             state => 0x0400,
91             zipCode => 0x0800,
92             country => 0x1000,
93             title => 0x2000,
94             custom1 => 0x4000,
95             custom2 => 0x8000,
96             custom3 => 0x10000,
97             custom4 => 0x20000,
98             note => 0x40000,
99             );
100              
101             sub import
102             {
103 2     2   18 &Palm::PDB::RegisterPDBHandlers(__PACKAGE__,
104             [ "addr", "DATA" ],
105             );
106             }
107              
108             #'
109              
110             # new
111             # Create a new Palm::Address database, and return it
112             sub new
113             {
114 0     0 1 0 my $classname = shift;
115 0         0 my $self = $classname->SUPER::new(@_);
116             # Create a generic PDB. No need to rebless it,
117             # though.
118              
119 0         0 $self->{name} = "AddressDB"; # Default
120 0         0 $self->{creator} = "addr";
121 0         0 $self->{type} = "DATA";
122 0         0 $self->{attributes}{resource} = 0;
123             # The PDB is not a resource database by
124             # default, but it's worth emphasizing,
125             # since AddressDB is explicitly not a PRC.
126              
127             # Initialize the AppInfo block
128 0         0 $self->{appinfo} = {
129             fieldLabels => {
130             # Displayed labels for the various fields in
131             # each address record.
132             # XXX - These are American English defaults. It'd
133             # be way keen to allow i18n.
134             name => "Name",
135             firstName => "First name",
136             company => "Company",
137             phone1 => "Work",
138             phone2 => "Home",
139             phone3 => "Fax",
140             phone4 => "Other",
141             phone5 => "E-mail",
142             phone6 => "Main",
143             phone7 => "Pager",
144             phone8 => "Mobile",
145             address => "Address",
146             city => "City",
147             state => "State",
148             zipCode => "Zip Code",
149             country => "Country",
150             title => "Title",
151             custom1 => "Custom 1",
152             custom2 => "Custom 2",
153             custom3 => "Custom 3",
154             custom4 => "Custom 4",
155             note => "Note",
156             },
157              
158             # XXX - The country code corresponds to "United
159             # States". Again, it'd be keen to allow the user's #
160             # country-specific defaults.
161             country => 22,
162              
163             misc => 0,
164             };
165              
166             # Add the standard AppInfo block stuff
167 0         0 &Palm::StdAppInfo::seed_StdAppInfo($self->{appinfo});
168              
169             # Give the PDB a blank sort block
170 0         0 $self->{sort} = undef;
171              
172             # Give the PDB an empty list of records
173 0         0 $self->{records} = [];
174              
175 0         0 return $self;
176             }
177              
178              
179             # new_Record
180             # Create a new, initialized record.
181             sub new_Record
182             {
183 0     0 1 0 my $classname = shift;
184 0         0 my $retval = $classname->SUPER::new_Record(@_);
185              
186             # Initialize the fields. This isn't particularly enlightening,
187             # but every AddressDB record has these.
188 0         0 $retval->{fields} = {
189             name => undef,
190             firstName => undef,
191             company => undef,
192             phone1 => undef,
193             phone2 => undef,
194             phone3 => undef,
195             phone4 => undef,
196             phone5 => undef,
197             address => undef,
198             city => undef,
199             state => undef,
200             zipCode => undef,
201             country => undef,
202             title => undef,
203             custom1 => undef,
204             custom2 => undef,
205             custom3 => undef,
206             custom4 => undef,
207             note => undef,
208             };
209              
210             # Initialize the phone labels
211 0         0 $retval->{phoneLabel} = {
212             phone1 => 0, # Work
213             phone2 => 1, # Home
214             phone3 => 2, # Fax
215             phone4 => 3, # Other
216             phone5 => 4, # E-mail
217             display => 0, # Display work phone by default
218             reserved => undef # ???
219             };
220              
221 0         0 return $retval;
222             }
223              
224             # ParseAppInfoBlock
225             # Parse the AppInfo block for Address databases.
226             #
227             # The AppInfo block has the following overall structure:
228             # 1: Categories (see StdAppInfo.pm)
229             # 2: reserved word
230             # 3: dirty field labels
231             # 4: field labels
232             # 5: country
233             # 6: misc
234             # 3: I think this is similar to the first part of the standard AppInfo
235             # blocka, a bit field of which field labels have changed (i.e.,
236             # which fields have been renamed).
237             # 4: An array of field labels (16-character strings, NUL-terminated).
238             # 5: The code for the country for which the labels were designed.
239             # 6: 7 reserved bits followed by one flag that's set if the database
240             # should be sorted by company.
241             sub ParseAppInfoBlock
242             {
243 1     1 1 405 my $self = shift;
244 1         2 my $data = shift;
245 1         2 my $dirtyFields;
246             my @fieldLabels;
247 0         0 my $country;
248 0         0 my $misc;
249              
250 0         0 my $i;
251 1         3 my $appinfo = {};
252 1         2 my $std_len;
253              
254             # Get the standard parts of the AppInfo block
255 1         5 $std_len = &Palm::StdAppInfo::parse_StdAppInfo($appinfo, $data);
256              
257 1         2 $data = $appinfo->{other}; # Look at the non-standard part
258              
259             # Get the rest of the AppInfo block
260 1         5 my $unpackstr = # Argument to unpack()
261             "x2" . # Reserved
262             "N" . # Dirty flags
263             "a$addrLabelLength" x $numFieldLabels .
264             # Address labels
265             "C" . # Country
266             "C"; # Misc
267              
268 1         11 ($dirtyFields,
269             @fieldLabels[0..($numFieldLabels-1)],
270             $country,
271             $misc) =
272             unpack $unpackstr, $data;
273 1         3 for (@fieldLabels)
274             {
275 22         38 s/\0.*$//; # Trim everything after the first NUL
276             # (when renaming custom fields, might
277             # have something like "Foo\0om 1"
278             }
279              
280 1         3 $appinfo->{dirtyFields} = $dirtyFields;
281 1         14 $appinfo->{fieldLabels} = {
282             name => $fieldLabels[0],
283             firstName => $fieldLabels[1],
284             company => $fieldLabels[2],
285             phone1 => $fieldLabels[3],
286             phone2 => $fieldLabels[4],
287             phone3 => $fieldLabels[5],
288             phone4 => $fieldLabels[6],
289             phone5 => $fieldLabels[7],
290             address => $fieldLabels[8],
291             city => $fieldLabels[9],
292             state => $fieldLabels[10],
293             zipCode => $fieldLabels[11],
294             country => $fieldLabels[12],
295             title => $fieldLabels[13],
296             custom1 => $fieldLabels[14],
297             custom2 => $fieldLabels[15],
298             custom3 => $fieldLabels[16],
299             custom4 => $fieldLabels[17],
300             note => $fieldLabels[18],
301             phone6 => $fieldLabels[19],
302             phone7 => $fieldLabels[20],
303             phone8 => $fieldLabels[21],
304             };
305 1         2 $appinfo->{country} = $country;
306 1         2 $appinfo->{misc} = $misc; # XXX - Parse the "misc" field further
307              
308 1         4 return $appinfo;
309             }
310              
311             sub PackAppInfoBlock
312             {
313 0     0 1 0 my $self = shift;
314 0         0 my $retval;
315             my $i;
316 0         0 my $other; # Non-standard AppInfo stuff
317              
318             # Pack the application-specific part of the AppInfo block
319 0         0 $other = pack("x2 N", $self->{appinfo}{dirtyFields});
320 0         0 $other .= pack("a$addrLabelLength" x $numFieldLabels,
321             $self->{appinfo}{fieldLabels}{name},
322             $self->{appinfo}{fieldLabels}{firstName},
323             $self->{appinfo}{fieldLabels}{company},
324             $self->{appinfo}{fieldLabels}{phone1},
325             $self->{appinfo}{fieldLabels}{phone2},
326             $self->{appinfo}{fieldLabels}{phone3},
327             $self->{appinfo}{fieldLabels}{phone4},
328             $self->{appinfo}{fieldLabels}{phone5},
329             $self->{appinfo}{fieldLabels}{address},
330             $self->{appinfo}{fieldLabels}{city},
331             $self->{appinfo}{fieldLabels}{state},
332             $self->{appinfo}{fieldLabels}{zipCode},
333             $self->{appinfo}{fieldLabels}{country},
334             $self->{appinfo}{fieldLabels}{title},
335             $self->{appinfo}{fieldLabels}{custom1},
336             $self->{appinfo}{fieldLabels}{custom2},
337             $self->{appinfo}{fieldLabels}{custom3},
338             $self->{appinfo}{fieldLabels}{custom4},
339             $self->{appinfo}{fieldLabels}{note},
340             $self->{appinfo}{fieldLabels}{phone6},
341             $self->{appinfo}{fieldLabels}{phone7},
342             $self->{appinfo}{fieldLabels}{phone8});
343 0         0 $other .= pack("C C x2",
344             $self->{appinfo}{country},
345             $self->{appinfo}{misc});
346 0         0 $self->{appinfo}{other} = $other;
347              
348             # Pack the standard part of the AppInfo block
349 0         0 $retval = &Palm::StdAppInfo::pack_StdAppInfo($self->{appinfo});
350              
351 0         0 return $retval;
352             }
353              
354             # ParseRecord
355             # Parse an Address Book record.
356              
357             # Address book records have the following overall structure:
358             # 1: phone labels
359             # 2: field map
360             # 3: fields
361              
362             # Each record can contain a number of fields, such as "name",
363             # "address", "city", "company", and so forth. Each field has an
364             # internal name ("zipCode"), a printable name ("Zip Code"), and a
365             # value ("90210").
366             #
367             # For most fields, there is a hard mapping between internal and
368             # printed names: "name" always corresponds to "Last Name". The fields
369             # "phone1" through "phone5" are different: each of these can be mapped
370             # to one of several printed names: "Work", "Home", "Fax", "Other",
371             # "E-Mail", "Main", "Pager" or "Mobile". Multiple internal names can
372             # map to the same printed name (a person might have several e-mail
373             # addresses), and the mapping is part of the record (i.e., each record
374             # has its own mapping).
375             #
376             # Part (3) is simply a series of NUL-terminated strings, giving the
377             # values of the various fields in the record, in a certain order. If a
378             # record does not have a given field, there is no string corresponding
379             # to it in this part.
380             #
381             # Part (2) is a bit field that specifies which fields the record
382             # contains.
383             #
384             # Part (1) determines the phone mapping described above. This is
385             # implemented as an unsigned long, but what we're interested in are
386             # the six least-significant nybbles. They are:
387             # disp phone5 phone4 phone3 phone2 phone1
388             # ("phone1" is the least-significant nybble). Each nybble holds a
389             # value in the range 0-15 which in turn specifies the printed name for
390             # that particular internal name.
391              
392             sub ParseRecord
393             {
394 2     2 1 50 my $self = shift;
395 2         6 my %record = @_;
396              
397 2         4 delete $record{offset}; # This is useless
398              
399 2         2 my $phoneFlags;
400             my @phoneTypes;
401 0         0 my $dispPhone; # Which phone to display in the phone list
402 0         0 my $reserved; # Not sure what this is. It's the 8 high bits
403             # of the "phone types" field.
404 0         0 my $fieldMap;
405 0         0 my $companyFieldOff; # Company field offset: offset into the
406             # raw "fields" string of the beginning of
407             # the company name, plus 1. Presumably this
408             # is to allow the address book app to quickly
409             # display by company name. It is 0 in entries
410             # that don't have a "Company" field.
411             # This can be ignored when reading, and
412             # must be computed when writing.
413 0         0 my $fields;
414 0         0 my @fields;
415              
416 2         8 ($phoneFlags, $fieldMap, $companyFieldOff, $fields) =
417             unpack("N N C a*", $record{data});
418 2         9 @fields = split /\0/, $fields;
419              
420             # Parse the phone flags
421 2         5 $phoneTypes[0] = $phoneFlags & 0x0f;
422 2         3 $phoneTypes[1] = ($phoneFlags >> 4) & 0x0f;
423 2         2 $phoneTypes[2] = ($phoneFlags >> 8) & 0x0f;
424 2         2 $phoneTypes[3] = ($phoneFlags >> 12) & 0x0f;
425 2         3 $phoneTypes[4] = ($phoneFlags >> 16) & 0x0f;
426 2         3 $dispPhone = ($phoneFlags >> 20) & 0x0f;
427 2         2 $reserved = ($phoneFlags >> 24) & 0xff;
428              
429 2         3 $record{phoneLabel}{phone1} = $phoneTypes[0];
430 2         3 $record{phoneLabel}{phone2} = $phoneTypes[1];
431 2         2 $record{phoneLabel}{phone3} = $phoneTypes[2];
432 2         3 $record{phoneLabel}{phone4} = $phoneTypes[3];
433 2         3 $record{phoneLabel}{phone5} = $phoneTypes[4];
434 2         2 $record{phoneLabel}{display} = $dispPhone;
435 2         3 $record{phoneLabel}{reserved} = $reserved;
436              
437             # Get the relevant fields
438 2 50       6 $fieldMap & 0x0001 and $record{fields}{name} = shift @fields;
439 2 50       5 $fieldMap & 0x0002 and $record{fields}{firstName} =
440             shift @fields;
441 2 50       5 $fieldMap & 0x0004 and $record{fields}{company} = shift @fields;
442 2 50       5 $fieldMap & 0x0008 and $record{fields}{phone1} = shift @fields;
443 2 50       4 $fieldMap & 0x0010 and $record{fields}{phone2} = shift @fields;
444 2 100       5 $fieldMap & 0x0020 and $record{fields}{phone3} = shift @fields;
445 2 100       3 $fieldMap & 0x0040 and $record{fields}{phone4} = shift @fields;
446 2 50       5 $fieldMap & 0x0080 and $record{fields}{phone5} = shift @fields;
447 2 50       4 $fieldMap & 0x0100 and $record{fields}{address} = shift @fields;
448 2 50       460 $fieldMap & 0x0200 and $record{fields}{city} = shift @fields;
449 2 50       4 $fieldMap & 0x0400 and $record{fields}{state} = shift @fields;
450 2 50       4 $fieldMap & 0x0800 and $record{fields}{zipCode} = shift @fields;
451 2 50       4 $fieldMap & 0x1000 and $record{fields}{country} = shift @fields;
452 2 50       3 $fieldMap & 0x2000 and $record{fields}{title} = shift @fields;
453 2 50       5 $fieldMap & 0x4000 and $record{fields}{custom1} = shift @fields;
454 2 50       3 $fieldMap & 0x8000 and $record{fields}{custom2} = shift @fields;
455 2 50       4 $fieldMap & 0x10000 and $record{fields}{custom3} = shift @fields;
456 2 50       3 $fieldMap & 0x20000 and $record{fields}{custom4} = shift @fields;
457 2 50       6 $fieldMap & 0x40000 and $record{fields}{note} = shift @fields;
458              
459 2         3 delete $record{data};
460              
461 2         7 return \%record;
462             }
463              
464             sub PackRecord
465             {
466 0     0 1   my $self = shift;
467 0           my $record = shift;
468 0           my $retval;
469              
470 0           $retval = pack("N",
471             ($record->{phoneLabel}{phone1} & 0x0f) |
472             (($record->{phoneLabel}{phone2} & 0x0f) << 4) |
473             (($record->{phoneLabel}{phone3} & 0x0f) << 8) |
474             (($record->{phoneLabel}{phone4} & 0x0f) << 12) |
475             (($record->{phoneLabel}{phone5} & 0x0f) << 16) |
476             (($record->{phoneLabel}{display} & 0x0f) << 20) |
477             (($record->{phoneLabel}{reserved} & 0xff) << 24));
478              
479             # Set the flag bits that indicate which fields exist in this
480             # record.
481 0           my $fieldMap = 0;
482              
483 0           foreach my $fieldname (qw(name firstName company
484             phone1 phone2 phone3 phone4 phone5
485             address city state zipCode country title
486             custom1 custom2 custom3 custom4
487             note))
488             {
489 0 0 0       if (defined($record->{fields}{$fieldname}) &&
490             ($record->{fields}{$fieldname} ne ""))
491             {
492 0           $fieldMap |= $fieldMapBits{$fieldname};
493             }
494             else
495             {
496 0           $record->{fields}{$fieldname} = "";
497             }
498             }
499              
500 0           $retval .= pack("N", $fieldMap);
501              
502 0           my $fields = '';
503 0           my $companyFieldOff = 0;
504              
505 0 0         $fields .= $record->{fields}{name} . "\0"
506             unless $record->{fields}{name} eq "";
507 0 0         $fields .= $record->{fields}{firstName} . "\0"
508             unless $record->{fields}{firstName} eq "";
509 0 0         if ($record->{fields}{company} ne "")
510             {
511 0           $companyFieldOff = length($fields) + 1;
512 0           $fields .= $record->{fields}{company} . "\0"
513             }
514              
515             # Append each nonempty field in turn to $fields.
516 0           foreach my $fieldname (qw(phone1 phone2 phone3 phone4 phone5
517             address city state zipCode country title
518             custom1 custom2 custom3 custom4 note))
519             {
520             # Skip empty fields (either blank or undefined).
521 0 0         next if !defined($record->{fields}{$fieldname});
522 0 0         next if $record->{fields}{$fieldname} eq "";
523              
524             # Append the field (with a terminating NUL)
525 0           $fields .= $record->{fields}{$fieldname} . "\0";
526             }
527              
528 0           $retval .= pack("C", $companyFieldOff);
529 0           $retval .= $fields;
530              
531 0           return $retval;
532             }
533              
534             1;
535              
536             __END__