File Coverage

blib/lib/FreeMED/Relay.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

#!/usr/bin/perl
#
# $Id: Relay.pm 71 2007-08-14 00:33:05Z jeff $
#
# Authors:
#      Jeff Buchbinder
#
# FreeMED Electronic Medical Record and Practice Management System
# Copyright (C) 1999-2006 FreeMED Software Foundation
#
# 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., 675 Mass Ave, Cambridge, MA 02139, USA.

#
#	FreeMED::Relay package for communicating with FreeMED 0.9.x+
#

package FreeMED::Relay;

use LWP::UserAgent;
use HTTP::Request::Common;
use JSON;	# objToJson(), jsonToObj()
use HTTP::Cookies;

use vars qw{ $VERSION };
BEGIN {
	$VERSION = '0.2';
}

sub new {
	my $class = shift;
	my $debug = shift;
	my $self = {};
	bless $self, $class;
	$self->{'debug'} = $debug;
	$self->_init();
	$JSON::UnMapping = 1;
	$JSON::QuotApos = 1;
	$JSON::BareKey = 1;
	return $self;
}

sub set_credentials {
	my $self = shift;

	my ( $base_uri, $username, $password ) = @_;
	print "base_uri = $base_uri\n" if $self->{'debug'};
	print "username = $username\n" if $self->{'debug'};
	print "password = $password\n" if $self->{'debug'};
	$self->{base_uri} = $base_uri;
	$self->{username} = $username;
	$self->{password} = $password;
}

sub login {
	my $self = shift;
	if (!defined($self->{username}) or !defined($self->{password})) {
		die "login(): Must set credentials before logging in\n";
	}

	$self->_init() if (!defined($self->{ua}));
	my $login = $self->call(
		'org.freemedsoftware.public.Login.Validate',
		$self->{'username'},
		$self->{'password'},
	);
	$self->{'logged_in'} = true;
	return $login;
}

sub call {
	my $self = shift;
	my $method = shift;
	my @params = @_;

	if (!($method =~ /public/) && !$self->{'logged_in'}) {
		print "Must be logged in first\n" if $self->{'debug'};
		return undef;
	}

	my $count = 0; my %p;
	foreach my $param (@params) {
		print "param = '$param'\n";
		if ( $param =~ /^HASH\(/ && $param->{'@var'} ) {
			print "Found file upload var in $param->{'@var'}\n" if (@self->{debug});
			# Add file transfer under @var = var, @filename = filename
			$p{$param->{'@var'}} = [ $param->{'@filename'} ];
		} else {
			my $json = objToJson( $param );
			print "param = $param, count = $count, json = $json\n" if $self->{'debug'};
			$p{"param${count}"} = ($json ? $json : $param );
			$count++;
		}
	}
	my $res = $self->{ua}->request(
		POST $self->{base_uri}."/relay.php/json/${method}",
		Content_Type => 'form-data',
		Content => [ %p ]
	);
	$self->{'cookie_jar'}->save();
	print "content : ".$res->content."\n" if ($self->{debug});
	return jsonToObj ( $res->content );
}

sub _init {
	my $self = shift;
	$self->{'ua'} = LWP::UserAgent->new;
	$self->{'cookie_jar'} = HTTP::Cookies->new( 'autosave' => 1 );
	$self->{'ua'}->cookie_jar( $self->{'cookie_jar'} );
}

1;
__END__