?? httpp.pm
字號:
package PunJab::Server::HTTPP;use strict;use warnings;use POE;use POE::Filter::XML;use POE::Filter::XML::Node;use POE::Filter::XML::NS qw/ :JABBER :IQ /;use POE::Filter::XML::Utils;use POE::Filter::Stream;use HTTP::Status;use HTTP::Request;use HTTP::Response;use PunJab::Util;use PunJab::Session;use PunJab::Server::HTTP;use PunJab::Filter::HTTPB;use POSIX qw(strftime);use Digest::SHA1;use Digest::MD5 qw(md5 md5_hex md5_base64);use Data::Uniqid qw ( suniqid uniqid luniqid );use URI::QueryParam;my $httpb_session;sub new { shift; my $config = shift; my $session = shift; my $input = shift; my $output = shift; $output = 'output' if not defined $output; $input = 'input' if not defined $input; $httpb_session = $session; PunJab::Server::HTTP->new($config,\&handler,\&streamer,\&p_error,'http_poll_server'); POE::Session->create ( inline_states => { _start => sub { my ($kernel,$heap) = @_[KERNEL, HEAP]; $heap->{'callback_session'} = $session; $heap->{'input'} = $input; $heap->{'output'} = $output; # this may need to change if ($config->{debug}>0) { &debug("HTTP Polling Server Started\n"); } $kernel->alias_set($session."_server"); }, _stop => sub { $_[KERNEL]->alias_remove($_[HEAP]->{'callback_session'}."_server"); }, input => \&input, output => \&output, }, heap => { CONFIG => $config }, options => { debug => $config->{'debug'}, trace => $config->{'debug'} } ); return undef;}sub output(){ my ($kernel , $heap, $id, $code, $content) = @_[KERNEL, HEAP, ARG0 .. ARG2]; &debug("HTTPB SERVER OUTPUT : \n". $id. "\n".$content); my $response = HTTP::Response->new(); my ($params,$sender); $response->code($code); $response->header("Content-Type", "text/xml"); $response->header("Content-Length", length($content)); $response->content($content); my $pb = $sender->postback( 'send_response', $response); $pb->($response); return;}sub input(){ my ($kernel , $heap, $sender, $request, $remote_ip) = @_[KERNEL, HEAP, ARG0 .. ARG1]; $heap->{'stream_count'} = 0; my $event_id = $heap->{'event_id'}++; $heap->{'events'}->{$event_id}->{'query_string'} = $request->uri->query(); $heap->{'events'}->{$event_id}->{'method'} = $request->method(); $heap->{'events'}->{$event_id}->{'content_type'} = $request->header('Content-Type'); $heap->{'events'}->{$event_id}->{'content_length'} = $request->header('Content-Length'); $heap->{'events'}->{$event_id}->{'debug_request'} = $request->header('DebugRequest'); $heap->{'events'}->{$event_id}->{'request_content'}= $request->content(); $heap->{'events'}->{$event_id}->{'remote_ip'} = $remote_ip; $heap->{'events'}->{$event_id}->{'sender'} = $sender; $kernel->post($heap->{'callback_session'}, $heap->{'input'} ,$request, $event_id); }sub p_error(){ my ($kernel, $heap, $sender, $syscall_name, $error_number, $error_string) = @_[KERNEL, HEAP, SENDER, ARG0 .. ARG2]; my $params; # when client dies we need to kill the stream event &debug($syscall_name); &debug($error_number); &debug($error_string);}sub streamer(){ my ($kernel, $heap, $sender) = @_[KERNEL, HEAP, SENDER]; my $params; }sub handler(){ my ($kernel,$heap,$sender,$request) = @_[KERNEL, HEAP, SENDER, ARG0]; if($request->isa('HTTP::Response')) { _request_failed( $request, 403, "Bad Request", "This was a response?", $sender ); return; } my $response = HTTP::Response->new(); $kernel->post($httpb_session."_server",'input',$sender,$request,$heap->{'remote_ip'}); return;}sub _request_failed() { my ($response, $fault_code, $fault_string, $result_description,$sender) = @_; my $stream = 1; my $response_content = qq{<body type='terminate' condition='internal-server-error' xmlns='http://jabber.org/protocol/httpbind'>$fault_string$result_description</body>}; $response->code($fault_code); $response->header("Content-Type", "text/xml"); $response->header("Content-Length", length($response_content)); $response->content($response_content); my $pb = $sender->postback( 'send_response', $response,$stream); $pb->($response,$stream);}1;__END__?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -