File Coverage

blib/lib/Confluence/Client/XMLRPC.pm

Criterion	Covered	Total	%
statement	7	9	77.7
branch			n/a
condition			n/a
subroutine	3	3	100.0
pod			n/a
total	10	12	83.3

package Confluence::Client::XMLRPC;
{
  $Confluence::Client::XMLRPC::VERSION = '2.5';
}
use strict;
use warnings;

# ABSTRACT: Client for the Atlassian Confluence wiki, based on RPC::XML

# Copyright (c) 2004 [e-mail]
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

# Version 2.1.1 changes by Torben K. Jensen
# + Support for automatic reconnect upon session expiration.

use RPC::XML;
use RPC::XML::Client;
use Env qw(CONFLDEBUG);
use Carp;
use vars '$AUTOLOAD';    # keep 'use strict' happy

our $AUTO_SESSION_RENEWAL = 1;

use fields qw(url user pass token client _cflVersion _serverInfo);

# Global variables
our $API        = 'confluence1';
our $RaiseError = 1;
our $PrintError = 0;
our $LastError  = '';

# For debugging
sub _debugPrint {
	require Data::Dumper;
	local $Data::Dumper::Terse     = 1;
	local $Data::Dumper::Indent    = 0;
	local $Data::Dumper::Quotekeys = 0;
	print STDERR ( shift @_ );
	print STDERR ( Data::Dumper::Dumper($_) . ( scalar @_ ? ', ' : '' ) ) while ( $_ = shift @_ );
	print STDERR "\n";
}

sub setRaiseError {
	shift if ref $_[0];
	shift if $_[0] eq __PACKAGE__;
	carp "setRaiseError expected scalar"
		unless defined $_[0] and not ref $_[0];
	my $old = $RaiseError;
	$RaiseError = $_[0];
	return $old;
}

sub setPrintError {
	shift if ref $_[0];
	shift if $_[0] eq __PACKAGE__;
	carp "setPrintError expected scalar"
		unless defined $_[0] and not ref $_[0];
	my $old = $PrintError;
	$PrintError = $_[0];
	return $old;
}

sub setApiVersion {
	shift if ref $_[0];
	shift if $_[0] eq __PACKAGE__;
	my $new = shift;
	carp "setApiVersion expected scalar"
		unless defined $new and not ref $new;
	my $old = $API;

	if ( defined($new) and $new =~ /\A(?:confluence)?([1-9])\Z/i ) {
		$API = 'confluence' . $1;
	}

	return $old;
}

sub lastError {
	return $LastError;
}

#  This function converts scalars to RPC::XML strings
sub argcopy {
	my ( $arg, $depth ) = @_;
	return $arg if $depth > 1;
	my $typ = ref $arg;
	if ( !$typ ) {
		if ( defined($arg) and ( $arg eq 'true' or $arg eq 'false' ) and $depth == 0 ) {
			return new RPC::XML::boolean($arg);
		}
		else {
			return new RPC::XML::string($arg);
		}
	}
	if ( $typ eq "HASH" ) {
		my %hash;
		foreach my $key ( keys %$arg ) {
			$hash{$key} = argcopy( $arg->{$key}, $depth + 1 );
		}
		return \%hash;
	}
	if ( $typ eq "ARRAY" ) {
		my @array = map { argcopy( $_, $depth + 1 ) } @$arg;
		return \@array;
	}
	return $arg;
}

