package HTTP::Server::EV::CGI;

use strict;
use bytes;
use Encode;
use Carp;
use Time::HiRes qw(gettimeofday tv_interval);
use Scalar::Util qw/weaken/;
no warnings;

use HTTP::Server::EV::Buffer;
use HTTP::Server::EV::BufTie;

our $VERSION = '0.41';

=head1 NAME

HTTP::Server::EV::CGI - Contains http request data and some extra functions.  

=head1 GETTING DATA

=over
	
To get headers and CGI compatible ENV vars use

=item $cgi->{ headers }{ header_name } = value


To get last parsed from form value use

=item $cgi->{ get }{ url_filed_name }

=item $cgi->{ cookies }{ cookie_name }

=item $cgi->{ post }{ form_filed_name } 

=item $cgi->{ file }{ form_file-filed_name } - L<HTTP::Server::EV::MultipartFile> object

=back


To get reference to array of all elements with same name ( selects, checkboxes, ...) use

=over

=item $cgi->get('filed_name')

=item $cgi->post('filed_name')

=item $cgi->file('filed_name')

=item $cgi->param('filed_name');

=back

Returns one or list of elements depending on call context. 
Prefers returning GET values if exists.

Never returns L<HTTP::Server::EV::MultipartFile> files, use $cgi->{ file }{ filed_name } or $cgi->file('filed_name')

All values are utf8 encoded

=head1 NON BLOCKING OUTPUT

$cgi->{buffer} = L<HTTP::Server::EV::Buffer> object

$cgi->buffer - returns non blocking filehandle tied to L<HTTP::Server::EV::Buffer> object

$cgi->attach(*STDOUT) - attaches STDOUT to socket makes it non blocking 

=head1 METHODS

=cut



our $cookies_lifetime = 3600*24*31;


#$cgi->new({ fd => sock fileno , post => {}, get => {} , headers => {} .... });

# new called only by HTTP::Server::EV 
sub new { # init all structures
	my($self) = @_;
	
	$self->start_timer;
	
	$self->{buffer} = HTTP::Server::EV::Buffer->new({ fd => $self->{fd} });
	$self->{stdout_guard} = [];
	
	## Parse headers. CGI.pm compatible
	( $self->{headers}{SCRIPT_NAME}, $self->{headers}{QUERY_STRING} ) =(split /\?/, $self->{headers}{REQUEST_URI});
	
	$self->{headers}{DOCUMENT_URI} = $self->{headers}{SCRIPT_NAME};
	
	$self->{headers}{REMOTE_ADDR} = $self->{headers}{'HTTP_X-REAL-IP'} if($HTTP::Server::EV::backend && $self->{headers}{'HTTP_X-REAL-IP'});
	$self->{headers}{CONTENT_TYPE} = $self->{headers}{'HTTP_CONTENT-TYPE'};
	$self->{headers}{CONTENT_LENGTH} = $self->{headers}{'HTTP_CONTENT-LENGTH'};
	
	


	## Reading get vars
	my @pairs = split(/[;&]/,$self->{headers}{QUERY_STRING},1024);
	foreach (@pairs) {
		my ($name, $data) = split /=/;
		$name = $self->urldecode($name);
		$data = $self->urldecode($data);
		
		$self->{get}{$name} = $data;
		
		$self->{get_a}{$name}=[] unless $self->{get_a}{$name};
		push @{$self->{get_a}{$name}},$data;
	}
	
	## Reading cookies
	@pairs = split(/; /,$self->{headers}{HTTP_COOKIE},100);
	foreach (@pairs) {
		my ($name, $data) = split /=/;
		$self->{cookies}{ $self->urldecode($name) } = $self->urldecode($data);
	}
	

	## Parse urlencoded post
	if($self->{REQUEST_BODY}){
		my @pairs = split(/[;&]/,$self->{REQUEST_BODY},1024);
		foreach (@pairs) {
			my ($name, $data) = split /=/;
			$name = $self->urldecode($name);
			$data = $self->urldecode($data);
			
			$self->{post}{$name} = $data;
					
			$self->{post_a}{$name}=[] unless $self->{post_a}{$name};
			push @{$self->{post_a}{$name}},$data;
		}
	}	
	
	return $self;
}

