git.maemo.org Git - dh-make-perl/blob - dev/arm/libwww-mechanize-perl/libwww-mechanize-perl-1.34/t/local/referer-server

   1 # Thanks to merlyn for nudging me and giving me this snippet!
   2
   3 use HTTP::Daemon;
   4 use URI::URL;
   5
   6 $|++;
   7
   8 my $d = HTTP::Daemon->new or die;
   9 my $lhurl = URI::URL->new( $d->url );
  10 $lhurl->host( "localhost" );
  11 print $lhurl->as_string, "\n";
  12
  13 $counter = 5;
  14 while ($counter-- and my $c = $d->accept) {
  15     while (my $r = $c->get_request) {
  16         my $ref = $r->headers->referer || "";
  17         $c->send_response(HTTP::Response->new(200, "OK", undef, "Referer: '$ref'"));
  18     }
  19     $c->close;
  20     undef($c);
  21 }