use 5.008;
use strict;
use warnings;
package App::Addex::AddressBook::Apple;
use base qw(App::Addex::AddressBook);
use App::Addex::Entry::EmailAddress;
use Encode ();
use Mac::Glue qw(:glue);
=head1 NAME
App::Addex::AddressBook::Apple - use Apple Address Book as the addex source
=head1 VERSION
version 0.016
=cut
our $VERSION = '0.016';
=head1 SYNOPSIS
This module implements the L<App::Addex::AddressBook> interface for Mac OS X's
Address Book application, using L<Mac::Glue> to get entries from the address
book.
You may need to set up glue for Address Book before this will work. You can do
this using F<gluemac> from L<Mac::Glue>
gluemac /Applications/Address\ Book.app
You will probably need to run this program with F<sudo>; just prepend C<sudo>
to the command above.
=cut
sub _glue {
return $_[0]->{_abook_glue} ||= Mac::Glue->new("Address_Book");
}
sub _demsng {
return if ! $_[1] or $_[1] eq 'msng';
return $_[1];
}
sub _fix_str {
my ($self, $str) = @_;
return '' unless defined $str;
return $str if Encode::is_utf8($str);
return Encode::decode(MacRoman => $str);
}
sub _fix_prop {
my ($self, $prop) = @_;
my $str = $self->_demsng($prop->get);
return $self->_fix_str($str);
}
sub _entrify {
my ($self, $person) = @_;
return unless my @emails = map {
App::Addex::Entry::EmailAddress->new({
address => $self->_demsng($_->prop('value')->get),
label => $self->_demsng($_->prop('label')->get),
});
} $person->prop("email")->get;
my %fields;
if (my $note = scalar $self->_demsng($person->prop('note')->get)) {
while ($note =~ /^(\S+):\s*([^\x20\t]+)$/mg) {
$fields{$1} = $2;
}
}
my $name;
if (my $fname = $self->_demsng($person->prop('first name')->get)) {
$fname = $self->_fix_str($fname);
my $mname = $self->_fix_prop($person->prop('middle name'));
my $lname = $self->_fix_prop($person->prop('last name'));
my $suffix = $self->_fix_prop($person->prop('suffix'));
$name = $fname
. (length $mname ? " $mname" : '')
. (length $lname ? " $lname" : '')
. (length $suffix ? " $suffix" : '');
} else {
$name = $self->_fix_prop($person->prop('name'));
}
CHECK_DEFAULT: {
if (@emails > 1 and my $default = $fields{default_email}) {
my $check;
if ($default =~ m{\A/(.+)/\z}) {
$default = qr/$1/;
$check = sub { $_[0]->address =~ $default };
} else {
$check = sub { $_[0]->label eq $default };
}
for my $i (0 .. $#emails) {
if ($check->($emails[$i])) {
unshift @emails, splice @emails, $i, 1 if $i != 0;
last CHECK_DEFAULT;
}
}
warn "no email found for $name matching $fields{default_email}\n";
}
}
return App::Addex::Entry->new({
name => $name,
nick => scalar $self->_demsng($person->prop('nickname')->get),
emails => \@emails,
fields => \%fields,
});
}
sub entries {
my ($self) = @_;
my @entries = map { $self->_entrify($_) } $self->_glue->prop("people")->get;
}
=head1 AUTHOR
Ricardo SIGNES, C<< <rjbs@cpan.org> >>
=head1 BUGS
Please report any bugs or feature requests through the web interface at
L<http://rt.cpan.org>. I will be notified, and then you'll automatically be
notified of progress on your bug as I make changes.
=head1 COPYRIGHT
Copyright 2006-2007 Ricardo Signes.
This program is free software; you may redistribute it and/or modify it
under the same terms as Perl itself.
=cut
1;