—
—
—
—
—

              
package HTTP::Server::EV;
no warnings;
HideShow 47 lines of Pod
=head1 NAME
HTTP::Server::EV - Asynchronous HTTP server written in C with request parser. 
=head1 DESCRIPTION
HTTP::Server::EV - Asynchronous HTTP server using EV event loop. 
It doesn`t load files received in the POST request in memory as moust of CGI modules does, but stores them directly to tmp files, so it`s useful for handling large files without using a lot of memory. 
=head1 INCLUDED MODULES
L<HTTP::Server::EV::CGI> - received http request object
L<HTTP::Server::EV::MultipartFile> - received file object
L<HTTP::Server::EV::Buffer> - non blocking output
L<HTTP::Server::EV::BufTie> - workaround for correct handling requests in L<Coro> threads
L<HTTP::Server::EV::IO::AIO> - Non-blocking disk IO. 
L<HTTP::Server::EV::IO::Blocking> - Blocking IO.
=head1 SYNOPSIS
        use EV;
        use Coro;
        use HTTP::Server::EV;
         
         
        my $server = HTTP::Server::EV->new;
         
        $server->listen(90, sub {
                my $cgi = shift;
                 
                $cgi->attach(*STDOUT);
                $cgi->header;
                print "Just another Perl server\n";
        });
         
        EV::run;
=cut
use EV;
use strict;
use Encode;
use Socket;
use utf8;
use Scalar::Util qw/weaken/;
use HTTP::Server::EV::CGI;
use HTTP::Server::EV::MultipartFile;
use HTTP::Server::EV::PortListener;
require Exporter;
*import = \&Exporter::import;
require DynaLoader;
$HTTP::Server::EV::VERSION = '0.41';
DynaLoader::bootstrap HTTP::Server::EV $HTTP::Server::EV::VERSION;
@HTTP::Server::EV::EXPORT = ();
@HTTP::Server::EV::EXPORT_OK = ();
our %listeners;
our $backend;
HideShow 30 lines of Pod
=head1 METHODS
=head2 new( { options } )
         
Options:
=over
=item tmp_path
Directory for saving received files. Tries to create if not found, dies on fail. 
Default: ./upload_tmpfiles/
=item cleanup_on_destroy
Usually HTTP::Server::EV::CGI deletes tmp files on DESTROY, but it might by bug if you delete HTTP::Server::EV::CGI object when its files are still opened. Setting on this flag causes HTTP::Server::EV delete all files in tmp_path on program close, but don`t use it if jou have several process working with same tmp dir.
Default: 0
=item backend
Seting on cause HTTP::Server::EV::CGI parse ip from X-Real-IP http header
Default: 0
=back
=cut
our $tmp_path;
our $instance;
sub new {
        my ($self, $params) = @_;
         
        return $instance if $instance;
         
        $params->{tmp_path} = './upload_tmpfiles/' unless($params->{tmp_path});
        unless(-d($params->{tmp_path})){
                mkdir($params->{tmp_path}) or die 'Can`t create path for tmp files!';
        }
        $params->{tmp_path} =~ s|([^/])^|$1/|;
         
        $HTTP::Server::EV::tmp_path = $params->{tmp_path};
         
        $backend = $params->{backend};
         
         
        if(eval { require HTTP::Server::EV::IO::AIO }){
                HTTP::Server::EV::IO::AIO->_use_me;
        }else{
                require HTTP::Server::EV::IO::Blocking;
                HTTP::Server::EV::IO::Blocking->_use_me;
        }
         
        eval { HTTP::Server::EV::Coro->_use_me };
         
        $instance = bless $params, $self;
         
}
HideShow 66 lines of Pod
=head2 listen( port , sub {req_received_callback} , { optional parameters and multipart processing callbacks })
Binds callback to port. Calls callback and passes L<HTTP::Server::EV::CGI> object in it. Returns L<HTTP::Server::EV::PortListener> obeject, you can keep it and use to stop port listening.
        $server->listen( 8080 , sub {
                my $cgi = shift;
                 
                $cgi->attach(local *STDOUT); # attach STDOUT to socket
                 
                $cgi->header; # print http headers to stdout
                 
                print "Test page";
        });
         
         
        $server->listen( 8080 , sub {
                #req_received_callback
                my $cgi = shift;
                 
                $cgi->attach(local *STDOUT); # attach STDOUT to socket
                 
                $cgi->header; # print http headers to stdout
                 
                print "Test page";
        }, { 
                threading => 1, # run every req_received_callback in Coro thread. "use Coro;" first
                 
                # you needn't specify all callbacks
         
                on_multipart => sub {
                        my ($cgi) = @_;
                        # called on multipart body receiving start
                },
                 
                on_file_open => sub {
                        my ($cgi, $multipart_file_obj ) = @_;
                        # called on multipart file receiving start
                },
                 
                on_file_write => sub {
                        my ($cgi, $multipart_file_obj, $data_chunk ) = @_;
                        # called when file part writed to disk. 
                        # usefur for on flow calculting hashes like md5 
                        # or just to know progress by reading  $multipart_file_obj->{size}
                },
                 
                on_file_received => sub {
                        my ($cgi, $multipart_file_obj) = @_;
                        # called on file writing done
                },
                 
                on_error => sub {
                        my ($cgi) = @_;
                        # called when server drops multipart post connection
                }
                 
        });
         
