package Catalyst::Model::http;

use strict;
use warnings;

use base qw/ Catalyst::Model /;

use LWP;
use HTTP::Request;

__PACKAGE__->mk_accessors(  qw/c/ );


=head1 NAME

Model::http- Catalyst Model to interact with web servers via http

=head1 SYNOPOSIS

Use this like you would use LWP.  Returns a HTTP::Response object.

	my $webpage =$c->model('http')->get({
	
		link	=> 'http::/www.perl.org',
	});
	
	print $webpage->content if $webpage;
	
	$c->model('http')->delete({
	
		link	=> 'http::/www.contentserver.com/oldentry',
	});
	
	$c->model('http')->post({
	
		link	=> 'http::/my.weblog.com',
		content	=> 'Here is my latest weblog post.  ->put works the same way',
		headers	=> {
		
			'Content-Type'	=> 'text/plain',
		},
	});

And that's that.  Right now not caching is performed.  

=head1 DESCRIPTION

This is a wrapper around LWP which allows you to perform GET, POST, POST and
DELETE on a http server that will accept those methods.  It's very simple
and does no caching.  You need to pass the full link you want act on.

Doesn't support WEBDAV type interactions, that's for another model :)  Also
it doesn't try to autoinflate bodies into objects, you just get text.

=head1 Methods

This module uses the following methods.

=head2 ACCEPT_CONTEXT

We need a current context so we can easily do some logging and meaningfully
interact with the current request

=cut

sub ACCEPT_CONTEXT
{
  my ( $self, $c, @extra_arguments ) = @_;
  
  bless { %$self, c => $c }, ref($self);
}


=head2 get

This accepts a link an tries to get it and returns errors otherwise.

=cut

sub get
{
    my ($self, $params) = @_;
	
	$params->{method} = 'GET';
	
	return $self->_ua($params);
}

=head2 post

This accepts a link an tries to get it and returns errors otherwise.

=cut

sub post
{
    my ($self, $params) = @_;
	
	$params->{method} = 'POST';
	
	return $self->_ua($params);
}

=head2 put

This accepts a link an tries to get it and returns errors otherwise.

=cut

sub put
{
    my ($self, $params) = @_;
	
	$params->{method} = 'PUT';
	
	return $self->_ua($params);
}

=head2 delete

This accepts a link an tries to get it and returns errors otherwise.

=cut

sub delete
{
    my ($self, $params) = @_;
	
	$params->{method} = 'DELETE';
	
	return $self->_ua($params);
}

=head2 _ua

Private function that is a LWP useragent.  It's used by the public functions of
this package to make the functions more semantically meaningful.
	
	$self->_ua({
	
		link	=> 'http://www.perl.org',
		method	=> 'GET',
	});
	
	$self->_ua({
	
		link	=> 'http://my.weblog.com/incoming',
		method	=> 'POST',
		content	=> 'This is my POSTed content.  PUT works the same way',
		headers	=> {
		
			Content-Type	=> 'text/plain',
		},
	});
	
And that's how it works, but you'll use the easy methods above to set the
http METHOD type automatically.
	
=cut

sub _ua
{
	my $self	= shift @_;
	my $params	= shift @_;
	
	my $link	= $params->{link} || return undef;
	my $method	= $params->{method} || 'GET';
	my $content	= $params->{content} || '';
	my $headers	= $params->{headers} || '';

	my $ua	= LWP::UserAgent->new;
	my $req	= HTTP::Request->new($method => $link);

	$req->content($content) if $content;
	$req->header(%$headers) if $headers;
	
	my $res	= $ua->request($req);
	 
	if ($res->is_success)
	{
		return $res;
	}
	else 
	{
		my $error = sprintf(
			
			"The error %s was return from loading %s", 
			$res->status_line,
			$link
		);
		
		$self->c->log->warn( $error );

		return undef;
	}
}


=head1 AUTHOR

John Napiorkowski

=head1 LICENSE

This library is free software, you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut


1;