line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Net::CardDAVTalk::VCard; |
2
|
|
|
|
|
|
|
|
3
|
2
|
|
|
2
|
|
40
|
use 5.014; |
|
2
|
|
|
|
|
8
|
|
4
|
2
|
|
|
2
|
|
21
|
use strict; |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
39
|
|
5
|
2
|
|
|
2
|
|
8
|
use warnings; |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
59
|
|
6
|
2
|
|
|
2
|
|
15
|
use Text::VCardFast qw(vcard2hash hash2vcard); |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
96
|
|
7
|
2
|
|
|
2
|
|
11
|
use Encode qw(decode_utf8 encode_utf8); |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
92
|
|
8
|
2
|
|
|
2
|
|
10
|
use MIME::Base64 qw(decode_base64); |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
73
|
|
9
|
2
|
|
|
2
|
|
619
|
use List::Pairwise qw(mapp); |
|
2
|
|
|
|
|
3426
|
|
|
2
|
|
|
|
|
137
|
|
10
|
2
|
|
|
2
|
|
826
|
use List::MoreUtils qw(all pairwise); |
|
2
|
|
|
|
|
19550
|
|
|
2
|
|
|
|
|
14
|
|
11
|
2
|
|
|
2
|
|
2665
|
use Data::Dumper; |
|
2
|
|
|
|
|
9357
|
|
|
2
|
|
|
|
|
4191
|
|
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
=head1 NAME |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
Net::CardDAVTalk::VCard - A wrapper for VCard files |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
=head1 SUBROUTINES/METHODS |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
# Core {{{ |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
=head2 $class->new() |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
Create a basic VCard object with no fields set |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
=cut |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
sub new { |
28
|
0
|
|
|
0
|
1
|
|
my $Proto = shift; |
29
|
0
|
|
0
|
|
|
|
my $Class = ref($Proto) || $Proto; |
30
|
|
|
|
|
|
|
|
31
|
0
|
|
|
|
|
|
my $Self = { |
32
|
|
|
|
|
|
|
type => 'VCARD', |
33
|
|
|
|
|
|
|
properties => { |
34
|
|
|
|
|
|
|
version => [ |
35
|
|
|
|
|
|
|
{ |
36
|
|
|
|
|
|
|
name => "version", |
37
|
|
|
|
|
|
|
value => "3.0" |
38
|
|
|
|
|
|
|
}, |
39
|
|
|
|
|
|
|
], |
40
|
|
|
|
|
|
|
} |
41
|
|
|
|
|
|
|
}; |
42
|
|
|
|
|
|
|
|
43
|
0
|
|
|
|
|
|
return bless $Self, $Class; |
44
|
|
|
|
|
|
|
} |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
=head2 $class->new_fromstring($String) |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
Create a new object and populate it by parsing the VCard file |
49
|
|
|
|
|
|
|
who's contents are given in the string. |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
=cut |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
sub new_fromstring { |
54
|
0
|
|
|
0
|
1
|
|
my $Proto = shift; |
55
|
0
|
|
0
|
|
|
|
my $Class = ref($Proto) || $Proto; |
56
|
0
|
|
|
|
|
|
my $Data = shift; |
57
|
|
|
|
|
|
|
|
58
|
0
|
|
|
|
|
|
my $Parsed = eval { vcard2hash($Data, multival => [ qw(n adr org) ]) }; |
|
0
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
|
60
|
0
|
|
|
|
|
|
my $Self = $Parsed->{objects}->[0]; |
61
|
0
|
0
|
|
|
|
|
if ($Self->{type} ne 'vcard') { |
62
|
0
|
|
|
|
|
|
warn "Found non-vcard '$Self->{type}' for in $_"; |
63
|
0
|
|
|
|
|
|
return undef; |
64
|
|
|
|
|
|
|
} |
65
|
|
|
|
|
|
|
|
66
|
0
|
|
|
|
|
|
bless $Self, $Class; |
67
|
|
|
|
|
|
|
|
68
|
0
|
|
|
|
|
|
$Self->Normalise(); |
69
|
|
|
|
|
|
|
|
70
|
0
|
|
|
|
|
|
$Self->{_raw} = $Data; |
71
|
|
|
|
|
|
|
|
72
|
0
|
|
|
|
|
|
return $Self; |
73
|
|
|
|
|
|
|
} |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
=head2 $class->new_fromfile($File) |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
Given a filename or filehandle, read and parse a vcard from it. |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
=cut |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
sub new_fromfile { |
82
|
0
|
|
|
0
|
1
|
|
my $Proto = shift; |
83
|
0
|
|
0
|
|
|
|
my $Class = ref($Proto) || $Proto; |
84
|
|
|
|
|
|
|
|
85
|
0
|
|
|
|
|
|
my $FileR = shift; |
86
|
|
|
|
|
|
|
|
87
|
0
|
|
|
|
|
|
my $Fh; |
88
|
0
|
0
|
|
|
|
|
if (ref $FileR) { |
89
|
0
|
|
|
|
|
|
$Fh = $FileR; |
90
|
|
|
|
|
|
|
} else { |
91
|
0
|
0
|
|
|
|
|
open($Fh, $FileR) |
92
|
|
|
|
|
|
|
|| die "Could not read '$FileR': $!"; |
93
|
|
|
|
|
|
|
} |
94
|
|
|
|
|
|
|
|
95
|
0
|
|
|
|
|
|
my $Input = do { local $/; <$Fh>; }; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
|
97
|
0
|
|
|
|
|
|
my $Self = $Class->new_fromstring($Input); |
98
|
0
|
0
|
|
|
|
|
$Self->{file} = $FileR if !ref $FileR; |
99
|
|
|
|
|
|
|
|
100
|
0
|
|
|
|
|
|
return $Self; |
101
|
|
|
|
|
|
|
} |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
=head2 $self->as_string() |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
Return a string representation of the VCard (inverse of |
106
|
|
|
|
|
|
|
new_fromstring) |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
=cut |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
sub as_string { |
111
|
0
|
|
|
0
|
1
|
|
my $Self = shift; |
112
|
0
|
|
|
|
|
|
delete $Self->{_raw}; |
113
|
0
|
|
|
|
|
|
$Self->{_raw} = eval { hash2vcard({ objects => [ $Self ] }) }; |
|
0
|
|
|
|
|
|
|
114
|
0
|
|
|
|
|
|
return $Self->{_raw}; |
115
|
|
|
|
|
|
|
} |
116
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
=head2 $self->uid() |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
Get or set the uid field of the card. |
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
=cut |
122
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
sub uid { |
124
|
0
|
|
|
0
|
1
|
|
my $Self = shift; |
125
|
0
|
|
|
|
|
|
$Self->V('uid', 'value', @_); |
126
|
|
|
|
|
|
|
} |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
# }}} |
129
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
# ME VCard manipulation {{{ |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
my @VParamTypes = qw(work home text voice fax cell cell video pager textphone internet); |
133
|
|
|
|
|
|
|
push @VParamTypes, map { uc } @VParamTypes; |
134
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
my @VItemN = qw(surnames givennames additionalnames honorificprefixs honorificsuffixes); |
136
|
|
|
|
|
|
|
my @VItemADR = qw(postofficebox extendedaddress streetaddress locality region postalcode countryname); |
137
|
|
|
|
|
|
|
my @VItemORG = qw(company department); |
138
|
|
|
|
|
|
|
my %VExpand = (n => \@VItemN, adr => \@VItemADR, org => \@VItemORG); |
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
my @ProtoPrefixes = ( |
141
|
|
|
|
|
|
|
[ 'tel', qr/tel:/ ], |
142
|
|
|
|
|
|
|
[ 'impp', qr/skype:/ ], |
143
|
|
|
|
|
|
|
[ 'impp', qr/xmpp:/ ], |
144
|
|
|
|
|
|
|
[ 'x-skype', qr/skype:/ ], |
145
|
|
|
|
|
|
|
[ 'x-socialprofile', qr/twitter:/ ], |
146
|
|
|
|
|
|
|
); |
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
my %ABLabelTypeMap = (Home => 'home', Mobile => 'cell', Twitter => 'twitter'); |
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
my %VCardEmailTypeMap = ( |
151
|
|
|
|
|
|
|
home => 'personal', |
152
|
|
|
|
|
|
|
work => 'work', |
153
|
|
|
|
|
|
|
); |
154
|
|
|
|
|
|
|
my %RevVCardEmailTypeMap = reverse %VCardEmailTypeMap; |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
my %VCardAdrTypeMap = ( |
157
|
|
|
|
|
|
|
home => 'home', |
158
|
|
|
|
|
|
|
work => 'work', |
159
|
|
|
|
|
|
|
); |
160
|
|
|
|
|
|
|
my %RevVCardAdrTypeMap = reverse %VCardAdrTypeMap; |
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
my %VCardTelTypeMap = ( |
163
|
|
|
|
|
|
|
home => 'home', |
164
|
|
|
|
|
|
|
work => 'work', |
165
|
|
|
|
|
|
|
cell => 'mobile', |
166
|
|
|
|
|
|
|
fax => 'fax', |
167
|
|
|
|
|
|
|
pager => 'pager', |
168
|
|
|
|
|
|
|
); |
169
|
|
|
|
|
|
|
my %RevVCardTelTypeMap = reverse %VCardTelTypeMap; |
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
my %VCardTypeMap = ( |
172
|
|
|
|
|
|
|
email => [ \%VCardEmailTypeMap, \%RevVCardEmailTypeMap ], |
173
|
|
|
|
|
|
|
adr => [ \%VCardAdrTypeMap, \%RevVCardAdrTypeMap ], |
174
|
|
|
|
|
|
|
tel => [ \%VCardTelTypeMap, \%RevVCardTelTypeMap ], |
175
|
|
|
|
|
|
|
); |
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
my %IMPPServiceTypeMap = qw( |
178
|
|
|
|
|
|
|
skype skype |
179
|
|
|
|
|
|
|
); |
180
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
my %IMPPProtoPrefixes = ( |
182
|
|
|
|
|
|
|
'skype' => ['skype'], |
183
|
|
|
|
|
|
|
'msn' => ['msn','msnim'], |
184
|
|
|
|
|
|
|
'googletalk' => ['xmpp'], |
185
|
|
|
|
|
|
|
'facebook' => ['xmpp'], |
186
|
|
|
|
|
|
|
'aim' => ['aim'], |
187
|
|
|
|
|
|
|
'yahoo' => ['ymsgr'], |
188
|
|
|
|
|
|
|
'icq' => ['icq','aim'], |
189
|
|
|
|
|
|
|
'jabber' => ['xmpp'], |
190
|
|
|
|
|
|
|
); |
191
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
my %XSocialProfileTypeMap = qw( |
193
|
|
|
|
|
|
|
twitter twitter |
194
|
|
|
|
|
|
|
); |
195
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
my %XServiceTypeMap = qw( |
197
|
|
|
|
|
|
|
twitter twitter |
198
|
|
|
|
|
|
|
skype skype |
199
|
|
|
|
|
|
|
skype-username skype |
200
|
|
|
|
|
|
|
aim chat |
201
|
|
|
|
|
|
|
icq chat |
202
|
|
|
|
|
|
|
google-talk chat |
203
|
|
|
|
|
|
|
jabber chat |
204
|
|
|
|
|
|
|
msn chat |
205
|
|
|
|
|
|
|
yahoo chat |
206
|
|
|
|
|
|
|
ms-imaddress chat |
207
|
|
|
|
|
|
|
); |
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
my %VCardNewOnlineMap = ( |
210
|
|
|
|
|
|
|
'web' => [ |
211
|
|
|
|
|
|
|
[ 'url' ] |
212
|
|
|
|
|
|
|
], |
213
|
|
|
|
|
|
|
'chat' => sub { [ |
214
|
|
|
|
|
|
|
[ 'impp', { 'x-service-type' => 'jabber', 'x-user' => $_[0] } ], |
215
|
|
|
|
|
|
|
] }, |
216
|
|
|
|
|
|
|
'twitter' => sub { [ |
217
|
|
|
|
|
|
|
[ 'x-socialprofile', { 'type' => 'twitter', 'x-user' => $_[0] }, "http://twitter.com/$_[0]" ], |
218
|
|
|
|
|
|
|
[ 'x-twitter' ], |
219
|
|
|
|
|
|
|
] }, |
220
|
|
|
|
|
|
|
'skype' => sub { [ |
221
|
|
|
|
|
|
|
[ 'impp', { 'x-service-type' => 'skype', 'x-user' => $_[0] } ], |
222
|
|
|
|
|
|
|
[ 'x-skype' ], |
223
|
|
|
|
|
|
|
] }, |
224
|
|
|
|
|
|
|
'other' => sub { [ |
225
|
|
|
|
|
|
|
[ 'impp', { 'x-user' => $_[0] } ], |
226
|
|
|
|
|
|
|
] }, |
227
|
|
|
|
|
|
|
); |
228
|
|
|
|
|
|
|
|
229
|
|
|
|
|
|
|
my $NoteParamName = 'x-menote'; |
230
|
|
|
|
|
|
|
|
231
|
|
|
|
|
|
|
sub Normalise { |
232
|
0
|
|
|
0
|
0
|
|
my $Self = shift; |
233
|
|
|
|
|
|
|
|
234
|
0
|
|
|
|
|
|
$Self->{meta} = {}; |
235
|
|
|
|
|
|
|
|
236
|
0
|
|
|
|
|
|
my $Props = $Self->{properties}; |
237
|
|
|
|
|
|
|
|
238
|
|
|
|
|
|
|
# Expand/decode/normalise all values |
239
|
0
|
|
|
|
|
|
for (values %$Props) { |
240
|
|
|
|
|
|
|
|
241
|
|
|
|
|
|
|
# All properties are array ref of items |
242
|
0
|
|
|
|
|
|
for (@$_) { |
243
|
|
|
|
|
|
|
|
244
|
|
|
|
|
|
|
# Scalar or array ref (e.g. 'n', 'adr', etc compound fields) |
245
|
0
|
|
0
|
|
|
|
my $Value = $_->{value} // $_->{values}; |
246
|
|
|
|
|
|
|
|
247
|
|
|
|
|
|
|
# If non-ascii value, it's utf-8 |
248
|
0
|
0
|
|
|
|
|
for (ref($Value) ? @$Value : $Value) { |
249
|
0
|
0
|
|
|
|
|
if (/[\x80-\xff]/) { |
250
|
0
|
|
0
|
|
|
|
$_ = eval { decode_utf8($_) } // $_; |
|
0
|
|
|
|
|
|
|
251
|
|
|
|
|
|
|
} |
252
|
|
|
|
|
|
|
} |
253
|
|
|
|
|
|
|
|
254
|
|
|
|
|
|
|
# Expand out 'n' and 'adr' fields into components. |
255
|
|
|
|
|
|
|
# Put scalars into expanded fields and scalar refs in values arrayref |
256
|
0
|
0
|
|
|
|
|
if (my $VFields = $VExpand{$_->{name}}) { |
257
|
0
|
|
0
|
|
|
|
@$_{@$VFields} = map { $_ // '' } @$Value[0 .. scalar(@$VFields)-1]; |
|
0
|
|
|
|
|
|
|
258
|
0
|
|
|
|
|
|
$_->{values} = [ \@$_{@$VFields} ]; |
259
|
0
|
|
|
|
|
|
delete $_->{value}; |
260
|
|
|
|
|
|
|
} |
261
|
|
|
|
|
|
|
|
262
|
|
|
|
|
|
|
# Handle base64 encoded value |
263
|
0
|
|
|
|
|
|
my $Encoding = $_->{params}->{encoding}; |
264
|
0
|
0
|
0
|
|
|
|
if (ref($Encoding) && lc $Encoding->[0] eq 'b') { |
265
|
0
|
|
|
|
|
|
$Value = decode_base64($Value); |
266
|
0
|
|
|
|
|
|
$_->{binary} = 1; |
267
|
|
|
|
|
|
|
} |
268
|
|
|
|
|
|
|
|
269
|
|
|
|
|
|
|
# Expand and lowercase comma separated type= parameters |
270
|
0
|
0
|
|
|
|
|
if (my $Type = $_->{params}->{type}) { |
271
|
0
|
0
|
|
|
|
|
$_->{params}->{type} = $Type = [ $Type ] if !ref $Type; |
272
|
0
|
|
|
|
|
|
@$Type = map { split /,/, lc $_ } @$Type; |
|
0
|
|
|
|
|
|
|
273
|
|
|
|
|
|
|
} |
274
|
0
|
0
|
|
|
|
|
if (my $ServiceType = $_->{params}->{'x-service-type'}) { |
275
|
0
|
0
|
|
|
|
|
$_->{params}->{'x-service-type'} = $ServiceType = [ $ServiceType ] if !ref $ServiceType; |
276
|
|
|
|
|
|
|
} |
277
|
|
|
|
|
|
|
|
278
|
0
|
|
|
|
|
|
$_->{value} = $Value; |
279
|
|
|
|
|
|
|
|
280
|
|
|
|
|
|
|
# Create 'groups' item that tracks items in each group |
281
|
0
|
0
|
|
|
|
|
push @{$Self->{groups}->{$_->{group}}}, $_ if $_->{group}; |
|
0
|
|
|
|
|
|
|
282
|
|
|
|
|
|
|
} |
283
|
|
|
|
|
|
|
} |
284
|
|
|
|
|
|
|
|
285
|
|
|
|
|
|
|
# Add any X-ABLabel group items as 'label' attribute |
286
|
0
|
0
|
|
|
|
|
if (my $Labels = $Props->{'x-ablabel'}) { |
287
|
0
|
0
|
|
|
|
|
my %LabelMap = map { $_->{group} ? ($_->{group} => $_) : () } @$Labels; |
|
0
|
|
|
|
|
|
|
288
|
0
|
|
|
|
|
|
for (keys %$Props) { |
289
|
0
|
0
|
|
|
|
|
next if $_ eq 'x-ablabel'; |
290
|
0
|
|
|
|
|
|
for (@{$Props->{$_}}) { |
|
0
|
|
|
|
|
|
|
291
|
0
|
0
|
0
|
|
|
|
if (my $Label = $LabelMap{$_->{group} // ''}) { |
292
|
0
|
|
|
|
|
|
my $LabelV = $_->{label} = $Label->{value}; |
293
|
0
|
|
|
|
|
|
$_->{labelref} = $Label; |
294
|
|
|
|
|
|
|
|
295
|
|
|
|
|
|
|
# Attach type= param if appropriate |
296
|
0
|
0
|
|
|
|
|
$LabelV = $1 if $LabelV =~ m{^_\$\!<([^>]*)}; |
297
|
0
|
0
|
|
|
|
|
if (my $TypeP = $ABLabelTypeMap{$LabelV}) { |
298
|
0
|
|
0
|
|
|
|
my $TypeList = ($_->{params}->{type} //= []); |
299
|
0
|
0
|
|
|
|
|
push @$TypeList, $TypeP if !grep { $_ eq $TypeP } @$TypeList; |
|
0
|
|
|
|
|
|
|
300
|
|
|
|
|
|
|
} |
301
|
|
|
|
|
|
|
} |
302
|
|
|
|
|
|
|
} |
303
|
|
|
|
|
|
|
} |
304
|
|
|
|
|
|
|
} |
305
|
|
|
|
|
|
|
|
306
|
|
|
|
|
|
|
# Handle v4 value=uri telephone numbers |
307
|
0
|
|
|
|
|
|
my $Version = $Props->{version}; |
308
|
0
|
0
|
0
|
|
|
|
if ($Version && $Version->[0] >= 4.0) { |
309
|
0
|
|
|
|
|
|
for (@ProtoPrefixes) { |
310
|
0
|
|
|
|
|
|
my ($Prop, $ProtoRE) = @$_; |
311
|
0
|
0
|
|
|
|
|
if (my $Items = $Props->{$Prop}) { |
312
|
0
|
|
|
|
|
|
for (@$Items) { |
313
|
0
|
0
|
|
|
|
|
if ($_->{value} =~ s/^($ProtoRE)//) { |
314
|
0
|
|
|
|
|
|
$_->{proto_strip} = $1; |
315
|
|
|
|
|
|
|
# If we found a uri prefix, better have value=uri param |
316
|
0
|
0
|
0
|
|
|
|
if (!$_->{params}->{value} && $Prop eq 'tel') { |
317
|
0
|
|
|
|
|
|
$_->{params}->{value} = [ 'uri' ]; |
318
|
|
|
|
|
|
|
} |
319
|
|
|
|
|
|
|
} |
320
|
|
|
|
|
|
|
} |
321
|
|
|
|
|
|
|
} |
322
|
|
|
|
|
|
|
} |
323
|
|
|
|
|
|
|
} |
324
|
|
|
|
|
|
|
|
325
|
|
|
|
|
|
|
# Create synthetic "online" list. Generate "online_type" and "online_value" |
326
|
|
|
|
|
|
|
# based on all the different types for twitter and skype contact info |
327
|
0
|
|
|
|
|
|
my $Online = $Props->{online} = []; |
328
|
|
|
|
|
|
|
|
329
|
|
|
|
|
|
|
# URL:foo.com |
330
|
0
|
|
|
|
|
|
for (@{$Props->{url}}) { |
|
0
|
|
|
|
|
|
|
331
|
0
|
|
|
|
|
|
$_->{online_type} = 'web'; |
332
|
0
|
|
|
|
|
|
$_->{online_value} = $_->{value}; |
333
|
|
|
|
|
|
|
|
334
|
0
|
|
|
|
|
|
push @$Online, $_; |
335
|
|
|
|
|
|
|
} |
336
|
|
|
|
|
|
|
|
337
|
|
|
|
|
|
|
# IMPP;X-SERVICE-TYPE=Skype;type=pref:skype:someskype |
338
|
0
|
|
|
|
|
|
for (@{$Props->{impp}}) { |
|
0
|
|
|
|
|
|
|
339
|
0
|
|
0
|
|
|
|
my $Type = lc(($_->{params}->{'x-service-type'} // [])->[0] // ''); |
|
|
|
0
|
|
|
|
|
340
|
0
|
|
|
|
|
|
my $Value = $_->{value}; |
341
|
0
|
|
0
|
|
|
|
my $ProtoPrefixes = $IMPPProtoPrefixes{$Type} // ['x-apple']; |
342
|
0
|
|
|
|
|
|
$Value =~ s/^$_:// for @$ProtoPrefixes; |
343
|
0
|
|
0
|
|
|
|
$_->{online_type} = $IMPPServiceTypeMap{$Type} // 'chat'; |
344
|
0
|
|
|
|
|
|
$_->{online_value} = $Value; |
345
|
|
|
|
|
|
|
|
346
|
0
|
|
|
|
|
|
push @$Online, $_; |
347
|
|
|
|
|
|
|
} |
348
|
|
|
|
|
|
|
|
349
|
|
|
|
|
|
|
# X-SOCIALPROFILE;type=twitter;x-user=sometwitter:http://twitter.com/sometwitter |
350
|
0
|
|
|
|
|
|
for (@{$Props->{'x-socialprofile'}}) { |
|
0
|
|
|
|
|
|
|
351
|
0
|
|
0
|
|
|
|
my $Type = lc(($_->{params}->{type} // [])->[0] // ''); |
|
|
|
0
|
|
|
|
|
352
|
0
|
|
0
|
|
|
|
my $Value = $_->{params}->{'x-user'}->[0] // $_->{value}; |
353
|
0
|
|
0
|
|
|
|
$_->{online_type} = $XSocialProfileTypeMap{$Type} // 'other'; |
354
|
0
|
|
|
|
|
|
$_->{online_value} = $Value; |
355
|
|
|
|
|
|
|
|
356
|
0
|
|
|
|
|
|
push @$Online, $_; |
357
|
|
|
|
|
|
|
} |
358
|
|
|
|
|
|
|
|
359
|
|
|
|
|
|
|
# X-YAHOO:someyahoo |
360
|
0
|
|
|
|
|
|
for my $Type (keys %XServiceTypeMap) { |
361
|
0
|
|
|
|
|
|
for (@{$Props->{"x-$Type"}}) { |
|
0
|
|
|
|
|
|
|
362
|
0
|
|
|
|
|
|
$_->{online_type} = $XServiceTypeMap{$Type}; |
363
|
0
|
|
|
|
|
|
$_->{online_value} = $_->{value}; |
364
|
|
|
|
|
|
|
|
365
|
0
|
|
|
|
|
|
push @$Online, $_; |
366
|
|
|
|
|
|
|
} |
367
|
|
|
|
|
|
|
} |
368
|
|
|
|
|
|
|
|
369
|
|
|
|
|
|
|
# Set contact_type to match API |
370
|
0
|
|
|
|
|
|
for ([ 'email', \%VCardEmailTypeMap ], |
371
|
|
|
|
|
|
|
[ 'tel', \%VCardTelTypeMap ], |
372
|
|
|
|
|
|
|
[ 'adr', \%VCardAdrTypeMap ]) { |
373
|
0
|
|
|
|
|
|
my ($Prop, $Map) = @$_; |
374
|
|
|
|
|
|
|
|
375
|
0
|
|
0
|
|
|
|
my $Props = $Props->{$Prop} || next; |
376
|
0
|
|
|
|
|
|
for (@$Props) { |
377
|
|
|
|
|
|
|
# Prefer calculated online_type, otherwise case on property name or type params |
378
|
|
|
|
|
|
|
my ($ContactType) = |
379
|
0
|
0
|
0
|
|
|
|
map { ($_ && $Map->{$_}) or () } |
380
|
0
|
|
0
|
|
|
|
(($_->{online_type} or ()), $_->{name}, @{$_->{params}->{type} // []}); |
|
0
|
|
0
|
|
|
|
|
381
|
|
|
|
|
|
|
|
382
|
0
|
|
0
|
|
|
|
$_->{contact_type} = $ContactType // 'other'; |
383
|
|
|
|
|
|
|
} |
384
|
|
|
|
|
|
|
} |
385
|
|
|
|
|
|
|
} |
386
|
|
|
|
|
|
|
|
387
|
|
|
|
|
|
|
sub DeleteUnusedLabels { |
388
|
0
|
|
|
0
|
0
|
|
my ($Self) = @_; |
389
|
0
|
|
|
|
|
|
my $Props = $Self->{properties}; |
390
|
|
|
|
|
|
|
|
391
|
0
|
|
|
|
|
|
for (@{$Props->{'x-ablabel'}}) { |
|
0
|
|
|
|
|
|
|
392
|
0
|
|
|
|
|
|
my $Group = $Self->{groups}->{$_->{group}}; |
393
|
0
|
|
|
|
|
|
my $NumItems = grep { !$_->{deleted} } @$Group; |
|
0
|
|
|
|
|
|
|
394
|
0
|
0
|
|
|
|
|
$_->{deleted} = 1 if $NumItems <= 1; |
395
|
|
|
|
|
|
|
} |
396
|
|
|
|
|
|
|
} |
397
|
|
|
|
|
|
|
|
398
|
|
|
|
|
|
|
sub ReadOnly { |
399
|
0
|
0
|
|
0
|
0
|
|
$_[0]->{ReadOnly} = $_[1] if @_ > 1; return $_[0]->{ReadOnly}; |
|
0
|
|
|
|
|
|
|
400
|
|
|
|
|
|
|
} |
401
|
|
|
|
|
|
|
|
402
|
|
|
|
|
|
|
sub V { |
403
|
0
|
|
|
0
|
0
|
|
my ($Self, $Prop, $Item) = splice @_, 0, 3; |
404
|
0
|
|
0
|
|
|
|
$Item //= 'value'; |
405
|
0
|
|
|
|
|
|
my $Props = $Self->{properties}; |
406
|
|
|
|
|
|
|
|
407
|
|
|
|
|
|
|
die "Tried to modify read-only contact, fetch directly, not from cache" |
408
|
0
|
0
|
0
|
|
|
|
if @_ && $Self->{ReadOnly}; |
409
|
|
|
|
|
|
|
|
410
|
|
|
|
|
|
|
# Always get/set first item of given type |
411
|
0
|
|
0
|
|
|
|
my $V = $Props->{$Prop} && $Props->{$Prop}->[0]; |
412
|
|
|
|
|
|
|
|
413
|
|
|
|
|
|
|
# If setting value, and no existing value, create new |
414
|
0
|
0
|
0
|
|
|
|
if (!$V && @_) { |
415
|
0
|
|
|
|
|
|
$V = $Props->{$Prop}->[0] = { name => $Prop, params => {} }; |
416
|
|
|
|
|
|
|
|
417
|
|
|
|
|
|
|
# Create parts if an multipart field |
418
|
0
|
0
|
|
|
|
|
if (my $VFields = $VExpand{$Prop}) { |
419
|
0
|
|
|
|
|
|
@$V{@$VFields} = ("") x scalar @$VFields; |
420
|
0
|
|
|
|
|
|
$V->{values} = [ \@$V{@$VFields} ]; |
421
|
|
|
|
|
|
|
} |
422
|
|
|
|
|
|
|
} |
423
|
|
|
|
|
|
|
|
424
|
|
|
|
|
|
|
# Get value |
425
|
0
|
0
|
|
|
|
|
if (!@_) { |
426
|
0
|
0
|
|
|
|
|
return $V ? $V->{$Item} : undef; |
427
|
|
|
|
|
|
|
|
428
|
|
|
|
|
|
|
# Set value |
429
|
|
|
|
|
|
|
} else { |
430
|
0
|
|
|
|
|
|
$Self->{vchanged}->{$Prop} = 1; |
431
|
|
|
|
|
|
|
|
432
|
0
|
|
|
|
|
|
local $_ = shift; |
433
|
|
|
|
|
|
|
|
434
|
0
|
0
|
|
|
|
|
if (defined $_) { |
435
|
|
|
|
|
|
|
# Trim whitespace and garbage from values |
436
|
0
|
|
|
|
|
|
s/^\s+//; |
437
|
0
|
|
|
|
|
|
s/\s+$//; |
438
|
|
|
|
|
|
|
# Ugg, saw U+200B (ZERO WIDTH SPACE) in some data, http://www.perlmonks.org/?node_id=1020973 |
439
|
0
|
|
|
|
|
|
s/\p{FORMAT}//g; |
440
|
|
|
|
|
|
|
} |
441
|
|
|
|
|
|
|
|
442
|
|
|
|
|
|
|
# Delete item if not a compound value and setting to empty string or undef |
443
|
0
|
0
|
0
|
|
|
|
if ((!defined $_ || $_ eq '') && !$V->{values}) { |
|
|
|
0
|
|
|
|
|
444
|
0
|
|
|
|
|
|
my $E = shift @{$Props->{$Prop}}; |
|
0
|
|
|
|
|
|
|
445
|
0
|
|
|
|
|
|
$E->{deleted} = 1; |
446
|
|
|
|
|
|
|
} |
447
|
|
|
|
|
|
|
|
448
|
|
|
|
|
|
|
# Otherwise store the new value |
449
|
|
|
|
|
|
|
else { |
450
|
0
|
|
0
|
|
|
|
$V->{$Item} = $_ // ''; |
451
|
|
|
|
|
|
|
|
452
|
|
|
|
|
|
|
# Uggg, for compound value, delete if all values empty |
453
|
0
|
0
|
0
|
0
|
|
|
if ($V->{values} && all { $$_ eq '' } @{$V->{values}} ) { |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
454
|
0
|
|
|
|
|
|
my $E = shift @{$Props->{$Prop}}; |
|
0
|
|
|
|
|
|
|
455
|
0
|
|
|
|
|
|
$E->{deleted} = 1; |
456
|
|
|
|
|
|
|
} |
457
|
|
|
|
|
|
|
} |
458
|
|
|
|
|
|
|
|
459
|
0
|
|
|
|
|
|
$Self->DeleteUnusedLabels; |
460
|
|
|
|
|
|
|
|
461
|
0
|
0
|
0
|
|
|
|
$Self->VRebuildFN if $Prop eq 'n' || $Prop eq 'org'; |
462
|
0
|
|
|
|
|
|
return $_; |
463
|
|
|
|
|
|
|
} |
464
|
|
|
|
|
|
|
} |
465
|
|
|
|
|
|
|
|
466
|
|
|
|
|
|
|
sub VDate { |
467
|
0
|
|
|
0
|
0
|
|
my $Self = shift; |
468
|
0
|
|
|
|
|
|
local $_ = shift; |
469
|
|
|
|
|
|
|
|
470
|
|
|
|
|
|
|
# Convert VCard -> Our format |
471
|
0
|
0
|
|
|
|
|
if (!@_) { |
472
|
0
|
0
|
|
|
|
|
return undef if !$_; |
473
|
|
|
|
|
|
|
|
474
|
0
|
0
|
|
|
|
|
if (/^(\d{4})-(\d{2})-(\d{2})(?:T|$)/) { |
475
|
0
|
|
|
|
|
|
my ($Y, $M, $D) = ($1, $2, $3); |
476
|
0
|
0
|
|
|
|
|
$Y = '0000' if $Y eq '1604'; # iOS magic "no year" value |
477
|
0
|
|
|
|
|
|
return "$Y-$M-$D"; |
478
|
|
|
|
|
|
|
} |
479
|
|
|
|
|
|
|
|
480
|
|
|
|
|
|
|
# V4 format |
481
|
0
|
0
|
|
|
|
|
if (/^(\d{4}|--)(\d{2})(\d{2})(?:T|$)/) { |
482
|
0
|
|
|
|
|
|
my ($Y, $M, $D) = ($1, $2, $3); |
483
|
0
|
0
|
|
|
|
|
$Y = '0000' if $Y eq '--'; |
484
|
0
|
0
|
|
|
|
|
$Y = '0000' if $Y eq '1604'; # iOS magic "no year" value |
485
|
0
|
|
|
|
|
|
return "$Y-$M-$D"; |
486
|
|
|
|
|
|
|
} |
487
|
|
|
|
|
|
|
|
488
|
|
|
|
|
|
|
# Convert Our format -> VCard |
489
|
|
|
|
|
|
|
} else { |
490
|
|
|
|
|
|
|
# Delete value if special "empty" value |
491
|
0
|
0
|
|
|
|
|
return undef if $_ eq '0000-00-00'; |
492
|
|
|
|
|
|
|
|
493
|
|
|
|
|
|
|
# Our format is V3 format |
494
|
|
|
|
|
|
|
|
495
|
|
|
|
|
|
|
# Convert to V4 format if V4 card |
496
|
0
|
0
|
|
|
|
|
if ($Self->V('version') >= 4.0) { |
497
|
0
|
|
|
|
|
|
my ($Y, $M, $D) = /^(\d{4})-(\d{2})-(\d{2})/; |
498
|
0
|
0
|
|
|
|
|
$Y = '--' if $Y eq '0000'; |
499
|
0
|
|
|
|
|
|
$_ = $Y . $M . $D; |
500
|
|
|
|
|
|
|
} |
501
|
|
|
|
|
|
|
|
502
|
0
|
|
|
|
|
|
return $_; |
503
|
|
|
|
|
|
|
} |
504
|
|
|
|
|
|
|
|
505
|
0
|
|
|
|
|
|
return undef; |
506
|
|
|
|
|
|
|
} |
507
|
|
|
|
|
|
|
sub VRebuildFN { |
508
|
0
|
|
|
0
|
0
|
|
my $Self = shift; |
509
|
|
|
|
|
|
|
|
510
|
|
|
|
|
|
|
my $NewFN = join " ", map { |
511
|
0
|
0
|
|
|
|
|
$Self->V('n', $_) or () |
|
0
|
|
|
|
|
|
|
512
|
|
|
|
|
|
|
} qw(honorificprefixs givennames additionalnames surnames); |
513
|
|
|
|
|
|
|
|
514
|
0
|
|
|
|
|
|
my $Suffixes = $Self->V('n', 'honorificsuffixes'); |
515
|
0
|
0
|
|
|
|
|
$NewFN .= ', ' . $Suffixes if $Suffixes; |
516
|
|
|
|
|
|
|
|
517
|
|
|
|
|
|
|
# FN is a required field, so we have to set it to something |
518
|
0
|
0
|
|
|
|
|
unless ($NewFN) { |
519
|
0
|
|
|
|
|
|
$NewFN = $Self->VCompany(); |
520
|
|
|
|
|
|
|
} |
521
|
0
|
0
|
|
|
|
|
unless ($NewFN) { |
522
|
0
|
|
|
|
|
|
my ($Email) = $Self->VEmails(); |
523
|
0
|
|
|
|
|
|
$NewFN = $Email->{value}; |
524
|
|
|
|
|
|
|
} |
525
|
0
|
0
|
|
|
|
|
unless ($NewFN) { |
526
|
0
|
|
|
|
|
|
$NewFN = "No Name"; |
527
|
|
|
|
|
|
|
} |
528
|
|
|
|
|
|
|
|
529
|
0
|
|
|
|
|
|
$Self->V('fn', 'value', $NewFN); |
530
|
|
|
|
|
|
|
} |
531
|
|
|
|
|
|
|
|
532
|
|
|
|
|
|
|
sub VTitle { |
533
|
0
|
|
|
0
|
0
|
|
my $Self = shift; |
534
|
0
|
|
0
|
|
|
|
$Self->V('n', 'honorificprefixs', @_) // ''; |
535
|
|
|
|
|
|
|
} |
536
|
|
|
|
|
|
|
sub VFirstName { |
537
|
0
|
|
|
0
|
0
|
|
my $Self = shift; |
538
|
0
|
0
|
|
|
|
|
if (!@_) { |
539
|
0
|
0
|
|
|
|
|
return join " ", map { $_ or () } $Self->V('n', 'givennames'), $Self->V('n', 'additionalnames'); |
|
0
|
|
|
|
|
|
|
540
|
|
|
|
|
|
|
} else { |
541
|
0
|
|
|
|
|
|
my ($GivenNames, $AdditionalNames) = split / +/, $_[0], 2; |
542
|
0
|
|
|
|
|
|
$Self->V('n', 'givennames', $GivenNames); |
543
|
0
|
|
|
|
|
|
$Self->V('n', 'additionalnames', $AdditionalNames); |
544
|
|
|
|
|
|
|
} |
545
|
|
|
|
|
|
|
} |
546
|
|
|
|
|
|
|
sub VLastName { |
547
|
0
|
|
|
0
|
0
|
|
my $Self = shift; |
548
|
0
|
|
0
|
|
|
|
$Self->V('n', 'surnames', @_) // ''; |
549
|
|
|
|
|
|
|
} |
550
|
|
|
|
|
|
|
|
551
|
|
|
|
|
|
|
sub VFN { |
552
|
0
|
|
|
0
|
0
|
|
my $Self = shift; |
553
|
0
|
|
0
|
|
|
|
$Self->V('fn', 'value', @_) // ''; |
554
|
|
|
|
|
|
|
} |
555
|
|
|
|
|
|
|
|
556
|
|
|
|
|
|
|
sub VNickname { |
557
|
0
|
|
0
|
0
|
0
|
|
shift->V('nickname', 'value', @_) // ''; |
558
|
|
|
|
|
|
|
} |
559
|
|
|
|
|
|
|
sub VBirthday { |
560
|
0
|
|
|
0
|
0
|
|
my $Self = shift; |
561
|
0
|
0
|
|
|
|
|
if (!@_) { |
562
|
0
|
|
0
|
|
|
|
return $Self->VDate($Self->V('bday')) // '0000-00-00'; |
563
|
|
|
|
|
|
|
} else { |
564
|
0
|
|
|
|
|
|
$Self->V('bday', 'value', $Self->VDate($_[0], 1)); |
565
|
|
|
|
|
|
|
} |
566
|
|
|
|
|
|
|
} |
567
|
|
|
|
|
|
|
|
568
|
|
|
|
|
|
|
sub VCompany { |
569
|
0
|
|
0
|
0
|
0
|
|
shift->V('org', 'company', @_) // ''; |
570
|
|
|
|
|
|
|
} |
571
|
|
|
|
|
|
|
sub VDepartment { |
572
|
0
|
|
0
|
0
|
0
|
|
shift->V('org', 'department', @_) // ''; |
573
|
|
|
|
|
|
|
} |
574
|
|
|
|
|
|
|
sub VPosition { |
575
|
0
|
|
0
|
0
|
0
|
|
shift->V('title', 'value', @_) // ''; |
576
|
|
|
|
|
|
|
} |
577
|
|
|
|
|
|
|
|
578
|
|
|
|
|
|
|
sub VNotes { |
579
|
0
|
|
0
|
0
|
0
|
|
shift->V('note', 'value', @_) // ''; |
580
|
|
|
|
|
|
|
} |
581
|
|
|
|
|
|
|
|
582
|
|
|
|
|
|
|
my %VBasicTypeMap = (type => 'contact_type', value => 'value'); |
583
|
|
|
|
|
|
|
my %VOnlineTypeMap = (type => 'online_type', value => 'online_value'); |
584
|
|
|
|
|
|
|
my %VAdrTypeMap = (type => 'contact_type', street => 'streetaddress', city => 'locality', state => 'region', postcode => 'postalcode', country => 'countryname'); |
585
|
|
|
|
|
|
|
my %RevVAdrTypeMap = reverse %VAdrTypeMap; |
586
|
|
|
|
|
|
|
|
587
|
|
|
|
|
|
|
sub VKN { |
588
|
0
|
|
|
0
|
0
|
|
my $I = shift; |
589
|
0
|
|
|
|
|
|
join "/", map { $I->{$_} } @_; |
|
0
|
|
|
|
|
|
|
590
|
|
|
|
|
|
|
} |
591
|
|
|
|
|
|
|
|
592
|
|
|
|
|
|
|
sub VIsSame { |
593
|
0
|
|
|
0
|
0
|
|
my ($Self, $Prop, $E, $N) = @_; |
594
|
|
|
|
|
|
|
|
595
|
0
|
0
|
0
|
|
|
|
if ($Prop eq 'email' || $Prop eq 'tel') { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
596
|
|
|
|
|
|
|
# If type or value is same, consider it the same item |
597
|
|
|
|
|
|
|
return 1 if $N->{contact_type} eq $E->{contact_type} |
598
|
0
|
0
|
0
|
|
|
|
|| $N->{value} eq $E->{value}; |
599
|
|
|
|
|
|
|
|
600
|
|
|
|
|
|
|
} elsif ($Prop eq 'adr') { |
601
|
|
|
|
|
|
|
# If type or value is same, consider it the same item |
602
|
|
|
|
|
|
|
return 1 if $N->{contact_type} eq $E->{contact_type} |
603
|
0
|
0
|
0
|
0
|
|
|
|| all { ($N->{$_} // '') eq $E->{$_} } @VItemADR; |
|
0
|
|
0
|
|
|
|
|
604
|
|
|
|
|
|
|
|
605
|
|
|
|
|
|
|
} elsif ($Prop eq 'online') { |
606
|
|
|
|
|
|
|
# If synthetic online type AND value is same, consider it the same item |
607
|
|
|
|
|
|
|
return 1 if $N->{contact_type} eq ($E->{online_type} // $E->{contact_type}) |
608
|
0
|
0
|
0
|
|
|
|
&& $N->{value} eq ($E->{online_value} // $E->{value}); |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
609
|
|
|
|
|
|
|
|
610
|
|
|
|
|
|
|
} else { |
611
|
0
|
|
|
|
|
|
die "Unknown prop: $Prop"; |
612
|
|
|
|
|
|
|
} |
613
|
|
|
|
|
|
|
} |
614
|
|
|
|
|
|
|
|
615
|
|
|
|
|
|
|
sub VUpdateExisting { |
616
|
0
|
|
|
0
|
0
|
|
my ($Self, $Prop, $E, $N, $TypeMap) = @_; |
617
|
|
|
|
|
|
|
|
618
|
|
|
|
|
|
|
# Need to update vcard specific properties |
619
|
0
|
0
|
|
|
|
|
if (my $Maps = $VCardTypeMap{$Prop}) { |
620
|
0
|
0
|
|
|
|
|
if (my $ParamType = $Maps->[1]->{$N->{contact_type}}) { |
|
|
0
|
|
|
|
|
|
621
|
|
|
|
|
|
|
# Make sure only the single right type is present in the vcard type param |
622
|
0
|
|
0
|
|
|
|
my $Types = ($E->{params}->{type} //= []); |
623
|
0
|
|
|
|
|
|
@$Types = grep { !$Maps->[0]->{$_} } @$Types; |
|
0
|
|
|
|
|
|
|
624
|
0
|
|
|
|
|
|
push @$Types, $ParamType; |
625
|
|
|
|
|
|
|
|
626
|
|
|
|
|
|
|
# Lets try and be smart and update any label |
627
|
0
|
0
|
|
|
|
|
$Self->VUpdateLabel($E, $N) if $Prop eq 'adr'; |
628
|
|
|
|
|
|
|
} |
629
|
|
|
|
|
|
|
elsif ($N->{contact_type} eq 'other') { |
630
|
0
|
|
|
|
|
|
delete $E->{params}->{type}; |
631
|
|
|
|
|
|
|
} |
632
|
|
|
|
|
|
|
|
633
|
|
|
|
|
|
|
} else { |
634
|
0
|
|
|
|
|
|
die "Unknown prop: $Prop"; |
635
|
|
|
|
|
|
|
} |
636
|
|
|
|
|
|
|
|
637
|
|
|
|
|
|
|
# Now copy over value(s) |
638
|
0
|
|
|
|
|
|
$E->{$_} = $N->{$_} for values %$TypeMap; |
639
|
|
|
|
|
|
|
} |
640
|
|
|
|
|
|
|
|
641
|
|
|
|
|
|
|
sub VUpdateLabel { |
642
|
0
|
|
|
0
|
0
|
|
my ($Self, $E, $N) = @_; |
643
|
|
|
|
|
|
|
|
644
|
0
|
|
|
|
|
|
my @Labels; |
645
|
|
|
|
|
|
|
# In v4, it's a parameter |
646
|
0
|
|
|
|
|
|
push @Labels, map { \$_ } @{$E->{params}->{label}}; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
647
|
|
|
|
|
|
|
|
648
|
|
|
|
|
|
|
# In v3, it's a separate property. Either in same group... |
649
|
0
|
0
|
|
|
|
|
if (my $Group = $E->{group}) { |
650
|
0
|
|
|
|
|
|
for (@{$E->{groups}->{$Group}}) { |
|
0
|
|
|
|
|
|
|
651
|
0
|
0
|
|
|
|
|
push @Labels, \$_->{value} if $_->{name} eq 'label'; |
652
|
|
|
|
|
|
|
} |
653
|
|
|
|
|
|
|
} |
654
|
|
|
|
|
|
|
# ... or check for label with same type (e.g. 'work', 'home', etc) |
655
|
0
|
0
|
|
|
|
|
if (!@Labels) { |
656
|
0
|
|
0
|
|
|
|
my ($EType) = grep { $VCardAdrTypeMap{$_} } @{$E->{params}->{type} // []}; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
657
|
0
|
|
|
|
|
|
my $Labels = $Self->{properties}->{label}; |
658
|
0
|
0
|
0
|
|
|
|
if ($EType && $Labels) { |
659
|
0
|
|
|
|
|
|
for (@$Labels) { |
660
|
0
|
|
0
|
|
|
|
my ($Type) = grep { $VCardAdrTypeMap{$_} } @{$_->{params}->{type} // []}; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
661
|
0
|
0
|
0
|
|
|
|
push @Labels, \$_->{value} if $Type && $Type eq $EType; |
662
|
|
|
|
|
|
|
} |
663
|
|
|
|
|
|
|
} |
664
|
|
|
|
|
|
|
} |
665
|
|
|
|
|
|
|
|
666
|
0
|
|
|
|
|
|
my @EI = @$E{@VItemADR}; |
667
|
0
|
|
|
|
|
|
my @NI = @$N{@VItemADR}; |
668
|
|
|
|
|
|
|
|
669
|
0
|
|
|
|
|
|
for my $Label (@Labels) { |
670
|
|
|
|
|
|
|
pairwise { |
671
|
0
|
0
|
|
0
|
|
|
$$Label =~ s/\b\Q$a\E\b/$b/ if length $a >= 3; |
672
|
0
|
|
|
|
|
|
} @EI, @NI; |
673
|
|
|
|
|
|
|
} |
674
|
|
|
|
|
|
|
} |
675
|
|
|
|
|
|
|
|
676
|
|
|
|
|
|
|
sub _MakeItem { |
677
|
0
|
|
|
0
|
|
|
my ($Name, $Type, $Value, $Params, @Extra) = @_; |
678
|
|
|
|
|
|
|
+{ |
679
|
0
|
0
|
0
|
|
|
|
name => $Name, |
680
|
|
|
|
|
|
|
contact_type => $Type, |
681
|
|
|
|
|
|
|
(ref $Value ? 'values' : 'value') => $Value, |
682
|
|
|
|
|
|
|
params => $Params // {}, |
683
|
|
|
|
|
|
|
@Extra, |
684
|
|
|
|
|
|
|
}; |
685
|
|
|
|
|
|
|
} |
686
|
|
|
|
|
|
|
|
687
|
|
|
|
|
|
|
sub VNewItem { |
688
|
0
|
|
|
0
|
0
|
|
my ($Self, $Prop, $N) = @_; |
689
|
0
|
|
0
|
|
|
|
my $Type = $N->{online_type} // $N->{contact_type}; |
690
|
0
|
|
0
|
|
|
|
my $Value = $N->{online_value} // $N->{value}; |
691
|
|
|
|
|
|
|
|
692
|
0
|
|
|
|
|
|
my @New; |
693
|
|
|
|
|
|
|
|
694
|
0
|
0
|
|
|
|
|
if (my $Maps = $VCardTypeMap{$Prop}) { |
|
|
0
|
|
|
|
|
|
695
|
0
|
|
|
|
|
|
my $Params = {}; |
696
|
0
|
|
|
|
|
|
my %Extra; |
697
|
|
|
|
|
|
|
|
698
|
|
|
|
|
|
|
# Set vcard type parameter |
699
|
0
|
0
|
|
|
|
|
if (my $ParamType = $Maps->[1]->{$Type}) { |
700
|
0
|
|
|
|
|
|
$Params->{type} = [ $ParamType ]; |
701
|
|
|
|
|
|
|
} |
702
|
|
|
|
|
|
|
|
703
|
|
|
|
|
|
|
# Expand address value into array ref components |
704
|
0
|
0
|
|
|
|
|
if ($Prop eq 'adr') { |
705
|
0
|
|
|
|
|
|
@Extra{@VItemADR} = @$N{@VItemADR}; |
706
|
0
|
|
|
|
|
|
$Value = [ \@Extra{@VItemADR} ]; |
707
|
|
|
|
|
|
|
} |
708
|
|
|
|
|
|
|
|
709
|
0
|
0
|
|
|
|
|
$Params->{$NoteParamName} = $N->{note} if $N->{note}; |
710
|
0
|
0
|
|
|
|
|
if ($N->{pref}) { |
711
|
0
|
|
0
|
|
|
|
$Params->{type} //= []; |
712
|
0
|
|
|
|
|
|
push @{$Params->{type}}, 'pref'; |
|
0
|
|
|
|
|
|
|
713
|
|
|
|
|
|
|
} |
714
|
|
|
|
|
|
|
|
715
|
0
|
|
|
|
|
|
push @New, _MakeItem($Prop, $Type, $Value, $Params, %Extra); |
716
|
|
|
|
|
|
|
} |
717
|
|
|
|
|
|
|
|
718
|
|
|
|
|
|
|
elsif ($Prop eq 'online') { |
719
|
|
|
|
|
|
|
|
720
|
0
|
|
0
|
|
|
|
my $NewMap = $VCardNewOnlineMap{$Type} // $VCardNewOnlineMap{other}; |
721
|
|
|
|
|
|
|
push @New, _MakeItem($_->[0], $Type, $Value, $_->[1]) |
722
|
0
|
0
|
|
|
|
|
for @{ref $NewMap eq 'CODE' ? $NewMap->($N->{online_value}) : $NewMap}; |
|
0
|
|
|
|
|
|
|
723
|
|
|
|
|
|
|
} |
724
|
|
|
|
|
|
|
|
725
|
|
|
|
|
|
|
else { |
726
|
0
|
|
|
|
|
|
die "Unknown prop: $Prop"; |
727
|
|
|
|
|
|
|
} |
728
|
|
|
|
|
|
|
|
729
|
0
|
0
|
|
|
|
|
if ($N->{note}) { |
730
|
0
|
|
|
|
|
|
$_->{$NoteParamName} = $N->{note} for @New; |
731
|
|
|
|
|
|
|
} |
732
|
0
|
0
|
|
|
|
|
if ($N->{pref}) { |
733
|
0
|
|
|
|
|
|
$_->{pref} = 1 for @New; |
734
|
|
|
|
|
|
|
} |
735
|
|
|
|
|
|
|
|
736
|
0
|
|
|
|
|
|
return @New; |
737
|
|
|
|
|
|
|
} |
738
|
|
|
|
|
|
|
|
739
|
|
|
|
|
|
|
sub VL { |
740
|
0
|
|
|
0
|
0
|
|
my ($Self, $Prop, $TypeMap) = splice @_, 0, 3; |
741
|
0
|
|
|
|
|
|
my $Props = $Self->{properties}; |
742
|
|
|
|
|
|
|
|
743
|
|
|
|
|
|
|
die "Tried to modify read-only contact, fetch directly, not from cache" |
744
|
0
|
0
|
0
|
|
|
|
if @_ && $Self->{ReadOnly}; |
745
|
|
|
|
|
|
|
|
746
|
0
|
|
0
|
|
|
|
my @E = grep { !$_->{deleted} } @{$Props->{$Prop} // []}; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
747
|
|
|
|
|
|
|
|
748
|
|
|
|
|
|
|
# Easy part, return items |
749
|
0
|
0
|
|
|
|
|
if (!@_) { |
750
|
0
|
|
|
|
|
|
my %Seen; |
751
|
|
|
|
|
|
|
return map { |
752
|
0
|
|
|
|
|
|
my $I = $_; |
|
0
|
|
|
|
|
|
|
753
|
|
|
|
|
|
|
# dedup. this might be wrong if the second has pref or note |
754
|
0
|
|
|
|
|
|
my $VKN = VKN($I, values %$TypeMap); |
755
|
0
|
0
|
|
|
|
|
if ($Seen{$VKN}) { |
756
|
0
|
|
|
|
|
|
(); |
757
|
|
|
|
|
|
|
} |
758
|
|
|
|
|
|
|
else { |
759
|
0
|
|
|
|
|
|
$Seen{$VKN} = 1; |
760
|
0
|
|
|
0
|
|
|
my %Props = mapp { ($a => $I->{$b}) } %$TypeMap; |
|
0
|
|
|
|
|
|
|
761
|
0
|
0
|
0
|
|
|
|
$Props{pref} = 1 if grep { $_ eq 'pref' } @{$_->{params}->{type} // []}; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
762
|
0
|
0
|
|
|
|
|
$Props{note} = $_->{params}->{$NoteParamName}->[0] if $_->{params}->{$NoteParamName}; |
763
|
0
|
|
|
|
|
|
\%Props; |
764
|
|
|
|
|
|
|
} |
765
|
|
|
|
|
|
|
} @E; |
766
|
|
|
|
|
|
|
|
767
|
|
|
|
|
|
|
# Harder part, set items. Try and preserve existing items |
768
|
|
|
|
|
|
|
} else { |
769
|
0
|
|
|
|
|
|
$Self->{vchanged}->{$Prop} = 1; |
770
|
|
|
|
|
|
|
|
771
|
|
|
|
|
|
|
# Find exact existing matches moved to different spot |
772
|
0
|
|
|
|
|
|
my %EMap = map { VKN($_, values %$TypeMap) => $_ } @E; |
|
0
|
|
|
|
|
|
|
773
|
|
|
|
|
|
|
|
774
|
0
|
|
|
|
|
|
my $Pos = 0; |
775
|
|
|
|
|
|
|
|
776
|
0
|
|
|
|
|
|
my @R; |
777
|
0
|
|
|
|
|
|
for my $New (@_) { |
778
|
0
|
|
0
|
0
|
|
|
my $N = { mapp { $b => ($New->{$a} // '') } %$TypeMap }; |
|
0
|
|
|
|
|
|
|
779
|
|
|
|
|
|
|
|
780
|
0
|
|
|
|
|
|
my @NewItems; |
781
|
|
|
|
|
|
|
|
782
|
|
|
|
|
|
|
# Exact existing item exists (maybe different position) |
783
|
0
|
0
|
|
|
|
|
if (my $E = delete $EMap{VKN($N, values %$TypeMap)}) { |
784
|
0
|
|
|
|
|
|
push @NewItems, $E; |
785
|
|
|
|
|
|
|
|
786
|
|
|
|
|
|
|
} else { |
787
|
0
|
|
|
|
|
|
my $E = $E[$Pos]; |
788
|
|
|
|
|
|
|
|
789
|
|
|
|
|
|
|
# Same item in same position, update value(s) |
790
|
|
|
|
|
|
|
# Not for online though, we always replace those |
791
|
0
|
0
|
0
|
|
|
|
if ($Prop ne 'online' && $E && $Self->VIsSame($Prop, $E, $N)) { |
|
|
|
0
|
|
|
|
|
792
|
|
|
|
|
|
|
# Don't re-use this item |
793
|
0
|
|
|
|
|
|
delete $EMap{VKN($E, values %$TypeMap)}; |
794
|
|
|
|
|
|
|
|
795
|
0
|
|
|
|
|
|
$Self->VUpdateExisting($Prop, $E, $N, $TypeMap); |
796
|
|
|
|
|
|
|
|
797
|
0
|
|
|
|
|
|
push @NewItems, $E; |
798
|
|
|
|
|
|
|
} |
799
|
|
|
|
|
|
|
|
800
|
|
|
|
|
|
|
# Add new item! |
801
|
|
|
|
|
|
|
else { |
802
|
0
|
|
|
|
|
|
push @NewItems, $Self->VNewItem($Prop, $N); |
803
|
|
|
|
|
|
|
|
804
|
|
|
|
|
|
|
} |
805
|
|
|
|
|
|
|
} |
806
|
|
|
|
|
|
|
|
807
|
0
|
0
|
|
|
|
|
if (my $Note = $New->{note}) { |
808
|
0
|
|
|
|
|
|
$_->{params}->{$NoteParamName} = [ $Note ] for @NewItems; |
809
|
|
|
|
|
|
|
} else { |
810
|
0
|
|
|
|
|
|
delete $_->{params}->{$NoteParamName} for @NewItems; |
811
|
|
|
|
|
|
|
} |
812
|
|
|
|
|
|
|
|
813
|
0
|
0
|
|
|
|
|
if ($New->{pref}) { |
814
|
0
|
|
|
|
|
|
for (@NewItems) { |
815
|
0
|
|
0
|
|
|
|
$_->{params}->{type} //= []; |
816
|
0
|
|
|
|
|
|
push @{$_->{params}->{type}}, 'pref'; |
|
0
|
|
|
|
|
|
|
817
|
|
|
|
|
|
|
} |
818
|
|
|
|
|
|
|
} else { |
819
|
0
|
|
|
|
|
|
for (@NewItems) { |
820
|
0
|
|
0
|
|
|
|
$_->{params}->{type} //= []; |
821
|
0
|
|
|
|
|
|
@{$_->{params}->{type}} = grep { $_ ne 'pref' } @{$_->{params}->{type}}; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
822
|
|
|
|
|
|
|
} |
823
|
|
|
|
|
|
|
} |
824
|
|
|
|
|
|
|
|
825
|
|
|
|
|
|
|
# Always add to result list |
826
|
0
|
|
|
|
|
|
push @R, @NewItems; |
827
|
0
|
|
|
|
|
|
$Pos += @NewItems; |
828
|
|
|
|
|
|
|
} |
829
|
|
|
|
|
|
|
|
830
|
|
|
|
|
|
|
# For tel, email, adr, just replace list |
831
|
0
|
0
|
0
|
|
|
|
if ($Prop eq 'email' || $Prop eq 'tel' || $Prop eq 'adr') { |
|
|
0
|
0
|
|
|
|
|
832
|
0
|
|
|
|
|
|
@{$Props->{$Prop}} = @R; |
|
0
|
|
|
|
|
|
|
833
|
|
|
|
|
|
|
|
834
|
|
|
|
|
|
|
} elsif ($Prop eq 'online') { |
835
|
|
|
|
|
|
|
# Maps to multiple props. Delete the old ones of types we're replacing |
836
|
0
|
|
|
|
|
|
my %ReplaceTypes = map { $_->{contact_type} => 1 } @R; |
|
0
|
|
|
|
|
|
|
837
|
0
|
|
|
|
|
|
$_->{deleted} = 1 for grep { $ReplaceTypes{$_->{online_type}} } @E; |
|
0
|
|
|
|
|
|
|
838
|
|
|
|
|
|
|
|
839
|
0
|
|
|
|
|
|
push @{$Props->{$Prop}}, @R; |
|
0
|
|
|
|
|
|
|
840
|
|
|
|
|
|
|
|
841
|
|
|
|
|
|
|
} else { |
842
|
0
|
|
|
|
|
|
die "Unknown prop: $Prop"; |
843
|
|
|
|
|
|
|
} |
844
|
|
|
|
|
|
|
|
845
|
0
|
|
|
|
|
|
$Self->DeleteUnusedLabels; |
846
|
|
|
|
|
|
|
|
847
|
0
|
0
|
|
|
|
|
$Self->VRebuildFN if $Prop eq 'email'; |
848
|
|
|
|
|
|
|
} |
849
|
|
|
|
|
|
|
} |
850
|
|
|
|
|
|
|
|
851
|
|
|
|
|
|
|
sub VEmails { |
852
|
0
|
|
|
0
|
0
|
|
shift->VL('email', \%VBasicTypeMap, @_); |
853
|
|
|
|
|
|
|
} |
854
|
|
|
|
|
|
|
sub VPhones { |
855
|
0
|
|
|
0
|
0
|
|
shift->VL('tel', \%VBasicTypeMap, @_); |
856
|
|
|
|
|
|
|
} |
857
|
|
|
|
|
|
|
sub VOnline { |
858
|
0
|
|
|
0
|
0
|
|
shift->VL('online', \%VOnlineTypeMap, @_); |
859
|
|
|
|
|
|
|
} |
860
|
|
|
|
|
|
|
sub VAddresses { |
861
|
0
|
|
|
0
|
0
|
|
shift->VL('adr', \%VAdrTypeMap, @_); |
862
|
|
|
|
|
|
|
} |
863
|
|
|
|
|
|
|
|
864
|
|
|
|
|
|
|
sub VKind { |
865
|
0
|
|
0
|
0
|
0
|
|
shift->V('x-addressbookserver-kind', 'value', @_) // 'contact'; |
866
|
|
|
|
|
|
|
} |
867
|
|
|
|
|
|
|
|
868
|
|
|
|
|
|
|
sub VGroupContactUIDs { |
869
|
0
|
|
|
0
|
0
|
|
my $Self = shift; |
870
|
0
|
|
|
|
|
|
my $Props = $Self->{properties}; |
871
|
|
|
|
|
|
|
|
872
|
|
|
|
|
|
|
die "Tried to modify read-only contact, fetch directly, not from cache" |
873
|
0
|
0
|
0
|
|
|
|
if @_ && $Self->{ReadOnly}; |
874
|
|
|
|
|
|
|
|
875
|
0
|
0
|
|
|
|
|
if (!@_) { |
876
|
|
|
|
|
|
|
return |
877
|
0
|
|
|
|
|
|
map { s/^urn://; s/^uuid://; $_ } |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
878
|
0
|
|
|
|
|
|
map { $_->{value} } |
879
|
0
|
0
|
|
|
|
|
@{$Props->{'x-addressbookserver-member'} ||[]}; |
|
0
|
|
|
|
|
|
|
880
|
|
|
|
|
|
|
|
881
|
|
|
|
|
|
|
} else { |
882
|
0
|
|
|
|
|
|
@{$Props->{'x-addressbookserver-member'}} = map { |
883
|
|
|
|
|
|
|
{ |
884
|
0
|
|
|
|
|
|
name => 'x-addressbookserver-member', |
885
|
|
|
|
|
|
|
params => {}, |
886
|
|
|
|
|
|
|
value => 'urn:uuid:' . $_, |
887
|
|
|
|
|
|
|
} |
888
|
0
|
|
|
|
|
|
} @{$_[0]}; |
|
0
|
|
|
|
|
|
|
889
|
|
|
|
|
|
|
|
890
|
0
|
|
|
|
|
|
$Self->{vchanged}->{'x-addressbookserver-member'} = 1; |
891
|
|
|
|
|
|
|
|
892
|
0
|
|
|
|
|
|
return @{$_[0]}; |
|
0
|
|
|
|
|
|
|
893
|
|
|
|
|
|
|
} |
894
|
|
|
|
|
|
|
|
895
|
|
|
|
|
|
|
} |
896
|
|
|
|
|
|
|
|
897
|
|
|
|
|
|
|
sub VGroupIds { |
898
|
0
|
|
|
0
|
0
|
|
my $Self = shift; |
899
|
0
|
0
|
|
|
|
|
!@_ || die "You can't set GroupIds on a contact, use ME::CalDAV::UpdateGroups"; |
900
|
0
|
0
|
|
|
|
|
return sort keys %{$Self->{ABGroups} || {}}; |
|
0
|
|
|
|
|
|
|
901
|
|
|
|
|
|
|
} |
902
|
|
|
|
|
|
|
|
903
|
|
|
|
|
|
|
sub VChanged { |
904
|
0
|
|
|
0
|
0
|
|
my $Self = shift; |
905
|
0
|
|
0
|
|
|
|
return keys %{$Self->{vchanged} // {}}; |
|
0
|
|
|
|
|
|
|
906
|
|
|
|
|
|
|
} |
907
|
|
|
|
|
|
|
sub VClearChanged { |
908
|
0
|
|
|
0
|
0
|
|
my $Self = shift; |
909
|
0
|
|
|
|
|
|
delete $Self->{vchanged}; |
910
|
|
|
|
|
|
|
} |
911
|
|
|
|
|
|
|
|
912
|
|
|
|
|
|
|
sub MFlagged { |
913
|
0
|
|
0
|
0
|
0
|
|
return shift->MMeta('SF:flagged', @_) || 0; |
914
|
|
|
|
|
|
|
} |
915
|
|
|
|
|
|
|
sub MImportance { |
916
|
|
|
|
|
|
|
# Defaults to empty string, make it a number |
917
|
0
|
|
0
|
0
|
0
|
|
return shift->MMeta('CY:importance', @_) || 0; |
918
|
|
|
|
|
|
|
} |
919
|
|
|
|
|
|
|
sub MMeta { |
920
|
0
|
|
|
0
|
0
|
|
my ($Self, $Prop) = (shift, shift); |
921
|
0
|
0
|
|
|
|
|
if (@_) { |
922
|
0
|
|
|
|
|
|
$Self->{meta}->{$Prop} = shift; |
923
|
0
|
|
|
|
|
|
$Self->{metachanged}->{$Prop} = 1; |
924
|
|
|
|
|
|
|
} |
925
|
0
|
|
|
|
|
|
return $Self->{meta}->{$Prop}; |
926
|
|
|
|
|
|
|
} |
927
|
|
|
|
|
|
|
|
928
|
|
|
|
|
|
|
sub MChanged { |
929
|
0
|
|
|
0
|
0
|
|
my $Self = shift; |
930
|
0
|
|
0
|
|
|
|
return map { [ $_, $Self->{meta}->{$_} ] } keys %{$Self->{metachanged} // {}}; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
931
|
|
|
|
|
|
|
} |
932
|
|
|
|
|
|
|
sub MClearChanged { |
933
|
0
|
|
|
0
|
0
|
|
my $Self = shift; |
934
|
0
|
|
|
|
|
|
delete $Self->{metachanged}; |
935
|
|
|
|
|
|
|
} |
936
|
|
|
|
|
|
|
|
937
|
|
|
|
|
|
|
# }}} |
938
|
|
|
|
|
|
|
|
939
|
|
|
|
|
|
|
1; |