File Coverage

blib/lib/vCard.pm
Criterion Covered Total %
statement 115 115 100.0
branch 39 48 81.2
condition 18 35 51.4
subroutine 31 31 100.0
pod 19 19 100.0
total 222 248 89.5


line stmt bran cond sub pod time code
1             package vCard;
2             $vCard::VERSION = '3.08';
3 3     3   232550 use Moo;
  3         16208  
  3         14  
4              
5 3     3   2225 use Path::Tiny;
  3         4  
  3         110  
6 3     3   1025 use Text::vCard;
  3         7  
  3         47  
7 3     3   964 use vCard::AddressBook;
  3         5  
  3         74  
8 3     3   1354 use URI;
  3         9126  
  3         3276  
9              
10             =head1 NAME
11              
12             vCard - Read, write, and edit vCards
13              
14             =head1 SYNOPSIS
15              
16             use vCard;
17              
18             # create the object
19             my $vcard = vCard->new;
20              
21             # these methods load vCard data
22             # (see method documentation for details)
23             $vcard->load_file($filename);
24             $vcard->load_string($string);
25             $vcard->load_hashref($hashref);
26              
27             # simple getters/setters
28             $vcard->full_name('Bruce Banner, PhD');
29             $vcard->title('Research Scientist');
30             $vcard->photo('http://example.com/bbanner.gif');
31              
32             # complex getters/setters
33             $vcard->phones([
34             { type => ['work', 'text'], number => '651-290-1234', preferred => 1 },
35             { type => ['home'], number => '651-290-1111' }
36             ]);
37             $vcard->email_addresses([
38             { type => ['work'], address => 'bbanner@ssh.secret.army.mil' },
39             { type => ['home'], address => 'bbanner@timewarner.com' },
40             ]);
41              
42             # these methods output data in vCard format
43             my $file = $vcard->as_file($filename); # writes to $filename
44             my $string = $vcard->as_string; # returns a string
45              
46              
47             =head1 DESCRIPTION
48              
49             A vCard is a digital business card. vCard and L provide an
50             API for parsing, editing, and creating vCards.
51              
52             This module is built on top of L. It provides a more intuitive user
53             interface.
54              
55             To handle an address book with several vCard entries in it, start with
56             L and then come back to this module.
57              
58             Note that the vCard RFC requires version() and full_name(). This module does
59             not check or warn if these conditions have not been met.
60              
61              
62             =head1 ENCODING AND UTF-8
63              
64             See the 'ENCODING AND UTF-8' section of L.
65              
66              
67             =head1 METHODS
68              
69             =cut
70              
71             has encoding_in => ( is => 'rw', default => sub {'UTF-8'} );
72             has encoding_out => ( is => 'rw', default => sub {'UTF-8'} );
73             has _data => ( is => 'rw', default => sub { { version => '4.0' } } );
74              
75             with 'vCard::Role::FileIO';
76              
77             =head2 load_hashref($hashref)
78              
79             $hashref should look like this:
80              
81             full_name => 'Bruce Banner, PhD',
82             given_names => ['Bruce'],
83             family_names => ['Banner'],
84             title => 'Research Scientist',
85             photo => 'http://example.com/bbanner.gif',
86             phones => [
87             { type => ['work'], number => '651-290-1234', preferred => 1 },
88             { type => ['cell'], number => '651-290-1111' },
89             },
90             addresses => [
91             { type => ['work'], ... },
92             { type => ['home'], ... },
93             ],
94             email_addresses => [
95             { type => ['work'], address => 'bbanner@shh.secret.army.mil' },
96             { type => ['home'], address => 'bbanner@timewarner.com' },
97             ],
98              
99             Returns $self in case you feel like chaining.
100              
101             =cut
102              
103             sub load_hashref {
104 1     1 1 7 my ( $self, $hashref ) = @_;
105 1         8 $self->_data($hashref);
106              
107             $self->_data->{version} = '4.0'
108 1 50       12 unless $self->_data->{version};
109              
110             $self->_data->{photo} = URI->new( $self->_data->{photo} )
111 1 50       12 unless ref $self->_data->{photo} =~ /^URI/;
112              
113 1         4989 return $self;
114             }
115              
116             =head2 load_file($filename)
117              
118             Returns $self in case you feel like chaining.
119              
120             =cut
121              
122             sub load_file {
123 2     2 1 81 my ( $self, $filename ) = @_;
124              
125 2         32 my $addressBook = vCard::AddressBook->new({
126             encoding_in => $self->encoding_in,
127             encoding_out => $self->encoding_out,
128             });
129 2         14 my $vcard = $addressBook->load_file($filename)->vcards->[0];
130              
131 2         7 $self->_data($vcard->_data);
132              
133 2         16 return $self;
134             }
135              
136             =head2 load_string($string)
137              
138             Returns $self in case you feel like chaining. This method assumes $string is
139             decoded (but not MIME decoded).
140              
141             =cut
142              
143             sub load_string {
144 3     3 1 13 my ( $self, $string ) = @_;
145              
146 3         52 my $addressBook = vCard::AddressBook->new({
147             encoding_in => $self->encoding_in,
148             encoding_out => $self->encoding_out,
149             });
150 3         14 my $vcard = $addressBook->load_string($string)->vcards->[0];
151              
152 2         5 $self->_data($vcard->_data);
153              
154 2         7 return $self;
155             }
156              
157             =head2 as_string()
158              
159             Returns the vCard as a string.
160              
161             =cut
162              
163             sub as_string {
164 7     7 1 1003 my ($self) = @_;
165 7         36 my $vcard = Text::vCard->new( { encoding_out => $self->encoding_out } );
166              
167 7         16 my $phones = $self->_data->{phones};
168 7         10 my $addresses = $self->_data->{addresses};
169 7         8 my $email_addresses = $self->_data->{email_addresses};
170              
171 7         15 $self->_build_simple_nodes( $vcard, $self->_data );
172 7         20 $self->_build_name_node( $vcard, $self->_data );
173 7 100       21 $self->_build_phone_nodes( $vcard, $phones ) if $phones;
174 7 100       17 $self->_build_address_nodes( $vcard, $addresses ) if $addresses;
175 7 100       19 $self->_build_email_address_nodes( $vcard, $email_addresses )
176             if $email_addresses;
177              
178 7         15 return $vcard->as_string;
179             }
180              
181             sub _simple_node_types {
182 18     18   5885 qw/full_name title photo birthday timezone version/;
183             }
184              
185             sub _build_simple_nodes {
186 7     7   9 my ( $self, $vcard, $data ) = @_;
187              
188 7         15 foreach my $node_type ( $self->_simple_node_types ) {
189 42 100       48 if ( $node_type eq 'full_name' ) {
190 7 100       13 next unless $data->{full_name};
191 4         12 $vcard->fullname( $data->{full_name} );
192             } else {
193 35 100       101 next unless $data->{$node_type};
194 23         67 $vcard->$node_type( $data->{$node_type} );
195             }
196             }
197             }
198              
199             sub _build_name_node {
200 7     7   9 my ( $self, $vcard, $data ) = @_;
201              
202 7 100       8 my $value = join ',', @{ $data->{family_names} || [] };
  7         25  
203 7 100       7 $value .= ';' . join ',', @{ $data->{given_names} || [] };
  7         19  
204 7 100       8 $value .= ';' . join ',', @{ $data->{other_names} || [] };
  7         25  
205 7 100       8 $value .= ';' . join ',', @{ $data->{honorific_prefixes} || [] };
  7         21  
206 7 100       6 $value .= ';' . join ',', @{ $data->{honorific_suffixes} || [] };
  7         17  
207              
208 7 100       28 $vcard->add_node( { node_type => 'N', data => [ { value => $value } ] } )
209             if $value ne ';;;;';
210             }
211              
212             sub _build_phone_nodes {
213 4     4   5 my ( $self, $vcard, $phones ) = @_;
214              
215 4         8 foreach my $phone (@$phones) {
216              
217             # TODO: better error handling
218 8 50       14 die "'number' attr missing from 'phones'" unless $phone->{number};
219             die "'type' attr in 'phones' should be an arrayref"
220 8 50 33     34 if ( $phone->{type} && ref( $phone->{type} ) ne 'ARRAY' );
221              
222 8   50     14 my $type = $phone->{type} || [];
223 8         9 my $preferred = $phone->{preferred};
224 8         10 my $number = $phone->{number};
225              
226 8         4 my $params = [];
227 8         23 push @$params, { type => $_ } foreach @$type;
228 8 100       17 push @$params, { pref => $preferred } if $preferred;
229              
230 8         28 $vcard->add_node(
231             { node_type => 'TEL',
232             data => [ { params => $params, value => $number } ],
233             }
234             );
235             }
236             }
237              
238             sub _build_address_nodes {
239 4     4   4 my ( $self, $vcard, $addresses ) = @_;
240              
241 4         7 foreach my $address (@$addresses) {
242              
243             die "'type' attr in 'addresses' should be an arrayref"
244 8 50 33     37 if ( $address->{type} && ref( $address->{type} ) ne 'ARRAY' );
245              
246 8   50     20 my $type = $address->{type} || [];
247 8         8 my $preferred = $address->{preferred};
248              
249 8         10 my $params = [];
250 8         22 push @$params, { type => $_ } foreach @$type;
251 8 50       15 push @$params, { pref => $preferred } if $preferred;
252              
253             my $value = join ';',
254             $address->{pobox} || '',
255             $address->{extended} || '',
256             $address->{street} || '',
257             $address->{city} || '',
258             $address->{region} || '',
259             $address->{post_code} || '',
260 8   50     76 $address->{country} || '';
      50        
      50        
      50        
      50        
      50        
      50        
261              
262 8         28 $vcard->add_node(
263             { node_type => 'ADR',
264             data => [ { params => $params, value => $value } ],
265             }
266             );
267             }
268             }
269              
270             sub _build_email_address_nodes {
271 4     4   5 my ( $self, $vcard, $email_addresses ) = @_;
272              
273 4         6 foreach my $email_address (@$email_addresses) {
274              
275             # TODO: better error handling
276             die "'address' attr missing from 'email_addresses'"
277 8 50       15 unless $email_address->{address};
278             die "'type' attr in 'email_addresses' should be an arrayref"
279             if ( $email_address->{type}
280 8 50 33     34 && ref( $email_address->{type} ) ne 'ARRAY' );
281              
282 8   50     12 my $type = $email_address->{type} || [];
283 8         10 my $preferred = $email_address->{preferred};
284              
285 8         8 my $params = [];
286 8         22 push @$params, { type => $_ } foreach @$type;
287 8 100       16 push @$params, { pref => $preferred } if $preferred;
288              
289             # TODO: better error handling
290 8         8 my $value = $email_address->{address};
291              
292 8         26 $vcard->add_node(
293             { node_type => 'EMAIL',
294             data => [ { params => $params, value => $value } ],
295             }
296             );
297             }
298             }
299              
300             =head2 as_file($filename)
301              
302             Write data in vCard format to $filename.
303              
304             Dies if not successful.
305              
306             =cut
307              
308             sub as_file {
309 1     1 1 662 my ( $self, $filename ) = @_;
310 1         5 my $file = $self->_path($filename);
311 1         34 $file->spew( $self->_iomode_out, $self->as_string );
312 1         1354 return $file;
313             }
314              
315             =head1 SIMPLE GETTERS/SETTERS
316              
317             These methods accept and return strings.
318              
319             =head2 version()
320              
321             Version number of the vcard. Defaults to '4.0'
322              
323             =head2 full_name()
324              
325             A person's entire name as they would like to see it displayed.
326              
327             =head2 title()
328              
329             A person's position or job.
330              
331             =head2 photo()
332              
333             This should be a link. Accepts a string or a URI object. This method
334             always returns a L object.
335              
336             TODO: handle binary images using the data uri schema
337              
338             =head2 birthday()
339              
340             =head2 timezone()
341              
342              
343             =head1 COMPLEX GETTERS/SETTERS
344              
345             These methods accept and return array references rather than simple strings.
346              
347             =head2 family_names()
348              
349             Accepts/returns an arrayref of family names (aka surnames).
350              
351             =head2 given_names()
352              
353             Accepts/returns an arrayref.
354              
355             =head2 other_names()
356              
357             Accepts/returns an arrayref of names which don't qualify as family_names or
358             given_names.
359              
360             =head2 honorific_prefixes()
361              
362             Accepts/returns an arrayref. eg C<[ 'Dr.' ]>
363              
364             =head2 honorific_suffixes()
365              
366             Accepts/returns an arrayref. eg C<[ 'Jr.', 'MD' ]>
367              
368             =head2 phones()
369              
370             Accepts/returns an arrayref that looks like:
371              
372             [
373             { type => ['work'], number => '651-290-1234', preferred => 1 },
374             { type => ['cell'], number => '651-290-1111' },
375             ]
376              
377             =head2 addresses()
378              
379             Accepts/returns an arrayref that looks like:
380              
381             [
382             { type => ['work'], street => 'Main St', preferred => 0 },
383             { type => ['home'],
384             pobox => 1234,
385             extended => 'asdf',
386             street => 'Army St',
387             city => 'Desert Base',
388             region => '',
389             post_code => '',
390             country => 'USA',
391             preferred => 1,
392             },
393             ]
394              
395             =head2 email_addresses()
396              
397             Accepts/returns an arrayref that looks like:
398              
399             [
400             { type => ['work'], address => 'bbanner@ssh.secret.army.mil' },
401             { type => ['home'], address => 'bbanner@timewarner.com', preferred => 1 },
402             ]
403              
404             =cut
405              
406 11     11 1 2297 sub version { shift->_setget( 'version', @_ ) }
407 8     8 1 363 sub full_name { shift->_setget( 'full_name', @_ ) }
408 8     8 1 1760 sub family_names { shift->_setget( 'family_names', @_ ) }
409 8     8 1 15 sub given_names { shift->_setget( 'given_names', @_ ) }
410 7     7 1 14 sub other_names { shift->_setget( 'other_names', @_ ) }
411 8     8 1 15 sub honorific_prefixes { shift->_setget( 'honorific_prefixes', @_ ) }
412 8     8 1 14 sub honorific_suffixes { shift->_setget( 'honorific_suffixes', @_ ) }
413 12     12 1 478 sub title { shift->_setget( 'title', @_ ) }
414 24     24 1 9267 sub photo { shift->_setget( 'photo', @_ ) }
415 12     12 1 2338 sub birthday { shift->_setget( 'birthday', @_ ) }
416 12     12 1 2203 sub timezone { shift->_setget( 'timezone', @_ ) }
417 8     8 1 17 sub phones { shift->_setget( 'phones', @_ ) }
418 8     8 1 1501 sub addresses { shift->_setget( 'addresses', @_ ) }
419 8     8 1 1704 sub email_addresses { shift->_setget( 'email_addresses', @_ ) }
420              
421             sub _setget {
422 142     142   131 my ( $self, $attr, $value ) = @_;
423              
424 142 50 100     432 $value = URI->new($value)
      66        
425             if $value && $attr eq 'photo' && ref $value =~ /^URI/;
426              
427 142 100       331 $self->_data->{$attr} = $value if $value;
428              
429 142         413 return $self->_data->{$attr};
430             }
431              
432             =head1 AUTHOR
433              
434             Eric Johnson (kablamo), github ~!at!~ iijo dot org
435              
436             =head1 ACKNOWLEDGEMENTS
437              
438             Thanks to L for making this module possible by
439             donating a significant amount of developer time.
440              
441             =cut
442              
443             1;