File Coverage

blib/lib/vCard/AddressBook.pm
Criterion Covered Total %
statement 104 104 100.0
branch 12 16 75.0
condition 15 35 42.8
subroutine 17 17 100.0
pod 5 5 100.0
total 153 177 86.4


line stmt bran cond sub pod time code
1             package vCard::AddressBook;
2             $vCard::AddressBook::VERSION = '3.09';
3 3     3   92286 use Moo;
  3         8307  
  3         19  
4              
5 3     3   1912 use vCard;
  3         8  
  3         83  
6 3     3   15 use Carp;
  3         5  
  3         208  
7 3     3   17 use Text::vCard;
  3         4  
  3         18  
8 3     3   1141 use Text::vCard::Addressbook;
  3         6  
  3         30  
9              
10             =head1 NAME
11              
12             vCard::AddressBook - Read, write, and edit vCard address books
13              
14             =head1 SYNOPSIS
15              
16             use vCard::AddressBook;
17              
18             # create the object
19             my $address_book = vCard::AddressBook->new();
20              
21             # these methods load vCard formatted data
22             $address_book->load_file('/path/file.vcf');
23             $address_book->load_string($string);
24              
25             my $vcard = $address_book->add_vcard; # returns a vCard object
26             $vcard->full_name('Bruce Banner, PhD');
27             $vcard->family_names(['Banner']);
28             $vcard->given_names(['Bruce']);
29             $vcard->email_addresses([
30             { type => ['work'], address => 'bbanner@ssh.secret.army.mil' },
31             { type => ['home'], address => 'bbanner@timewarner.com' },
32             ]);
33              
34             # $address_book->vcards() returns an arrayref of vCard objects
35             foreach my $vcard (@{ $address_book->vcards() }) {
36             print $vcard->full_name() . "\n";
37             print $vcard->email_addresses->[0]->{address} . "\n";
38             }
39              
40             # these methods output data in vCard format
41             my $file = $address_book->as_file('/path/file.vcf'); # write to a file
42             my $string = $address_book->as_string();
43              
44              
45             =head1 DESCRIPTION
46              
47             A vCard is a digital business card. L and vCard::AddressBook provide an
48             API for parsing, editing, and creating vCards.
49              
50             This module is built on top of L and L
51             and provides a more intuitive user interface.
52              
53              
54             =head1 ENCODING AND UTF-8
55              
56             =head2 Constructor Arguments
57              
58             The 'encoding_in' and 'encoding_out' constructor parameters allow you to read
59             and write vCard files with any encoding. Examples of valid values are
60             'UTF-8', 'Latin1', and 'none'.
61              
62             Both parameters default to 'UTF-8' and this should just work for the vast
63             majority of people. The latest vCard RFC 6350 only allows UTF-8 as an encoding
64             so most people should not need to use either parameter.
65              
66             =head2 MIME encodings
67              
68             vCard RFC 6350 only allows UTF-8 but it still permits 8bit MIME encoding
69             schemes such as Quoted-Printable and Base64 which are supported by this module.
70              
71             =head2 Getting and setting values on a vCard object
72              
73             If you set values on a vCard object they must be decoded values. The
74             only exception to this rule is if you are messing around with the
75             'encoding_out' constructor arg.
76              
77             When you get values from a vCard object they will be decoded values.
78              
79              
80             =head1 METHODS
81              
82             =cut
83              
84             has encoding_in => ( is => 'rw', default => sub {'UTF-8'} );
85             has encoding_out => ( is => 'rw', default => sub {'UTF-8'} );
86             has vcards => ( is => 'rw', default => sub { [] } );
87              
88             with 'vCard::Role::FileIO';
89              
90             =head2 add_vcard()
91              
92             Creates a new vCard object and adds it to the address book. Returns a L
93             object.
94              
95             =cut
96              
97             sub add_vcard {
98 3     3 1 1131 my ($self) = @_;
99 3         52 my $vcard = vCard->new(
100             { encoding_in => $self->encoding_in,
101             encoding_out => $self->encoding_out,
102             }
103             );
104 3         16 push @{ $self->vcards }, $vcard;
  3         7  
105 3         5 return $vcard;
106             }
107              
108             =head2 load_file($filename)
109              
110             Load and parse the contents of $filename. Returns $self so the method can be
111             chained.
112              
113             =cut
114              
115             sub load_file {
116 3     3 1 224 my ( $self, $filename ) = @_;
117              
118 3         16 my $file = $self->_path($filename);
119 3         124 my $string = $file->slurp( $self->_iomode_in );
120              
121 3         2010 $self->load_string($string);
122              
123 3         15 return $self;
124             }
125              
126             =head2 load_string($string)
127              
128             Load and parse the contents of $string. This method assumes that $string is
129             decoded (but not MIME decoded). Returns $self so the method can be chained.
130              
131             =cut
132              
133             sub load_string {
134 7     7 1 3639 my ( $self, $string ) = @_;
135              
136 7 100       48 die <
137             ERROR: Either there is no END in this vCard or there is a problem with the line
138             endings. Note that the vCard RFC requires line endings delimited by \\r\\n
139             regardless of your operating system. Windows :crlf mode will strip out the \\r
140             so don't use that.
141             EOS
142             unless $string =~ m/\r\n/m;
143              
144 6         18 $self->_create_vcards($string);
145              
146 6         87 return $self;
147             }
148              
149             sub _create_vcards {
150 6     6   7 my ( $self, $string ) = @_;
151              
152 6         78 my $vcards_data = Text::vCard::Addressbook->new(
153             { encoding_in => $self->encoding_in,
154             encoding_out => $self->encoding_out,
155             }
156             )->_pre_process_text($string);
157              
158 6         12557 foreach my $vcard_data (@$vcards_data) {
159             carp "This file has $vcard_data->{type} data that was not parsed"
160 6 50       33 unless $vcard_data->{type} =~ /VCARD/i;
161              
162 6         198 my $vcard = vCard->new(
163             { encoding_in => $self->encoding_in,
164             encoding_out => $self->encoding_out,
165             }
166             );
167             my $text_vcard = Text::vCard->new(
168             { asData_node => $vcard_data->{properties},
169 6         88 encoding_out => $self->encoding_out,
170             }
171             );
172              
173 6         25 $self->_copy_simple_nodes( $text_vcard => $vcard );
174 6         21 $self->_copy_name( $text_vcard => $vcard );
175 6         16 $self->_copy_photo( $text_vcard => $vcard );
176 6         23 $self->_copy_phones( $text_vcard => $vcard );
177 6         17 $self->_copy_addresses( $text_vcard => $vcard );
178 6         19 $self->_copy_email_addresses( $text_vcard => $vcard );
179              
180 6         7 push @{ $self->vcards }, $vcard;
  6         137  
181             }
182             }
183              
184             sub _copy_simple_nodes {
185 6     6   10 my ( $self, $text_vcard, $vcard ) = @_;
186              
187 6         27 foreach my $node_type ( vCard->_simple_node_types ) {
188 36 100       48 if ( $node_type eq 'full_name' ) {
189 6 50       22 next unless $text_vcard->fullname;
190 6         18 $vcard->full_name( $text_vcard->fullname );
191             } else {
192 30 50       78 next unless $text_vcard->$node_type;
193 30         60 $vcard->$node_type( $text_vcard->$node_type );
194             }
195             }
196             }
197              
198             sub _copy_photo {
199 6     6   9 my ( $self, $text_vcard, $vcard ) = @_;
200 6         16 $vcard->photo( URI->new( $text_vcard->photo ) );
201             }
202              
203             sub _copy_name {
204 6     6   10 my ( $self, $text_vcard, $vcard ) = @_;
205              
206 6         14 my ($node) = $text_vcard->get('n');
207              
208 6   33     30 $vcard->family_names( [ $node->family || () ] );
209 6   33     30 $vcard->given_names( [ $node->given || () ] );
210 6   33     29 $vcard->other_names( [ $node->middle || () ] );
211 6   33     32 $vcard->honorific_prefixes( [ $node->prefixes || () ] );
212 6   33     25 $vcard->honorific_suffixes( [ $node->suffixes || () ] );
213             }
214              
215             sub _copy_phones {
216 6     6   7 my ( $self, $text_vcard, $vcard ) = @_;
217              
218 6         8 my @phones;
219 6   50     18 my $nodes = $text_vcard->get('tel') || [];
220              
221 6         12 foreach my $node (@$nodes) {
222 12         12 my $phone;
223 12         32 $phone->{type} = scalar $node->types;
224 12 100       33 $phone->{preferred} = $node->is_pref ? 1 : 0;
225 12         46 $phone->{number} = $node->value;
226 12         23 push @phones, $phone;
227             }
228              
229 6         23 $vcard->phones( \@phones );
230             }
231              
232             sub _copy_addresses {
233 6     6   9 my ( $self, $text_vcard, $vcard ) = @_;
234              
235 6         8 my @addresses;
236 6   50     15 my $nodes = $text_vcard->get('adr') || [];
237              
238 6         14 foreach my $node (@$nodes) {
239 12         10 my $address;
240 12         18 $address->{type} = scalar $node->types;
241 12 50       23 $address->{preferred} = $node->is_pref ? 1 : 0;
242 12   50     46 $address->{po_box} = $node->po_box || undef;
243 12   50     36 $address->{street} = $node->street || undef;
244 12   50     34 $address->{city} = $node->city || undef;
245 12   50     34 $address->{post_code} = $node->post_code || undef;
246 12   50     37 $address->{region} = $node->region || undef;
247 12   50     35 $address->{country} = $node->country || undef;
248 12   50     42 $address->{extended} = $node->extended || undef;
249 12         24 push @addresses, $address;
250             }
251              
252 6         21 $vcard->addresses( \@addresses );
253             }
254              
255             sub _copy_email_addresses {
256 6     6   8 my ( $self, $text_vcard, $vcard ) = @_;
257              
258 6         8 my @email_addresses;
259 6   50     14 my $nodes = $text_vcard->get('email') || [];
260              
261 6         13 foreach my $node (@$nodes) {
262 12         9 my $email_address;
263 12         29 $email_address->{type} = scalar $node->types;
264 12 100       23 $email_address->{preferred} = $node->is_pref ? 1 : 0;
265 12         39 $email_address->{address} = $node->value;
266 12         21 push @email_addresses, $email_address;
267             }
268              
269 6         19 $vcard->email_addresses( \@email_addresses );
270             }
271              
272             =head2 as_file($filename)
273              
274             Write all the vCards to $filename. Files are written as UTF-8 by default.
275             Dies if not successful.
276              
277             =cut
278              
279             sub as_file {
280 1     1 1 4 my ( $self, $filename ) = @_;
281 1         7 my $file = $self->_path($filename);
282 1         59 $file->spew( $self->_iomode_out, $self->as_string );
283 1         759 return $file;
284             }
285              
286             =head2 as_string()
287              
288             Returns all the vCards as a single string.
289              
290             =cut
291              
292             sub as_string {
293 1     1 1 2 my ($self) = @_;
294 1         2 my $string = '';
295 1         2 $string .= $_->as_string for @{ $self->vcards };
  1         7  
296 1         11 return $string;
297             }
298              
299             =head1 AUTHOR
300              
301             Eric Johnson (kablamo), github ~!at!~ iijo dot org
302              
303             =head1 ACKNOWLEDGEMENTS
304              
305             Thanks to L for making this module possible by
306             donating a significant amount of developer time.
307              
308             =cut
309              
310             1;