=head2 $cgi->next

Drops port listener callback processing. Don`t use it somewhere except HTTP::Server::EV port listener callback or set goto label NEXT_REQ: 

=cut

sub next { $_[0]->{received} ? goto(NEXT_REQ) : $_[0]-> drop};

=head2 $cgi->fd

Returns file descriptor (int)

=cut

sub fd { shift->{fd} }

=head2 $cgi->fh

Returns perl file handle attached to socket. 
Non buffered and blocking, use $cgi->{buffer}->print() or $cgi->buffer handle instead for sending data without attaching socket.

=cut

sub fh { 
	croak 'Can`t get fh of closed socket!' unless $_[0]->{buffer};
	
	$_[0]->{buffer}{fh}
}

=head2 $cgi->buffer

Returns handle tied to L<HTTP::Server::EV::Buffer> object. Writing to this handle buffered an non-blocking

=cut

sub buffer { 
	croak 'Can`t geet buffered handle from closed socket!' unless $_[0]->{buffer};
	
	tie($_[0]->{buf_fh}, 'HTTP::Server::EV::Buffer', $_[0]->{buffer}) unless $_[0]->{buf_fh};
	
	return $_[0]->{buf_fh};
}

=head2 $cgi->attach(*FH)

Attaches client socket to FH.
Uses L<HTTP::Server::EV::BufTie> to support processing requests in L<Coro> threads when using L<Coro::EV>
Uses L<HTTP::Server::EV::Buffer> to provide non-blocking output.

	$server->listen( 8080 , sub {
		my $cgi = shift;
		
		$cgi->attach(*STDOUT); # attach STDOUT to socket
		
		$cgi->header; # print http headers
		
		print "Test page"; 
	});


=cut


sub attach {
	croak 'Can`t attach closed socket!' unless $_[0]->{buffer};
	
	push @{$_[0]->{stdout_guard}}, HTTP::Server::EV::BufTie->new($_[1], $_[0]->{buffer});
}


=head2 $cgi->copy(*FH)

Attaches socket to handle but don`t uses L<HTTP::Server::EV::BufTie> magick and buffered L<HTTP::Server::EV::Buffer> otput.

=cut


sub copy {
	croak 'Can`t attach closed socket!' unless $_[0]->{buffer};
	
	open($_[1], '>&', $_[0]->{fd} ) or croak 'Can`t attach socket handle';
	binmode $_[1];
}


=head2 $cgi->print($data)

Buffered non-blocking print to socket. Same as $cgi->{buffer}->print or $cgi->buffer handle

=cut


sub print {shift->{buffer}->print(@_)};


=head2 $cgi->flush

Flushes all buffered data to socket. Same as $cgi->{buffer}->flush

=cut


sub flush {$_[0]->{buffer}->flush};



=head2 $cgi->close

Flush all buffered data and close received connection.

=cut

sub close { 
	delete $_[0]->{buffer}; # From 0.21 HTTP::Server::EV::Buffer closes socket
	$_[0]->{stdout_guard} = []; # close all attached handles
	#CORE::close $_[0]->{fh} ;
	#HTTP::Server::EV::close_socket( $_[0]->{fd} );
};


=head2 $cgi->start_timer

Initalize a page generation timer. Called automatically on every request

=head2 $cgi->flush_timer

Returns string like '0.12345' with page generation time	

=cut


### Page generation timer
sub start_timer { shift->{timer}=[gettimeofday] }; # start/reset timer
sub flush_timer { return tv_interval(shift->{timer}) }; # get generation time

### Get params as array refs. Ex: $cgi->post('checkboxes') - ['one','two']
sub get { return $_[0]->{get_a}{$_[1]} ? $_[0]->{get_a}{$_[1]} : [] ;}
sub post { return $_[0]->{post_a}{$_[1]} ? $_[0]->{post_a}{$_[1]} : [] ;}
sub file { return $_[0]->{file_a}{$_[1]} ? $_[0]->{file_a}{$_[1]} : [] ;}
sub param {
	if(wantarray){
		return @{$_[0]->{get_a}{$_[1]} || []} || @{$_[0]->{post_a}{$_[1]} || []};
	}else{
		return $_[0]->{get}{$_[1]} || $_[0]->{post}{$_[1]};
	}
}


