File Coverage

blib/lib/Text/vCard/Precisely/V3.pm
Criterion Covered Total %
statement 153 188 81.3
branch 38 58 65.5
condition 7 14 50.0
subroutine 32 38 84.2
pod 10 11 90.9
total 240 309 77.6


line stmt bran cond sub pod time code
1             package Text::vCard::Precisely::V3;
2              
3             our $VERSION = '0.27';
4              
5 28     28   1185185 use 5.12.5;
  28         219  
6              
7 28     28   6523 use Moose;
  28         5439774  
  28         197  
8 28     28   194800 use Moose::Util::TypeConstraints;
  28         1458  
  28         1798  
9 28     28   66729 use MooseX::Types::DateTime qw(TimeZone);
  28         8175768  
  28         280  
10              
11 28     28   53539 use Carp;
  28         68  
  28         2080  
12 28     28   14780 use Data::UUID;
  28         15691  
  28         1712  
13 28     28   6864 use Text::LineFold;
  28         407512  
  28         1234  
14 28     28   6559 use URI;
  28         50455  
  28         758  
15 28     28   2633 use Path::Tiny;
  28         33297  
  28         1539  
16 28     28   197 use Encode qw(encode decode);
  28         79  
  28         1837  
17              
18             =encoding utf8
19              
20             =head1 NAME
21              
22             Text::vCard::Precisely::V3 - Read, Write and Edit B<just ONLY vCards 3.0> precisely
23              
24             =head1 SYNOPSIS
25              
26             use Text::vCard::Precisely;
27             my $vc = Text::vCard::Precisely->new();
28             # Or you can write like below if you want to be expressly using 3.0:
29             my $vc3 = Text::vCard::Precisely->new( version => '3.0' );
30             #or $vc3 = Text::vCard::Precisely::V3->new();
31              
32             $vc->n([ 'Gump', 'Forrest', , 'Mr', '' ]);
33             $vc->fn( 'Forrest Gump' );
34              
35             use GD;
36             use MIME::Base64;
37             my $gd = GD::Image->new( 100, 100 );
38             my $black = $gd->colorAllocate( 0, 0, 0 );
39             $gd->rectangle( 0, 0, 99, 99, $black );
40              
41             my $img = $gd->png();
42             my $base64 = MIME::Base64::encode($img);
43              
44             $vc->photo([
45             { content => 'https://avatars2.githubusercontent.com/u/2944869?v=3&s=400', media_type => 'image/jpeg' },
46             { content => $img, media_type => 'image/png' }, # Now you can set a binary image directly
47             { content => $base64, media_type => 'image/png' }, # Also accept the text encoded in Base64
48             ]);
49              
50             $vc->org('Bubba Gump Shrimp Co.'); # Now you can set/get org!
51              
52             $vc->tel({ content => '+1-111-555-1212', types => ['work'], pref => 1 });
53              
54             $vc->email({ content => 'forrestgump@example.com', types => ['work'] });
55              
56             $vc->adr( {
57             types => ['work'],
58             pobox => '109',
59             extended => 'Shrimp Bld.',
60             street => 'Waters Edge',
61             city => 'Baytown',
62             region => 'LA',
63             post_code => '30314',
64             country => 'United States of America',
65             });
66              
67             $vc->url({ content => 'https://twitter.com/worthmine', types => ['twitter'] }); # for URL param
68              
69             print $vc->as_string();
70              
71             =head1 DESCRIPTION
72              
73             A vCard is a digital business card. vCard and L<Text::vFile::asData|https://metacpan.org/pod/Text::vFile::asData> provide an API for parsing vCards.
74              
75             This module is forked from L<Text::vCard|https://metacpan.org/pod/Text::vCard> because some reason below:
76              
77             =over
78              
79             =item
80              
81             Text::vCard B<doesn't provide> full methods based on L<RFC2426|https://tools.ietf.org/html/rfc2426>
82              
83             =item
84              
85             Mac OS X and iOS can't parse vCard4.0 with UTF-8 precisely.
86             they cause some Mojibake
87              
88             =item
89              
90             Android 4.4.x can't parse vCard4.0
91              
92             =back
93              
94             To handle an address book with several vCard entries in it, start with
95             L<Text::vFile::asData>
96             and then come back to this module.
97              
98             Note that the vCard RFC requires C<FN> type.
99             And this module does NOT check or warn if these conditions have not been met.
100              
101             =cut
102              
103 28     28   13585 use Text::vFile::asData;
  28         136318  
  28         157  
