File Coverage

blib/lib/Text/vCard/Precisely/V3.pm
Criterion Covered Total %
statement 149 186 80.1
branch 38 60 63.3
condition 6 14 42.8
subroutine 31 37 83.7
pod 10 11 90.9
total 234 308 75.9


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