sub new {
	my Confluence::Client::XMLRPC $self = shift;
	my ( $url, $user, $pass, $version ) = @_;
	unless ( ref $self ) {
		$self = fields::new($self);
	}
	$self->{url}  = $url;
	$self->{user} = $user;
	$self->{pass} = $pass;

	$API = 'confluence1';
	if ( defined($version) and $version =~ /\A(?:confluence)?([1-9])\Z/i ) {
		$API = 'confluence' . $1;
	}

	warn "Creating client connection to $url" if $CONFLDEBUG;
	$self->{client} = new RPC::XML::Client $url;
	warn "Logging in $user" if $CONFLDEBUG;
	my $result = $self->{client}->simple_request( "$API.login", $user, $pass );
	$LastError
		= defined($result)
		? (
		ref($result) eq 'HASH'
		? ( exists $result->{faultString} ? "REMOTE ERROR: " . $result->{faultString} : '' )
		: ''
		)
		: "XML-RPC ERROR: Unable to connect to " . $self->{url};
	_debugPrint( "Result=", $result ) if $CONFLDEBUG;

	if ($LastError) {
		croak $LastError if $RaiseError;
		warn $LastError  if $PrintError;
		$self->{token} = '';
		return '';
	}

	$self->{token} = $result;

	_debugPrint( "Checking Confluence server version" ) if $CONFLDEBUG;
	my $serverInfo = _rpc( $self, 'getServerInfo' );
	if ( !defined($serverInfo) or ref($serverInfo) ne ref({}) ) {
		croak "Unable to determine Confluence version: aborting" if $RaiseError;
		warn  "Unable to determine Confluence version: aborting" if $PrintError;
		$self->{token} = '';
		return '';
	}
	$self->{'_serverInfo'} = $serverInfo;
	$self->{'_cflVersion'} = sprintf( "%03s%03s%03s", @{ $serverInfo }{ 'majorVersion', 'minorVersion', 'patchLevel' } );

	# set default API version based on Confluence version (unless explicitly given)
	unless ( defined($version) and $version =~ /\A(?:confluence)?([1-9])\Z/i ) {
		if ( $self->{'_cflVersion'} ge '004000000' ) {
			$API = 'confluence2';
		}
		else {
			$API = 'confluence1';
		}
	}
	return $self;
} ## end sub new

# login is an alias for new
sub login {
	return new @_;
}

sub getServerInfo {
	my Confluence::Client::XMLRPC $self = shift;
	if ($CONFLDEBUG) {
		_debugPrint("Retrieving serverInfo from local cache");
		_debugPrint( "Result=", $self->{'_serverInfo'} );
	}
	return $self->{'_serverInfo'};
}

sub getPageSummary {
	my Confluence::Client::XMLRPC $self = shift;

	if ( $self->{'_cflVersion'} ge "004000000" ) {
		return _rpc( $self, 'getPageSummary', @_ );
	}
	else {
		# Emulate method on older Confluence versions
		if ( my $page = _rpc( $self, 'getPage', @_ ) ) {
			my (%data) = map { $_ => $page->{$_} } grep { /\A(?:id|parentId|permissions|space|title|url|version)\Z/ } keys %{$page};
			return \%data;
		}
		else {
			return '';
		}
	}
}

sub updatePage {
	my Confluence::Client::XMLRPC $self = shift;
	my $page                            = shift;
	my $pageUpdateOptions               = ( shift || {} );

	if ( $self->{'_cflVersion'} ge "002010000" ) {
		_debugPrint("Using API method updatePage() for Confluence >= 2.10") if $CONFLDEBUG;
		return _rpc( $self, 'updatePage', $page, $pageUpdateOptions );
	}
	else {
		_debugPrint("Trying to emulate updatePage() for Confluence < 2.10") if $CONFLDEBUG;
		if ( my $existingPage = $self->getPage( $page->{'id'} ) ) {
			my %new = ();
			foreach my $key ( keys %{$existingPage} ) {
				$new{$key} = $existingPage->{$key};
			}
			foreach my $key ( keys %{$page} ) {
				$new{$key} = $page->{$key};
			}
			return _rpc( $self, 'storePage', \%new );
		}
	}
	return '';
}