104             my $vf = Text::vFile::asData->new( { preserve_params => 1 } );
105              
106 28     28   7895 use Text::vCard::Precisely::V3::Node;
  28         103  
  28         1339  
107 28     28   15372 use Text::vCard::Precisely::V3::Node::MultiContent;
  28         112  
  28         1263  
108 28     28   8711 use Text::vCard::Precisely::V3::Node::N;
  28         92  
  28         1206  
109 28     28   8396 use Text::vCard::Precisely::V3::Node::Address;
  28         88  
  28         989  
110 28     28   8323 use Text::vCard::Precisely::V3::Node::Tel;
  28         86  
  28         979  
111 28     28   16161 use Text::vCard::Precisely::V3::Node::Email;
  28         271  
  28         3505  
112 28     28   10102 use Text::vCard::Precisely::V3::Node::Image;
  28         99  
  28         1968  
113 28     28   17549 use Text::vCard::Precisely::V3::Node::URL;
  28         142  
  28         1403  
114 28     28   16797 use Text::vCard::Precisely::V3::Node::SocialProfile;
  28         124  
  28         117452  
115              
116             has encoding_in => ( is => 'rw', isa => 'Str', default => 'UTF-8', );
117             has encoding_out => ( is => 'rw', isa => 'Str', default => 'UTF-8', );
118              
119             =head1 Constructors
120              
121             =head2 load_hashref($HashRef)
122              
123             Accepts a HashRef that looks like below:
124              
125             my $hashref = {
126             N => [ 'Gump', 'Forrest', '', 'Mr.', '' ],
127             FN => 'Forrest Gump',
128             SORT_STRING => 'Forrest Gump',
129             ORG => 'Bubba Gump Shrimp Co.',
130             TITLE => 'Shrimp Man',
131             PHOTO => { media_type => 'image/gif', content => 'http://www.example.com/dir_photos/my_photo.gif' },
132             TEL => [
133             { types => ['WORK','VOICE'], content => '(111) 555-1212' },
134             { types => ['HOME','VOICE'], content => '(404) 555-1212' },
135             ],
136             ADR =>[{
137             types => ['work'],
138             pref => 1,
139             extended => 100,
140             street => 'Waters Edge',
141             city => 'Baytown',
142             region => 'LA',
143             post_code => '30314',
144             country => 'United States of America'
145             },{
146             types => ['home'],
147             extended => 42,
148             street => 'Plantation St.',
149             city => 'Baytown',
150             region => 'LA',
151             post_code => '30314',
152             country => 'United States of America'
153             }],
154             URL => 'http://www.example.com/dir_photos/my_photo.gif',
155             EMAIL => 'forrestgump@example.com',
156             REV => '2008-04-24T19:52:43Z',
157             };
158              
159             =cut
160              
161             sub load_hashref {
162 13     13 1 588 my ( $self, $hashref ) = @_;
163 13         74 while ( my ( $key, $content ) = each %$hashref ) {
164 71         315 my $method = $self->can( lc $key );
165 71 50 33     268 next unless $method and $content;
166 71 50       190 if ( ref $content eq 'Hash' ) {
    50          
167 0         0 $self->$method( { name => uc($key), %$content } );
168             } elsif ( ref $content eq 'Array' ) {
169 0         0 $self->$method( { name => uc($key), @$content } );
170             } else {
171 71         2117 $self->$method($content);
172             }
173             }
174 13         324 return $self;
175             }
176              
177             =head2 load_file($file_name)
178              
179             Accepts a file name
180              
181             =cut
182              
183             sub load_file {
184 2     2 1 6309 my ( $self, $filename ) = @_;
185 2 50       25 open my $vcf, "<", $filename or croak "couldn't open vcf: $!";
186 2         109 my $data = $vf->parse($vcf)->{'objects'}[0];
187 2         8137 close $vcf;
188              
189 2 50       17 croak "$filename is NOT a vCard file." unless $data->{'type'} eq 'VCARD';
190              
191 2         24 my $hashref = $self->_make_hashref( $data->{'properties'} );
192 2         11 $self->load_hashref($hashref);
193             }
194              
195             =head2 load_string($vCard)
196              
197             Accepts a vCard string
198              
199             =cut
200              
201             sub load_string {
202 2     2 1 2505 my ( $self, $str ) = @_;
203 2         22 my @lines = split /\r\n/, $str;
204 2         14 my $data = $vf->parse_lines(@lines);
205 2         7748 my $hashref = $self->_make_hashref( $data->{'objects'}[0]->{'properties'} );
206 2         10 $self->load_hashref($hashref);
207             }
208              
209             sub _make_hashref {
210 9     9   24 my ( $self, $data ) = @_;
211 9         19 my $hashref = {};
212 9         27 while ( my ( $name, $content ) = each %{ $data->{'properties'} } ) {
  44         126  
213 35 100       56 next if $name eq 'VERSION';
214 30         39 foreach my $node (@$content) {
215 30 100       66 if ( $name eq 'N' ) {
    100          
    100          
    50          
216 5         30 my @names = split /(?<!\\);/, $node->{'value'};
217 5   50     22 $hashref->{$name} ||= \@names;
218             } elsif ( $name eq 'TEL' ) {
219 5         8 my $content = $node->{'value'};
220 5 50       14 $hashref->{$name} = [] unless exists $hashref->{$name};
221 5 50       17 if ( ref( $node->{'params'} ) eq 'ARRAY' ) {
    50          
222 0         0 my @types = map { values %$_ } @{ $node->{'params'} };
  0         0  
  0         0  
223 0         0 push @{ $hashref->{$name} }, { types => \@types, content => $content };
  0         0  
224             } elsif ( ref( $node->{'param'} ) eq 'HASH' ) {
225 0 0       0 push my @types, sort @{ $node->{'params'} } if ref $node->{'params'};
  0         0  
226 0         0 push @{ $hashref->{$name} }, { types => \@types, content => $content };
  0         0  
227             } else {
228 5         10 push my @types, $node->{'param'};
229 5         6 push @{ $hashref->{$name} }, { types => \@types, content => $content };
  5         17  
230             }
231 5   33     14 $hashref->{$name} ||= $content;
232             } elsif ( $name eq 'REV' ) {
233 5   33     32 $hashref->{$name} ||= $node->{'value'};
234             } elsif ( $name eq 'ADR' ) {
235 0         0 my $ref = $self->_parse_param($node);
236 0         0 my @addesses = split /(?<!\\);/, $node->{'value'};
237 0         0 $ref->{'pobox'} = $addesses[0];
238 0         0 $ref->{'extended'} = $addesses[1];
239 0         0 $ref->{'street'} = $addesses[2];
240 0         0 $ref->{'city'} = $addesses[3];
241 0         0 $ref->{'region'} = $addesses[4];
242 0         0 $ref->{'post_code'} = $addesses[5];
243 0         0 $ref->{'country'} = $addesses[6];
244 0         0 push @{ $hashref->{$name} }, $ref;
  0         0  
245             } else {
246 15         32 my $ref = $self->_parse_param($node);
247 15         28 $ref->{'content'} = $node->{'value'};
248 15         17 push @{ $hashref->{$name} }, $ref;
  15         37  
249             }
250             }
251             }
252 9         23 return $hashref;
253             }
254              
255             sub _parse_param {
256 15     15   25 my ( $self, $content ) = @_;
257 15         18 my $ref = {};
258 15 50       30 $ref->{'types'} = [ split /,/, $content->{'param'}{'TYPE'} ] if $content->{'param'}{'TYPE'};
259 15 50       27 $ref->{'pref'} = $content->{'param'}{'PREF'} if $content->{'param'}{'PREF'};
260 15         20 return $ref;
261             }
262              
263             =head1 METHODS
264              
265             =head2 as_string()
266              
267             Returns the vCard as a string.
268             You have to use C<Encode::encode_utf8()> if your vCard is written in UTF-8
269              
270             =cut
271              
272             my $cr = "\x0D\x0A";
273             our $will_be_deprecated = [qw(name profile mailer agent class)];
274              
275             my @types = qw(
276             FN N NICKNAME
277             ADR LABEL TEL EMAIL GEO
278             ORG TITLE ROLE CATEGORIES
279             NOTE SOUND UID URL KEY
280             SOCIALPROFILE PHOTO LOGO SOURCE
281             SORT-STRING
282             ), map {uc} @$will_be_deprecated;
283              
284             sub as_string {
285 51     51 1 3861 my ($self) = @_;
286 51         168 my $str = $self->_header();
287 51         225 $str .= $self->_make_types(@types);
288 51 100       1446 $str .= 'BDAY:' . $self->bday() . $cr if $self->bday();
289 51 50       1296 $str .= 'UID:' . $self->uid() . $cr if $self->uid();
290 51         179 $str .= $self->_footer();
291 51         187 $str = $self->_fold($str);
292 51         1804 return decode( $self->encoding_out(), $str );
293             }
294              
295             sub _header {
296 86     86   197 my ($self) = @_;
297 86         248 my $str = "BEGIN:VCARD" . $cr;
298 86         2816 $str .= 'VERSION:' . $self->version() . $cr;
299 86 100       2382 $str .= 'PRODID:' . $self->prodid() . $cr if $self->prodid();
300 86         247 return $str;
301             }
302              
303             sub _make_types {
304 86     86   179 my $self = shift;
305 86         169 my $str = '';
306 86         203 foreach my $node (@_) {
307 2032         3642 $node =~ tr/-/_/;
308 2032         7187 my $method = $self->can( lc $node );
309 2032 50       4361 croak "the Method you provided, $node is not supported." unless $method;
310 2032 100 100     55473 if ( ref $self->$method eq 'ARRAY' ) {
    100          
    100          
311 239         410 foreach my $item ( @{ $self->$method } ) {
  239         6250  
312              
313             #if ( $item->isa('Text::vCard::Precisely::V3::Node::MultiContent') ) {
314             # $str .= $item->as_string();
315             #} els
316 271 50       1159 if ( $item->isa('Text::vCard::Precisely::V3::Node') ) {
    0          
317 271         1029 $str .= $item->as_string();
318             } elsif ($item) {
319 0         0 $str .= uc($node) . ":" . $item->as_string() . $cr;
320             }
321             }
322             } elsif ( $self->$method()
323             and $self->$method()->isa('Text::vCard::Precisely::V3::Node::N') )
324             {
325 30         749 $str .= $self->$method()->as_string();
326             } elsif ( $self->$method ) {
327 16         514 $str .= $self->$method();
328             }
329             }
330 86         300 return $str;
331             }
332              
333             sub _footer {
334 86     86   179 my $self = shift;
335 86         188 my $str = '';
336 86 100       2411 map { $str .= "TZ:" . $_->name() . $cr } @{ $self->tz() } if $self->tz();
  3         33  
  2         44  
337 86 100       2432 $str .= 'REV:' . $self->rev() . $cr if $self->rev();
338 86         238 $str .= "END:VCARD";
339 86         222 return $str;
340             }
341              
342             sub _fold {
343 86     86   273 my $self = shift;
344 86 50       262 my $str = shift or croak "Can't fold empty strings!";
345 86         2491 my $lf = Text::LineFold->new( # line break with 75bytes
346             CharMax => 74,
347             Charset => $self->encoding_in(),
348             OutputCharset => $self->encoding_out(),
349             Newline => $cr,
350             );
351 86         53930 $str = $lf->fold( "", " ", $str );
352 86         154876 return $str;
353             }
354              
355             =head2 as_file($filename)
356              
357             Write data in vCard format to $filename.
358             Dies if not successful.
359              
360             =cut
361              
362             sub as_file {
363 2     2 1 2678 my ( $self, $filename ) = @_;
364 2 50       11 croak "No filename was set!" unless $filename;
365              
366 2         20 my $file = path($filename);
367              
368             #$file->spew( {binmode => ":encoding(UTF-8)"}, $self->as_string() );
369 2         116 $file->spew_utf8( $self->as_string() );
370 2         6199 return $file;
371             }
372              
373             =head1 SIMPLE GETTERS/SETTERS
374              
375             These methods accept and return strings
376              
377             =head2 version()
378              
379             returns Version number of the vcard. Defaults to B<'3.0'> and this method is B<READONLY>
380              
381             =cut
382              
383             has version => ( is => 'ro', isa => 'Str', default => '3.0' );
384              
385             =head2 rev()
386              
387             To specify revision information about the current vCard3.0
388              
389             =cut
390              
391             subtype 'TimeStamp' => as 'Str' => where {m/^\d{4}-?\d{2}-?\d{2}(?:T\d{2}:?\d{2}:?\d{2}Z)?$/is}
392             => message {"The TimeStamp you provided, $_, was not correct"};
393             coerce 'TimeStamp', from 'Int', via {
394             my ( $s, $m, $h, $d, $M, $y ) = gmtime($_);
395             return sprintf '%4d-%02d-%02dT%02d:%02d:%02dZ', $y + 1900, $M + 1, $d, $h, $m, $s
396             }, from 'ArrayRef[HashRef]', via { $_->[0]{'content'} };
397             has rev => ( is => 'rw', isa => 'TimeStamp', coerce => 1 );
398              
399             =head2 name(), profile(), mailer(), agent(), class();
400              
401             These Types will be DEPRECATED in vCard4.0 and it seems they are useless
402             So just support it as B<READONLY> methods
403            
404             =cut
405              
406             has $will_be_deprecated => ( is => 'ro', isa => 'Str' );
407              
408             =head1 COMPLEX GETTERS/SETTERS
409              
410             They are based on Moose with coercion.
411             So, these methods accept not only ArrayRef[HashRef] but also ArrayRef[Str],
412             single HashRef or single Str.
413              
414             Read source if you were confused.
415              
416             =head2 n()
417              
418             To specify the components of the name of the object the vCard represents.
419              
420             =cut
421              
422             subtype 'N' => as 'Text::vCard::Precisely::V3::Node::N';
423             coerce 'N', from 'HashRef[Maybe[Ref]|Maybe[Str]]', via {
424             my %param;
425             while ( my ( $key, $content ) = each %$_ ) {
426             $param{$key} = $content if $content;
427             }
428             return Text::vCard::Precisely::V3::Node::N->new( \%param );
429             },
430             from 'HashRef[Maybe[Str]]',
431             via { Text::vCard::Precisely::V3::Node::N->new($_) }, from 'ArrayRef[Maybe[Str]]', via {
432             Text::vCard::Precisely::V3::Node::N->new(
433             { family => $_->[0] || '',
434             given => $_->[1] || '',
435             additional => $_->[2] || '',
436             prefixes => $_->[3] || '',
437             suffixes => $_->[4] || '',
438             }
439             )
440             },
441             from 'Str',
442             via { Text::vCard::Precisely::V3::Node::N->new( { content => [ split /(?<!\\);/, $_ ] } ) };
443             has n => ( is => 'rw', isa => 'N', coerce => 1 );
444              
445             =head2 tel()
446              
447             Accepts/returns an ArrayRef that looks like:
448              
449             [
450             { type => ['work'], content => '651-290-1234', preferred => 1 },
451             { type => ['home'], content => '651-290-1111' },
452             ]
453            
454             =cut
455              
456             subtype 'Tels' => as 'ArrayRef[Text::vCard::Precisely::V3::Node::Tel]';
457             coerce 'Tels',
458             from 'Str',
459             via { [ Text::vCard::Precisely::V3::Node::Tel->new( { content => $_ } ) ] },
460             from 'HashRef', via {
461             my $types = ref( $_->{'types'} ) eq 'ARRAY' ? $_->{'types'} : [ $_->{'types'} ];
462             [ Text::vCard::Precisely::V3::Node::Tel->new( { %$_, types => $types } ) ]
463             }, from 'ArrayRef[HashRef]', via {
464             [ map {
465             my $types = ref( $_->{'types'} ) eq 'ARRAY' ? $_->{'types'} : [ $_->{'types'} ];
466             Text::vCard::Precisely::V3::Node::Tel->new( { %$_, types => $types } )
467             } @$_
468             ]
469             };
470             has tel => ( is => 'rw', isa => 'Tels', coerce => 1 );
471              
472             =head2 adr(), address()
473              
474             Accepts/returns an ArrayRef that looks like:
475              
476             [
477             { types => ['work'], street => 'Main St', pref => 1 },
478             { types => ['home'],
479             pobox => 1234,
480             extended => 'asdf',
481             street => 'Army St',
482             city => 'Desert Base',
483             region => '',
484             post_code => '',
485             country => 'USA',
486             pref => 2,
487             },
488             ]
489              
490             =cut
491              
492             subtype 'Address' => as 'ArrayRef[Text::vCard::Precisely::V3::Node::Address]';
493             coerce 'Address',
494             from 'HashRef',
495             via { [ Text::vCard::Precisely::V3::Node::Address->new($_) ] }, from 'ArrayRef[HashRef]', via {
496             [ map { Text::vCard::Precisely::V3::Node::Address->new($_) } @$_ ]
497             };
498             has adr => ( is => 'rw', isa => 'Address', coerce => 1 );
499              
500             =head2 email()
501              
502             Accepts/returns an ArrayRef that looks like:
503              
504             [
505             { type => ['work'], content => 'bbanner@ssh.secret.army.mil' },
506             { type => ['home'], content => 'bbanner@timewarner.com', pref => 1 },
507             ]
508              
509             or accept the string as email like below
510              
511             'bbanner@timewarner.com'
512              
513             =cut
514              
515             subtype 'Email' => as 'ArrayRef[Text::vCard::Precisely::V3::Node::Email]';
516             coerce 'Email',
517             from 'Str',
518             via { [ Text::vCard::Precisely::V3::Node::Email->new( { content => $_ } ) ] },
519             from 'HashRef',
520             via { [ Text::vCard::Precisely::V3::Node::Email->new($_) ] }, from 'ArrayRef[HashRef]', via {
521             [ map { Text::vCard::Precisely::V3::Node::Email->new($_) } @$_ ]
522             };
523             has email => ( is => 'rw', isa => 'Email', coerce => 1 );
524              
525             =head2 url()
526              
527             Accepts/returns an ArrayRef that looks like:
528              
529             [
530             { content => 'https://twitter.com/worthmine', types => ['twitter'] },
531             { content => 'https://github.com/worthmine' },
532             ]
533              
534             or accept the string as URL like below
535              
536             'https://github.com/worthmine'
537              
538             =cut
539              
540             subtype 'URLs' => as 'ArrayRef[Text::vCard::Precisely::V3::Node::URL]';
541             coerce 'URLs', from 'Str', via {
542             my $name = uc [ split /::/, ( caller(2) )[3] ]->[-1];
543             return [ Text::vCard::Precisely::V3::Node::URL->new( { name => $name, content => $_ } ) ]
544             }, from 'HashRef', via {
545             my $name = uc [ split /::/, ( caller(2) )[3] ]->[-1];
546             return [
547             Text::vCard::Precisely::V3::Node::URL->new( { name => $name, content => $_->{'content'} } )
548             ]
549             }, from 'Object', # Can't asign 'URI' or 'Object[URI]'
550             via {
551             my $name = uc [ split /::/, ( caller(2) )[3] ]->[-1];
552             return [
553             Text::vCard::Precisely::V3::Node::URL->new(
554             { name => $name, content => $_->as_string(), }
555             )
556             ]
557             }, from 'ArrayRef[HashRef]', via {
558             [ map { Text::vCard::Precisely::V3::Node::URL->new($_) } @$_ ]
559             };
560             has url => ( is => 'rw', isa => 'URLs', coerce => 1 );
561              
562             =head2 photo(), logo()
563              
564             Accepts/returns an ArrayRef of URLs or Images: Even if they are raw image binary or text encoded in Base64, it does not matter
565             Attention! Mac OS X and iOS B<ignore> the description beeing URL
566             use Base64 encoding or raw image binary if you have to show the image you want
567              
568             =cut
569              
570             subtype 'Photos' => as 'ArrayRef[Text::vCard::Precisely::V3::Node::Image]';
571             coerce 'Photos', from 'HashRef', via {
572             my $name = uc [ split /::/, ( caller(2) )[3] ]->[-1];
573             return [
574             Text::vCard::Precisely::V3::Node::Image->new(
575             { name => $name,
576             media_type => $_->{'media_type'} || $_->{'type'},
577             content => $_->{'content'},
578             }
579             )
580             ]
581             }, from 'ArrayRef[HashRef]', via {
582             [ map {
583             if ( ref $_->{'types'} eq 'ARRAY' ) {
584             ( $_->{'media_type'} ) = @{ $_->{'types'} };
585             delete $_->{'types'};
586             }
587             Text::vCard::Precisely::V3::Node::Image->new($_)
588             } @$_
589             ]
590             }, from 'Str', # when parse BASE64 encoded strings
591             via {
592             my $name = uc [ split /::/, ( caller(2) )[3] ]->[-1];
593             return [
594             Text::vCard::Precisely::V3::Node::Image->new(
595             { name => $name,
596             content => $_,
597             }
598             )
599             ]
600             }, from 'ArrayRef[Str]', # when parse BASE64 encoded strings
601             via {
602             my $name = uc [ split /::/, ( caller(2) )[3] ]->[-1];
603             return [
604             map { Text::vCard::Precisely::V3::Node::Image->new( { name => $name, content => $_, } ) }
605             @$_ ]
606             }, from 'Object', # when URI.pm is used
607             via { [ Text::vCard::Precisely::V3::Node::Image->new( { content => $_->as_string() } ) ] };
608             has [qw| photo logo |] => ( is => 'rw', isa => 'Photos', coerce => 1 );
609              
610             =head2 note()
611              
612             To specify supplemental information or a comment that is associated with the vCard
613              
614             =head2 org(), title(), role(), categories()
615              
616             To specify additional information for your jobs
617              
618             In these, C<CATEGORIES> may have multiple content with being separated by COMMA.
619             multiple content is expressed by using ArrayRef like this:
620              
621             $vc->categories([qw(Internet Travel)]);
622              
623             =head2 fn(), full_name(), fullname()
624              
625             A person's entire name as they would like to see it displayed
626              
627             =head2 nickname()
628              
629             To specify the text corresponding to the nickname of the object the vCard represents
630              
631             Like C<CATEGORIES>, It ALSO may have multiple content with being separated by COMMA.
632              
633             $vc->nickname([qw(Johny John)]);
634              
635             =cut
636              
637             subtype 'SeparatedByComma' => as 'Text::vCard::Precisely::V3::Node::MultiContent';
638             coerce 'SeparatedByComma', from 'Str', via {
639             my $name = uc [ split /::/, ( caller(2) )[3] ]->[-1];
640             return Text::vCard::Precisely::V3::Node::MultiContent->new( { name => $name, content => [$_] } )
641             }, from 'ArrayRef[Str]', via {
642             my $name = uc [ split /::/, ( caller(2) )[3] ]->[-1];
643             return Text::vCard::Precisely::V3::Node::MultiContent->new( { name => $name, content => $_ } )
644             };
645             has [qw|categories nickname|] => ( is => 'rw', isa => 'SeparatedByComma', coerce => 1 );
646              
647             =head2 geo()
648              
649             To specify information related to the global positioning of the object the vCard represents
650              
651             =head2 key()
652              
653             To specify a public key or authentication certificate associated with the object that the vCard represents
654              
655             =head2 label()
656              
657             ToDo: because B<It's DEPRECATED in vCard4.0>
658             To specify the formatted text corresponding to delivery address of the object the vCard represents
659              
660             =cut
661              
662             subtype 'Nodes' => as 'ArrayRef[Text::vCard::Precisely::V3::Node]';
663             coerce 'Nodes', from 'Str', via {
664             my $name = uc [ split /::/, ( caller(2) )[3] ]->[-1];
665             return [ Text::vCard::Precisely::V3::Node->new( { name => $name, content => $_ } ) ]
666             }, from 'HashRef', via {
667             my $name = uc [ split /::/, ( caller(2) )[3] ]->[-1];
668             return [
669             Text::vCard::Precisely::V3::Node->new(
670             { name => $_->{'name'} || $name,
671             types => $_->{'types'} || [],
672             content => $_->{'content'} || croak "No value in HashRef!",
673             }
674             )
675             ]
676             }, from 'ArrayRef[HashRef]', via {
677             my $name = uc [ split /::/, ( caller(2) )[3] ]->[-1];
678             return [
679             map {
680             Text::vCard::Precisely::V3::Node->new(
681             { name => $_->{'name'} || $name,
682             types => $_->{'types'} || [],
683             content => $_->{'content'} || croak "No value in HashRef!",
684             }
685             )
686             } @$_
687             ]
688             };
689             has [qw|note org title role fn geo key label|] => ( is => 'rw', isa => 'Nodes', coerce => 1 );
690              
691             =head2 sort_string()
692              
693             To specify the family name, given name or organization text
694             to be used for national-language-specific sorting of the FN, N and ORG
695             B<This method will be DEPRECATED in vCard4.0> Use C<SORT-AS> param instead of it.
696              
697             L<Text::vCard::Precisely::V4|https://metacpan.org/pod/Text::vCard::Precisely::V4> supports it.
698              
699             =cut
700              
701             has sort_string => ( is => 'rw', isa => 'Nodes', coerce => 1 );
702              
703             =head2 uid()
704              
705             To specify a value that represents a globally unique identifier corresponding to the individual or resource associated with the vCard
706              
707             =cut
708              
709             subtype 'UID' => as 'Str' =>
710             where {m/^urn:uuid:[A-F0-9]{8}-[A-F0-9]{4}-[A-F0-9]{4}-[A-F0-9]{4}-[A-F0-9]{12}$/is}
711             => message {"The UID you provided, $_, was not correct"};
712             has uid => ( is => 'rw', isa => 'UID' );
713              
714             =head2 tz(), timezone()
715              
716             Both are same method with Alias
717              
718             To specify information related to the time zone of the object the vCard represents
719             utc-offset format is NOT RECOMMENDED in vCard4.0
720             TZ can be a URL, but there is no document in L<RFC2426|https://tools.ietf.org/html/rfc2426> or L<RFC6350|https://tools.ietf.org/html/rfc6350>
721              
722             So it just supports some text values
723              
724             =cut
725              
726             subtype 'TimeZones' => as 'ArrayRef[DateTime::TimeZone]';
727             coerce 'TimeZones', from 'ArrayRef', via {
728             [ map { DateTime::TimeZone->new( name => $_ ) } @$_ ]
729             }, from 'Str', via { [ DateTime::TimeZone->new( name => $_ ) ] };
730             has tz => ( is => 'rw', isa => 'TimeZones', coerce => 1 );
731              
732             =head2 bday(), birthday()
733              
734             Both are same method with Alias
735              
736             To specify the birth date of the object the vCard represents
737            
738             =cut
739              
740             has bday => ( is => 'rw', isa => 'Str' );
741              
742             =head2 prodid()
743              
744             To specify the identifier for the product that created the vCard object
745              
746             =cut
747              
748             subtype 'ProdID' => as 'Str';
749             coerce 'ProdID', from 'ArrayRef[HashRef]', via { $_[0]->[0]{'content'} };
750             has prodid => ( is => 'rw', isa => 'ProdID', coerce => 1 );
751              
752             =head2 source()
753              
754             To identify the source of directory information contained in the content type
755              
756             =head2 sound()
757              
758             To specify a digital sound content information that annotates some aspect of the vCard
759             This property is often used to specify the proper pronunciation of the name property value of the vCard
760            
761             =cut
762              
763             has [qw|source sound|] => ( is => 'rw', isa => 'URLs', coerce => 1 );
764              
765             =head2 socialprofile()
766            
767             There is no documents about C<X-SOCIALPROFILE> in RFC but it works!
768              
769             =cut
770              
771             subtype 'SocialProfile' => as 'ArrayRef[Text::vCard::Precisely::V3::Node::SocialProfile]';
772             coerce 'SocialProfile',
773             from 'HashRef',
774             via { [ Text::vCard::Precisely::V3::Node::SocialProfile->new($_) ] },
775             from 'ArrayRef[HashRef]', via {
776             [ map { Text::vCard::Precisely::V3::Node::SocialProfile->new($_) } @$_ ]
777             };
778             has socialprofile => ( is => 'rw', isa => 'SocialProfile', coerce => 1 );
779              
780             __PACKAGE__->meta->make_immutable;
781 28     28   393 no Moose;
  28         109  
  28         284  
