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 |