src/Modules/HTTPDtype.pl

   1 # HTTPDtype.pl: retrieves http server headers
   2 #       Author: Joey Smith <joey@php.net>
   3 #    Licensing: Artistic License
   4 #      Version: v0.1 (20031110)
   5 #
   6 use strict;
   7
   8 package HTTPDtype;
   9
  10 sub HTTPDtype {
  11     my ($HOST) = @_;
  12     my($line) = '';
  13     my($code, $mess, %h);
  14
  15     $HOST = 'joeysmith.com' unless length($HOST) > 0;
  16     return unless &::loadPerlModule("Net::HTTP::NB");
  17     return unless &::loadPerlModule("IO::Select");
  18
  19         my $s = Net::HTTP::NB->new(Host => $HOST) || return;
  20         $s->write_request(HEAD => "/");
  21
  22         my $sel = IO::Select->new($s);
  23         $line = "Header timeout" unless $sel->can_read(10);
  24         ($code, $mess, %h) = $s->read_response_headers;
  25
  26         $line = (length($h{Server}) > 0) ? $h{Server} :
  27           "Couldn't fetch headers from $HOST";
  28
  29     &::pSReply($line||"Unknown Error Condition");
  30
  31 }
  32
  33 1;