view release on metacpan or  search on metacpan

lib/Email/Folder/Exchange/WebDAV.pm  view on Meta::CPAN

sub _ua { # {{{
    my ($self, $ua) = @_;
    $self->{_ua} = $ua if @_ == 2;
    return $self->{_ua};
} # }}}

sub uri { # {{{
    my ($self, $uri) = @_;
    $self->{uri} = $uri if @_ == 2;
    return $self->{uri};
} # }}}

sub _login { # {{{
    my ($self, $uri, $username, $password) = @_;
    my $scheme = $uri->scheme;
    my $host = $uri->host;
    my $ua = $self->_ua;

    # login using FBA (forms-based authentication)
    my $auth_uri = $uri->clone;
    $auth_uri->path('exchweb/bin/auth/owaauth.dll');
    my $login_req = HTTP::Request->new(
        POST => $auth_uri->as_string,
    );
    $login_req->content_type('application/x-www-form-urlencoded');
    $login_req->content(
        'destination=' . uri_escape($uri->as_string) . 
        '&username=' . uri_escape($username) . 
        '&password=' . uri_escape($password)
    );

    my $login_res = $ua->request($login_req);
    croak $login_res->message if $login_res->code >= 400 and $login_res->code < 500;

    return 1;
} # }}}

sub new { # {{{
    my ($self, $class, $url, $username, $password) = ({}, @_);
    bless $self, $class;

    croak "URI required" unless $url;

    # create user agent
    my $ua = LWP::UserAgent->new( keep_alive => 1, cookie_jar => {} );
    $self->_ua($ua);

    # create uri object
    my $uri = URI->new($url);
    $self->uri($uri);

		# guess path
		if(! $uri->path || $uri->path =~ m{^/$}) {
		  my $path_user = $username;
			$path_user =~ s/.*\\//;

			$uri->path("/exchange/$path_user/Inbox");
		}


    # get credentials from url if specified
    my $credentials = $uri->userinfo;
    $uri->userinfo(undef);

    if($credentials && !($username || $password)) {
        ($username, $password) = split(/:/, uri_unescape($credentials), 2);
    }
    croak "Credentials required" unless $username;

    $self->_login($uri, $username, $password);
    
    return $self;
} # }}}

sub _message_urls { # {{{
    my ($self) = @_;
    return $self->{_message_urls} if $self->{_message_urls};

    my $req = HTTP::Request->new(
        SEARCH => $self->uri->as_string,
    );
    $req->content_type('text/xml');
    $req->header(Depth => 1);


    my $folder_path = $self->uri->path;
    $req->content(qq{
        <?xml version='1.0' ?>
        <a:searchrequest xmlns:a='DAV:'><a:sql>
        SELECT "DAV:ishidden"
          FROM scope('shallow traversal of "$folder_path"')
         WHERE "DAV:ishidden"=False AND "DAV:isfolder"=False
        </a:sql></a:searchrequest>
    });

    my $ua = $self->_ua;

    my @message_urls;
    my $buf = "";

    my $res = $ua->request($req, sub {
        my $chunk = shift;
        $buf .= $chunk;

        while($buf =~ m#<a:href>(.*?)</a:href>#g) {
            push @message_urls, $1;

        }
        $buf = substr($buf, (pos $buf || 0));
    });
    croak $res->message unless $res->code >= 200 and $res->code < 300;

    $self->{_message_urls} = \@message_urls;

    return $self->{_message_urls};
} # }}}

sub messages { # {{{
    my $self = shift;

    my @messages;
    while(my $message = $self->next_message) {
        push @messages, $message;
    }

    return @messages;