Newsgroup: it.comp.lang.perl
Titolo: Parsing delle richieste del browser al server

Salve,
la domanda è molto semplice.
Ho bisogno di una libreria che prenda come argomento, una richiesta inviata
da un browser al server e ne tragga le relative variabili.
Ho provato a cercare le librerie HTTP ma non ho trovato molto.
L'unica che mi poteva aiutare un po' era http::Message però è un po'
limitata.
grazie in anticipo!

 
forse troppo semplice .. quindi posto la mia semplice risposta:
recv($client, $request, 10000, 0);
($get,%header) = &GET_REQUEST( $request );
sub GET_REQUEST {
   my $request = shift;
   my @header = split("\n",$request);
   my $header_num = (scalar(@header) - 1);
   my (%header,$header,$key,$value);
 
   my $get = $header[0];
   chomp($get);
 
   for my $num (1 .. $header_num)
   {
      next if ($header[$num] !~ m/:/);
      $header = $header[$num];
      chomp($header);
      ($key,$value) = split(": ",$header,2);
      $key =~ s/\r//;
      $header{$key} = $value;
   }
   return ($get,%header);
}
credo cmq di non aver capito bene la domanda.

 Ho provato a cercare le librerie HTTP ma non ho trovato molto.
Ecco un esempio generico che estrae la query da una URI e poi 
estrae i valori delle singole variabili della query. Ti rimando
alla documentazione di CGI per sapere come gestire i casi 
particolari:
 
   ---------
    use strict;
    use warnings;
    use URI;
    use CGI;
    my $request = '
http://www.google.it/search
'
                . '?hl=it&q=richiesta+http&btnG=Cerca+con+Google&meta=';
    my $uri = URI->new( $request );
    my $query_string = $uri->query( $query );
    my $query = new CGI( $query_string );
    foreach my $p ($query->param()) {
        my $value = $query->param( $p );
        print "$p -> $value\n";
    }
   ---------
ciao,
S.
-- 
Stefano Rodighiero      |  
http://larsen.perlmonk.org
mailto:
lar...@perl.it
   |  
http://www.perl.it

 credo cmq di non aver capito bene la domanda.
Lo sapevo che non avevo capito!