sub updateOrStorePage {
	my Confluence::Client::XMLRPC $self = shift;
	my $newPage                         = shift;

	my $couldUpdate = 1;
	foreach my $field ( qw( id space title content version ) ) {
		$couldUpdate--, last unless exists $newPage->{$field};
	}

	# do we have all necessary data for calling the updatePage method?
	if ($couldUpdate) {
		return $self->updatePage( $newPage, @_ );
	}
	elsif ( exists( $newPage->{'id'} ) ) {

		# something is missing, but we might be able to get it from Confluence
		# check if page already exists
		my ( $raise, $print ) = ( setRaiseError(0), setPrintError(0) );
		my $oldPage = $self->getPageSummary( $newPage->{'id'} );
		setRaiseError($raise);
		setPrintError($print);
		if ( defined($oldPage) and ref($oldPage) eq ref({}) ) {
			foreach my $key ( keys %{$newPage} ) {
				$oldPage->{$key} = $newPage->{$key}
			}
			return $self->updatePage( $oldPage, @_ );
		}
	}
	elsif ( exists( $newPage->{'space'} ) and exists( $newPage->{'title'} ) ) {

		# can store new page with these two fields
		# check if page already exists
		my ( $raise, $print ) = ( setRaiseError(0), setPrintError(0) );
		my $oldPage = $self->getPageSummary( $newPage->{'space'}, $newPage->{'title'} );
		setRaiseError($raise);
		setPrintError($print);
		if ( defined($oldPage) and ref($oldPage) eq ref({}) ) {
			foreach my $key ( keys %{$newPage} ) {
				$oldPage->{$key} = $newPage->{$key}
			}
			return $self->updatePage( $oldPage, @_ );
		}
	}

	# might as well fail...
	return _rpc( $self, 'storePage', $newPage );
}

sub _rpc {
	my Confluence::Client::XMLRPC $self = shift;
	my $method = shift;
	croak "ERROR: Not connected" unless $self->{token};
	my @args = map { argcopy( $_, 0 ) } @_;
	_debugPrint( "Sending $API.$method ", @args ) if $CONFLDEBUG;
	my $result = $self->{client}->simple_request( "$API.$method", $self->{token}, @args );
	$LastError
		= defined($result)
		? (
		ref($result) eq 'HASH'
		? (
			exists $result->{faultString}
			? "REMOTE ERROR: " . $result->{faultString}
			: ''
			)
		: ''
		)
		: defined $RPC::XML::ERROR ? $RPC::XML::ERROR
		:                            "XML-RPC ERROR: Unable to connect to " . $self->{url};

	_debugPrint( "Result=", $result ) if $CONFLDEBUG;

	if ( ( $LastError =~ /InvalidSessionException/i ) && $AUTO_SESSION_RENEWAL ) {

		# Session time-out; log back in.
		warn "SESSION EXPIRED: Reconnecting...\n" if $PrintError;
		my ( $url, $user, $pass ) = ( $self->{url}, $self->{user}, $self->{pass} );
		$self->{pass} = '';    # Prevent repeated attempts.
		if ( my $clone = Confluence::Client::XMLRPC->new( $url, $user, $pass, $API ) ) {
			$self->{token}         = $clone->{token};
			$self->{'_cflVersion'} = $clone->{'_cflVersion'};
			$self->{'_serverInfo'} = $clone->{'_serverInfo'};

			$result = _rpc( $self, $method, @_ );
			$self->{pass} = $pass;
		}
	}
	if ($LastError) {
		croak $LastError if $RaiseError;
		warn $LastError  if $PrintError;
	}
	return $LastError ? '' : $result;
} ## end sub _rpc

# Define commonly used functions to avoid overhead of autoload
sub getPage {
	my Confluence::Client::XMLRPC $self = shift;
	_rpc( $self, 'getPage', @_ );
}

sub storePage {
	my Confluence::Client::XMLRPC $self = shift;
	_rpc( $self, 'storePage', @_ );
}

# Use autolaod for everything else
sub AUTOLOAD {
	my Confluence::Client::XMLRPC $self = shift;
	$AUTOLOAD =~ s/Confluence::Client::XMLRPC:://;
	return if $AUTOLOAD =~ /DESTROY/;
	_rpc( $self, $AUTOLOAD, @_ );
}

1;

__END__