view release on metacpan or  search on metacpan

lib/Net/CalDAVTalk.pm  view on Meta::CPAN

  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 $CanSync;
      my $Report = $Propstat->{"{$NS_D}prop"}{"{$NS_D}supported-report-set"}{"{$NS_D}supported-report"};
      $Report = [] unless ($Report and ref($Report) eq 'ARRAY');
      foreach my $item (@$Report) {
        # XXX - do we want to check the other things too?
        $CanSync = 1 if $item->{"{$NS_D}report"}{"{$NS_D}sync-collection"};
      }

      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),
        canSync    => ($CanSync ? $JSON::true : $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;

lib/Net/CalDAVTalk.pm  view on Meta::CPAN

  }

  my $Response = $Self->Request(
    'REPORT',
    "$calendarId/",
    x('C:calendar-query', $Self->NS(),
      x('D:prop',
        x('D:getetag'),
      ),
      x('C:filter',
        x('C:comp-filter', { name => 'VCALENDAR' },
          x('C:comp-filter', { name => 'VEVENT' },
            @Extra,
          ),
        ),
      ),
    ),
    Depth => 1,
  );

  my (%Links, @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 $etag = $Propstat->{"{$NS_D}prop"}{"{$NS_D}getetag"}{content};
      $Links{$href} = $etag;
    }
  }

  return \%Links;
}

=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->GetEventsMulti($calendarId, [$Self->fullpath($href)], %Args);

  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;
    }
  }

  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) = @_;

  my ($Added, $Removed, $Errors, $SyncToken) = $Self->SyncEventLinks($calendarId, %Args);

  my @AllUrls = sort keys %$Added;

  my ($Events, $ThisErrors, $Links) = $Self->GetEventsMulti($calendarId, \@AllUrls, %Args);
  push @$Errors, @$ThisErrors;

  return wantarray ? ($Events, $Removed, $Errors, $SyncToken, $Links) : $Events;
}

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

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

In scalar context still just returns Added, in list context returns
Added, Removed, Errors and new token:

* Added: hash of href to etag - added or changed
* Removed: array of href
* Errors: array of descritive string
* NewToken: scalar opaque DAV:sync-token

e.g.

   my ($Added, $Removed, $Errors, $NewToken)
      = $CalDAV->SyncEventLinks('Default', syncToken => '...');

=cut

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