view release on metacpan or  search on metacpan

lib/Bosch/RCPPlus.pm  view on Meta::CPAN

sub new
{
	my $proto = shift;
	my $class = ref($proto) || $proto;
	my %args = @_;

	my $self = {
		ua => LWP::UserAgent->new(),
		protocol => $args{protocol} || 'http',
		host => $args{host} || 'localhost',
		username => $args{username},
		password => $args{password},
		path => $args{path} || '/rcp.xml',
	};

	bless ($self, $class);
	return $self;
}

sub uri
{
	my ($proto) = @_;
	return URI->new($proto->{path})->abs($proto->{protocol} . '://' . $proto->{host});
}

sub request
{
	my ($proto, %args) = @_;
	my @headers = ();

	push @headers, @{$args{headers}} if ($args{headers});

	my $uri = $proto->uri;
	$uri->query_form($args{query}) if ($args{query});

	my $request = HTTP::Request->new(
		$args{method} || 'GET',
		$uri,
		\@headers,
		$args{content}
	);

	return $proto->{ua}->request($request);
}

sub cmd
{
	my ($proto, %args) = @_;

	my $format = $args{format};
	delete $args{format};

	my $r = $proto->request(query => \%args);

	if ($r->code eq 401) {
		my $authenticate = $r->header('www-authenticate');

		if ($authenticate and $authenticate =~ /realm="([^"]+)"/i) {
			my $realm = $1;
			$proto->{ua}->credentials($proto->{host}, $realm, $proto->{username}, $proto->{password});
			$r = $proto->request(query => \%args);

			return new Bosch::RCPPlus::AuthError($r->content) if ($r->code eq 401);
		} else {
			return new Bosch::RCPPlus::AuthError($r->content);
		}
	}

	return new Bosch::RCPPlus::Response($r->content, \%args, $format);
}

1;