view release on metacpan or  search on metacpan

t/rfc9555.t  view on Meta::CPAN

  is($given[0]{value}, 'John', 'given');

  my @given2 = grep { $_->{kind} eq 'given2' } @{$name->{components}};
  is(scalar @given2, 2, 'two given2 values');
  is($given2[0]{value}, 'Philip', 'given2[0]');
  is($given2[1]{value}, 'Paul', 'given2[1]');

  my @title = grep { $_->{kind} eq 'title' } @{$name->{components}};
  is($title[0]{value}, 'Dr.', 'title prefix');

  my @cred = grep { $_->{kind} eq 'credential' } @{$name->{components}};
  ok(scalar @cred >= 2, 'has credentials');

  my @gen = grep { $_->{kind} eq 'generation' } @{$name->{components}};
  is($gen[0]{value}, 'Jr.', 'generation');

  is($name->{sortAs}{surname}, 'Stevenson', 'sortAs surname');
  is($name->{sortAs}{given}, 'John Philip', 'sortAs given');
});

# RFC 9555 Figure 13: NICKNAME
test_vcard('NICKNAME', "NICKNAME:Johnny\n", sub {
  ok($_[0]->{nicknames}, 'has nicknames');
  my @nn = values %{$_[0]->{nicknames}};
  is($nn[0]{name}, 'Johnny', 'nickname');
});

# RFC 9555 Figure 14: PHOTO
test_vcard('PHOTO', "PHOTO:https://www.example.com/pub/photos/jqpublic.gif\n", sub {
  ok($_[0]->{media}, 'has media');
  my @m = values %{$_[0]->{media}};
  is($m[0]{kind}, 'photo', 'photo kind');
  is($m[0]{uri}, 'https://www.example.com/pub/photos/jqpublic.gif', 'photo uri');
});

# RFC 9555 Figure 16: EMAIL
test_vcard('EMAIL',
  "EMAIL;TYPE=work:jqpublic\@xyz.example.com\nEMAIL;PREF=1:jane_doe\@example.com\n", sub {
  ok($_[0]->{emails}, 'has emails');
  my @em = sort { $a->{address} cmp $b->{address} } values %{$_[0]->{emails}};
  is(scalar @em, 2, 'two emails');
  is($em[1]{address}, 'jqpublic@xyz.example.com', 'work email');
  ok($em[1]{contexts}{work}, 'work context');
  is($em[0]{address}, 'jane_doe@example.com', 'personal email');
  is($em[0]{pref}, 1, 'pref=1');
});

# RFC 9555 Figure 17: IMPP
test_vcard('IMPP', "IMPP;PREF=1:xmpp:alice\@example.com\n", sub {
  ok($_[0]->{onlineServices}, 'has onlineServices');
  my @os = values %{$_[0]->{onlineServices}};
  is($os[0]{uri}, 'xmpp:alice@example.com', 'impp uri');
  is($os[0]{pref}, 1, 'pref=1');
});

# RFC 9555 Figure 18: LANG
test_vcard('LANG',
  "LANG;TYPE=work;PREF=1:en\nLANG;TYPE=work;PREF=2:fr\nLANG;TYPE=home:fr\n", sub {
  ok($_[0]->{preferredLanguages}, 'has preferredLanguages');
  my @langs = sort { ($a->{pref}//99) <=> ($b->{pref}//99) } values %{$_[0]->{preferredLanguages}};
  is(scalar @langs, 3, 'three language prefs');
  is($langs[0]{language}, 'en', 'first lang');
  is($langs[0]{pref}, 1, 'pref=1');
  ok($langs[0]{contexts}{work}, 'work context');
});

# RFC 9555 Figure 19: LANGUAGE
test_vcard('LANGUAGE', "LANGUAGE:de-AT\n", sub {
  is($_[0]->{language}, 'de-AT', 'language');
});

# RFC 9555 Figure 20: SOCIALPROFILE
test_vcard('SOCIALPROFILE',
  "SOCIALPROFILE;SERVICE-TYPE=Mastodon:https://example.com/\@foo\n", sub {
  ok($_[0]->{onlineServices}, 'has onlineServices');
  my @os = values %{$_[0]->{onlineServices}};
  is($os[0]{service}, 'Mastodon', 'service');
  is($os[0]{uri}, 'https://example.com/@foo', 'uri');
});

# RFC 9555 Figure 21: TEL with multiple types
test_vcard('TEL',
  "TEL;VALUE=uri;PREF=1;TYPE=\"voice,home\":tel:+1-555-555-5555;ext=5555\nTEL;VALUE=uri;TYPE=home:tel:+33-01-23-45-67\n", sub {
  ok($_[0]->{phones}, 'has phones');
  my @ph = sort { ($a->{pref}//99) <=> ($b->{pref}//99) } values %{$_[0]->{phones}};
  is(scalar @ph, 2, 'two phones');
  is($ph[0]{number}, 'tel:+1-555-555-5555;ext=5555', 'first phone number');
  ok($ph[0]{contexts}{private}, 'home -> private');
  ok($ph[0]{features}{voice}, 'voice feature');
  is($ph[0]{pref}, 1, 'pref=1');
});

# RFC 9555 Figure 25: ORG with SORT-AS
test_vcard('ORG',
  "ORG;SORT-AS=\"ABC\":ABC\\, Inc.;North American Division;Marketing\n", sub {
  ok($_[0]->{organizations}, 'has organizations');
  my @orgs = values %{$_[0]->{organizations}};
  is($orgs[0]{name}, 'ABC, Inc.', 'org name');
  is(scalar @{$orgs[0]{units}}, 2, 'two units');
  is($orgs[0]{units}[0]{name}, 'North American Division', 'first unit');
  is($orgs[0]{units}[1]{name}, 'Marketing', 'second unit');
  is($orgs[0]{sortAs}, 'ABC', 'sortAs');
});

# RFC 9555 Figure 26: RELATED
test_vcard('RELATED',
  "RELATED;TYPE=friend:urn:uuid:f81d4fae-7dec-11d0-a765-00a0c91e6bf6\nRELATED;TYPE=contact:https://example.com/directory/john.vcf\n", sub {
  ok($_[0]->{relatedTo}, 'has relatedTo');
  my $r1 = $_[0]->{relatedTo}{'urn:uuid:f81d4fae-7dec-11d0-a765-00a0c91e6bf6'};
  ok($r1, 'related friend');
  ok($r1->{relation}{friend}, 'friend relation');
  my $r2 = $_[0]->{relatedTo}{'https://example.com/directory/john.vcf'};
  ok($r2, 'related contact');
  ok($r2->{relation}{contact}, 'contact relation');
});

# RFC 9555 Figure 28: EXPERTISE
test_vcard('EXPERTISE',
  "EXPERTISE;LEVEL=beginner;INDEX=2:Chinese literature\nEXPERTISE;INDEX=1;LEVEL=expert:chemistry\n", sub {
  ok($_[0]->{personalInfo}, 'has personalInfo');
  my @pi = sort { ($a->{listAs}//0) <=> ($b->{listAs}//0) } values %{$_[0]->{personalInfo}};