package QBit::WebInterface::OwnServer;
$QBit::WebInterface::OwnServer::VERSION = '0.007';
use qbit;

use base qw(QBit::WebInterface);

use IO::Socket;
use MIME::Types;
use URI::Escape qw(uri_escape_utf8);

use QBit::WebInterface::OwnServer::Request;
use QBit::WebInterface::Response;

my %RESPONSE_TEXT = (
    200 => 'OK',
    201 => 'CREATED',
    202 => 'Accepted',
    203 => 'Partial Information',
    204 => 'No Response',
    301 => 'Moved',
    302 => 'Found',
    303 => 'Method',
    304 => 'Not Modified',
    400 => 'Bad request',
    401 => 'Unauthorized',
    402 => 'PaymentRequired',
    403 => 'Forbidden',
    404 => 'Not found',
    500 => 'Internal Error',
    501 => 'Not implemented',
    502 => 'Service temporarily overloaded',
    503 => 'Gateway timeout',
);

sub run {
    my ($self, %opts) = @_;

    $opts{'port'} ||= 5000;

    my $server_socket = IO::Socket::INET->new(
        Proto     => 'tcp',
        LocalPort => $opts{'port'},
        Listen    => SOMAXCONN,
        Reuse     => 1,
    ) || throw gettext('Cannot create socket');

    l "http://127.0.0.1:$opts{'port'}";
    l "Ctrl+C to terminate";

    my $mimetypes = MIME::Types->new();

    while (my $socket = $server_socket->accept()) {
        try {
            $self->request(QBit::WebInterface::OwnServer::Request->new(socket => $socket, port => $opts{'port'}));

            l $self->request->uri;

            if (length(my $static_path = $self->_is_static($self->request->uri))) {
                if ($static_path =~ /\.\.\// || !-f $static_path) {
                    $self->response(QBit::WebInterface::Response->new(status => 404));
                } else {
                    my $mimetype = $mimetypes->mimeTypeOf($static_path);

                    $self->response(
                        QBit::WebInterface::Response->new(
                            status => 200,
                            data   => \readfile($static_path, binary => $mimetype && $mimetype->isBinary()),
                        )
                    );
                    $self->response->content_type($mimetype->type() . ($mimetype->isAscii() ? '; charset=UTF-8' : ''))
                      if $mimetype;
                }
            } else {
                $self->build_response();
            }
        }
        catch {
            l shift->as_string();
            $self->response(QBit::WebInterface::Response->new()) unless $self->response();
            $self->response->status(500);
            $self->response->data('');
        };

        binmode($socket);

        my $status = $self->response->status || 200;

        print $socket "HTTP/1.0 $status "
          . (exists($RESPONSE_TEXT{$status}) ? " $RESPONSE_TEXT{$status}" : 'Unknown') . "\n";
        print $socket 'Server: QBit::WebInterface::OwnServer (' . ref($self) . ")\n";
        print $socket 'Set-Cookie: ' . $_->as_string() . "\n" foreach values(%{$self->response->cookies});

        while (my ($key, $value) = each(%{$self->response->headers})) {
            print $socket "$key: $value\n";
        }

        if ($status == 200) {
            print $socket 'Content-Type: ' . $self->response->content_type . "\n\n";
            print $socket 'Content-Disposition: '
              . 'attachment; filename="'
              . $self->_escape_filename($self->response->filename) . '"'
              if $self->response->filename;

            if (defined($self->response->data)) {
                my $data_ref = ref($self->response->data) ? $self->response->data : \$self->response->data;
                utf8::encode($$data_ref) if utf8::is_utf8($$data_ref);
                print $socket $$data_ref;
            }

        } elsif ($status == 301 || $status == 302) {
            print $socket 'Location: ' . $self->response->location . "\n\n";
        } elsif ($status == 404) {
            print $socket "Content-Type: text/html\n\n";
            print $socket '<html><body><h1>Not found</h1><body></html>';
        } elsif ($status == 500) {
            print $socket "Content-Type: text/html\n\n";
            print $socket '<html><body><h1>Internal server error</h1><body></html>';
        } else {
            print $socket "\n\n";
        }

        close($socket);
    }
}

sub get_cmd {
    my ($self) = @_;

    my ($path, $cmd);
    if ($self->request->uri() =~ /^\/([^?\/]+)(?:\/([^\/?#]+))?/) {
        ($path, $cmd) = ($1, $2);
    } else {
        ($path, $cmd) = $self->default_cmd();
    }

    $path = '' unless defined($path);
    $cmd  = '' unless defined($cmd);

    return ($path, $cmd);
}

sub make_cmd {
    my ($self, $new_cmd, $new_path, @params) = @_;

    my %vars = defined($params[0])
      && ref($params[0]) eq 'HASH' ? %{$params[0]} : @params;

    my ($path, $cmd) = $self->get_cmd();

    $path = uri_escape_utf8($self->_get_new_path($new_path, $path));
    $cmd = uri_escape_utf8($self->_get_new_cmd($new_cmd, $cmd));

    return "/$path/$cmd"
      . (
        %vars
        ? '?'
          . join(
            $self->get_option('link_param_separator', '&amp;'),
            map {uri_escape_utf8($_) . '=' . uri_escape_utf8($vars{$_})} keys(%vars)
          )
        : ''
      );
}

sub _is_static {
    my ($self, $uri) = @_;

    my $path = __normalize_path($uri);

    $self->{'static_locations'} ||= {'/qbit' => $self->{'__ORIG_OPTIONS__'}{'FrameworkPath'} . 'QBit/data'};

    foreach my $l (sort {length($b) <=> length($a)} keys(%{$self->{'static_locations'}})) {
        my $location = $l;
        $location =~ s/\/$//;
        if ($path =~ /^$location\/(.+)$/) {
            return "$self->{'static_locations'}{$l}/$1";
        }
    }

    return '';

}

sub __normalize_path {
    my ($path) = @_;

    for ($path) {
        s/\?.+$//;
        s/[^\/a-zA-Z0-9_\.-]//g;
        while (s/\/[a-zA-Z0-9_-]+?\/\.\.(\/|$)/$1/) { }
    }

    return $path;
}

TRUE;

__END__

=encoding utf8

=head1 Name

QBit::WebInterface::OwnServer - WebInterface with own HTTP server.

=head1 GitHub

https://github.com/Madskill/QBit-WebInterface-OwnServer

=head1 Install

=over

=item *

cpanm QBit::WebInterface::OwnServer

=item *

apt-get install libqbit-webinterface-ownserver-perl (http://perlhub.ru/)

=back

For more information. please, see code.

=cut
