source: trunk/LATMOS-Accounts/lib/LATMOS/Accounts/Bases/Zimbra.pm @ 1904

package LATMOS::Accounts::Bases::Zimbra;

use 5.010000;
use strict;
use warnings;

use base qw(LATMOS::Accounts::Bases);
use LATMOS::Accounts::Log;
use SOAP::Lite;
use HTTP::Cookies;
use XML::XPath;

our $VERSION = (q$Rev$ =~ /^Rev: (\d+) /)[0];

=head1 NAME

LATMOS::Zimbra - Perl extension for blah blah blah

=head1 SYNOPSIS

  use LATMOS::Accounts::Bases;
  my $base = LATMOS::Accounts::Bases->new('unix');
  ...

=head1 DESCRIPTION

Account base access over standard unix file format.

=head1 FUNCTIONS

=cut

=head2 new(%config)

Create a new LATMOS::Ad object for windows AD $domain.

domain / server: either the Ad domain or directly the server

ldap_args is an optionnal list of arguments to pass to L<Net::LDAP>.

=cut

sub new {
    my ($class, %config) = @_;
    
    my $base = {
        login => $config{login},
        password => $config{password},
        url => $config{url},
        domain => $config{domain},
    };

    bless($base, $class);
}

sub DESTROY {
    my ($self) = @_;
    $self->{_db} && $self->{_db}->rollback;
}

=head2 load

Read file and load data into memory

=cut

sub load {
    my ($self) = @_;

    $self->{soap} and return 1;

    my $soap = SOAP::Lite->new();

    $soap->proxy(
        $self->{url},
        ssl_opts => [
            verify_hostname => 0,
            SSL_verify_mode => 0x00,
        ],
        cookie_jar => HTTP::Cookies->new(ignore_discard => 1),
    );

    $soap->default_ns('urn:zimbraAdmin');
    my $som = $soap->call('AuthRequest',
        SOAP::Data->name('account')
            ->value( $self->{login} )
            ->attr({ by => 'name' }),
        SOAP::Data->name('password')
            ->value($self->{password}),
        SOAP::Data->name('persistAuthTokenCookie')
            ->value('1'),
    );

    if ($som->fault) {
        la_log(LA_ERR, "Cannot connect to Zimbra using SOAP: %s", $som->faultstring);
        return;
    }

    $soap->outputxml(1);
    $self->{soap} = $soap;

    1;
}

=head2 soapcall (@args)

Perform a call to zimbra SOAP interface, return an C<XML::XPath> Object.

Return nothing if an error is returned.

=cut

sub soapcall {
    my ($self, @args) = @_;

    my $xml = $self->{soap}->call(@args);

    my $xpath = XML::XPath->new(xml => $xml);

    if (my $node = $xpath->findnodes('//faultstring')) {
        la_log(LA_ERR, "Saop error: %s", $node->string_value);
        return;
    }

    return $xpath;
}

1;

__END__

=head1 SEE ALSO

=head1 AUTHOR

Olivier Thauvin, E<lt>olivier.thauvin@latmos.ipsl.frE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2008, 2009 CNRS SA/CETP/LATMOS

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.10.0 or,
at your option, any later version of Perl 5 you may have available.


=cut