package Terse::WebSocket;
use base 'Terse';
use MIME::Base64;
sub new {
	my ($class, $t) = @_;
	my $self = $class->SUPER::new();
	my $version = '';
	my $env =  $t->request->env; 
	$self->options = {
		secret => 'ABABCABC-ABC-ABC-ABCD-ABCABCABCABC',
		upgrade    => $env->{HTTP_UPGRADE},
		connection => $env->{HTTP_CONNECTION},
		host       => $env->{HTTP_HOST},
		origin => $env->{HTTP_ORIGIN},
		($env->{HTTP_SEC_WEBSOCKET_KEY} 
			? (sec_websocket_key => $env->{HTTP_SEC_WEBSOCKET_KEY})
			: ()
		),
		($env->{HTTP_SEC_WEBSOCKET_KEY1}
			? (sec_websocket_key1 => $env->{HTTP_SEC_WEBSOCKET_KEY1})
			: (sec_websocket_key2 => $env->{HTTP_SEC_WEBSOCKET_KEY2})
		),
		subprotocol => 'chat',
    	};
	if (exists $env->{HTTP_SEC_WEBSOCKET_VERSION}) {
		$fields->{'sec_websocket_version'} = $env->{HTTP_SEC_WEBSOCKET_VERSION};
		if ($env->{HTTP_SEC_WEBSOCKET_VERSION} eq '13') {
            		$self->version = 'draft-ietf-hybi-17';
        	}
       		else {
            		$self->version = 'draft-ietf-hybi-10';
        	}
    	}
	$self->resource_name = "$env->{SCRIPT_NAME}$env->{PATH_INFO}"
		  . ($env->{QUERY_STRING} ? "?$env->{QUERY_STRING}" : "");
	$self->psgix = $env->{'psgix.io'}; 
	if ($env->{HTTP_X_FORWARDED_PROTO} && $env->{HTTP_X_FORWARDED_PROTO} eq 'https') {
		$self->secure(1);
	}
	unless ($self->parse($_[0])) {
		$self->error($req->error);
		return;
	}
	return $self;
}

sub headers {
	my ($self) = @_;
	my $version = $self->version || 'draft-ietf-hybi-10';
	my @headers = ();
	push @headers, Upgrade => 'WebSocket';
	push @headers, Connection => 'Upgrade';
	if ($version eq 'draft-hixie-75' || $version eq 'draft-ietf-hybi-00') {
        	return 'invalid_host' unless defined $self->options->host;
		my $location = 'ws';
    		$location .= 's' if $self->options->secure;
    		$location .= '://';
    		$location .= $self->options->host;
    		$location .= ':' . $self->options->port if defined $self->options->port;
    		$location .= $self->resource_name || '/';
        	my $origin = $self->options->origin ? $self->options->origin : 'http://' . $self->options->host;
        	$origin =~ s{^http:}{https:} if !$self->options->origin && $self->options->secure;
		if ($version eq 'draft-hixie-75') {
            		push @headers, 'WebSocket-Protocol' => $self->subprotocol
              			if defined $self->options->subprotocol;
            		push @headers, 'WebSocket-Origin'   => $origin;
           	 	push @headers, 'WebSocket-Location' => $location;
        	}
        	elsif ($version eq 'draft-ietf-hybi-00') {
            		push @headers, 'Sec-WebSocket-Protocol' => $self->options->subprotocol
              			if defined $self->options->subprotocol;
            		push @headers, 'Sec-WebSocket-Origin'   => $origin;
            		push @headers, 'Sec-WebSocket-Location' => $location;
        	}
    	}
	elsif ($version eq 'draft-ietf-hybi-10' || $version eq 'draft-ietf-hybi-17') {
        	return 'invalid_required_key' unless defined $self->options->key;
        	my $key = $self->options->key;
        	$key .= $self->options->secret;
        	$key = Digest::SHA::sha1($key);
        	$key = MIME::Base64::encode_base64($key);
        	$key =~ s{\s+}{}g;
        	push @headers, 'Sec-WebSocket-Accept' => $key;
        	push @headers, 'Sec-WebSocket-Protocol' => $self->options->subprotocol
          		if defined $self->options->subprotocol;
    	}
    	else {
		return 'invalid_version';
    	}
	return @headers;
}

sub send {
	my ($self, $message) = @_;
	my $pg = $self->psgix;	
	my $mask = $self->mask ||= 0;
	my (@DECODED) = map { ord($_) } split //, $message;
	my (@ENCODED, @MASK);
	my $length = scalar @DECODED + 128;
	if ($length > 256 || $mask) {
		@MASK = map { int(rand(256)) } 0 .. 3;
		my $i;
		for (@DECODED) {
			push @ENCODED, $_ ^ $MASK[$i++ % 4];
		}
		unshift @ENCODED, @MASK;
		if ($length > 256) {
			my $times = int($length / 256) - 1;
			my $excess = $length - (($times * 256) + 128);
			unshift @ENCODED, $excess;
			unshift @ENCODED, $times;
			unshift @ENCODED, 254;
		} else {
			unshift @ENCODED, $length;
		}
	} else {
		@ENCODED = @DECODED;
		unshift @ENCODED, $length - 128;
	}
	syswrite $pg, join("", map {chr($_)} (129,  @ENCODED));
	return;
}

sub recieve {
	my ($self) = @_;
	my $pg = $self->psgix;
	my $content = "";
	my $len = sysread($pg, $content, 8192);
	return unless $len;
	$len = sysread($pg, $content, 8192, length($content)) while $len >= 8192;
	my $hdr = substr($content, 0, 1);
	my @bits = split //, unpack("B*", $hdr);
        $self->fin($bits[0]);
        $self->rsv([@bits[1 .. 3]]);
	$content = substr($content, 1, length($content));
	my @ENCODED = map { unpack "C", $_ } split //, $content;
	my $length;
	if (scalar @ENCODED > 126) {
		my @length = splice @ENCODED, 0, 3;
		$length = ((($length[0] + 2) * $length[1]) + $length[2]);
	} else {
		$length = shift @ENCODED;
		$length -= 128;
	}
	my @MASK = splice @ENCODED, 0, 4;
	return 'invalid_length' if (scalar @ENCODED != $length);
	my (@DECODED, $i);
	for (@ENCODED) {
		push @DECODED, $_ ^ $MASK[$i++ % 4];
	}
	$content = join "", map { chr($_) } @DECODED;
	return $content;
}

__DONE__;

1;

=head1 NAME

Terse::WebSocket - Lightweight WebSockets

=head1 VERSION

Version 0.114

=cut

=head1 SYNOPSIS

	package Chat;

	use base 'Terse';

	sub auth {
		my ($self, $t, $session) = @_;
		return 0 if $t->params->not;
		return $session;
	}

	sub chat {
		my ($self, $t) = @_;
		$self->webchat->{$t->sid->value} = $t->websocket(
			connect => {
				my ($websocket) = @_;
				$websocket->send('Hello');
			},
			recieve => {
				my ($websocket, $message) = @_;

				$websocket->send($message); # echo
			},
			error => { ... },
			disconnect => { ... }
		);
	}

	1;

	PERL5LIB=lib:./t/lib plackup -s Starman t/lib/Chat.psgi

	CONNECT ws://localhost:5000?req=chat;


=head1 AUTHOR

LNATION, C<< <email at lnation.org> >>

=head1 LICENSE AND COPYRIGHT

L<Terse>.

=cut
