Blob Blame History Raw
package Net::CardDAVTalk::VCard;

use 5.014;
use strict;
use warnings;
use Text::VCardFast qw(vcard2hash hash2vcard);
use Encode qw(decode_utf8 encode_utf8);
use MIME::Base64 qw(decode_base64);
use List::Pairwise qw(mapp);
use List::MoreUtils qw(all pairwise);
use Date::Format qw(strftime);
use File::MMagic;
use Data::Dumper;

=head1 NAME

Net::CardDAVTalk::VCard - A wrapper for VCard files

=head1 SUBROUTINES/METHODS

# Core {{{

=head2 $class->new()

Create a basic VCard object with no fields set

=cut

my $FileMagic = File::MMagic->new;

sub new {
  my $Proto = shift;
  my $Class = ref($Proto) || $Proto;

  my $Self = {
    type => 'VCARD',
    properties => {
      version => [
        {
          name => "version",
          value => "3.0"
        },
      ],
    }
  };

  return bless $Self, $Class;
}

=head2 $class->new_fromstring($String)

Create a new object and populate it by parsing the VCard file
who's contents are given in the string.

=cut

sub new_fromstring {
  my $Proto = shift;
  my $Class = ref($Proto) || $Proto;
  my $Data = shift;

  my $Parsed = eval { vcard2hash($Data, multival => [ qw(n adr org) ]) };

  my $Self = $Parsed->{objects}->[0];
  if ($Self->{type} ne 'vcard') {
    warn "Found non-vcard '$Self->{type}' for in $_";
    return undef;
  }

  bless $Self, $Class;

  $Self->Normalise();

  $Self->{_raw} = $Data;

  return $Self;
}

=head2 $class->new_fromfile($File)

Given a filename or filehandle, read and parse a vcard from it.

=cut

sub new_fromfile {
  my $Proto = shift;
  my $Class = ref($Proto) || $Proto;

  my $FileR = shift;

  my $Fh;
  if (ref $FileR) {
    $Fh = $FileR;
  } else {
    open($Fh, $FileR)
      || die "Could not read '$FileR': $!";
  }

  my $Input = do { local $/; <$Fh>; };

  my $Self = $Class->new_fromstring($Input);
  $Self->{file} = $FileR if !ref $FileR;

  return $Self;
}

=head2 $self->as_string()

Return a string representation of the VCard (inverse of
new_fromstring)

=cut

sub as_string {
  my $Self = shift;
  delete $Self->{_raw};
  $Self->{_raw} = eval { hash2vcard({ objects => [ $Self ] }) };
  return $Self->{_raw};
}

=head2 $self->uid()

Get or set the uid field of the card.

=cut

sub uid {
  my $Self = shift;
  $Self->V('uid', 'value', @_);
}
sub rev {
  my $Self = shift;
  $Self->V('rev', 'value', @_);
}

# }}}

# ME VCard manipulation {{{

my @VParamTypes = qw(work home text voice fax cell cell video pager textphone internet);
push @VParamTypes, map { uc } @VParamTypes;

my @VItemN = qw(surnames givennames additionalnames honorificprefixs honorificsuffixes);
my @VItemADR = qw(postofficebox extendedaddress streetaddress locality region postalcode countryname);
my @VItemORG = qw(company department);
my %VExpand = (n => \@VItemN, adr => \@VItemADR, org => \@VItemORG);

my @ProtoPrefixes = (
  [ 'tel', qr/tel:/ ],
  [ 'impp', qr/skype:/ ],
  [ 'impp', qr/xmpp:/ ],
  [ 'x-skype', qr/skype:/ ],
  [ 'x-socialprofile', qr/twitter:/ ],
);

my %ABLabelTypeMap = (Home => 'home', Mobile => 'cell', Twitter => 'twitter');

my %VCardEmailTypeMap = (
  home => 'personal',
  work => 'work',
);
my %RevVCardEmailTypeMap = reverse %VCardEmailTypeMap;

my %VCardAdrTypeMap = (
  home => 'home',
  work => 'work',
);
my %RevVCardAdrTypeMap = reverse %VCardAdrTypeMap;

my %VCardTelTypeMap = (
  home => 'home',
  work => 'work',
  cell => 'mobile',
  fax => 'fax',
  pager => 'pager',
);
my %RevVCardTelTypeMap = reverse %VCardTelTypeMap;

my %VCardTypeMap = (
  email => [ \%VCardEmailTypeMap, \%RevVCardEmailTypeMap ],
  adr => [ \%VCardAdrTypeMap, \%RevVCardAdrTypeMap ],
  tel => [ \%VCardTelTypeMap, \%RevVCardTelTypeMap ],
);

my %IMPPServiceTypeMap = qw(
  skype       skype
);

my %IMPPProtoPrefixes = (
  'skype' =>      ['skype'],
  'msn' =>        ['msn','msnim'],
  'googletalk' => ['xmpp'],
  'facebook' =>   ['xmpp'],
  'aim' =>        ['aim'],
  'yahoo' =>      ['ymsgr'],
  'icq' =>        ['icq','aim'],
  'jabber' =>     ['xmpp'],
);

my %XSocialProfileTypeMap = qw(
  twitter     twitter
);

my %XServiceTypeMap = qw(
  twitter         twitter
  skype           skype
  skype-username  skype
  aim             chat
  icq             chat
  google-talk     chat
  jabber          chat
  msn             chat
  yahoo           chat
  ms-imaddress    chat
);

my %VCardNewOnlineMap = (
  'web' => [
    [ 'url' ]
  ],
  'chat' => sub { [
    [ 'impp', { 'x-service-type' => 'jabber', 'x-user' => $_[0] } ],
  ] },
  'twitter' => sub { [
    [ 'x-socialprofile', { 'type' => 'twitter', 'x-user' => $_[0] }, "http://twitter.com/$_[0]" ],
    [ 'x-twitter' ],
  ] },
  'skype' => sub { [
    [ 'impp', { 'x-service-type' => 'skype', 'x-user' => $_[0] } ],
    [ 'x-skype' ],
  ] },
  'other' => sub { [
    [ 'impp', { 'x-user' => $_[0] } ],
  ] },
);

my $NoteParamName = 'x-menote';