=head2 $cgi->set_cookies({ name=> 'value', name2=> 'value2' }, $sec_lifetime );

Takes hashref with cookies as first argumet. Second(optional) argument is cookies lifetime in seconds(1 month by default)

=cut



sub set_cookies {
	my ($self,$cookies, $lifetime)=@_;
	my ($name,$value);
	my @days=qw(Sun Mon Tue Wed Thu Fri Sat);
	my @months=qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
	my ($sec,$min,$hour,$mday,$mon,$year,$wday)=gmtime( time + ( defined($lifetime) ? $lifetime :  $HTTP::Server::EV::CGI::cookies_lifetime ) );
	my $date = sprintf("%s, %02d-%s-%04d %02d:%02d:%02d GMT",$days[$wday],$mday,$months[$mon],$year+1900,$hour,$min,$sec);
	$self->{cookiesbuffer}.="Set-Cookie: $name=$value; path=/; expires=$date;\r\n" while(($name,$value)=each %{$cookies});
};

# generate headers

=head2 $cgi->header( \%args );

Prints http headers and cookies buffer to socket

Args:

=over

=item STATUS 

HTTP status string. '200 OK' by default

=item Server 

Server header. 'Perl HTTP::Server::EV' by default

=item Content-Type

Content-Type header. 'text/html' by default

=back

All other args will be converted to headers.

=cut


sub header {
	my ($self,$params)=@_;
	croak 'Can`t print headers to closed socket!' unless $_[0]->{buffer};
	
	my $headers = 'HTTP/1.1 '.($params->{'STATUS'} ? delete($params->{'STATUS'}) : '200 OK')."\r\n";
	$headers .= 'Server: '.($params->{'Server'} ? delete($params->{'Server'}) : 'Perl HTTP::Server::EV')."\r\n";
	$headers .= $self->{cookiesbuffer};
	$headers .= 'Content-Type: '.($params->{'Content-Type'} ? delete($params->{'Content-Type'}) : 'text/html')."\r\n";
	
	$headers .= $_.': '.$params->{$_}."\r\n" for(keys %{$params});
	
	$self->{buffer}->print($headers."\r\n");
}


=head2 $cgi->urldecode( $str );

Returns urldecoded utf8 string

=cut

sub urldecode {
	my $tmp = $_[1];
	$tmp=~s/\+/ /gs;
	$tmp=~s/%(?:([Dd][0-9a-fA-F])%([0-9a-fA-F]{2})|([0-9a-fA-F]{2}))/
		$1 ? chr(hex $1).chr(hex $2) : decode("cp1251",chr(hex $3))
	/eg;
	Encode::_utf8_on($tmp);
	return $tmp;
};
	





=head1 NOT RECEIVED REQUEST METHODS

You can call these methods only after HTTP::Server::EV::PortListener on_multipart callback, when server receives POST data. You shouldn`t call them after request has received. 

=head2 $cgi->stop;

Stop request processing

=head2 $cgi->start;

Starts stopped request processing. 

=head2 $cgi->drop;

Drop user connection

=cut


sub stop { HTTP::Server::EV::stop_req($_[0]->{stack_pos}); 1}

sub start {
	my $fd = HTTP::Server::EV::start_req($_[0]->{stack_pos});
	EV::feed_fd_event($fd, EV::READ) if defined $fd;
	1;
}

sub drop { 
	HTTP::Server::EV::drop_req($_[0]->{stack_pos});
	EV::feed_fd_event($_[0]->{fd}, EV::READ);
}






sub DESTROY {
	
	if(!$_[0]->{received} and $_[0]->{parent_listener}{on_error}) {
		$_[0]->{parent_listener}{on_error}->($_[0]) if $_[0]->{parent_listener}{on_error};
	}
	
}

1;