782              
783             #== Alias =================================================================
784             sub organization {
785 0     0 0   my $self = shift;
786 0           $self->org(@_);
787             }
788              
789             sub address {
790 0     0 1   my $self = shift;
791 0           $self->adr(@_);
792             }
793              
794             sub fullname {
795 0     0 1   my $self = shift;
796 0           $self->fn(@_);
797             }
798              
799             sub full_name {
800 0     0 1   my $self = shift;
801 0           $self->fn(@_);
802             }
803              
804             sub birthday {
805 0     0 1   my $self = shift;
806 0           $self->bday(@_);
807             }
808              
809             sub timezone {
810 0     0 1   my $self = shift;
811 0           $self->tz(@_);
812             }
813              
814             1;
815              
816             =head1 aroud UTF-8
817              
818             if you want to send precisely the vCard3.0 with UTF-8 characters to the
819             B<Android4.4.x or before>, you have to set Charset param for each values like below:
820              
821             ADR;CHARSET=UTF-8:201号室;マンション;通り;市;都道府県;郵便番号;日本
822              
823             =head1 for under perl-5.12.5
824              
825             This module uses C<\P{ascii}> in regexp so You have to use 5.12.5 and later
826              
827             =head1 SEE ALSO
828              
829             =over
830              
831             =item
832              
833             L<RFC 2426|https://tools.ietf.org/html/rfc2426>
834              
835             =item
836              
837             L<RFC 2425|https://tools.ietf.org/html/rfc2425>
838              
839             =item
840              
841             L<Text::vFile::asData>
842              
843             =item
844              
845             L<Text::vCard::Precisely::V4>
846              
847             =back
848              
849             =head1 AUTHOR
850              
851             Yuki Yoshida(L<worthmine|https://github.com/worthmine>)
852              
853             =head1 LICENSE
854              
855             This is free software; you can redistribute it and/or modify it under the same terms as Perl.