Grazie, ho risolto cosě :-) :
Copiando un po' di sano codice da HTTP::Deamon
sub RecData {
my ($this, $name, $data)=@_;
return -1 unless exists $this->{Session}->{$name};
$this->{Session}->{$name}->{RecData}.=$data;
#print "ricevuto $data\n";
unless (exists $this->{Session}->{$name}->{Env}) {
$this->GotHeader($name) || return undef;
$this->HeaderReq($name) || return undef;
}
unless ($this->{Session}->{$name}->{OverData}) {
$this->OverData($name) || return undef;
$this->{Session}->{$name}->{OverData}=1;
}
#print "ha inviato i dati ".$this->{Session}->{$name}->{RecData}."\n";
#print "post data ".$this->{Session}->{$name}->{PostData}."\n";
#$this->send_error($name,400);
$this->SendReply($name);
}
sub OverData {
my ($this, $name)=@_;
# Find out how much content to read
my $te = $this->GetHeader($name,'Transfer-Encoding');
my $ct = $this->GetHeader($name,'Content-Type');
my $len = $this->GetHeader($name,'Content-Length');
if ($te) {
$this->send_error($name,501); # Unknown transfer encoding
print "non conosco il trasfer encoding\n";
return undef;
} elsif ($ct && lc($ct) =~ m/^multipart\/\w+\s*;.*boundary\s*=\s*(\w+)/) {
# Handle multipart content type
my $boundary = "$CRLF--$1--$CRLF";
my $index;
while (1) {
$index = index($this->{Session}->{$name}->{RecData}, $boundary);
last if $index >= 0;
# end marker not yet found
return undef;
}
$index += length($boundary);
$this->{Session}->{$name}->{PostData}=substr($this->{Session}->{$name}->{Rec
Data}, 0, $index);
substr($this->{Session}->{$name}->{RecData}, 0, $index) = '';
} elsif ($len) {
# Plain body specified by "Content-Length"
my $missing = $len - length($this->{Session}->{$name}->{RecData});
return undef if $missing>0;
if (length($this->{Session}->{$name}->{RecData}) > $len) {
$this->{Session}->{$name}->{PostData}=substr($this->{Session}->{$name}->{Rec
Data},0,$len);
substr($this->{Session}->{$name}->{RecData}, 0, $len) = '';
} else {
$this->{Session}->{$name}->{PostData}=$this->{Session}->{$name}->{RecData};
$this->{Session}->{$name}->{RecData}='';
}
}
return 1;
}
sub HeaderReq {
my ($this, $name)=@_;
if ($this->{Session}->{$name}->{RecData} !~ s/^(\S+)[ \t]+(\S+)(?:[
\t]+(HTTP\/\d+\.\d+))?[^\012]*\012//) {
$this->send_error($name,400); # BAD_REQUEST
return undef;
}
my $method = $1;
my $uri = $2;
my $proto = $3 || "HTTP/0.9";
if ($method ne "GET" && $method ne "POST") {
$this->send_error($name,400);
return undef;
}
$this->{Session}->{$name}->{Env}={};
$this->{Session}->{$name}->{Env}->{REQUEST_METHOD}=$method;
$this->{Session}->{$name}->{Env}->{REQUEST_URL}=$uri;
$this->{Session}->{$name}->{Env}->{SERVER_PROTOCOL}=$proto;
print "m:$method u:$uri p:$proto\n";
my($key, $val);
while ($this->{Session}->{$name}->{RecData} =~ s/^([^\012]*)\012//) {
$_ = $1;
s/\015$//;
if (/^([^:\s]+)\s*:\s*(.*)/) {
$this->push_header($name,$key, $val) if $key;
($key, $val) = ($1, $2);
} elsif (/^\s+(.*)/) {
$val .= " $1";
} else {
last;
}
}
$this->push_header($name,$key, $val) if $key && $val;
return 1;
}
sub push_header {
my ($this, $name, $key, $value)=@_;
return undef unless exists %{$this->{Session}}->{$name};
$key=~ tr/[a-z]/[A-Z]/;
$key=~ s/\-/_/;
return undef if $key eq "REQUEST_METHOD" || $key eq "REQUEST_URL" || $key eq
"SERVER_PROTOCOL";
#print "$key => $value\n";
$this->{Session}->{$name}->{Env}->{$key}.=$value;
}
sub GetHeader {
my ($this, $name, $key)=@_;
$key=~ tr/[a-z]/[A-Z]/;
$key=~ s/\-/_/;
return $this->{Session}->{$name}->{Env}->{"$key"} if exists
$this->{Session}->{$name}->{Env}->{"$key"};
return undef;
}
sub GotHeader {
my ($this, $name)=@_;
# HTTP::Daemon code :)
# loop until we have the whole header in $buf
$this->{Session}->{$name}->{RecData} =~ s/^(?:\015?\012)+//; # ignore
leading blank lines \012=\n
if ($this->{Session}->{$name}->{RecData} =~ /\012/) { # potential, has at
least one line
if ($this->{Session}->{$name}->{RecData} =~
/^\w+[^\012]+HTTP\/\d+\.\d+\015?\012/) {
if ($this->{Session}->{$name}->{RecData} =~ /\015?\012\015?\012/) {
return 1; # we have it
} elsif (length($this->{Session}->{$name}->{RecData}) > 16*1024) {
$this->send_error($name,413); # REQUEST_ENTITY_TOO_LARGE
return undef;
}
} else {
return 1; # HTTP/0.9 client
}
} elsif (length($this->{Session}->{$name}->{RecData}) > 16*1024) {
$this->send_error($name,414); # REQUEST_URI_TOO_LARGE
return undef;
}
return undef;
}