File Coverage

blib/lib/Net/CalDAVTalk.pm

Criterion	Covered	Total	%
statement	88	1269	6.9
branch	1	800	0.1
condition	0	246	0.0
subroutine	25	79	31.6
pod	22	22	100.0
total	136	2416	5.6

package Net::CalDAVTalk;

use 5.006;
use strict;
use warnings FATAL => 'all';

use Net::DAVTalk;
use base qw(Net::DAVTalk);

use Carp;
use Data::ICal;
use Data::ICal::Entry::Event;
use Data::ICal::TimeZone;
use Data::ICal::Entry::Alarm::Email;
use Data::ICal::Entry::Alarm::Display;
use DateTime::Format::ICal;
use DateTime::TimeZone;
use JSON::XS qw(encode_json);
use Net::CalDAVTalk::TimeZones;
use Text::VCardFast qw(vcard2hash);
use XML::Spice;
use MIME::Base64 qw(encode_base64);
use MIME::Types;
use Digest::SHA qw(sha1_hex);
use URI::Escape qw(uri_unescape);

# monkey patch like a bandit
BEGIN {
  my @properties = Data::ICal::Entry::Alarm::optional_unique_properties();
  foreach my $want (qw(uid acknowledged)) {
    push @properties, $want unless grep { $_ eq $want } @properties;
  }
  no warnings 'redefine';
  *Data::ICal::Entry::Alarm::optional_unique_properties = sub { @properties };
}

our (
  $DefaultCalendarColour,
  $DefaultDisplayName,
);

our $UTC = DateTime::TimeZone::UTC->new();
our $FLOATING = DateTime::TimeZone::Floating->new();
our $LOCALE = DateTime::Locale->load('en_US');

# Beginning and End of time as used for "all event" date ranges
# Reducing this range may result in events disappearing from FastMail
# calendars, as we think they have been deleted from the other end,
# so best to avoid this.
# However, from my tests, the events should be resurrected once this date
# window includes them again.

my $BoT = '1970-01-01T00:00:00';
my $EoT = '2038-01-19T00:00:00';

my (
  %WeekDayNames,
  %WeekDayNamesReverse,
  %DaysByName,
  %DaysByIndex,
  %ColourNames,
  @Frequencies,
  %RecurrenceProperties,
  %UTCLinks,
  %MustBeTopLevel,
  %EventKeys,
);

BEGIN {
  %WeekDayNames = (
    su => 'sunday',
    mo => 'monday',
    tu => 'tuesday',
    we => 'wednesday',
    th => 'thursday',
    fr => 'friday',
    sa => 'saturday',
  );
  %WeekDayNamesReverse = reverse %WeekDayNames;

  %DaysByName = (
    su => 0,
    mo => 1,
    tu => 2,
    we => 3,
    th => 4,
    fr => 5,
    sa => 6,
  );

  %DaysByIndex           = reverse %DaysByName;
  $DefaultCalendarColour = '#0252D4';
  $DefaultDisplayName    = 'Untitled Calendar';
  @Frequencies           = qw{yearly monthly weekly daily hourly minutely secondly};

  %EventKeys = (
    '' => {
      uid                  => [0, 'string',    1, undef],
      relatedTo            => [0, 'string',    0, undef],
      prodId               => [0, 'string',    0, undef],
      created              => [0, 'utcdate',   0, undef],
      updated              => [0, 'utcdate',   1, undef],
      sequence             => [0, 'number',    0, undef],
      title                => [0, 'string',    0, ''],
      description          => [0, 'string',    0, ''],
      links                => [0, 'object',    0, undef],
      locale               => [0, 'string',    0, undef],
      localizations        => [0, 'patch',     0, undef],
      locations            => [0, 'object',    0, undef],
      isAllDay             => [0, 'bool',      0, $JSON::false],
      start                => [0, 'localdate', 1, undef],
      timeZone             => [0, 'timezone',  0, undef],
      duration             => [0, 'duration',  0, undef],
      recurrenceRule       => [0, 'object',    0, undef],
      recurrenceOverrides  => [0, 'patch',     0, undef],
      status               => [0, 'string',    0, undef],
      showAsFree           => [0, 'bool',      0, undef],
      replyTo              => [0, 'object',    0, undef],
      participants         => [0, 'object',    0, undef],
      useDefaultAlerts     => [0, 'bool',      0, $JSON::false],
      alerts               => [0, 'object',    0, undef],
    },
    replyTo => {
      imip                 => [0, 'mailto',    0, undef],
      web                  => [0, 'href',      0, undef],
    },
    links => {
      href                 => [0, 'string',    1, undef],
      type                 => [0, 'string',    0, undef],
      size                 => [0, 'number',    0, undef],
      rel                  => [0, 'string',    1, undef],
      title                => [0, 'string',    1, undef],
      properties           => [0, 'string',    1, undef],
    },
    locations => {
      name                 => [0, 'string',    0, undef],
      accessInstructions   => [0, 'string',    0, undef],
      rel                  => [0, 'string',    0, 'unknown'],
      timeZone             => [0, 'timezone',  0, undef],
      address              => [0, 'object',    0, undef],
      coordinates          => [0, 'string',    0, undef],
      uri                  => [0, 'string',    0, undef],
    },
    recurrenceRule => {
      frequency            => [0, 'string',    1, undef],
      interval             => [0, 'number',    0, undef],
      rscale               => [0, 'string',    0, 'gregorian'],
      skip                 => [0, 'string',    0, 'omit'],
      firstDayOfWeek       => [0, 'string',    0, 'monday'],
      byDay                => [1, 'object',    0, undef],
      byDate               => [1, 'number',    0, undef],
      byMonth              => [1, 'string',    0, undef],
      byYearDay            => [1, 'number',    0, undef],
      byWeekNo             => [1, 'number',    0, undef],
      byHour               => [1, 'number',    0, undef],
      byMinute             => [1, 'number',    0, undef],
      bySecond             => [1, 'number',    0, undef],
      bySetPosition        => [1, 'number',    0, undef],
      count                => [0, 'number',    0, undef],
      until                => [0, 'localdate', 0, undef],
    },
    byDay => {
      day                  => [0, 'string',    1, undef],
      nthOfPeriod          => [0, 'number',    0, undef],
    },
    participants => {
      name                 => [0, 'string',    1, undef],
      email                => [0, 'string',    1, undef],
      kind                 => [0, 'string',    0, 'unknown'],
      roles                => [1, 'string',    1, undef],
      locationId           => [0, 'string',    0, undef],
      scheduleStatus       => [0, 'string',    0, 'needs-action'],
      schedulePriority     => [0, 'string',    0, 'required'],
      scheduleRSVP         => [0, 'bool',      0, $JSON::false],
      scheduleUpdated      => [0, 'utcdate',   0, undef],
      memberOf             => [1, 'string',    0, undef],
    },
    alerts => {
      relativeTo           => [0, 'string',    0, 'before-start'],
      offset               => [0, 'duration',  1, undef],
      action               => [0, 'object',    1, undef],
    },
    action => {
      type                 => [0, 'string',    1, undef],
    },
  );

  %RecurrenceProperties = (
    bymonthday => {
      name   => 'byDate',
      max    => 31,
      signed => 1,
    },
    byyearday  => {
      name   => 'byYearDay',
      max    => 366,
      signed => 1,
    },
    byweekno   => {
      name   => 'byWeekNo',
      max    => 53,
      signed => 1,
    },
    byhour     => {
      name => 'byHour',
      max  => 23,
    },
    byminute   => {
      name => 'byMinute',
      max  => 59,
    },
    bysecond   => {
      name => 'bySecond',
      max  => 60,
    },
    bysetpos   => {
      name   => 'bySetPosition',
      max    => 366,
      signed => 1,
    },
  );

  %MustBeTopLevel = map { $_ => 1 } qw{
    uid
    relatedTo
    prodId
    isAllDay
    recurrenceRule
    recurrenceOverrides
    replyTo
    participantId
  };
  # not in tc-api / JMAP, but necessary for iMIP
  $MustBeTopLevel{method} = 1;

  # Colour names defined in CSS Color Module Level 3
  # http://www.w3.org/TR/css3-color/

  %ColourNames
    = map { $_ => 1 }
      qw{
        aliceblue
        antiquewhite
        aqua
        aquamarine
        azure
        beige
        bisque
        black
        blanchedalmond
        blue
        blueviolet
        brown
        burlywood
        cadetblue
        chartreuse
        chocolate
        coral
        cornflowerblue
        cornsilk
        crimson
        cyan
        darkblue
        darkcyan
        darkgoldenrod
        darkgray
        darkgreen
        darkgrey
        darkkhaki
        darkmagenta
        darkolivegreen
        darkorange
        darkorchid
        darkred
        darksalmon
        darkseagreen
        darkslateblue
        darkslategray
        darkslategrey
        darkturquoise
        darkviolet
        deeppink
        deepskyblue
        dimgray
        dimgrey
        dodgerblue
        firebrick
        floralwhite
        forestgreen
        fuchsia
        gainsboro
        ghostwhite
        gold
        goldenrod
        gray
        green
        greenyellow
        grey
        honeydew
        hotpink
        indianred
        indigo
        ivory
        khaki
        lavender
        lavenderblush
        lawngreen
        lemonchiffon
        lightblue
        lightcoral
        lightcyan
        lightgoldenrodyellow
        lightgray
        lightgreen
        lightgrey
        lightpink
        lightsalmon
        lightseagreen
        lightskyblue
        lightslategray
        lightslategrey
        lightsteelblue
        lightyellow
        lime
        limegreen
        linen
        magenta
        maroon
        mediumaquamarine
        mediumblue
        mediumorchid
        mediumpurple
        mediumseagreen
        mediumslateblue
        mediumspringgreen
        mediumturquoise
        mediumvioletred
        midnightblue
        mintcream
        mistyrose
        moccasin
        navajowhite
        navy
        oldlace
        olive
        olivedrab
        orange
        orangered
        orchid
        palegoldenrod
        palegreen
        paleturquoise
        palevioletred
        papayawhip
        peachpuff
        peru
        pink
        plum
        powderblue
        purple
        red
        rosybrown
        royalblue
        saddlebrown
        salmon
        sandybrown
        seagreen
        seashell
        sienna
        silver
        skyblue
        slateblue
        slategray
        slategrey
        snow
        springgreen
        steelblue
        tan
        teal
        thistle
        tomato
        turquoise
        violet
        wheat
        white
        whitesmoke
        yellow
        yellowgreen
      };

  %UTCLinks = (
    'Etc/GMT-0'     => 1,
    'Etc/GMT+0'     => 1,
    'Etc/GMT0'      => 1,
    'Etc/GMT'       => 1,
    'Etc/Greenwich' => 1,
    'Etc/UCT'       => 1,
    'Etc/Universal' => 1,
    'Etc/UTC'       => 1,
    'Etc/Zulu'      => 1,
    'GMT'           => 1,
    'UCT'           => 1,
    'UTC'           => 1,
  );
}


=head1 NAME

Net::CalDAVTalk - Module to talk CalDAV and give a JSON interface to the data

=head1 VERSION

Version 0.10

=cut

our $VERSION = '0.10';


=head1 SYNOPSIS

This module is the initial release of the code used at FastMail for talking
to CalDAV servers.  It's quite specific to an early version of our API, so
while it might be useful to others, it's being pushed to CPAN more because
the Cassandane test suite needs it.

See Net::DAVTalk for details on how to specify hosts and paths.

    my $CalDAV = Net::CalDAVTalk->new(
        user => $service->user(),
        password => $service->pass(),
        host => $service->host(),
        port => $service->port(),
        scheme => 'http',
        url => '/',
        expandurl => 1,
    );

or using DNS:

    my $domain = $user;
    $domain =~ s/.*\@//;

    my $url;
    my ($reply) = $Resolver->search("_caldavs._tcp.$domain", "srv");
    if ($reply) {
      my @d = $reply->answer;
      if (@d) {
        my $host = $d[0]->target();
        my $port = $d[0]->port();
        $url = "https://$host";
        $url .= ":$port" unless $port eq 443;
      }
    }

This will use the '/.well-known/caldav' address to find the actual current user
principal, and from there the calendar-home-set for further operations.

    my $foo = Net::CalDAVTalk->new(
       user => $user,
       password => $password,
       url => $url,
       expandurl => 1,
    );


=head1 SUBROUTINES/METHODS

=head2 new(%args)

Takes the same arguments as Net::DAVTalk and adds the caldav namespaces
and some Cyrus specific namespaces for all XML requests.

  A => 'http://apple.com/ns/ical/'
  C => 'urn:ietf:params:xml:ns:caldav'
  CY => 'http://cyrusimap.org/ns/'
  UF => 'http://cyrusimap.org/ns/userflag/'
  SF => 'http://cyrusimap.org/ns/sysflag/'

=cut

sub new {
  my ($Class, %Params) = @_;

  $Params{homesetns} = 'C';
  $Params{homeset} = 'calendar-home-set';
  $Params{wellknown} = 'caldav';

  my $Self = $Class->SUPER::new(%Params);

  $Self->ns(A => 'http://apple.com/ns/ical/');
  $Self->ns(C => 'urn:ietf:params:xml:ns:caldav');
  $Self->ns(CY => 'http://cyrusimap.org/ns/');
  $Self->ns(UF => 'http://cyrusimap.org/ns/userflag/');
  $Self->ns(SF => 'http://cyrusimap.org/ns/sysflag/');

  return $Self;
}

=head2 $self->tz($name)

Returns a DateTime::TimeZone object for the given name, but caches
the result for speed.

=cut

sub tz {
  my $Self = shift;
  my $tzName = shift;
  return $FLOATING unless defined $tzName;
  return $UTC if $UTCLinks{$tzName};
  unless (exists $Self->{_tz}{$tzName}) {
    $Self->{_tz}{$tzName} = DateTime::TimeZone->new(name => $tzName);
  }
  return $Self->{_tz}{$tzName};
}

=head2 $self->logger(sub { })

Sets a function to receive all log messages.  Gets called with the first
argument being a level name, and then a list of items to log:

e.g.

   $CalDAV->logger(sub {
      my $level = shift;
      return if ($level eq 'debug' and not $ENV{DEBUG_CALDAV});
      warn "LOG $level: $_\n" for @_;
   });

=cut

sub logger {
  my $Self = shift;

  if ($@) {
    $Self->{logger} = shift;
  }

  return $Self->{logger};
}

=head2 $self->DeleteCalendar($calendarId)

Delete the named calendar from the server (shorturl - see Net::DAVTalk)

=cut

=head2 $Cal->DeleteCalendar($calendarId)

Delete the calendar with collection name $calendarId (full or relative path)

e.g.

    $Cal->DeleteCalendar('Default');

=cut

sub DeleteCalendar {
  my ($Self, $calendarId) = @_;

  unless ($calendarId) {
    confess 'Calendar not specified';
  }

  $Self->Request(
    'DELETE',
    "$calendarId/",
  );

  return 1;
}

sub _fixColour {
  my $color = lc(shift || '');

  return $color if $ColourNames{$color};
  return $DefaultCalendarColour unless $color =~ m/^\s*(\#[a-f0-9]{3,8})\s*$/;
  $color = $1;
  return uc($color) if length($color) == 7;

  # Optional digit is for transparency (RGBA)
  if ( $color =~ m/^#(.)(.)(.).?$/ ) {
    return uc "#$1$1$2$2$3$3";
  }

  # Last two digits are for transparency (RGBA)
  if ( length($color) == 9 ) {
    return uc(substr($color,0,7));
  }

  return $DefaultCalendarColour;
}


=head2 $self->GetCalendar($calendarId)

Get a single calendar from the server by calendarId
(currently implemented very inefficiently as a get
of all calendars.  Returns undef if the calendar
doesn't exist.

e.g
   my $Calendar = $CalDAV->GetCalendar('Default');

=cut

sub GetCalendar {
  my ($Self, $CalendarId) = @_;
  my $Calendars = $Self->GetCalendars();
  die "No calendars" unless ($Calendars and @$Calendars);
  my ($Calendar) = grep { $_->{id} eq $CalendarId } @$Calendars;
  return $Calendar;
}

=head2 $self->GetCalendars(Properties => [])

Fetch all the calendars on the server.  You can request additional
properties, but they aren't parsed well yet.

e.g

   my $Calendars = $CalDAV->GetCalendars();
   foreach my $Cal (@$Calendars) {
      # do stuff
   }

=cut

sub GetCalendars {
  my ($Self, %Args) = @_;

  # XXX To generalise for CPAN:
  # XXX   - the PROPFIND should be D:allprop unless $Args{Properties} is set
  # XXX   - return all properties as object attributes without renaming
  # XXX   - translate property names to our own liking within ME::CalDAV

  my %Properties = map { $_ => 1 } (
    'D:displayname',
    'D:resourcetype',
    'A:calendar-color',
    'D:current-user-privilege-set',
    'D:acl',
    'A:calendar-order',
    'C:calendar-timezone',
    'D:sync-token',
    'D:supported-report-set',
    'C:supported-calendar-data',
    @{$Args{Properties} || []},
  );

  my $Response = $Self->Request(
    'PROPFIND',
    '',
    x('D:propfind', $Self->NS(),
      x('D:prop',
        map { x($_) } keys %Properties,
      ),
    ),
    Depth => 1,
  );

  my @Calendars;

  my $NS_A = $Self->ns('A');
  my $NS_C = $Self->ns('C');
  my $NS_CY = $Self->ns('CY');
  my $NS_D = $Self->ns('D');
  foreach my $Response (@{$Response->{"{$NS_D}response"} || []}) {
    next unless $Response->{"{$NS_D}href"}{content};
    my $href = uri_unescape($Response->{"{$NS_D}href"}{content});

    # grab the short version of the path
    my $calendarId = $Self->shortpath($href);
    # and remove trailing slash always
    $calendarId =~ s{/$}{};

    foreach my $Propstat (@{$Response->{"{$NS_D}propstat"} || []}) {
      next unless $Propstat->{"{$NS_D}prop"}{"{$NS_D}resourcetype"}{"{$NS_C}calendar"};

      # XXX - this should be moved into ME::CalDAV::GetCalendars()
      my $visData = $Propstat->{"{$NS_D}prop"}{"{$NS_C}X-FM-isVisible"}{content};
      my $isVisible = (not defined($visData) or $visData) ? $JSON::true : $JSON::false;

      my %Privileges = (
        mayAdmin => $JSON::false,
        mayWrite => $JSON::false,
        mayRead => $JSON::false,
        mayReadFreeBusy => $JSON::false,
      );

      my $Priv = $Propstat->{"{$NS_D}prop"}{"{$NS_D}current-user-privilege-set"}{"{$NS_D}privilege"};
      $Priv = [] unless ($Priv and ref($Priv) eq 'ARRAY');
      foreach my $item (@$Priv) {
        $Privileges{'mayAdmin'} = $JSON::true if $item->{"{$NS_CY}admin"};
        $Privileges{'mayWrite'} = $JSON::true if $item->{"{$NS_D}write-content"};
        $Privileges{'mayRead'} = $JSON::true if $item->{"{$NS_D}read"};
        $Privileges{'mayReadFreeBusy'} = $JSON::true if $item->{"{$NS_C}read-free-busy"};
      }

      my $CanEvent;
      my $Type = $Propstat->{"{$NS_D}prop"}{"{$NS_C}supported-calendar-data"}{"{$NS_C}calendar-data"};
      $Type = [] unless ($Type and ref($Type) eq 'ARRAY');
      foreach my $item (@$Type) {
        next unless $item->{"\@content-type"};
        $CanEvent = 1 if $item->{"\@content-type"}{content} eq "application/event+json";
      }

      # XXX - temporary compat
      $Privileges{isReadOnly} = $Privileges{mayWrite} ? $JSON::false : $JSON::true;

      my @ShareWith;
      my $ace = $Propstat->{"{$NS_D}prop"}{"{$NS_D}acl"}{"{$NS_D}ace"};
      $ace = [] unless ($ace and ref($ace) eq 'ARRAY');
      foreach my $Acl (@$ace) {
        next if $Acl->{"{$NS_D}protected"};  # ignore admin ACLs
        next unless $Acl->{"{$NS_D}grant"};
        next unless $Acl->{"{$NS_D}grant"}{"{$NS_D}privilege"};
        next unless ref($Acl->{"{$NS_D}grant"}{"{$NS_D}privilege"}) eq 'ARRAY';
        # XXX - freeBusyPublic here?  Or should we do it via the web server?
        my $user = uri_unescape($Acl->{"{$NS_D}principal"}{"{$NS_D}href"}{content} // '');
        next unless $user =~ m{^/dav/principals/user/([^/]+)};
        my $email = $1;
        next if $email eq 'admin';
        my %ShareObject = (
          email => $email,
          mayAdmin => $JSON::false,
          mayWrite => $JSON::false,
          mayRead => $JSON::false,
          mayReadFreeBusy => $JSON::false,
        );
        foreach my $item (@{$Acl->{"{$NS_D}grant"}{"{$NS_D}privilege"}}) {
          $ShareObject{'mayAdmin'} = $JSON::true if $item->{"{$NS_CY}admin"};
          $ShareObject{'mayWrite'} = $JSON::true if $item->{"{$NS_D}write-content"};
          $ShareObject{'mayRead'} = $JSON::true if $item->{"{$NS_D}read"};
          $ShareObject{'mayReadFreeBusy'} = $JSON::true if $item->{"{$NS_C}read-free-busy"};
        }

        push @ShareWith, \%ShareObject;
      }

      my %Cal = (
        id         => $calendarId,
        name       => ($Propstat->{"{$NS_D}prop"}{"{$NS_D}displayname"}{content} || $DefaultDisplayName),
        href       => $href,
        color      => _fixColour($Propstat->{"{$NS_D}prop"}{"{$NS_A}calendar-color"}{content}),
        timeZone   => $Propstat->{"{$NS_D}prop"}{"{$NS_C}calendar-timezone"}{content},
        isVisible  => $isVisible,
        precedence => int($Propstat->{"{$NS_D}prop"}{"{$NS_A}calendar-order"}{content} || 1),
        syncToken  => ($Propstat->{"{$NS_D}prop"}{"{$NS_D}sync-token"}{content} || ''),
        shareWith  => (@ShareWith ? \@ShareWith : $JSON::false),
        _can_event => ($CanEvent ? $JSON::true : $JSON::false),
        %Privileges,
      );


      push @Calendars, \%Cal;
    }
  }

  return \@Calendars;
}

=head2 $self->NewCalendar($Args)

Create a new calendar.  The Args are the as the things returned by GetCalendars,
except that if you don't provide 'id' (same as shorturl), then a UUID will be
generated for you.  It's recommended to not provide 'id' unless you need to
create a specific path for compatibility with other things, and to use 'name'
to identify the calendar for users.  'name' is stored as DAV:displayname.

e.g.

   my $Id = $CalDAV->NewCalendar({name => 'My Calendar', color => 'aqua'});

(Color names will be translated based on the CSS name list)

=cut

sub NewCalendar {
  my ($Self, $Args) = @_;

  unless (ref($Args) eq 'HASH') {
    confess 'Invalid calendar';
  }

  # The URL should be "/$calendarId/" but this isn't true with Zimbra (Yahoo!
  # Calendar). It will accept a MKCALENDAR at "/$calendarId/" but will rewrite
  # the calendar's URL to be "/$HTMLEscapedDisplayName/". I'm sure MKCALENDAR
  # should follow WebDAV's MKCOL method here, but it's not specified in CalDAV.

  # default values
  $Args->{id} //= $Self->genuuid();
  $Args->{name} //= $DefaultDisplayName;

  my $calendarId = $Args->{id};

  my @Properties;

  push @Properties, x('D:displayname', $Args->{name});

  if (exists $Args->{isVisible}) {
    push @Properties, x('C:X-FM-isVisible', ($Args->{isVisible} ? 1 : 0));
  }

  if (exists $Args->{color}) {
    push @Properties, x('A:calendar-color', _fixColour($Args->{color}));
  }

  if (exists $Args->{timeZone}) {
    push @Properties, x('C:calendar-timezone', $Args->{timeZone});
  }

  if (exists $Args->{precedence}) {
    unless (($Args->{precedence} // '') =~ /^\d+$/) {
      confess "Invalid precedence ($Args->{precedence}) (expected int >= 0)";
    }

    push @Properties, x('A:calendar-order', $Args->{precedence});
  }

  $Self->Request(
    'MKCALENDAR',
    "$calendarId/",
    x('C:mkcalendar', $Self->NS(),
      x('D:set',
        x('D:prop', @Properties),
      ),
    ),
  );

  return $calendarId;
}

=head2 $self->UpdateCalendar($Args)

Like 'NewCalendar', but updates an existing calendar, and 'id' is required.
Returns the id, just like NewCalendar.

=cut

sub UpdateCalendar {
  my ($Self, $Args, $Prev) = @_;

  unless (ref($Args) eq 'HASH') {
    confess 'Invalid calendar';
  }

  my %Calendar   = %{$Args};
  my $calendarId = $Calendar{id};

  unless ($calendarId) {
    confess 'Calendar not specified';
  }

  my @Params;

  if (defined $Calendar{name}) {
    push @Params, x('D:displayname', $Calendar{name});
  }

  if (defined $Calendar{color}) {
    push @Params, x('A:calendar-color', _fixColour($Calendar{color}));
  }

  if (exists $Args->{timeZone}) {
    push @Params, x('C:calendar-timezone', $Args->{timeZone});
  }

  if (exists $Calendar{isVisible}) {
    push @Params, x('C:X-FM-isVisible', $Calendar{isVisible} ? 1 : 0);
  }

  if (exists $Calendar{precedence}) {
    unless (($Calendar{precedence} ||'') =~ /^\d+$/) {
      confess "Invalid precedence ($Calendar{precedence})";
    }

    push @Params, x('A:calendar-order', $Calendar{precedence});
  }

  return $calendarId unless @Params;

  $Self->Request(
    'PROPPATCH',
    "$calendarId/",
    x('D:propertyupdate', $Self->NS(),
      x('D:set',
        x('D:prop',
          @Params,
        ),
      ),
    ),
  );

  return $calendarId;
}

# Event methods

=head2 $self->DeleteEvent($Event|$href)

Given a single event or the href to the event, delete that event,
delete it from the server.

Returns true.

=cut

sub DeleteEvent {
  my ($Self) = shift;
  my ($Event) = @_;

  confess "Need an event" unless $Event;

  $Event = { href => $Event, summary => $Event } unless ref($Event) eq 'HASH';

  $Self->Request(
    'DELETE',
    $Event->{href},
  );

  return 1;
}

=head2 $self->GetEvents($calendarId, %Args)

Fetches some or all of the events in a calendar.

Supported args:

  href => [] - perform a multi-get on just these fullpath urls.
  after+before => ISO8601 - date range to query

In scalar context returns an arrayref of events.  In list context
returns both an arrayref of events and an arrayref of errors:

e.g.

    my ($Events, $Errors) = $CalDAV->GetEvents('Default');

=cut

sub GetEvents {
  my ($Self, $calendarId, %Args) = @_;

  # validate parameters {{{

  confess "Need a calendarId" unless $calendarId;

  my @Query;
  my $TopLevel = 'C:calendar-query';
  my $Filter;
  if ($Args{href}) {
    $TopLevel = 'C:calendar-multiget';
    $Filter = x('D:href', $Args{href});
  }
  elsif ($Args{AlwaysRange} || $Args{after} || $Args{before}) {
    my $Start = _wireDate($Args{after} || $BoT);
    my $End = _wireDate($Args{before} || $EoT);

    $Filter = x('C:filter',
      x('C:comp-filter', { name => 'VCALENDAR' },
        x('C:comp-filter', { name => 'VEVENT' },
          x('C:time-range', {
            start => $Start->strftime('%Y%m%dT000000Z'),
            end   => $End->strftime('%Y%m%dT000000Z'),
          }),
        ),
      ),
    );
  }
  else {
    $Filter = x('C:filter',
      x('C:comp-filter', { name => 'VCALENDAR' },
        x('C:comp-filter', { name => 'VEVENT' },
        ),
      ),
    );
  }
  my @Annotations;
  my $AnnotNames = $Args{Annotations} || [];
  foreach my $key (@$AnnotNames) {
    my $name = ($key =~ m/:/ ? $key : "C:$key");
    push @Annotations, x($name);
  }

  # }}}

  my %CalProps;
  if ($Args{ContentType}) {
    $CalProps{'content-type'} = $Args{ContentType};
  }
  if ($Args{Version}) {
    $CalProps{'version'} = $Args{Version};
  }

  my $Response = $Self->Request(
    'REPORT',
    "$calendarId/",
    x($TopLevel, $Self->NS(),
      x('D:prop',
        x('C:calendar-data', \%CalProps),
        @Annotations,
      ),
      $Filter,
    ),
    Depth => 1,
  );

  return $Response if $Args{Raw};

  my (@Events, @Errors);

  my $NS_A = $Self->ns('A');
  my $NS_C = $Self->ns('C');
  my $NS_D = $Self->ns('D');
  foreach my $Response (@{$Response->{"{$NS_D}response"} || []}) {
    my $href = uri_unescape($Response->{"{$NS_D}href"}{content} // '');
    next unless $href;
    foreach my $Propstat (@{$Response->{"{$NS_D}propstat"} || []}) {
      my $Prop = $Propstat->{"{$NS_D}prop"}{"{$NS_C}calendar-data"};
      my $Data = $Prop->{content};
      next unless $Data;

      my $Event;

      if ($Prop->{'-content-type'} and $Prop->{'-content-type'} =~ m{application/event\+json}) {
        # JSON event is in API format already
        $Event = eval { decode_json($Data) };
      }
      else {
        # returns an array, but there should only be one UID per file
        ($Event) = eval { $Self->vcalendarToEvents($Data) };
      }

      if ($@) {
        push @Errors, $@;
        next;
      }
      next unless $Event;

      if ($Args{Full}) {
        $Event->{_raw} = $Data;
      }

      $Event->{href} = $href;
      $Event->{id} = $Self->shortpath($href);

      foreach my $key (@$AnnotNames) {
        my $propns = $NS_C;
        my $name = $key;
        if ($key =~ m/(.*):(.*)/) {
          $name = $2;
          $propns = $Self->ns($1);
        }
        my $AData = $Propstat->{"{$NS_D}prop"}{"{$propns}$name"}{content};
        next unless $AData;
        $Event->{annotation}{$name} = $AData;
      }

      push @Events, $Event;
    }
  }

  return wantarray ? (\@Events, \@Errors) : \@Events;
}

=head2 $self->GetEvent($href)

Just get a single event (calls GetEvents with that href)

=cut

sub GetEvent {
  my ($Self, $href, %Args) = @_;

  # XXX - API
  my $calendarId = $href;
  $calendarId =~ s{/[^/]*$}{};

  my ($Events, $Errors) = $Self->GetEvents($calendarId, %Args, href => $Self->fullpath($href));

  die "Errors @$Errors" if @$Errors;
  die "Multiple items returned for $href" if @$Events > 1;

  return $Events->[0];
}

=head2 $self->GetFreeBusy($calendarId, %Args)

Like 'GetEvents' but uses a free-busy-query and then generates
synthetic events out of the result.

Doesn't have a 'href' parameter, just the before/after range.

=cut

sub GetFreeBusy {
  my ($Self, $calendarId, %Args) = @_;

  # validate parameters {{{

  confess "Need a calendarId" unless $calendarId;

  my @Query;
  if ($Args{AlwaysRange} || $Args{after} || $Args{before}) {
    my $Start = _wireDate($Args{after} || $BoT);
    my $End = _wireDate($Args{before} || $EoT);

    push @Query,
            x('C:time-range', {
              start => $Start->strftime('%Y%m%dT000000Z'),
              end   => $End->strftime('%Y%m%dT000000Z'),
            });
  }

  # }}}

  my $Response = $Self->Request(
    'REPORT',
    "$calendarId/",
    x('C:free-busy-query', $Self->NS(),
      @Query,
    ),
    Depth => 1,
  );

  my $Data = eval { vcard2hash($Response->{content}, multival => ['rrule'], only_one => 1) }
    or confess "Error parsing VFreeBusy data: $@";

  my @result;
  my @errors;
  my $now = DateTime->now();
  foreach my $item (@{$Data->{objects}[0]{objects}}) {
    next unless $item->{type} eq 'vfreebusy';
    foreach my $line (@{$item->{properties}{freebusy}}) {
      my ($Start, $End) = split '/', $line->{value};
      my ($StartTime, $IsAllDay) = $Self->_makeDateObj($Start, 'UTC', 'UTC');
      my $EndTime;
      if ($End =~ m/^[+-]?P/i) {
          my $Duration = eval { DateTime::Format::ICal->parse_duration(uc $End) }
            || next;
          $EndTime = $StartTime->clone()->add($Duration);
      } else {
        ($EndTime) = $Self->_makeDateObj($End, 'UTC', 'UTC');
      }
      my $duration = $Self->_make_duration($EndTime->subtract_datetime($StartTime));
      my $NewEvent = {
        timeZone => 'Etc/UTC',
        start => $StartTime->iso8601(),
        duration => $duration,
        title => ($Args{name} // ''),
        isAllDay => ($IsAllDay ? $JSON::true : $JSON::false),
        updated => $now->iso8601(),
      };

      # Generate a uid that should remain the same for this freebusy entry
      $NewEvent->{uid} = _hexkey($NewEvent) . '-freebusyauto';
      $NewEvent->{isAllDay} =
        $NewEvent->{isAllDay} ? $JSON::true : $JSON::false;
      push @result, $NewEvent;
    }
  }

  warn Dumper(\@result);
  return (\@result, \@errors);
}

=head2 $self->SyncEvents($calendarId, %Args)

Like GetEvents, but if you pass a syncToken argument, then it will
fetch changes since that token (obtained from an earlier GetCalendars
call).

In scalar context still just returns new events, in list context returns
Events, Removed and Errors.

e.g.

   my ($Events, $Removed, $Errors) = $CalDAV->SyncEvents('Default', syncToken => '...');

=cut

sub SyncEvents {
  my ($Self, $calendarId, %Args) = @_;

  confess "Need a calendarId" unless $calendarId;

  my @Annotations;
  my $AnnotNames = $Args{Annotations} || [];
  foreach my $key (@$AnnotNames) {
    my $name = ($key =~ m/:/ ? $key : "C:$key");
    push @Annotations, x($name);
  }

  my %CalProps;
  if ($Args{ContentType}) {
    $CalProps{'content-type'} = $Args{ContentType};
  }
  if ($Args{Version}) {
    $CalProps{'version'} = $Args{Version};
  }

  my $Response = $Self->Request(
    'REPORT',
    "$calendarId/",
    x('D:sync-collection', $Self->NS(),
      x('D:sync-token', ($Args{syncToken} ? ($Args{syncToken}) : ())),
      x('D:sync-level', 1),
      x('D:prop',
        x('D:getetag'),
        x('C:calendar-data', \%CalProps),
        @Annotations,
      ),
    ),
  );

  my (@Events, @Removed, @Errors);

  my $NS_A = $Self->ns('A');
  my $NS_C = $Self->ns('C');
  my $NS_D = $Self->ns('D');
  foreach my $Response (@{$Response->{"{$NS_D}response"} || []}) {
    my $href = uri_unescape($Response->{"{$NS_D}href"}{content} // '');
    next unless $href;

    unless ($Response->{"{$NS_D}propstat"}) {
      push @Removed, $Self->shortpath($href);
      next;
    }

    foreach my $Propstat (@{$Response->{"{$NS_D}propstat"} || []}) {
      my $status = $Propstat->{"{$NS_D}status"}{content};
      if ($status =~ m/ 200 /) {
        my $Prop = $Propstat->{"{$NS_D}prop"}{"{$NS_C}calendar-data"};
        my $Data = $Prop->{content};
        next unless $Data;

        my $Event;

        if ($Prop->{'-content-type'} and $Prop->{'-content-type'} =~ m{application/event\+json}) {
          # JSON event is in API format already
          $Event = eval { decode_json($Data) };
        }
        else {
          # returns an array, but there should only be one UID per file
          ($Event) = eval { $Self->vcalendarToEvents($Data) };
        }

        if ($@) {
          push @Errors, $@;
          next;
        }
        next unless $Event;

        if ($Args{Full}) {
          $Event->{_raw} = $Data;
        }

        $Event->{href} = $href;
        $Event->{id} = $Self->shortpath($href);

        foreach my $key (@$AnnotNames) {
          my $propns = $NS_C;
          my $name = $key;
          if ($key =~ m/(.*):(.*)/) {
            $name = $2;
            $propns = $Self->ns($1);
          }
          my $AData = $Propstat->{"{$NS_D}prop"}{"{$propns}$name"}{content};
          next unless $AData;
          $Event->{annotation}{$name} = $AData;
        }

        push @Events, $Event;
      }
      else {
        push @Errors, "Odd status $status";
      }
    }
  }

  return wantarray ? (\@Events, \@Removed, \@Errors) : \@Events;
}

=head2 $self->NewEvent($calendarId, $Args)

Create a new event in the named calendar.  If you don't specify 'uid' then
a UUID will be created.  You should only specify the UID if you need to for
syncing purposes - it's better to auto-generate otherwise.

Returns the href, but also updates 'uid' in $Args.

Also updates 'sequence'.

e.g.

    my $href = $CalDAV->NewEvent('Default', $Args);
    my $newuid = $Args->{uid};

=cut

sub NewEvent {
  my ($Self, $calendarId, $Args) = @_;

  confess "Need a calendarId" unless $calendarId;

  confess "invalid event" unless ref($Args) eq 'HASH';

  my $UseEvent = delete $Args->{_put_event_json};

  # calculate updated sequence numbers
  unless (exists $Args->{sequence}) {
    $Args->{sequence} = 1;
  }

  if ($Args->{exceptions}) {
    foreach my $recurrenceId (sort keys %{$Args->{exceptions}}) {
      my $val = $Args->{exceptions}{$recurrenceId};
      next unless $val;
      next if exists $val->{sequence};

      $val->{sequence} = $Args->{sequence};
    }
  }

  $Args->{uid} //= $Self->genuuid();
  my $uid = $Args->{uid};
  my $path = $uid;
  $path =~ tr/[a-zA-Z0-9\@\.\_\-]//cd;
  my $href = "$calendarId/$path.ics";

  if ($UseEvent) {
    $Self->Request(
      'PUT',
      $href,
      encode_json($Args),
      'Content-Type'  => 'application/event+json',
    );
  }
  else {
    my $VCalendar = $Self->_argsToVCalendar($Args);
    $Self->Request(
      'PUT',
      $href,
      $VCalendar->as_string(),
      'Content-Type'  => 'text/calendar',
    );
  }

  return $href;
}

=head2 $self->UpdateEvent($href, $Args)

Like NewEvent, but you only need to specify keys that you want to change,
and it takes the full href to the card instead of the containing calendar.

=cut

sub UpdateEvent {
  my ($Self, $href, $Args) = @_;

  my $UseEvent = delete $Args->{_put_event_json};

  my ($OldEvent, $NewEvent) = $Self->_updateEvent($href, $Args);

  if ($UseEvent) {
    $Self->Request(
      'PUT',
      $href,
      encode_json($NewEvent),
      'Content-Type'  => 'application/event+json',
    );
  }
  else {
    my $VCalendar = $Self->_argsToVCalendar($NewEvent);
    $Self->Request(
      'PUT',
      $href,
      $VCalendar->as_string(),
      'Content-Type'  => 'text/calendar',
    );
  }

  return 1;
}

sub _updateEvent {
  my ($Self, $href, $Args) = @_;

  my $OldEvent = $Self->GetEvent($href);

  confess "Error getting old event for $href"
    unless $OldEvent;

  my %NewEvent;

  foreach my $Property (keys %EventKeys) {
    if (exists $Args->{$Property}) {
      if (defined $Args->{$Property}) {
        $NewEvent{$Property} = $Args->{$Property};
      }
    }
    elsif (exists $OldEvent->{$Property}) {
      $NewEvent{$Property} = $OldEvent->{$Property};
    }
  }

  # calculate updated sequence numbers
  unless (exists $Args->{sequence}) {
    $NewEvent{sequence} = ($OldEvent->{sequence} || 0) + 1;
  }

  if ($NewEvent{exceptions}) {
    foreach my $recurrenceId (sort keys %{$NewEvent{exceptions}}) {
      my $val = $NewEvent{exceptions}{$recurrenceId};
      next unless $val;
      next if exists $val->{sequence};

      my $old = $OldEvent->{exceptions}{$recurrenceId};
      my $sequence = $NewEvent{sequence};
      if ($old && exists $old->{sequence}) {
        $sequence = $old->{sequence} + 1 unless $sequence > $old->{sequence};
      }
      $val->{sequence} = $sequence;
    }
  }

  $NewEvent{href} = $href;

  return ($OldEvent, \%NewEvent);
}

=head2 $self->AnnotateEvent($href, $Args)

Instead of actually changing an event itself, use proppatch to
add or remove properties on the event.

=cut

sub AnnotateEvent {
  my ($Self, $href, $Args) = @_;

  my $OldEvent = $Self->GetEvent($href);

  confess "Error getting old event for $href"
    unless $OldEvent;

  my @Set;
  my @Remove;
  foreach my $key (sort keys %$Args) {
    my $name = ($key =~ m/:/ ? $key : "C:$key");
    if (defined $Args->{$key}) {
      push @Set, x($name, $Args->{$key});
    }
    else {
      push @Remove, x($name);
    }
  }

  my @Params;
  push @Params, x('D:set', x('D:prop', @Set)) if @Set;
  push @Params, x('D:remove', x('D:prop', @Remove)) if @Remove;
  return undef unless @Params;

  $Self->Request(
    'PROPPATCH',
    $href,
    x('D:propertyupdate', $Self->NS(), @Params),
  );

  return 1;
}

=head2 $self->MoveEvent($href, $newCalendarId)

Move an event into a new calendar.  Returns the new href.

=cut

sub MoveEvent {
  my ($Self, $href, $newCalendarId) = @_;

  my $OldEvent = $Self->GetEvent($href);

  return unless $OldEvent;

  my $dest = $href;
  $dest =~ s{.*/}{$newCalendarId/};
  return if $href eq $dest;

  $Self->Request(
    'MOVE',
    $href,
    undef,
    'Destination' => $Self->fullpath($dest),
  );

  warn "CAL: MoveEvent $Self->{user} ($href => $dest)\n";

  return $dest;
}

sub _BYDAY2byDay {
  my ($BYDAY) = @_;

  my ($Count, $Day) = $BYDAY =~ /^([-+]?\d+)?(\w\w)$/;

  unless ($Day) {
    confess 'Recurrence BYDAY-weekday not specified';
  }

  unless ($WeekDayNames{$Day}) {
    confess 'Invalid recurrence BYDAY-weekday';
  }

  if ($Count) {
    unless (($Count >= -53) and ($Count <= 53)) {
      confess 'Recurrence BYDAY-ordwk is out of range';
    }
  }

  return {
    day => $WeekDayNames{$Day},
    $Count ? (nthOfPeriod => int($Count)) : (),
  };
}

sub _byDay2BYDAY {
  my ($byDay) = @_;

  unless (defined $byDay) {
    confess 'Invalid recurrence byDay';
  }

  unless (ref $byDay eq 'HASH') {
    confess 'Recurrence byDay is not an object';
  }

  my $Day          = $WeekDayNamesReverse{$byDay->{day}};
  unless ($Day) {
    confess 'Recurrence byDay is not a known day';
  }
  my $Prefix = '';
  $Prefix = int($byDay->{nthOfPeriod}) if $byDay->{nthOfPeriod};

  return $Prefix . uc($Day);
}

sub _makeDateObj {
  my $Self = shift;
  my $DateStr = shift;
  my $TZStr = shift;
  my $TargetTz = shift;

  my ($Date, $HasTime) = _vDate($DateStr);

  # if it's all day, return it immediately
  return ($Date, 1) unless $HasTime;

  # Do the timezone manipulation as required
  $Date->set_time_zone($Self->tz($TZStr)) if $TZStr;
  $Date->set_time_zone($Self->tz($TargetTz)) if $TargetTz;

  return ($Date, 0);
}

sub _getDateObj {
  my $Self = shift;
  my $Calendar = shift;
  my $VItem = shift;
  my $TargetTz = shift;

  my $TimeZone = $Self->_getTimeZone($Calendar, $VItem);
  my ($Date, $IsAllDay) = $Self->_makeDateObj($VItem->{value}, $TimeZone, $TargetTz);

  return (wantarray ? ($Date, $TimeZone, $IsAllDay) : $Date);
}

sub _getDateObjMulti {
  my $Self = shift;
  my $Calendar = shift;
  my $VItem = shift;
  my $TargetTz = shift;

  my @Dates;

  my $TimeZone = $Self->_getTimeZone($Calendar, $VItem);
  foreach my $Value (split /,/, $VItem->{value}) {
    # XXX - handle $V2 sanely
    if (lc($VItem->{params}{value}[0] || '') eq 'period') {
      ($Value, my $V2) = split /\//, $Value;
    }
    my ($Date, $IsAllDay) = $Self->_makeDateObj($Value, $TimeZone, $TargetTz);
    push @Dates, $Date;
  }

  return @Dates;
}

# Exclude DTSTAMP from auto uid generation
sub _hexkey {
  my $VEvent = shift;
  my $updated = delete $VEvent->{properties}->{updated};
  my $d = Data::Dumper->new([$VEvent]);
  $d->Indent(0);
  $d->Sortkeys(1);
  my $Key = sha1_hex($d->Dump());
  $VEvent->{properties}->{updated} = $updated if defined $updated;
  return $Key;
}

sub _saneuid {
  my $uid = shift;
  return unless $uid;
  return if $uid =~ m/\s/;
  return if $uid =~ m/[\x7f-\xff]/;
  # any other sanity checks?
  return 1;
}

sub _makeParticipant {
  my ($Self, $Calendar, $Participants, $VAttendee, $role) = @_;

  my $id = $VAttendee->{value};
  return unless $id;
  $id =~ s/^mailto://i;
  return if $id eq '';

  $Participants->{$id} ||= {};

  # XXX - if present on one but not the other, take the "best" version
  $Participants->{$id}{name} = $VAttendee->{params}{"cn"}[0] // "";
  $Participants->{$id}{email} = $id;
  $Participants->{$id}{kind} = lc $VAttendee->{params}{"cutype"}[0]
    if $VAttendee->{params}{"cutype"};
  push @{$Participants->{$id}{roles}}, $role;
  # we don't support locationId yet
  if ($VAttendee->{params}{"partstat"}) {
    $Participants->{$id}{scheduleStatus} = lc($VAttendee->{params}{"partstat"}[0] // "needs-action");
  }
  if ($VAttendee->{params}{"role"}) {
    push @{$Participants->{$id}{roles}}, 'chair'
      if uc $VAttendee->{params}{"role"}[0] eq 'CHAIR';
    $Participants->{$id}{schedulePriority} = 'optional'
      if uc $VAttendee->{params}{"role"}[0] eq 'OPT-PARTICIPANT';
    $Participants->{$id}{schedulePriority} = 'non-participant'
      if uc $VAttendee->{params}{"role"}[0] eq 'NON-PARTICIPANT';
  }
  if ($VAttendee->{params}{"rsvp"}) {
    $Participants->{$id}{scheduleRSVP} = lc($VAttendee->{params}{"rsvp"}[0] // "") eq 'yes' ? $JSON::true : $JSON::false;
  }
  if (exists $VAttendee->{params}{"x-dtstamp"}) {
    my ($Date) = eval { $Self->_makeDateObj($VAttendee->{params}{"x-dtstamp"}[0], 'UTC', 'UTC') };
    $Participants->{$id}{"scheduleUpdated"} = $Date->iso8601() . 'Z' if $Date;
  }
  # memberOf is not supported

  if (exists $VAttendee->{params}{"x-sequence"}) {
    $Participants->{$id}{"x-sequence"} = $VAttendee->{params}{"x-sequence"}[0] // "";
  }
}

sub _make_duration {
  my ($Self, $dtdur, $IsAllDay) = @_;

  my ($w, $d, $H, $M, $S) = (
    $dtdur->weeks,
    $dtdur->days,
    $dtdur->hours,
    $dtdur->minutes,
    $dtdur->seconds,
  );

  return 'PT0S' unless ($w || $d || $H || $M || $S);

  my @bits = ('P');
  push @bits, ($w, 'W') if $w;
  push @bits, ($d, 'D') if $d;
  if (not $IsAllDay and ($H || $M || $S)) {
    push @bits, 'T';
    push @bits, ($H, 'H') if $H;
    push @bits, ($M, 'M') if $M;
    push @bits, ($S, 'S') if $S;
  }

  return join ('', @bits);
}

=head2 $NewEvent = Net::CalDAVTalk->NormaliseEvent($Event);

Doesn't change the original event, but removes any keys which are the same as their default value

=cut

sub NormaliseEvent {
  my ($class, $Event, $Root) = @_;

  $Root ||= '';

  my %Copy = %$Event;

  # XXX: patches need to be normalised as well...
  my $Spec = $EventKeys{$Root};
  foreach my $key (keys %$Event) {
    delete $Copy{$key} unless $Spec->{$key};
  }
  foreach my $key (sort keys %$Spec) {
    # remove if it's the default
    if ($Spec->{$key}[1] eq 'object') {
      my $Item = delete $Copy{$key};
      next unless $Item; # no object
      if ($Spec->{$key}[0]) {
        $Copy{$key} = [map { $class->NormaliseEvent($_, $key) } @$Item];
      }
      else {
        $Copy{$key} = $class->NormaliseEvent($Item, $key);
      }
    }
    elsif ($Spec->{$key}[1] eq 'bool') {
      delete $Copy{$key} if !!$Spec->{$key}[3] == !!$Copy{$key};
    }
    elsif ($Spec->{$key}[1] eq 'mailto') {
      $Copy{$key} = lc $Copy{$key} if $Copy{$key};
    }
    else {
      delete $Copy{$key} if _safeeq($Spec->{$key}[3], $Copy{$key});
    }
  }

  return \%Copy;
}

=head2 Net::CalDAVTalk->CompareEvents($Event1, $Event2);

Returns true if the events are identical

=cut

sub CompareEvents {
  my ($class, $Event1, $Event2) = @_;

  my $E1 = $class->NormaliseEvent($Event1);
  my $E2 = $class->NormaliseEvent($Event2);

  return _safeeq($E1, $E2);
}


sub _getEventsFromVCalendar {
  my ($Self, $VCalendar) = @_;

  my $CalendarData = eval { vcard2hash($VCalendar, multival => ['rrule'], only_one => 1) }
    or confess "Error parsing VCalendar data: $@\n\n$VCalendar";

  my @Events;

  foreach my $Calendar (@{$CalendarData->{objects} || []}) {
    next unless lc $Calendar->{type} eq 'vcalendar';

    my $method = $Calendar->{properties}{method}[0]{value};
    my $prodid = $Calendar->{properties}{prodid}[0]{value};

    foreach my $VEvent (@{$Calendar->{objects} || []}) {
      next unless lc $VEvent->{type} eq 'vevent';

      # parse simple component properties {{{

      my %Properties
        = map { $_ => $VEvent->{properties}{$_}[0] }
            keys %{$VEvent->{properties}};

      my $uid = $Properties{uid}{value};
      # Case: UID is badly broken or missing -
      # let's just calculate a UID based on the incoming data.  This
      # is the 'ICS sync url with no UIDs in it' case from BTS-3205,
      # http://mozorg.cdn.mozilla.net/media/caldata/DutchHolidays.ics
      $uid = _hexkey($VEvent) . '-syncauto' unless _saneuid($uid);

      my $ShowAsFree = (lc($Properties{transp}{value} || '')) eq 'transparent';

      # clean up whitespace on text fields
      foreach my $Property (qw{description location summary}) {
        next unless defined $Properties{$Property}{value};
        $Properties{$Property}{value} =~ s/^\s+//gs;
        $Properties{$Property}{value} =~ s/\s+$//gs;
      }

      my @description;
      push @description, $Properties{description}{value}
        if defined $Properties{description}{value};

      # }}}

      # parse time component properties {{{

      my ($IsAllDay, $Start, $StartTimeZone, $End, $EndTimeZone) = ('') x 5;

      confess "$uid: DTSTART not specified" unless defined $Properties{dtstart}{value};

      ($Start, $StartTimeZone, $IsAllDay) = $Self->_getDateObj($Calendar, $Properties{dtstart});

      if (defined $Properties{dtend}{value}) {
        if (defined $Properties{duration}{value}) {
          warn "$uid: DTEND and DURATION cannot both be set";
        }

        ($End, $EndTimeZone) = $Self->_getDateObj($Calendar, $Properties{dtend});
      }
      elsif (defined $Properties{duration}{value}) {
        my $Duration = DateTime::Format::ICal->parse_duration(uc $Properties{duration}{value});
        $End = $Start->clone()->add($Duration);
        $EndTimeZone = $StartTimeZone;
      }
      else {
        $End         = $Start->clone();
        $EndTimeZone = $StartTimeZone;
      }

      if (DateTime->compare($Start, $End) > 0) {
        # swap em!
        ($Start, $End) = ($End, $Start);
        ($StartTimeZone, $EndTimeZone) = ($EndTimeZone, $StartTimeZone);
      }

      if ($IsAllDay and $StartTimeZone) {
        warn "$uid: AllDay event with timezone $StartTimeZone specified";
      }

      # if one is set, make sure they are both set
      $StartTimeZone ||= $EndTimeZone;
      $EndTimeZone   ||= $StartTimeZone;

      # }}}

      my %Recurrence;

      if (exists $Properties{rrule}) {
        my %RRULE;

        foreach my $RRULE (@{$Properties{rrule}{values}}) {
          my ($Key,$Value) = split '=', $RRULE;
          next unless defined $Value;

          $RRULE{lc $Key} = $Value;
        }

        # parse simple recurrence properties {{{

        if (exists $RRULE{freq}) {
          my $freq = lc $RRULE{freq};
          unless (grep { $_ eq $freq } @Frequencies) {
            confess "$uid: Invalid recurrence FREQ ($RRULE{freq})";
          }

          $Recurrence{frequency} = $freq;
        }
        else {
          use Data::Dumper;
          confess "$uid: Recurrence FREQ not specified";
        }

        if (exists $RRULE{interval}) {
          unless ($RRULE{interval} =~ /^\d+$/) {
            confess "$uid: Invalid recurrence INTERVAL ($RRULE{interval})";
          }
          my $interval = int $RRULE{interval};

          if ($interval == 0) {
            confess "$uid: Recurrence INTERVAL is out of range ($RRULE{interval})";
          }

          # default == 1, so don't set a key for it
          if ($interval > 1) {
            $Recurrence{interval} = $interval;
          }
        }

        if (exists $RRULE{rscale}) {
          $Recurrence{rscale} = lc $RRULE{rscale};
          $Recurrence{skip} = lc $RRULE{skip} if $RRULE{skip};
        }

        if (exists $RRULE{wkst}) {
          my $wkst = lc $RRULE{wkst};
          unless ($WeekDayNames{$wkst}) {
            confess "$uid: Invalid recurrence WKST ($RRULE{wkst})";
          }

          # default is Monday, so don't set a key for it
          if ($wkst ne 'mo') {
            $Recurrence{firstDayOfWeek} = $WeekDayNames{$wkst};
          }
        }

        if (exists $RRULE{byday}) {
          my @byDays;

          foreach my $BYDAY (split ',', $RRULE{byday}) {
            push @byDays, _BYDAY2byDay(lc $BYDAY);
          }

          $Recurrence{byDay} = \@byDays if @byDays;
        }

        if (exists $RRULE{bymonth}) {
          foreach my $BYMONTH (split ',', $RRULE{bymonth}) {
            unless ($BYMONTH =~ /^\d+L?$/) {
              confess "$uid: Invalid recurrence BYMONTH ($BYMONTH, $RRULE{bymonth})";
            }

            push @{$Recurrence{byMonth}}, "$BYMONTH";
          }
        }

        if (exists $RRULE{count}) {
          if (exists $RRULE{until}) {
            #confess "$uid: Recurrence COUNT and UNTIL cannot both be set";
            # seen in the wild: PRODID:-//dmfs.org//mimedir.icalendar//EN
            delete $RRULE{until};
          }

          unless ($RRULE{count} =~ /^\d+$/) {
            confess "$uid: Invalid recurrence COUNT ($RRULE{count})";
          }

          $Recurrence{count} = int $RRULE{count};
        }

        if (exists $RRULE{until}) {
          # rfc5545 3.3.10 - UNTIL must be in DTSTART timezone, but both
          # google and iCloud store it in Z, so we will too as per rfc2445.
          my ($Until, $IsAllDay) = $Self->_makeDateObj($RRULE{until}, $StartTimeZone, $StartTimeZone);
          $Recurrence{until} = $Until->iso8601();
        }

        # }}}

        # parse generic recurrence properties {{{

        foreach my $Property (keys %RecurrenceProperties) {
          if (defined $RRULE{$Property}) {
            foreach my $Value (split ',', $RRULE{$Property}) {
              my ($Valid, $Min) = $RecurrenceProperties{$Property}{signed}
                ? ('[-+]?[1-9]\d*', ($RecurrenceProperties{$Property}{max} * -1))
                : ('\d+', 0);

              unless ($Value =~ /^$Valid$/) {
                confess "$uid: Invalid recurrence $Property ($Value)";
              }

              unless (($Value >= $Min) and ($Value <= $RecurrenceProperties{$Property}{max})) {
                confess "$uid: Recurrence $Property is out of range ($Value)";
              }

              push @{$Recurrence{$RecurrenceProperties{$Property}{name}}}, int $Value;
            }
          }
        }

        # }}}
      }

      my %Overrides;
      if (exists $VEvent->{properties}{exdate}) {
        foreach my $Item (@{$VEvent->{properties}{exdate}}) {
          foreach my $Date ($Self->_getDateObjMulti($Calendar, $Item, $StartTimeZone)) {
            $Overrides{$Date->iso8601()} = $JSON::null;
          }
        }
      }

      if ($VEvent->{properties}{rdate}) {
        # rdate      = "RDATE" rdtparam ":" rdtval *("," rdtval) CRLF
        foreach my $Item (@{$VEvent->{properties}{rdate}}) {
          foreach my $Date ($Self->_getDateObjMulti($Calendar, $Item, $StartTimeZone)) {
            $Overrides{$Date->iso8601()} = {};
          }
        }
      }

      # parse alarms {{{

      my %Alerts;
      foreach my $VAlarm (@{$VEvent->{objects} || []}) {
        next unless lc $VAlarm->{type} eq 'valarm';

        my %AlarmProperties
          = map { $_ => $VAlarm->{properties}{$_}[0] }
              keys %{$VAlarm->{properties}};

        my $alarmuid = $AlarmProperties{uid}{value} || _hexkey($VAlarm) . '-alarmauto';

        my %Alert;

        my $AlarmAction = lc $AlarmProperties{action}{value};
        next unless $AlarmAction;

        my %Action;

        if ($AlarmAction eq 'display') {
          $Action{type} = 'display';
        }
        elsif ($AlarmAction eq 'email') {
          $Action{type} = 'email';

          $Action{to} = [
            map { my ($x) = $_->{value} =~ m/^(?:mailto:)?(.*)/i; { email => $x } }
            @{$VAlarm->{properties}{attendee} // []}
          ];
        }
        elsif ($AlarmAction eq 'uri') {
          $Action{type} = 'uri';
          $Action{uri} = $VAlarm->{properties}{uri} // [];
        }
        elsif ($AlarmAction eq 'audio') {
          # audio alerts aren't the same as popups, but for now...
          $Action{type} = 'display';
        }
        elsif ($AlarmAction eq 'none') {
          next;
        }
        else {
          warn "$uid: UNKNOWN VALARM ACTION $AlarmAction";
          next;
        }

        if ($AlarmProperties{acknowledged}) {
          my $date = $Self->_getDateObj($Calendar, $AlarmProperties{acknowledged}, 'UTC');
          $Action{acknowledged} = $date->iso8601() . 'Z';
        }

        my $Trigger = $AlarmProperties{trigger}{value}
          || next;

        my $Related = (lc ($AlarmProperties{trigger}{params}{related}[0] || '') eq 'end')
          ? 'end'
          : 'start';

        my $Duration;
        if ($Trigger =~ m/^[+-]?P/i) {
          $Duration = eval { DateTime::Format::ICal->parse_duration(uc $Trigger) }
            || next;

        } else {
          my $AlertDate = $Self->_getDateObj($Calendar, $AlarmProperties{trigger}, $StartTimeZone);
          $Duration = $AlertDate->subtract_datetime($Related eq 'end' ? $End : $Start);
        }

        if ($Duration->is_negative()) {
          $Duration = $Duration->inverse();
          $Alert{relativeTo} = "before-$Related";
        }
        else {
          $Alert{relativeTo} = "after-$Related";
        }

        $Alert{action} = \%Action;
        $Alert{offset} = $Self->_make_duration($Duration);

        $Alerts{$alarmuid} = \%Alert;
      }

      # }}}

      # parse attendees {{{

      my %Participants;
      for my $VOrganizer (@{$VEvent->{properties}{organizer} || []}) {
        $Self->_makeParticipant($Calendar, \%Participants, $VOrganizer, 'owner');
      }
      for my $VAttendee (@{$VEvent->{properties}{attendee} || []}) {
        $Self->_makeParticipant($Calendar, \%Participants, $VAttendee, 'attendee');
      }

      # }}}

      # parse attachments {{{

      my %Links;
      foreach my $Attach (@{$VEvent->{properties}{attach} || []}) {
        next unless $Attach->{value};
        next unless grep { $Attach->{value} =~ m{^$_://} } qw{http https ftp};

        my $uri = $Attach->{value};
        my $filename = $Attach->{params}{filename}[0];
        # XXX - mime guessing?
        my $mime = $Attach->{params}{fmttype}[0];
        if (not defined $mime) {
          $::MimeTypes ||= MIME::Types->new;
          my $MimeTypeObj = $::MimeTypes->mimeTypeOf($filename);
          $mime = $MimeTypeObj->type() if $MimeTypeObj;
        }

        my $size = $Attach->{params}{size}[0];

        $Links{$uri} = {
          href => $uri,
          rel => 'enclosure',
          defined $filename ? (title => $filename) : (),
          defined $mime ? (type => $mime) : (),
          defined $size ? (size => 0+$size) : (),
        };
      }
      foreach my $URL (@{$VEvent->{properties}{url} || []}) {
        my $uri = $URL->{value};
        next unless $uri;
        $Links{$uri} = { href => $uri };
      }

      # }}}

      # ============= Metadata
      my %Event = (uid => $uid);
      # no support for relatedTo yet
      $Event{prodId} = $prodid;
      if ($Properties{created}{value}) {
        # UTC item
        my $Date = eval { $Self->_getDateObj($Calendar, $Properties{created}, 'UTC') };
        $Event{created} = $Date->iso8601() . 'Z' if $Date;
      }
      if ($Properties{dtstamp}{value}) {
        # UTC item
        my $Date = eval { $Self->_getDateObj($Calendar, $Properties{dtstamp}, 'UTC') };
        $Event{updated} = $Date->iso8601() . 'Z' if $Date;
      }
      $Event{updated} ||= DateTime->now->iso8601();
      $Event{sequence} = int($Properties{sequence}{value}) if $Properties{sequence};
      $Event{method} = $method if $method;

      # ============= What
      $Event{title} = $Properties{summary}{value} if $Properties{summary};
      $Event{description} = join("\n", @description) if @description;
      # htmlDescription is not supported
      $Event{links} = \%Links if %Links;
      my $language;
      if ($Properties{description} and $Properties{description}{params}{language}) {
        $language = $Properties{description}{params}{language}[0];
      }
      if ($Properties{summary} and $Properties{summary}{params}{language}) {
        $language = $Properties{summary}{params}{language}[0];
      }
      $Event{locale} = $language if $language;
      # translations is not supported

      # ============= Where
      # XXX - support more structured representations from VEVENTs
      if ($Properties{location}{value}) {
        $Event{locations}{location} = { name => $Properties{location}{value} };
      }
      if (not $IsAllDay and $StartTimeZone and $StartTimeZone ne $EndTimeZone) {
        $Event{locations}{end} = { rel => 'end', timeZone => $EndTimeZone };
      }

      # ============= When
      $Event{isAllDay} = $IsAllDay ? $JSON::true : $JSON::false;
      $Event{start} = $Start->iso8601() if ref($Start);
      $Event{timeZone} = $StartTimeZone if not $IsAllDay;
      my $duration = $Self->_make_duration($End->subtract_datetime($Start), $IsAllDay);
      $Event{duration} = $duration if $duration;

      $Event{recurrenceRule} = \%Recurrence if %Recurrence;
      $Event{recurrenceOverrides} = \%Overrides if %Overrides;

      # ============= Scheduling
      if ($Properties{status}{value}) {
        $Event{status} = lc($Properties{status}{value}) if lc($Properties{status}{value}) ne 'confirmed';
      }
      if ($Properties{transp}{value}) {
        $Event{showAsFree} = $JSON::true if lc($Properties{transp}{value}) eq 'transparent';
      }
      foreach my $email (sort keys %Participants) { # later wins
        $Event{replyTo} = { imip => "mailto:$email" } if grep { $_ eq 'owner' } @{$Participants{$email}{roles}};
      }
      $Event{participants} = \%Participants if %Participants;

      # ============= Alerts
      # useDefaultAlerts is not supported
      $Event{alerts} = \%Alerts if %Alerts;

      if ($Properties{lastmodified}{value}) {
        # UTC item
        my $Date = eval { $Self->_getDateObj($Calendar, $Properties{lastmodified}, 'UTC') };
        $Event{lastModified} = $Date->iso8601() . 'Z';
      }
      if ($Properties{'recurrence-id'}{value}) {
        # in our system it's always in the timezone of the event, but iCloud
        # returns it in UTC despite the event having a timezone.  Super weird.
        # Anyway, we need to format it to the StartTimeZone of the parent
        # event if there is one, and we don't have that yet!
        $Event{_recurrenceObj} = $Self->_getDateObj($Calendar, $Properties{'recurrence-id'});
      }
      push @Events, \%Event;
    }
  }

  return \@Events;
}

sub _getTimeZone {
  my $Self = shift;
  my ($Calendar, $Element) = @_;

  if ($Element->{value} =~ m/Z$/) {
    return 'Etc/UTC';
  }

  my $TZID = $Element->{params}{tzid}[0];

  return undef unless $TZID;

  return $Self->{_tznamemap}{$TZID} if exists $Self->{_tznamemap}{$TZID};

  my %TzOffsets;

  foreach my $VTimeZone (@{$Calendar->{objects} || []}) {
    next unless lc $VTimeZone->{type} eq 'vtimezone';
    next unless ($VTimeZone->{properties}{tzid}[0]{value} || '') eq $TZID;

    foreach my $Observance (@{$VTimeZone->{objects} || []}) {
      next unless grep { (lc $Observance->{type} || '') eq $_ } qw{standard daylight};
      next unless defined $Observance->{properties}{tzoffsetto}[0]{value};

      $TzOffsets{lc $Observance->{type}}
        = $Observance->{properties}{tzoffsetto}[0]{value};
    }
  }

  return undef unless exists $TzOffsets{standard};

  my $TimeZone = Net::CalDAVTalk::TimeZones->GetTimeZone(
    TZID               => $TZID,
    Time               => $Element->{value},
    StandardTzOffsetTo => $TzOffsets{standard},
    ($TzOffsets{daylight}
      ? (DaylightTzOffsetTo => $TzOffsets{daylight})
      : ()),
  ) || undef;

  $Self->{_tznamemap}{$TZID} = $TimeZone;
  return $TimeZone;
}

sub _wireDate {
  # format: YYYY-MM-DDTHH:MM:SS Z?
  my $isoDate = shift;
  my $timeZone = shift || $FLOATING;
  confess "Invalid value '$isoDate' was not ISO8601" unless $isoDate =~ m/^(\d{4,})-(\d\d)-(\d\d)T(\d\d):(\d\d):(\d\d)(Z?)$/i;
  $timeZone = 'Etc/UTC' if $7;

  my $Date = DateTime->_new(
    year => $1,
    month => $2,
    day => $3,
    hour => $4,
    minute => $5,
    second => $6,
    time_zone => $timeZone,
    locale => $LOCALE,
  ) or confess "Invalid value '$isoDate'";

  return $Date;
}

sub _vDate {
  # format: :YYYYMMDDTHHMMSS (floating)
  # format: :YYYYMMDDTHHMMSSZ (UTC)
  # format: ;TZID=X/Y:YYMMDDTHHMMSS (zoned)
  # format: ;TYPE=DATE:YYYYMMDD (but we don't know about that)
  my $vDate = shift;

  if ($vDate =~ m/^(\d\d\d\d)(\d\d)(\d\d)T(\d\d)(\d\d)(\d\d)(\.\d+)?(Z?)$/i) {
    my $Date = DateTime->_new(
      year => $1,
      month => $2,
      day => $3,
      hour => $4,
      minute => $5,
      second => $6,
      # ignore milliseconds in $7
      time_zone => ($8 eq 'Z' ? $UTC : $FLOATING),
      locale => $LOCALE,
    ) or confess "Invalid value '$vDate' for DATETIME";

    return ($Date, 1);
  }

  if ($vDate =~ m/^(\d\d\d\d)(\d\d)(\d\d)$/) {
    # all day
    my $Date = DateTime->_new(
      year => $1,
      month => $2,
      day => $3,
      time_zone => $FLOATING,
      locale => $LOCALE,
    ) or confess "Invalid value '$vDate' for DATE";

    return ($Date, 0);
  }

  # we only support those two patterns
  confess "Date '$vDate' was neither a DATE or DATETIME value";
}

sub _makeVTime {
  my $Self = shift;
  my ($TimeZones, $wire, $tz, $IsAllDay) = @_;

  my $date = _wireDate($wire, $tz);

  return $Self->_makeVTimeObj($TimeZones, $date, $tz, $IsAllDay);
}

sub _makeVTimeObj {
  my $Self = shift;
  my ($TimeZones, $date, $tz, $IsAllDay) = @_;

  # all day?
  if ($IsAllDay) {
    return [$date->strftime('%Y%m%d'), { VALUE => 'DATE' }];
  }

  # floating?
  unless ($tz) {
    return [$date->strftime('%Y%m%dT%H%M%S')];
  }

  # UTC?
  if ($UTCLinks{$tz}) {
    return [$date->strftime('%Y%m%dT%H%M%SZ')];
  }

  my $zone = $Self->tz($tz);

  $TimeZones->{$zone->name()} = 1;

  return [$date->strftime('%Y%m%dT%H%M%S'), { TZID => $zone->name() }];
}

sub _makeZTime {
  my ($Self, $date) = @_;
  return $Self->_makeVTime({}, $date, 'UTC');
}

sub _makeLTime {
  my $Self = shift;
  my ($TimeZones, $ltime, $tz, $IsAllDay) = @_;

  my $date = _wireDate($ltime, $Self->tz($tz));

  return [$date->strftime('%Y%m%d'), { VALUE => 'DATE' }] if $IsAllDay;

  unless ($tz) {
    # floating
    return [$date->strftime('%Y%m%dT%H%M%S')];
  }

  if ($tz =~ m/UTC/i) {
    return [$date->strftime('%Y%m%dT%H%M%SZ')];
  }

  # XXX - factor this crap out
  $TimeZones->{$tz} = 1;

  # XXX - use our cache
  my $zone = $Self->tz($tz);

  return [$date->strftime('%Y%m%dT%H%M%S'), { TZID => $zone->name() }];
}

sub _argsToVEvents {
  my $Self = shift;
  my ($TimeZones, $Args, $recurrenceData) = @_;
  my @VEvents;

  my $VEvent = Data::ICal::Entry::Event->new();

  # required properties
  $VEvent->add_properties(
    uid      => $Args->{uid},
    sequence => ($Args->{sequence} || 0),
    transp   => ($Args->{showAsFree} ? 'TRANSPARENT' : 'OPAQUE'),
  );

  if ($recurrenceData) {
    my ($recurrenceId, $TopLevel) = @$recurrenceData;
    $VEvent->add_property('recurrence-id' => $Self->_makeLTime($TimeZones, $recurrenceId, $TopLevel->{timeZone}, $TopLevel->{isAllDay}));
  }

  # direct copy if properties exist
  foreach my $Property (qw{description title}) {
    my $Prop = $Args->{$Property} // '';
    next if $Prop eq '';
    my %lang;
    $lang{language} = $Args->{locale} if exists $Args->{locale};
    my $key = $Property;
    $key = 'summary' if $Property eq 'title';
    $VEvent->add_property($key => [$Prop, \%lang]);
  }

  # dates in UTC - stored in UTC
  $VEvent->add_property(created => $Self->_makeZTime($Args->{created})) if $Args->{created};
  $VEvent->add_property(dtstamp => $Self->_makeZTime($Args->{updated} || DateTime->now->iso8601()));

  # dates in localtime - zones based on location
  my $EndTimeZone;
  my $locations = $Args->{locations} || {};
  foreach my $id (sort keys %$locations) {
    if ($locations->{$id}{rel} and $locations->{id}{rel} eq 'end') {
      $EndTimeZone = $locations->{end}{timeZone};
    }
    if ($locations->{$id}{name}) {
      $VEvent->add_property(location => $locations->{$id}{name});
    }
  }

  my $StartTimeZone = $Args->{timeZone};
  my $Start = _wireDate($Args->{start}, $StartTimeZone);
  $VEvent->add_property(dtstart => $Self->_makeVTimeObj($TimeZones, $Start, $StartTimeZone, $Args->{isAllDay}));
  if ($Args->{duration}) {
    $EndTimeZone //= $StartTimeZone;
    my $Duration = eval { DateTime::Format::ICal->parse_duration($Args->{duration}) };
    my $End = $Start->clone()->add($Duration) if $Duration;
    $VEvent->add_property(dtend => $Self->_makeVTimeObj($TimeZones, $End, $EndTimeZone, $Args->{isAllDay}));
  }

  if ($Args->{recurrenceRule}) {
    my %Recurrence = $Self->_makeRecurrence($Args->{recurrenceRule}, $Args->{isAllDay}, $StartTimeZone);

    # RFC 2445 4.3.10 - FREQ is the first part of the RECUR value type.
    # RFC 5545 3.3.10 - FREQ should be first to ensure backward compatibility.
    my $rule = join(';',
      ('FREQ=' . delete($Recurrence{FREQ})),
      (map { "$_=$Recurrence{$_}" } keys %Recurrence),
    );
    $VEvent->add_property(rrule => $rule);
  }

  if ($Args->{recurrenceOverrides}) {
    foreach my $recurrenceId (sort keys %{$Args->{recurrenceOverrides}}) {
      my $val = $Args->{recurrenceOverrides}{$recurrenceId};
      if ($val) {
        if (keys %$val) {
          my $SubEvent = $Self->_maximise($Args, $val, $recurrenceId);
          push @VEvents, $Self->_argsToVEvents($TimeZones, $SubEvent, [$recurrenceId, $Args]);
        }
        else {
          $VEvent->add_property(rdate => $Self->_makeLTime($TimeZones, $recurrenceId, $StartTimeZone, $Args->{isAllDay}));
        }
      }
      else {
        $VEvent->add_property(exdate => $Self->_makeLTime($TimeZones, $recurrenceId, $StartTimeZone, $Args->{isAllDay}));
      }
    }
  }

  if ($Args->{alerts}) {
    for my $id (sort keys %{$Args->{alerts}}) {
      my $Alert = $Args->{alerts}{$id};

      my $Type          = $Alert->{action}{type} // '';
      my $Recipients    = $Alert->{action}{recipients} // [];
      my $Uri           = $Alert->{action}{uri} // '';
      my $Offset        = $Alert->{offset};
      my $Sign          = $Alert->{relativeTo} =~ m/before/ ? '-' : '';
      my $Loc1          = $Alert->{relativeTo} =~ m/end/ ? "ends" : "starts";
      my $Loc2          = $Alert->{relativeTo} =~ m/end/ ? "ended" : "started";
      my $Minutes       = DateTime::Format::ICal->parse_duration(uc $Offset)->in_units('minutes');

      my $VAlarm;

      if ($Type eq 'display') {
        $VAlarm = Data::ICal::Entry::Alarm::Display->new();
        $VAlarm->add_properties(
          description => (($Sign eq '-')
            ? "'$Args->{title}' $Loc1 in $Minutes minutes"
            : "'$Args->{title}' $Loc2 $Minutes minutes ago"),
        );
      }
      elsif ($Type eq 'email' || $Type eq 'uri') {
        my ($Summary, $Description);

        if ($Sign eq '-') {
          $Summary     = "Event alert: '$Args->{title}' $Loc1 in $Minutes minutes";
          $Description = "Your event '$Args->{title}' $Loc1 in $Minutes minutes";
        }
        else {
          $Summary     = "Event alert: '$Args->{title}' $Loc2 $Minutes minutes ago";
          $Description = "Your event '$Args->{title}' $Loc2 $Minutes minutes ago";
        }

        $VAlarm = Data::ICal::Entry::Alarm::Email->new();
        $VAlarm->add_properties(
          summary     => $Summary,
          description => join("\n",
            $Description,
            "",
            "Description:",
            $Args->{description},
            # XXX more
          ),
          (map { ( attendee => "MAILTO:$_" ) } @$Recipients), # XXX naive?
        );

        if ($Type eq 'uri') {
          $VAlarm->add_property("X-URI", $Uri);
        }
      }
      else {
        confess "Unknown alarm type $Type";
      }

      $VAlarm->add_property(uid => $id);
      $VAlarm->add_property(trigger => "${Sign}$Offset");
      $VAlarm->add_property(related => 'end') if $Alert->{relativeTo} =~ m/end/;

      if ($Alert->{action}{acknowledged}) {
        $VAlarm->add_property(acknowledged => $Self->_makeZTime($Alert->{action}{acknowledged}));
      }

      $VEvent->add_entry($VAlarm);
    }
  }

  my %namemap;
  if ($Args->{participants}) {
    foreach my $Address (sort keys %{$Args->{participants}}) {
      my $Attendee = $Args->{participants}{$Address};
      my $Email = $Attendee->{email} || $Address;
      my $Rsvp  = $Attendee->{rsvp};

      my %AttendeeProps;
      if ($Attendee->{"name"}) {
        $AttendeeProps{"CN"} = $Attendee->{"name"};
        $namemap{lc "mailto:$Email"}= $Attendee->{"name"};
      }

      next unless grep { $_ eq 'attendee' } @{$Attendee->{roles}};

      $AttendeeProps{"CUTYPE"}     = uc $Attendee->{"kind"} if defined $Attendee->{"kind"};
      $AttendeeProps{"RSVP"}       = uc $Attendee->{"scheduleRSVP"} if defined $Attendee->{"scheduleRSVP"};
      $AttendeeProps{"X-SEQUENCE"} = $Attendee->{"x-sequence"} if defined $Attendee->{"x-sequence"};
      $AttendeeProps{"X-DTSTAMP"}  = $Self->_makeZTime($Attendee->{"scheduleUpdated"}) if defined $Attendee->{"scheduleUpdated"};
      foreach my $prop (keys %AttendeeProps) {
        delete $AttendeeProps{$prop} if $AttendeeProps{$prop} eq '';
      }
      if (grep { $_ eq 'chair' } @{$Attendee->{roles}}) {
        $Attendee->{ROLE} = 'CHAIR';
      }
      elsif ($Attendee->{schedulePriority} and $Attendee->{schedulePriority} eq 'optional') {
        $Attendee->{ROLE} = 'OPT-PARTICIPANT';
      }
      elsif ($Attendee->{schedulePriority} and $Attendee->{schedulePriority} eq 'non-participant') {
        $Attendee->{ROLE} = 'NON-PARTICIPANT';
      }
      # default is REQ-PARTICIPANT

      $AttendeeProps{PARTSTAT} = uc $Attendee->{"scheduleStatus"} if $Attendee->{"scheduleStatus"};

      $VEvent->add_property(attendee => [ "MAILTO:$Email", \%AttendeeProps ]);
    }
  }
  if ($Args->{replyTo}) {
    if ($Args->{replyTo}{imip}) {
      my $CN = $namemap{lc $Args->{replyTo}{imip}};
      $VEvent->add_property(organizer => [ $Args->{replyTo}{imip}, $CN ? {CN => $CN} : () ]);
    }
  }

  if ($Args->{links}) {
    foreach my $uri (sort keys %{$Args->{links}}) {
      my $Attach = $Args->{links}{$uri};
      my $Url = $Attach->{href} || $uri;
      if ($Attach->{rel} && $Attach->{rel} eq 'enclosure') {
        my $FileName = $Attach->{title};
        my $Mime = $Attach->{type};
        my $Size = $Attach->{size};

        my %AttachProps;
        $AttachProps{FMTTYPE} = $Mime if defined $Mime;
        $AttachProps{SIZE} = $Size if defined $Size;
        $AttachProps{FILENAME} = $FileName if defined $FileName;
        $VEvent->add_property(attach => [ $Url, \%AttachProps ]);
      }
      # otherwise it's just a URL
      else {
        $VEvent->add_property(url => [ $Url ]);
      }
    }
  }

  # detect if this is a dummy top-level event and skip it
  unshift @VEvents, $VEvent unless ($Args->{replyTo} and not $Args->{participants});

  return @VEvents;
}

sub _argsToVCalendar {
  my $Self = shift;
  my $Item = shift;
  my %ExtraProp = @_;

  my $VCalendar = Data::ICal->new();
  my $havepid = 0;

  foreach my $extra (keys %ExtraProp) {
    $VCalendar->add_properties($extra => $ExtraProp{$extra});
  }
  $VCalendar->add_properties(calscale => 'GREGORIAN');

  my @VEvents;
  my %TimeZones;
  foreach my $Args (ref $Item eq 'ARRAY' ? @$Item : $Item) {
    if (not $havepid and $Args->{prodId}) {
      $VCalendar->add_properties('prodid' => $Args->{prodId});
      $havepid = 1;
    }
    # initialise timestamp if not given one
    $Args->{dtstamp} //= DateTime->now()->strftime('%Y-%m-%dT%H:%M:%S');
    push @VEvents, $Self->_argsToVEvents(\%TimeZones, $Args);
  }

  # add timezone parts first
  foreach my $Zone (sort keys %TimeZones) {
    my $VTimeZone = Net::CalDAVTalk::TimeZones->GetVTimeZone($Zone);
    next unless $VTimeZone;
    $VCalendar->add_entry($VTimeZone);
  }

  # then the events
  foreach my $VEvent (@VEvents) {
    $VCalendar->add_entry($VEvent);
  }

  return $VCalendar;
}

sub _makeRecurrence {
  my $Self = shift;
  my ($Args, $IsAllDay, $TZ) = @_;

  my %Recurrence;

  # validate simple recurrence properties {{{

  unless (ref($Args) eq 'HASH') {
    confess 'Invalid recurrence';
  }

  if ($Args->{frequency}) {
    unless (grep { $_ eq $Args->{frequency} } @Frequencies) {
      confess "Invalid recurrence frequency ($Args->{frequency})";
    }

    $Recurrence{FREQ} = uc($Args->{frequency});
  }
  else {
    confess 'Recurrence frequency not specified';
  }

  if (defined $Args->{interval}) {
    unless ($Args->{interval} =~ /^\d+$/) {
      confess "Invalid recurrence interval ($Args->{interval})";
    }

    if ($Args->{interval} == 0) {
      confess "Recurrence interval is out of range ($Args->{interval})";
    }

    if ($Args->{interval} > 1) {
      $Recurrence{INTERVAL} = $Args->{interval};
    }
  }

  if (defined $Args->{firstDayOfWeek}) {
    unless (exists $DaysByIndex{$Args->{firstDayOfWeek}}) {
      confess "Invalid recurrence firstDayOfWeek ($Args->{firstDayOfWeek})";
    }

    unless ($Args->{firstDayOfWeek} == 1){
      $Recurrence{WKST} = uc $DaysByIndex{$Args->{firstDayOfWeek}};
    }
  }

  if ($Args->{byDay}) {
    unless (ref($Args->{byDay}) eq 'ARRAY') {
      confess 'Invalid recurrence byDay';
    }

    unless (@{$Args->{byDay}}) {
      confess 'Recurrence byDay is empty';
    }

    $Recurrence{BYDAY} = join(',', map{ _byDay2BYDAY($_) } @{$Args->{byDay}});
  }

  if ($Args->{byMonth}) {
    unless (ref($Args->{byMonth}) eq 'ARRAY') {
      confess 'Invalid recurrence byMonth';
    }

    unless (@{$Args->{byMonth}}) {
      confess 'Recurrence byMonth is empty';
    }

    my @BYMONTHS;

    foreach my $byMonth (@{$Args->{byMonth}}) {
      unless ($byMonth =~ /^(\d+)L?$/i) {
        confess "Recurrence byMonth is not a number with optional L ($byMonth)";
      }
      my $monthNum = $1;
      unless ($monthNum >= 1 and $monthNum <= 13) {
        # not sure if 13 is OK
        confess "Recurrence byMonth is too high ($monthNum)";
      }

      push @BYMONTHS, $byMonth;
    }

    $Recurrence{BYMONTH} = join ',', @BYMONTHS;
  }

  if (defined $Args->{count}) {
    if (defined $Args->{until}) {
      confess 'Recurrence count and until cannot both be set';
    }

    unless ($Args->{count} =~ /^\d+$/) {
      confess "Invalid recurrence count ($Args->{count})";
    }

    $Recurrence{COUNT} = $Args->{count};
  }

  if ($Args->{until}) {
    my $Until = _wireDate($Args->{until}, $Self->tz($TZ));

    if ($IsAllDay) {
      $Recurrence{UNTIL} = $Until->strftime('%Y%m%d');
    }
    else {
      # API is in Localtime, but both iCloud and Google use 'Z' times as per
      # rfc2445, so we'll copy them for compatibility.
      $Until->set_time_zone($UTC);
      $Recurrence{UNTIL} = $Until->strftime('%Y%m%dT%H%M%SZ');
    }
  }

  # }}}

  # validate generic recurrence properties {{{

  foreach my $Property (keys %RecurrenceProperties) {
    my $Name = $RecurrenceProperties{$Property}{name};

    if ($Args->{$Name}) {
      unless (ref($Args->{$Name}) eq 'ARRAY') {
        confess "Invalid recurrence $Name";
      }

      unless (@{$Args->{$Name}}) {
        confess "Recurrence $Name is empty";
      }

      my @Values;

      foreach my $Value (@{$Args->{$Name}}) {
        my ($Valid, $Min) = $RecurrenceProperties{$Property}{signed}
          ? ('[-+]?[1-9]\d*', ($RecurrenceProperties{$Property}{max} * -1))
          : ('\d+', 0);

        unless ($Value =~ /^$Valid$/) {
          confess "Invalid recurrence $Name ($Value)";
        }

        unless (($Min <= $Value) and ($Value <= $RecurrenceProperties{$Property}{max})) {
          confess "Recurrence $Name is out of range ($Value)";
        }

        push @Values, $Value;
      }

      $Recurrence{uc $Property} = join ',', @Values;
    }
  }

  # }}}

  return %Recurrence;
}

=head2 $self->vcalendarToEvents($Data)

Convert a text vcalendar (either a single event or an entire ical file) into an array of events.

Returns an array (not arrayref) of Events in UID order.

e.g.

    foreach my $Event ($CalDAV->vcalendarToEvents($Data)) {
        # ...
    }

=cut

sub _insert_override {
  my $Event = shift;
  my $recurrenceId = shift;
  my $Recurrence = shift;

  my %override;
  my %oldkeys = map { $_ => 1 } keys %$Event;
  foreach my $Key (sort keys %$Recurrence) {
    delete $oldkeys{$Key};
    next if $MustBeTopLevel{$Key}; # XXX - check safeeq and die?
    if ($Key eq 'start') {
      # special case, it's the recurrence-id
      next if _safeeq($Recurrence->{start}, $recurrenceId);
      $override{start} = $Recurrence->{start};
      next;
    }
    next if _safeeq($Recurrence->{$Key}, $Event->{$Key});
    _add_override(\%override, _quotekey($Key), $Recurrence->{$Key}, $Event->{$Key});
  }

  foreach my $Key (sort keys %oldkeys) {
    next if $MustBeTopLevel{$Key};
    $override{$Key} = $JSON::null;
  }

  # in theory should never happen, but you could edit something back to be identical
  return unless %override;
  $Event->{recurrenceOverrides}{$recurrenceId} = \%override;
}

sub vcalendarToEvents {
  my $Self = shift;
  my $Data = shift;

  # Internal caches need to be invalidated on each item read! A bit evil really...
  delete $Self->{_tznamemap};

  my %map;
  my %exceptions;
  my $Events = $Self->_getEventsFromVCalendar($Data);

  foreach my $Event (@$Events) {
    my $uid = $Event->{uid};
    if ($Event->{_recurrenceObj}) {
      push @{$exceptions{$uid}}, $Event;
    }
    elsif ($map{$uid}) {
      # it looks like sometimes Google doesn't remember to put the Recurrence ID
      # on additional recurrences after the first one, which is going to screw up
      # pretty badly because if the date has changed, then we can't even notice
      # which recurrent it was SUPPOSED to be.  *sigh*.
      warn "DUPLICATE EVENT FOR $uid\n" . Dumper($map{$uid}, $Event);
      push @{$exceptions{$uid}}, $Event;
      $map{$uid}{_dirty} = 1;
    }
    else {
      $map{$uid} = $Event;
    }
  }

  foreach my $uid (keys %exceptions) {
    unless ($map{$uid}) {
      # create a synthetic top-level
      my $First = $exceptions{$uid}[0];
      $map{$uid} = {
        uid => $uid,
        # these two are required at top level, but may be different
        # in recurrences so aren't in MustBeTopLevel
        start => $First->{start},
        updated => $First->{updated},
      };
      $map{$uid}{timeZone} = $First->{timeZone} unless $First->{isAllDay};
      foreach my $key (keys %MustBeTopLevel) {
        $map{$uid}{$key} = $First->{$key} if exists $First->{$key};
      }
    }
    foreach my $SubEvent (@{$exceptions{$uid}}) {
      my $recurrenceId = $SubEvent->{start};
      if ($SubEvent->{_recurrenceObj}) {
        my $Date = delete $SubEvent->{_recurrenceObj};
        $Date->set_time_zone($map{$uid}{timeZone}) if $map{$uid}{timeZone};
        $recurrenceId = $Date->iso8601();
      }
      _insert_override($map{$uid}, $recurrenceId, $SubEvent);
    }
  }

  return map { $map{$_} } sort keys %map;
}

=head2 $self->UpdateAddressSet($DisplayName, $EmailAddress)

Set the address set and display name for the calendar user (if supported)

=cut

sub UpdateAddressSet {
  my ($Self, $NewDisplayName, $NewAddressSet) = @_;

  my ($DisplayName, $AddressSet) = $Self->GetProps(\$Self->{principal}, 'D:displayname', [ 'C:calendar-user-address-set', 'D:href' ]);

  if (!$AddressSet || $AddressSet ne "mailto:" . $NewAddressSet ||
      !$DisplayName || $DisplayName ne $NewDisplayName) {
    $Self->Request(
      'PROPPATCH',
      "",
      x('D:propertyupdate', $Self->NS(),
        x('D:set',
          x('D:prop',
            x('D:displayname', $NewDisplayName),
            x('C:calendar-user-address-set', "mailto:" . $NewAddressSet),
          )
        )
      )
    );
    return 1;
  }

  return 0;
}

=head2 $self->GetICal($calendarId, $isFreeBusy)

Given a calender, fetch all the events and generate an ical format file
suitable for import into a client.

=cut

sub GetICal {
  my $Self = shift;
  my $calendarId = shift;
  my $isFreeBusy = shift;

  confess "Need a calendarId" unless $calendarId;

  my $Calendars = $Self->GetCalendars();
  foreach my $Cal (@$Calendars) {
    next unless $calendarId eq $Cal->{id};
    my ($Events, $Errors) = $isFreeBusy ?
                            $Self->GetFreeBusy($calendarId) :
                            $Self->GetEvents($calendarId);
    return undef if @$Errors;
    $Self->_stripNonICal($_) for @$Events;
    my $VCalendar = $Self->_argsToVCalendar($Events,
      method => 'PUBLISH',
      'x-wr-calname' => $Cal->{name},
      'x-wr-timezone' => $Cal->{timeZone},
      'x-apple-calendar-color' => $Cal->{color},
      # XXX - do we want to add our sync-token here or something?
    );
    return ($VCalendar->as_string(), $Cal);
  }
  return undef; # 404
}

sub _quotekey {
  my $key = shift;
  $key =~ s/\~/~0/gs;
  $key =~ s/\//~1/gs;
  return $key;
}

sub _unquotekey {
  my $key = shift;
  $key =~ s/\~1/\//gs;
  $key =~ s/\~0/~/gs;
  return $key;
}

sub _add_override {
  my ($override, $prefix, $New, $Old) = @_;

  # basic case - it's not an object, so we just override
  if ($ENV{JMAP_ALWAYS_FULL} or ref($New) ne 'HASH' or ref($Old) or 'HASH') {
    $override->{$prefix} = $New;
    return;
  }

  # XXX - if too many, we could just abort...
  my %subover;
  my %oldkeys = map { $_ => 1 } keys %$Old;
  foreach my $Key (sort keys %$New) {
    delete $oldkeys{$Key};
    next if _safeeq($New->{$Key}, $Old->{$Key});
    _add_override(\%subover, "$prefix/" . _quotekey($Key), $New->{$Key}, $Old->{$Key});
  }
  foreach my $Key (sort keys %oldkeys) {
    $subover{"$prefix/" . _quotekey($Key)} = $JSON::null;
  }

  # which one is better?
  if (length(encode_json($New)) < length(encode_json(\%subover))) {
    $override->{$prefix} = $New; # cheaper to just encode the whole object
  }
  else {
    $override->{$_} = $subover{$_} for keys %subover;
  }
}

sub _apply_patch {
  my $path = shift;
  my $hash = shift;
  my $value = shift;

  return unless $path =~ s{^([^/]+)(/?)}{};
  return unless ref($hash) eq 'HASH';
  my $qkey = $1;
  my $slash = $2;
  my $key = _unquotekey($qkey);
  if ($slash) {
    _apply_patch($path, $hash->{$key}, $value);
  }
  elsif(defined $value) {
    $hash->{$key} = $value;
  }
  else {
    delete $hash->{$key};
  }
}

sub _maximise {
  my $Self = shift;
  my $Event = shift;
  my $Recurrence = shift;
  my $recurrenceId = shift;

  #warn "MAXIMIZING EVENT INTO RECURRENCE: " . Dumper($Event, $Recurrence);

  my $new = _deepcopy($Event);
  $new->{start} = $recurrenceId;
  delete $new->{recurrenceRule};
  delete $new->{recurrenceOverrides};

  foreach my $path (sort keys %$Recurrence) {
    my $value = $Recurrence->{$path};
    _apply_patch($path, $new, $value);
  }

  return $new;
}

sub _stripNonICal {
  my $Self = shift;
  my $Event = shift;

  delete $Event->{alerts};
  delete $Event->{attendees};
  delete $Event->{organizer};

  foreach my $exception (values %{$Event->{exceptions}}) {
    next unless $exception;
    $Self->_stripNonICal($exception);
  }
}

sub _safeeq {
  my ($a, $b) = @_;
  my $json = JSON::XS->new->canonical;
  return $json->encode([$a]) eq $json->encode([$b]);
}

sub _deepcopy {
  my $data = shift;
  my $json = JSON::XS->new->canonical;
  my $enc = $json->encode([$data]);
  my $copy = $json->decode($enc);
  return $copy->[0];
}


=head1 AUTHOR

Bron Gondwana, C<< <brong at cpan.org> >>

=head1 BUGS

Please report any bugs or feature requests to C<bug-net-caldavtalk at rt.cpan.org>, or through
the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Net-CalDAVTalk>.  I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.




=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc Net::CalDAVTalk


You can also look for information at:

=over 4

=item * RT: CPAN's request tracker (report bugs here)

L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Net-CalDAVTalk>

=item * AnnoCPAN: Annotated CPAN documentation

L<http://annocpan.org/dist/Net-CalDAVTalk>

=item * CPAN Ratings

L<http://cpanratings.perl.org/d/Net-CalDAVTalk>

=item * Search CPAN

L<http://search.cpan.org/dist/Net-CalDAVTalk/>

=back


=head1 ACKNOWLEDGEMENTS


=head1 LICENSE AND COPYRIGHT

Copyright 2015 FastMail Pty Ltd.

This program is free software; you can redistribute it and/or modify it
under the terms of the the Artistic License (2.0). You may obtain a
copy of the full license at:

L<http://www.perlfoundation.org/artistic_license_2_0>

Any use, modification, and distribution of the Standard or Modified
Versions is governed by this Artistic License. By using, modifying or
distributing the Package, you accept this license. Do not use, modify,
or distribute the Package, if you do not accept this license.

If your Modified Version has been derived from a Modified Version made
by someone other than you, you are nevertheless required to ensure that
your Modified Version complies with the requirements of this license.

This license does not grant you the right to use any trademark, service
mark, tradename, or logo of the Copyright Holder.

This license includes the non-exclusive, worldwide, free-of-charge
patent license to make, have made, use, offer to sell, sell, import and
otherwise transfer the Package with respect to any patent claims
licensable by the Copyright Holder that are necessarily infringed by the
Package. If you institute patent litigation (including a cross-claim or
counterclaim) against any party alleging that the Package constitutes
direct or contributory patent infringement, then this Artistic License
to you shall terminate on the date that such litigation is filed.

Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER
AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES.
THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR
PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY
YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR
CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR
CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE,
EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.


=cut

1; # End of Net::CalDAVTalk