sub Normalise {
  my $Self = shift;

  $Self->{meta} = {};

  my $Props = $Self->{properties};

  # Expand/decode/normalise all values
  for (values %$Props) {

    # All properties are array ref of items
    for (@$_) {

      # Scalar or array ref (e.g. 'n', 'adr', etc compound fields)
      my $Value = $_->{value} // $_->{values};

      # If non-ascii value, it's utf-8
      for (ref($Value) ? @$Value : $Value) {
        if (/[\x80-\xff]/) {
          $_ = eval { decode_utf8($_) } // $_;
        }
      }

      # Expand out 'n' and 'adr' fields into components.
      #  Put scalars into expanded fields and scalar refs in values arrayref
      if (my $VFields = $VExpand{$_->{name}}) {
        @$_{@$VFields} = map { $_ // '' } @$Value[0 .. scalar(@$VFields)-1];
        $_->{values} = [ \@$_{@$VFields} ];
        delete $_->{value};
      }

      # Handle base64 encoded value
      my $Encoding = $_->{params}->{encoding};
      if (ref($Encoding) && lc $Encoding->[0] eq 'b') {
        $Value = decode_base64($Value);
        $_->{binary} = 1;
      }

      # Expand and lowercase comma separated type= parameters
      if (my $Type = $_->{params}->{type}) {
        $_->{params}->{type} = $Type = [ $Type ] if !ref $Type;
        @$Type = map { split /,/, lc $_ } @$Type;
      }
      if (my $ServiceType = $_->{params}->{'x-service-type'}) {
        $_->{params}->{'x-service-type'} = $ServiceType = [ $ServiceType ] if !ref $ServiceType;
      }

      $_->{value} = $Value;

      # Create 'groups' item that tracks items in each group
      push @{$Self->{groups}->{$_->{group}}}, $_ if $_->{group};
    }
  }

  # Add any X-ABLabel group items as 'label' attribute
  if (my $Labels = $Props->{'x-ablabel'}) {
    my %LabelMap = map { $_->{group} ? ($_->{group} => $_) : () } @$Labels;
    for (keys %$Props) {
      next if $_ eq 'x-ablabel';
      for (@{$Props->{$_}}) {
        if (my $Label = $LabelMap{$_->{group} // ''}) {
          my $LabelV = $_->{label} = $Label->{value};
          $_->{labelref} = $Label;

          # Attach type= param if appropriate
          $LabelV = $1 if $LabelV =~ m{^_\$\!<([^>]*)};
          if (my $TypeP = $ABLabelTypeMap{$LabelV}) {
            my $TypeList = ($_->{params}->{type} //= []);
            push @$TypeList, $TypeP if !grep { $_ eq $TypeP } @$TypeList;
          }
        }
      }
    }
  }

  # Handle v4 value=uri telephone numbers
  my $Version = $Props->{version};
  if ($Version && $Version->[0] >= 4.0) {
    for (@ProtoPrefixes) {
      my ($Prop, $ProtoRE) = @$_;
      if (my $Items = $Props->{$Prop}) {
        for (@$Items) {
          if ($_->{value} =~ s/^($ProtoRE)//) {
            $_->{proto_strip} = $1;
            # If we found a uri prefix, better have value=uri param
            if (!$_->{params}->{value} && $Prop eq 'tel') {
              $_->{params}->{value} = [ 'uri' ];
            }
          }
        }
      }
    }
  }

  # Create synthetic "online" list. Generate "online_type" and "online_value"
  # based on all the different types for twitter and skype contact info
  my $Online = $Props->{online} = [];

  # URL:foo.com
  for (@{$Props->{url} // []}) {
    $_->{online_type}  = 'web';
    $_->{online_value} = $_->{value};

    push @$Online, $_;
  }

  # IMPP;X-SERVICE-TYPE=Skype;type=pref:skype:someskype
  for (@{$Props->{impp} // []}) {
    my $Type  = lc(($_->{params}->{'x-service-type'} // [])->[0] // '');
    my $Value = $_->{value};
    my $ProtoPrefixes = $IMPPProtoPrefixes{$Type} // ['x-apple'];
    $Value =~ s/^$_:// for @$ProtoPrefixes;
    $_->{online_type}  = $IMPPServiceTypeMap{$Type} // 'chat';
    $_->{online_value} = $Value;

    push @$Online, $_;
  }

  # X-SOCIALPROFILE;type=twitter;x-user=sometwitter:http://twitter.com/sometwitter
  for (@{$Props->{'x-socialprofile'} // []}) {
    my $Type  = lc(($_->{params}->{type} // [])->[0] // '');
    my $Value = $_->{params}->{'x-user'}->[0] // $_->{value};
    $_->{online_type}  = $XSocialProfileTypeMap{$Type} // 'other';
    $_->{online_value} = $Value;

    push @$Online, $_;
  }

  # X-YAHOO:someyahoo
  for my $Type (keys %XServiceTypeMap) {
    for (@{$Props->{"x-$Type"} // []}) {
      $_->{online_type}  = $XServiceTypeMap{$Type};
      $_->{online_value} = $_->{value};

      push @$Online, $_;
    }
  }

  # Set contact_type to match API
  for ([ 'email', \%VCardEmailTypeMap ],
       [ 'tel', \%VCardTelTypeMap ],
       [ 'adr', \%VCardAdrTypeMap ]) {
    my ($Prop, $Map) = @$_;

    my $Props = $Props->{$Prop} || next;
    for (@$Props) {
      # Prefer calculated online_type, otherwise case on property name or type params
      my ($ContactType) =
        map { ($_ && $Map->{$_}) or () }
          (($_->{online_type} or ()), $_->{name}, @{$_->{params}->{type} // []});

      $_->{contact_type} = $ContactType // 'other';
    }
  }

  # Check N, FN and VERSION fields are present
  if (!$Props->{version}) {
    $Self->V('version', 'value', '3.0');
  }
  if (!$Props->{n}) {
    $Self->V('n', 'surnames', '');
  }
  if (!$Props->{fn}) {
    $Self->VRebuildFN();
  }

}

sub DeleteUnusedLabels {
  my ($Self) = @_;
  my $Props = $Self->{properties};

  for (@{$Props->{'x-ablabel'} // []}) {
    my $Group = $Self->{groups}->{$_->{group}};
    my $NumItems = grep { !$_->{deleted} } @$Group;
    $_->{deleted} = 1 if $NumItems <= 1;
  }
}

sub ReadOnly {
  $_[0]->{ReadOnly} = $_[1] if @_ > 1; return $_[0]->{ReadOnly};
}

sub V {
  my ($Self, $Prop, $Item) = splice @_, 0, 3;
  $Item //= 'value';
  my $Props = $Self->{properties};

  die "Tried to modify read-only contact, fetch directly, not from cache"
    if @_ && $Self->{ReadOnly};

  # Always get/set first item of given type
  my $V = $Props->{$Prop} && $Props->{$Prop}->[0];

  # If setting value, and no existing value, create new
  if (!$V && @_) {
    $V = $Props->{$Prop}->[0] = { name => $Prop, params => {} };

    # Create parts if an multipart field
    if (my $VFields = $VExpand{$Prop}) {
      @$V{@$VFields} = ("") x scalar @$VFields;
      $V->{values} = [ \@$V{@$VFields} ];
    }
  }

  # Get value
  if (!@_) {
    return $V ? $V->{$Item} : undef;

  # Set value
  } else {
    $Self->{vchanged}->{$Prop} = 1;

    local $_ = shift;

    if (defined $_) {
      # Trim whitespace and garbage from values
      s/^\s+//;
      s/\s+$//;
      # Ugg, saw U+200B (ZERO WIDTH SPACE) in some data, http://www.perlmonks.org/?node_id=1020973
      s/\p{FORMAT}//g;
    }

    # Delete item if not a compound value and setting to empty string or undef
    if ((!defined $_ || $_ eq '') && !$V->{values}) {
      my $E = shift @{$Props->{$Prop}};
      $E->{deleted} = 1;
    }

    # Otherwise store the new value
    else {
      $V->{$Item} = $_ // '';

      # Uggg, for compound value, delete if all values empty
      if ($Prop ne 'n' && $V->{values} && all { $$_ eq '' } @{$V->{values}} ) {
        my $E = shift @{$Props->{$Prop}};
        $E->{deleted} = 1;
      }
    }

    $Self->DeleteUnusedLabels;

    $Self->VRebuildFN if $Prop eq 'n' || $Prop eq 'org';
    return $_;
  }
}

sub VDate {
  my $Self = shift;
  local $_ = shift;

  # Convert VCard -> Our format
  if (!@_) {
    return undef if !$_;

    if (/^(\d{4})-(\d{2})-(\d{2})(?:T|$)/) {
      my ($Y, $M, $D) = ($1, $2, $3);
      $Y = '0000' if $Y eq '1604'; # iOS magic "no year" value
      return "$Y-$M-$D";
    }

    # V4 format
    if (/^(\d{4}|--)(\d{2})(\d{2})(?:T|$)/) {
      my ($Y, $M, $D) = ($1, $2, $3);
      $Y = '0000' if $Y eq '--';
      $Y = '0000' if $Y eq '1604'; # iOS magic "no year" value
      return "$Y-$M-$D";
    }

  # Convert Our format -> VCard
  } else {
    # Delete value if special "empty" value
    return undef if $_ eq '0000-00-00';

    # Our format is V3 format

    # Convert to V4 format if V4 card
    if ($Self->V('version') >= 4.0) {
      my ($Y, $M, $D) = /^(\d{4})-(\d{2})-(\d{2})/;
      $Y = '--' if $Y eq '0000';
      $_ = $Y . $M . $D;
    }

    return $_;
  }

  return undef;
}
sub VRebuildFN {
  my $Self = shift;

  my $NewFN = join " ", map {
    $Self->V('n', $_) or ()
  } qw(honorificprefixs givennames additionalnames surnames);

  my $Suffixes = $Self->V('n', 'honorificsuffixes');
  $NewFN .= ', ' . $Suffixes if $Suffixes;

  # FN is a required field, so we have to set it to something
  unless ($NewFN) {
    $NewFN = $Self->VCompany();
  }
  unless ($NewFN) {
    my ($Email) = $Self->VEmails();
    $NewFN = $Email->{value};
  }
  unless ($NewFN) {
    $NewFN = "No Name";
  }

  $Self->V('fn', 'value', $NewFN);
}

sub VTitle {
  my $Self = shift;
  $Self->V('n', 'honorificprefixs', @_) // '';
}
sub VFirstName {
  my $Self = shift;
  if (!@_) {
    return join " ", map { $_ or () } $Self->V('n', 'givennames'), $Self->V('n', 'additionalnames');
  } else {
    my ($GivenNames, $AdditionalNames) = split / +/, $_[0], 2;
    $Self->V('n', 'givennames', $GivenNames);
    $Self->V('n', 'additionalnames', $AdditionalNames);
  }
}
sub VLastName {
  my $Self = shift;
  $Self->V('n', 'surnames', @_) // '';
}

sub VFN {
  my $Self = shift;
  $Self->V('fn', 'value', @_) // '';
}

sub VNickname {
  shift->V('nickname', 'value', @_) // '';
}
sub VBirthday {
  my $Self = shift;
  if (!@_) {
    return $Self->VDate($Self->V('bday')) // '0000-00-00';
  } else {
    $Self->V('bday', 'value', $Self->VDate($_[0], 1));
  }
}

sub VCompany {
  shift->V('org', 'company', @_) // '';
}
sub VDepartment {
  shift->V('org', 'department', @_) // '';
}
sub VPosition {
  shift->V('title', 'value', @_) // '';
}

sub VNotes {
  shift->V('note', 'value', @_) // '';
}

my %VBasicTypeMap = (type => 'contact_type', value => 'value');
my %VOnlineTypeMap = (type => 'online_type', value => 'online_value');
my %VAdrTypeMap = (type => 'contact_type', street => 'streetaddress', city => 'locality', state => 'region', postcode => 'postalcode', country => 'countryname');
my %RevVAdrTypeMap = reverse %VAdrTypeMap;

sub VKN {
  my $I = shift;
  join "/", map { $I->{$_} } @_;
}

sub VIsSame {
  my ($Self, $Prop, $E, $N) = @_;

  if ($Prop eq 'email' || $Prop eq 'tel') {
    # If type or value is same, consider it the same item
    return 1 if $N->{contact_type} eq $E->{contact_type}
      || $N->{value} eq $E->{value};

  } elsif ($Prop eq 'adr') {
    # If type or value is same, consider it the same item
    return 1 if $N->{contact_type} eq $E->{contact_type}
      || all { ($N->{$_} // '') eq $E->{$_} } @VItemADR;

  } elsif ($Prop eq 'online') {
    # If synthetic online type AND value is same, consider it the same item
    return 1 if $N->{contact_type} eq ($E->{online_type} // $E->{contact_type})
        && $N->{value} eq ($E->{online_value} // $E->{value});

  } else {
    die "Unknown prop: $Prop";
  }
}

sub VUpdateExisting {
  my ($Self, $Prop, $E, $N, $TypeMap) = @_;

  # Need to update vcard specific properties
  if (my $Maps = $VCardTypeMap{$Prop}) {
    if (my $ParamType = $Maps->[1]->{$N->{contact_type}}) {
      # Make sure only the single right type is present in the vcard type param
      my $Types = ($E->{params}->{type} //= []);
      @$Types = grep { !$Maps->[0]->{$_} } @$Types;
      push @$Types, $ParamType;

      # Lets try and be smart and update any label
      $Self->VUpdateLabel($E, $N) if $Prop eq 'adr';
    }
    elsif ($N->{contact_type} eq 'other') {
      delete $E->{params}->{type};
    }

  } else {
    die "Unknown prop: $Prop";
  }

  # Now copy over value(s)
  $E->{$_} = $N->{$_} for values %$TypeMap;
}

sub VUpdateLabel {
  my ($Self, $E, $N) = @_;

  my @Labels;
  # In v4, it's a parameter
  push @Labels, map { \$_ } @{$E->{params}->{label}};

  # In v3, it's a separate property. Either in same group...
  if (my $Group = $E->{group}) {
    for (@{$E->{groups}->{$Group}}) {
      push @Labels, \$_->{value} if $_->{name} eq 'label';
    }
  }
  # ... or check for label with same type (e.g. 'work', 'home', etc)
  if (!@Labels) {
    my ($EType) = grep { $VCardAdrTypeMap{$_} } @{$E->{params}->{type} // []};
    my $Labels = $Self->{properties}->{label};
    if ($EType && $Labels) {
      for (@$Labels) {
        my ($Type) = grep { $VCardAdrTypeMap{$_} } @{$_->{params}->{type} // []};
        push @Labels, \$_->{value} if $Type && $Type eq $EType;
      }
    }
  }

  my @EI = @$E{@VItemADR};
  my @NI = @$N{@VItemADR};

  for my $Label (@Labels) {
    pairwise {
      $$Label =~ s/\b\Q$a\E\b/$b/ if length $a >= 3;
    } @EI, @NI;
  }
}

sub _MakeItem {
  my ($Name, $Type, $Value, $Params, @Extra) = @_;
  +{
    name                              => $Name,
    contact_type                      => $Type,
    (ref $Value ? 'values' : 'value') => $Value,
    params                            => $Params // {},
    @Extra,
  };
}

sub VNewItem {
  my ($Self, $Prop, $N) = @_;
  my $Type = $N->{online_type} // $N->{contact_type};
  my $Value = $N->{online_value} // $N->{value};

  my @New;

  if (my $Maps = $VCardTypeMap{$Prop}) {
    my $Params = {};
    my %Extra;

    # Set vcard type parameter
    if (my $ParamType = $Maps->[1]->{$Type}) {
      $Params->{type} = [ $ParamType ];
    }

    # Expand address value into array ref components
    if ($Prop eq 'adr') {
      @Extra{@VItemADR} = @$N{@VItemADR};
      $Value = [ \@Extra{@VItemADR} ];
    }

    $Params->{$NoteParamName} = $N->{note} if $N->{note};
    if ($N->{pref}) {
      $Params->{type} //= [];
      push @{$Params->{type}}, 'pref';
    }

    push @New, _MakeItem($Prop, $Type, $Value, $Params, %Extra);
  }

  elsif ($Prop eq 'online') {

    my $NewMap = $VCardNewOnlineMap{$Type} // $VCardNewOnlineMap{other};
    push @New, _MakeItem($_->[0], $Type, $Value, $_->[1])
      for @{ref $NewMap eq 'CODE' ? $NewMap->($N->{online_value}) : $NewMap};
  }

  else {
    die "Unknown prop: $Prop";
  }

  if ($N->{note}) {
    $_->{$NoteParamName} = $N->{note} for @New;
  }
  if ($N->{pref}) {
    $_->{pref} = 1 for @New;
  }

  return @New;
}

sub VL {
  my ($Self, $Prop, $TypeMap) = splice @_, 0, 3;
  my $Props = $Self->{properties};

  die "Tried to modify read-only contact, fetch directly, not from cache"
    if @_ && $Self->{ReadOnly};

  my @E = grep { !$_->{deleted} } @{$Props->{$Prop} // []};

  # Easy part, return items
  if (!@_) {
    my %Seen;
    return map {
      my $I = $_;
      # dedup. this might be wrong if the second has pref or note
      my $VKN = VKN($I, values %$TypeMap);
      if ($Seen{$VKN}) {
        ();
      }
      else {
        $Seen{$VKN} = 1;
        my %Props = mapp { ($a => $I->{$b}) } %$TypeMap;
        $Props{pref} = 1 if grep { $_ eq 'pref' } @{$_->{params}->{type} // []};
        $Props{note} = $_->{params}->{$NoteParamName}->[0] if $_->{params}->{$NoteParamName};
        \%Props;
      }
    } @E;

  # Harder part, set items. Try and preserve existing items
  } else {
    $Self->{vchanged}->{$Prop} = 1;

    # Find exact existing matches moved to different spot
    my %EMap = map { VKN($_, values %$TypeMap) => $_ } @E;

    my $Pos = 0;

    my @R;
    for my $New (@_) {
      my $N = { mapp { $b => ($New->{$a} // '') } %$TypeMap };

      my @NewItems;

      # Exact existing item exists (maybe different position)
      if (my $E = delete $EMap{VKN($N, values %$TypeMap)}) {
        push @NewItems, $E;

      } else {
        my $E = $E[$Pos];

        # Same item in same position, update value(s)
        # Not for online though, we always replace those
        if ($Prop ne 'online' && $E && $Self->VIsSame($Prop, $E, $N)) {
          # Don't re-use this item
          delete $EMap{VKN($E, values %$TypeMap)};

          $Self->VUpdateExisting($Prop, $E, $N, $TypeMap);

          push @NewItems, $E;
        }

        # Add new item!
        else {
          push @NewItems, $Self->VNewItem($Prop, $N);

        }
      }

      if (my $Note = $New->{note}) {
        $_->{params}->{$NoteParamName} = [ $Note ] for @NewItems;
      } else {
        delete $_->{params}->{$NoteParamName} for @NewItems;
      }

      if ($New->{pref}) {
        for (@NewItems) {
          $_->{params}->{type} //= [];
          push @{$_->{params}->{type}}, 'pref';
        }
      } else {
        for (@NewItems) {
          $_->{params}->{type} //= [];
          @{$_->{params}->{type}} = grep { $_ ne 'pref' } @{$_->{params}->{type}};
        }
      }

      # Always add to result list
      push @R, @NewItems;
      $Pos += @NewItems;
    }

    # For tel, email, adr, just replace list
    if ($Prop eq 'email' || $Prop eq 'tel' || $Prop eq 'adr') {
      @{$Props->{$Prop}} = @R;

    } elsif ($Prop eq 'online') {
      # Maps to multiple props. Delete the old ones of types we're replacing
      my %ReplaceTypes = map { $_->{contact_type} => 1 } @R;
      $_->{deleted} = 1 for grep { $ReplaceTypes{$_->{online_type}} } @E;

      push @{$Props->{$Prop}}, @R;

    } else {
      die "Unknown prop: $Prop";
    }

    $Self->DeleteUnusedLabels;

    $Self->VRebuildFN if $Prop eq 'email';
  }
}

sub VEmails {
  shift->VL('email', \%VBasicTypeMap, @_);
}
sub VPhones {
  shift->VL('tel', \%VBasicTypeMap, @_);
}
sub VOnline {
  shift->VL('online', \%VOnlineTypeMap, @_);
}
sub VAddresses {
  shift->VL('adr', \%VAdrTypeMap, @_);
}

sub VKind {
  shift->V('x-addressbookserver-kind', 'value', @_) // 'contact';
}

sub VGroupContactUIDs {
  my $Self = shift;
  my $Props = $Self->{properties};

  die "Tried to modify read-only contact, fetch directly, not from cache"
    if @_ && $Self->{ReadOnly};

  if (!@_) {
    return 
      map { s/^urn://; s/^uuid://; $_ }
      map { $_->{value} }
      @{$Props->{'x-addressbookserver-member'} ||[]};

  } else {
    @{$Props->{'x-addressbookserver-member'}} = map {
      {
        name => 'x-addressbookserver-member',
        params => {},
        value => 'urn:uuid:' . $_,
      }
    } @{$_[0]};

    $Self->{vchanged}->{'x-addressbookserver-member'} = 1;

    return @{$_[0]};
  }

}

sub VGroupIds {
  my $Self = shift;
  !@_ || die "You can't set GroupIds on a contact, use ME::CalDAV::UpdateGroups";
  return sort keys %{$Self->{ABGroups} || {}};
}

sub VChanged {
  my $Self = shift;
  return keys %{$Self->{vchanged} // {}};
}
sub VClearChanged {
  my $Self = shift;
  delete $Self->{vchanged};
}

sub MFlagged {
  return shift->MMeta('SF:flagged', @_) || 0;
}
sub MImportance {
  # Defaults to empty string, make it a number
  return shift->MMeta('CY:importance', @_) || 0;
}
sub MMeta {
  my ($Self, $Prop) = (shift, shift);
  if (@_) {
    $Self->{meta}->{$Prop} = shift;
    $Self->{metachanged}->{$Prop} = 1;
  }
  return $Self->{meta}->{$Prop};
}

sub MChanged {
  my $Self = shift;
  return map { [ $_, $Self->{meta}->{$_} ] } keys %{$Self->{metachanged} // {}};
}
sub MClearChanged {
  my $Self = shift;
  delete $Self->{metachanged};
}

sub VPhoto {
  my $Self = shift;
  !@_ || die "You can't set a photo on a contact (yet)";
  my $Prop = $Self->{properties}->{photo}->[0] // undef;
  return unless $Prop;

  # XXX assuming binary (inline)
  # v2.1: implied
  # v3:   param VALUE=BINARY
  # v4:   data: URI

  # XXX assuming v2.1/v3 TYPE= param
  my $Type = exists $Prop->{params}->{type}->[0] ? "image/$Prop->{params}->{type}->[0]" : $FileMagic->checktype_contents($Prop->{value});

  # XXX using REV for modified, probably safe
  my $Modified = $Self->{properties}->{rev}->[0]->{value} // strftime("%Y%m%dT%H%M%SZ", @{[gmtime]});

  # X-ABCROP-RECTANGLE=ABClipRect_1&0&248&640&640&RulkMf15QMtW5L8kpxRZBw==
  my $Crop;
  if (exists $Prop->{params}->{'x-abcrop-rectangle'}) {
    my ($Label, $X, $Y, $W, $H, $Checksum) = split '&', $Prop->{params}->{'x-abcrop-rectangle'}->[0];
    $Crop = {
      X => $X,
      Y => $Y,
      W => $W,
      H => $H,
    };
  }

  # bundle it all up
  return {
    Data     => $Prop->{value},
    Type     => $Type,
    Size     => length $Prop->{value},
    Modified => $Modified,
    ($Crop ? (Crop => $Crop) : ()),
  }
}

# }}}

1;