Merge pull request #7 from retupmoca/freebusy

Add the ability to fetch free/busy information for a user

lib/EWS/Calendar/Role/Reader.pm

@@ -4,15 +4,22 @@ BEGIN {
 }
 use Moose::Role;
 
-with 'EWS::Calendar::Role::RetrieveWithinWindow';
+with 'EWS::Calendar::Role::RetrieveWithinWindow','EWS::Calendar::Role::RetrieveAvailability';
 use EWS::Calendar::Window;
 
 sub retrieve {
     my ($self, $opts) = @_;
-    return $self->retrieve_within_window({
-        window => EWS::Calendar::Window->new($opts),
-        %$opts,
-    });
+    if($opts->{'freebusy'}){
+        return $self->retrieve_availability({
+            window => EWS::Calendar::Window->new($opts),
+            %$opts,
+        });
+    } else {
+        return $self->retrieve_within_window({
+            window => EWS::Calendar::Window->new($opts),
+            %$opts,
+        });
+    }
 }
 
 no Moose::Role;

lib/EWS/Calendar/Role/RetrieveAvailability.pm

@@ -0,0 +1,76 @@
+package EWS::Calendar::Role::RetrieveAvailability;
+BEGIN {
+  $EWS::Calendar::Role::RetrieveWithinWindow::VERSION = '1.141040';
+}
+use Moose::Role;
+
+sub retrieve_availability {
+    my ($self, $opts) = @_;
+
+    # GetUserAvailability docs:
+    # http://msdn.microsoft.com/en-us/library/office/aa564001%28v=exchg.140%29.aspx
+    my ($response, $trace) = $self->client->GetUserAvailability->(
+        TimeZone => {
+            Bias => 0,
+            StandardTime => {
+                Bias => 0,
+                Time => '00:00:00',
+                DayOrder => 0,
+                Month => 0,
+                DayOfWeek => 'Sunday',
+            },
+            DaylightTime => {
+                Bias => 0,
+                Time => '00:00:00',
+                DayOrder => 0,
+                Month => 0,
+                DayOfWeek => 'Sunday',
+            },
+        },
+        MailboxDataArray => {
+            MailboxData => {
+                Email => {
+                    Address => $opts->{email},
+                },
+                AttendeeType => 'Required',
+                ExcludeConflicts => 'false',
+            },
+        },
+        FreeBusyViewOptions => {
+            TimeWindow => {
+                StartTime => $opts->{window}->start->iso8601,
+                EndTime   => $opts->{window}->end->iso8601,
+            },
+            RequestedView => 'MergedOnly',
+            MergedFreeBusyIntervalInMinutes => 15,
+        },
+    );
+
+    use Data::Dumper;
+    print Dumper($trace);
+    print Dumper($response);
+
+    if($response->{GetUserAvailabilityResult}
+                ->{FreeBusyResponseArray}
+                ->{FreeBusyResponse}->[0]
+                ->{ResponseMessage}
+                ->{ResponseClass} ne 'Success'){
+        return $response->{GetUserAvailabilityResult}
+                        ->{FreeBusyResponseArray}
+                        ->{FreeBusyResponse}->[0]
+                        ->{ResponseMessage}
+                        ->{MessageText};
+    }
+    # MergedFreeBusy: http://msdn.microsoft.com/en-us/library/office/aa566048%28v=exchg.140%29.aspx
+    my $merged = $response->{GetUserAvailabilityResult}
+                          ->{FreeBusyResponseArray}
+                          ->{FreeBusyResponse}->[0]
+                          ->{FreeBusyView}
+                          ->{MergedFreeBusy};
+
+    # actual interface?
+    return split('', $merged);
+}
+
+no Moose::Role;
+1;

lib/EWS/Client.pm

@@ -11,6 +11,8 @@ with qw/
     EWS::Client::Role::FindFolder
     EWS::Client::Role::GetFolder
     EWS::Client::Role::ExpandDL
+    EWS::Client::Role::GetUserAvailability
+    EWS::Client::Role::ResolveNames
 /;
 use EWS::Client::Contacts;
 use EWS::Client::Calendar;

lib/EWS/Client/Role/GetUserAvailability.pm

@@ -0,0 +1,24 @@
+package EWS::Client::Role::GetUserAvailability;
+BEGIN {
+  $EWS::Client::Role::GetFolder::VERSION = '1.141040';
+}
+
+use Moose::Role;
+
+has GetUserAvailability => (
+    is => 'ro',
+    isa => 'CodeRef',
+    lazy_build => 1,
+);
+
+sub _build_GetUserAvailability {
+    my $self = shift;
+    return $self->wsdl->compileClient(
+        operation => 'GetUserAvailability',
+        transport => $self->transporter->compileClient(
+            action => 'http://schemas.microsoft.com/exchange/services/2006/messages/GetUserAvailability' ),
+    );
+}
+
+no Moose::Role;
+1;

