Lemonldap::NG::Common::Apache::Session::SOAP - Perl extension written to

## @file
# Client side of the SOAP proxy mechanism for Apache::Session modules

## @class
# Client side of the SOAP proxy mechanism for Apache::Session modules
package Lemonldap::NG::Common::Apache::Session::SOAP;

use strict;
use SOAP::Lite;

our $VERSION = '1.0.0';

#parameter proxy Url of SOAP service
#parameter proxyOptions SOAP::Lite options
#parameter User Username
#parameter Password Password

# Variables shared with SOAP::Transport::HTTP::Client
our ( $user, $password ) = ( '', '' );

BEGIN {

    sub SOAP::Transport::HTTP::Client::get_basic_credentials {
        return $Lemonldap::NG::Common::Apache::Session::SOAP::user =>
          $Lemonldap::NG::Common::Apache::Session::SOAP::password;
    }
}

# PUBLIC INTERFACE

## @cmethod Lemonldap::NG::Common::Apache::Session::SOAP TIEHASH(string session_id, hashRef args)
# Constructor for Perl TIE mechanism. See perltie(3) for more.
# @return Lemonldap::NG::Common::Apache::Session::SOAP object
sub TIEHASH {
    my $class = shift;

    my $session_id = shift;
    my $args       = shift;
    my ( $proxy, $proxyOptions );
    die "proxy argument is required"
      unless ( $args and $args->{proxy} );
    my $self = {
        data     => { _session_id => $session_id },
        modified => 0,
    };
    foreach (qw(proxy proxyOptions ns)) {
        $self->{$_} = $args->{$_};
    }
    ( $user, $password ) = ( $args->{User}, $args->{Password} );
    bless $self, $class;

    if ( defined $session_id && $session_id ) {
        die "unexistant session $session_id"
          unless ( $self->get($session_id) );
    }
    else {
        die "unable to create session"
          unless ( $self->newSession() );
    }
    return $self;
}

sub FETCH {
    my $self = shift;
    my $key  = shift;
    return $self->{data}->{$key};
}

sub STORE {
    my $self  = shift;
    my $key   = shift;
    my $value = shift;

    $self->{data}->{$key} = $value;
    $self->{modified} = 1;
    return $value;
}

sub DELETE {
    my $self = shift;
    my $key  = shift;

    $self->{modified} = 1;

    delete $self->{data}->{$key};
}

sub CLEAR {
    my $self = shift;

    $self->{modified} = 1;

    $self->{data} = {};
}

sub EXISTS {
    my $self = shift;
    my $key  = shift;
    return exists $self->{data}->{$key};
}

sub FIRSTKEY {
    my $self  = shift;
    my $reset = keys %{ $self->{data} };
    return each %{ $self->{data} };
}

sub NEXTKEY {
    my $self = shift;
    return each %{ $self->{data} };
}

sub DESTROY {
    my $self = shift;
    $self->save;
}

## @method private SOAP::Lite _connect()
# @return The SOAP::Lite object. Build it at the first call.
sub _connect {
    my $self = shift;
    return $self->{service} if ( $self->{service} );
    my @args = ( $self->{proxy} );
    if ( $self->{proxyOptions} ) {
        push @args, %{ $self->{proxyOptions} };
    }
    $self->{ns} ||= 'urn:Lemonldap/NG/Common/CGI/SOAPService';
    return $self->{service} = SOAP::Lite->ns( $self->{ns} )->proxy(@args);
}

## @method private $ _soapCall(string func, @args)
# @param $func remote function to call
# @param @args Functions parameters
# @return Result
sub _soapCall {
    my $self = shift;
    my $func = shift;
    my $r    = $self->_connect->$func(@_);
    if ( $r->fault ) {
        print STDERR "SOAP Error: " . $r->fault->{faultstring};
        return ();
    }
    return $r->result;
}

## @method hashRef get(string id)
# @param $id Apache::Session session ID.
# @return User datas
sub get {
    my $self = shift;
    my $id   = shift;
    my $r    = $self->_soapCall( "getAttributes", $id );
    return 0 unless ( $r or $r->{error} );
    return $self->{data} = $r->{attributes};
}

## @method hashRef newSession()
# Build a new Apache::Session session.
# @return User datas (just the session ID)
sub newSession {
    my $self = shift;
    return $self->{data} = $self->_soapCall("newSession");
}

## @method boolean save()
# Save user datas if modified.
sub save {
    my $self = shift;
    return unless ( $self->{modified} );
    return $self->_soapCall( "setAttributes", $self->{data}->{_session_id},
        $self->{data} );
}

## @method boolean delete()
# Deletes the current session.
sub delete {
    my $self = shift;
    return $self->_soapCall( "deleteSession", $self->{data}->{_session_id} );
}

## @method get_key_from_all_sessions()
# Not documented.
sub get_key_from_all_sessions() {
    my $class = shift;
    my $args  = shift;
    my $data  = shift;
    my $self  = bless {}, $class;
    foreach (qw(proxy proxyOptions ns)) {
        $self->{$_} = $args->{$_};
    }
    die('proxy is required') unless ( $self->{proxy} );
    ( $user, $password ) = ( $args->{User}, $args->{Password} );
    if ( ref($data) eq 'CODE' ) {
        my $r = $self->_soapCall( "get_key_from_all_sessions", $args );
        my $res;
        if ($r) {
            foreach my $k ( keys %$r ) {
                my $tmp = &$data( $r->{$k}, $k );
                $res->{$k} = $tmp if ( defined($tmp) );
            }
        }
    }
    else {
        return $self->_soapCall( "get_key_from_all_sessions", $args, $data );
    }
}

1;
__END__