File Coverage

blib/lib/App/Addex/AddressBook/Apple.pm
Criterion Covered Total %
statement 13 15 86.6
branch n/a
condition n/a
subroutine 5 5 100.0
pod n/a
total 18 20 90.0


line stmt bran cond sub pod time code
1 1     1   23969 use 5.008;
  1         4  
  1         38  
2 1     1   5 use strict;
  1         2  
  1         47  
3 1     1   5 use warnings;
  1         5  
  1         89  
4              
5             package App::Addex::AddressBook::Apple;
6             {
7             $App::Addex::AddressBook::Apple::VERSION = '0.018';
8             }
9 1     1   7 use base qw(App::Addex::AddressBook);
  1         1  
  1         687  
10             # ABSTRACT: use Apple Address Book as the addex source (doomed)
11              
12 1     1   488 use App::Addex::Entry::EmailAddress;
  0            
  0            
13             use Encode ();
14              
15             use Mac::Glue qw(:glue);
16              
17              
18             sub _glue {
19             return $_[0]->{_abook_glue} ||= Mac::Glue->new("Address_Book");
20             }
21              
22             sub _demsng {
23             return if ! $_[1] or $_[1] eq 'msng';
24             return $_[1];
25             }
26              
27             sub _fix_str {
28             my ($self, $str) = @_;
29              
30             return '' unless defined $str;
31             return $str if Encode::is_utf8($str);
32             return Encode::decode(MacRoman => $str);
33             }
34              
35             sub _fix_prop {
36             my ($self, $prop) = @_;
37             my $str = $self->_demsng($prop->get);
38             return $self->_fix_str($str);
39             }
40              
41             sub _entrify {
42             my ($self, $person) = @_;
43              
44             return unless my @emails = map {
45             App::Addex::Entry::EmailAddress->new({
46             address => $self->_demsng($_->prop('value')->get),
47             label => $self->_demsng($_->prop('label')->get),
48             });
49             } $person->prop("email")->get;
50              
51             my %fields;
52             if (my $note = scalar $self->_demsng($person->prop('note')->get)) {
53             while ($note =~ /^(\S+):\s*([^\x20\t]+)$/mg) {
54             $fields{$1} = $2;
55             }
56             }
57              
58             my $name;
59              
60             if (my $fname = $self->_demsng($person->prop('first name')->get)) {
61             $fname = $self->_fix_str($fname);
62             my $mname = $self->_fix_prop($person->prop('middle name'));
63             my $lname = $self->_fix_prop($person->prop('last name'));
64             my $suffix = $self->_fix_prop($person->prop('suffix'));
65              
66             $name = $fname
67             . (length $mname ? " $mname" : '')
68             . (length $lname ? " $lname" : '')
69             . (length $suffix ? " $suffix" : '');
70             } else {
71             $name = $self->_fix_prop($person->prop('name'));
72             }
73              
74             CHECK_DEFAULT: {
75             if (@emails > 1 and my $default = $fields{default_email}) {
76             my $check;
77             if ($default =~ m{\A/(.+)/\z}) {
78             $default = qr/$1/;
79             $check = sub { $_[0]->address =~ $default };
80             } else {
81             $check = sub { $_[0]->label eq $default };
82             }
83              
84             for my $i (0 .. $#emails) {
85             if ($check->($emails[$i])) {
86             unshift @emails, splice @emails, $i, 1 if $i != 0;
87             last CHECK_DEFAULT;
88             }
89             }
90              
91             warn "no email found for $name matching $fields{default_email}\n";
92             }
93             }
94              
95             return App::Addex::Entry->new({
96             name => $name,
97             nick => scalar $self->_demsng($person->prop('nickname')->get),
98             emails => \@emails,
99             fields => \%fields,
100             });
101             }
102              
103             sub entries {
104             my ($self) = @_;
105              
106             my @entries = map { $self->_entrify($_) } $self->_glue->prop("people")->get;
107             }
108              
109             1;
110              
111             __END__
112              
113             =pod
114              
115             =head1 NAME
116              
117             App::Addex::AddressBook::Apple - use Apple Address Book as the addex source (doomed)
118              
119             =head1 VERSION
120              
121             version 0.018
122              
123             =head1 SYNOPSIS
124              
125             B<Achtung!> Using this requires L<Mac::Glue>. Mac::Glue is not going to work
126             on more recent OS X. Instead, check out
127             L<App::Addex::AddressBook::AppleScript>.
128              
129             This module implements the L<App::Addex::AddressBook> interface for Mac OS X's
130             Address Book application, using L<Mac::Glue> to get entries from the address
131             book.
132              
133             You may need to set up glue for Address Book before this will work. You can do
134             this using F<gluemac> from L<Mac::Glue>
135              
136             gluemac /Applications/Address\ Book.app
137              
138             You will probably need to run this program with F<sudo>; just prepend C<sudo>
139             to the command above.
140              
141             =head1 AUTHOR
142              
143             Ricardo SIGNES <rjbs@cpan.org>
144              
145             =head1 COPYRIGHT AND LICENSE
146              
147             This software is copyright (c) 2006 by Ricardo SIGNES.
148              
149             This is free software; you can redistribute it and/or modify it under
150             the same terms as the Perl 5 programming language system itself.
151              
152             =cut