lib/EWS/Client/Role/ResolveNames.pm

@@ -0,0 +1,24 @@
+package EWS::Client::Role::ResolveNames;
+BEGIN {
+  $EWS::Client::Role::FindItem::VERSION = '1.141040';
+}
+use Moose::Role;
+
+has ResolveNames => (
+    is => 'ro',
+    isa => 'CodeRef',
+    lazy_build => 1,
+);
+
+sub _build_ResolveNames {
+    my $self = shift;
+    return $self->wsdl->compileClient(
+        operation => 'ResolveNames',
+        transport => $self->transporter->compileClient(
+            action => 'http://schemas.microsoft.com/exchange/services/2006/messages/ResolveNames' ),
+    );
+}
+
+no Moose::Role;
+1;
+

lib/EWS/Client/Role/SOAP.pm

@@ -46,6 +46,8 @@ sub _build_transporter {
             $self->username, $self->password);
     }
 
+    $t->userAgent->ssl_opts( verify_hostname => 0, SSL_verify_mode => 0x00 );
+
     return $t;
 }
 
@@ -63,6 +65,20 @@ sub _build_wsdl {
     $wsdl->importDefinitions('ews-types.xsd');
     $wsdl->importDefinitions('ews-messages.xsd');
 
+    # skip the t:Culture element in the ResolveNames response
+    # it breaks the XML Parser for some reason
+    $wsdl->addHook(path => "{http://schemas.microsoft.com/exchange/services/2006/messages}ResolveNamesResponse/ResponseMessages/ResolveNamesResponseMessage/ResolutionSet/Resolution/Contact",
+        before => sub {
+            my ($xml, $path) = @_;
+            my @nodes = $xml->childNodes();
+            foreach my $node (@nodes) {
+                if($node->nodeName eq 't:Culture'){
+                    $xml->removeChild($node);
+                }
+            }
+            return $xml;
+         });
+
     return $wsdl;
 }
 

lib/EWS/Contacts/Role/Reader.pm

@@ -27,12 +27,22 @@ sub _check_for_errors {
 sub _list_contactitems {
     my ($self, $kind, $response) = @_;
 
-    return map  { $_->{Contact} }
-           grep { defined $_->{'Contact'}->{'DisplayName'} and length $_->{'Contact'}->{'DisplayName'} }
-           map  { @{ $_->{Items}->{cho_Item} || [] } }
-           map  { exists $_->{RootFolder} ? $_->{RootFolder} : $_ } 
-           map  { $_->{"${kind}ResponseMessage"} }
-                $self->_list_messages($kind, $response);
+    if($kind eq 'ResolveNames'){
+        return map { $_->{Contact} }
+               grep { defined $_->{'Contact'}->{'DisplayName'} and length $_->{'Contact'}->{'DisplayName'} }
+               map { @{ $_->{Resolution} } }
+               map { $_->{ResolutionSet} }
+               map { $_->{ResolveNamesResponseMessage} }
+                   $self->_list_messages($kind, $response);
+    }
+    else {
+        return map  { $_->{Contact} }
+               grep { defined $_->{'Contact'}->{'DisplayName'} and length $_->{'Contact'}->{'DisplayName'} }
+               map  { @{ $_->{Items}->{cho_Item} || [] } }
+               map  { exists $_->{RootFolder} ? $_->{RootFolder} : $_ } 
+               map  { $_->{"${kind}ResponseMessage"} }
+                    $self->_list_messages($kind, $response);
+    }
 }
 
 sub _get_contacts {
@@ -91,5 +101,34 @@ sub retrieve {
     });
 }
 
+sub _get_resolvenames {
+    my ($self, $opts) = @_;
+
+    return scalar $self->client->ResolveNames->(
+        (exists $opts->{impersonate} ? (
+            Impersonation => {
+                ConnectingSID => {
+                    PrimarySmtpAddress => $opts->{impersonate},
+                }
+            },
+        ) : ()),
+        RequestVersion => {
+            Version => $self->client->server_version,
+        },
+        ReturnFullContactData => 'true',
+        UnresolvedEntry => $opts->{unresolved_entry}
+    );
+}
+
+sub retrieve_gal {
+    my ($self, $opts) = @_;
+
+    my $get_response = $self->_get_resolvenames($opts);
+
+    return EWS::Contacts::ResultSet->new({
+            items => [ $self->_list_contactitems('ResolveNames', $get_response) ]
+    });
+}
+
 no Moose::Role;
 1;