=cut
         
sub listen {
        my ($self, $port, $cb, $params) = @_;
         
        die "You can`t bind two listeners on one port!\n" if $listeners{$port};
         
        my $socket;
        socket($socket, AF_INET, SOCK_STREAM, getprotobyname('tcp')) || die "socket: $!";
        setsockopt( $socket, SOL_SOCKET, SO_REUSEADDR, pack('l', 1)) || die "setsockopt: $!";
        bind( $socket, sockaddr_in($port, INADDR_ANY )) || die "bind: $!";
        listen( $socket, SOMAXCONN) || die "listen: $!";
        binmode $socket;
         
         
        sub _main_cb { 
                my $cgi = $_[0];
                 
                eval { $cb->($cgi); };
                if($@){ warn "ERROR IN CALLBACK: $@"; }
                 
                return;
                 
                NEXT_REQ:
                $cgi->close;
        };
         
        $listeners{$port} = HTTP::Server::EV::PortListener -> new({
                ptr => 
                        listen_socket($socket, 
                        $params->{threading} ? sub { Coro::async(\&_main_cb, @_) } : \&_main_cb ,  
                        sub { 
                                $_[0]->{parent_listener} = $listeners{$port};
                                weaken $_[0]->{parent_listener};
                                 
                                $listeners{$port}->{on_multipart}->(@_) if $listeners{$port}->{on_multipart};
                        }),
                         
                socket => $socket,
                 
                %{ $params },
                # on_multipart
                # on_file_open
                # on_file_write
                # on_file_received
                # on_error
        });
}
HideShow 6 lines of Pod
=head2 cleanup
Delete all files in tmp_path. Automatically called on DESTROY if cleanup_on_destroy set
=cut
sub cleanup {
        my @files = glob (shift->{tmp_path}.'*');
        unlink $_ for (@files);
}
sub DESTROY {
        my $self = shift;
        $self->cleanup if($self->{cleanup_on_destroy});
}
sub dl_load_flags {0}; # Prevent DynaLoader from complaining and croaking
HideShow 21 lines of Pod
=head1 BUGS/WARNINGS
Static allocated buffers:
- 4kb for GET/POST form field names
- 4kb for GET values
- 50kb for POST form field values ( not for files. Files are stored into tmp directly from socket stream, so filesize not limited by HTTP::Server::EV)
HTTP::Server::EV drops connection if some buffer overflows. You can change these values in EV.xs and recompile module.
=head1 COPYRIGHT AND LICENSE
This module is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=cut
1;