Форум программистов [Powered by Invision Power Board]

Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате

Форум программистов > Perl: разработка для Web > Проблемы с сокетами

Автор: Black Rabbit 3.11.2006, 03:34

Здравствуйте. Хочу написать аналог http://www.l0rdphi1.com/tools/httpsocket/httpsocket.phps на перле.

Вот начало кода

Код


package LIB::DAdminAPI;
#use strict;
use Socket();
use IO::Socket();
use IO::Select();
require MIME::Base64;

sub new{
 my($class) = @_;
 my $class = shift;
 my $self = {
     Errors  => []
  }; 
   
 while(scalar(@_)) {
        $self->{lc($_[0])} = $_[1]; shift, shift;
    } 
    
 bless($self, $class); 
 return $self;
}

sub connect{
 my $self = shift;
  $sock = IO::Socket::INET->new(
         PeerAddr => $self->{server},
         PeerPort => $self->{port}||'2222',
         Proto    => 'tcp',
         Listen    => 5,
         Reuse     => 1,
         Timeout  => $self->{timeout}||20,
         Debug      => $self->{debug}        
     );    
 
  unless ( defined($sock) ) {
      $self->_fixError( "Unable to connect to $self->{server}: $!\n");    
      return undef;
    } 
  $sock->autoflush(1);
    
 print "Content-Type: text/html\n\n";
while ($new_sock = $sock->accept()) {
    while (defined ($buf = <$new_sock>)) {
       print $buf;
    }
}
close ($sock);
}

sub _fixError{
  my $self = shift;
  push @{$self->{Errors}},@_[0];
}


1;

Код


my $conn = new LIB::DAdminAPI(server => 'hostname');
$conn->connect();
print $conn->{Errors}[0]; 
print $!;

На выходе в $! получаю ошибку Bad file descriptor + скрипт надолго подвисает.
Что я делаю не так??? smile

Автор: Black Rabbit 4.11.2006, 15:37

Уфф... вроде разобралась

Код


sub connect{
  my $self = shift;
 
  $sock = IO::Socket::INET->new(
         PeerAddr => $self->{server},
         PeerPort => $self->{port}||'2222',
         Proto    => 'tcp',
         Timeout  => $self->{timeout}||15    
     );    
  unless ( defined($sock) ) {
      $self->_fixError( "Unable to connect to $self->{server}: $!\n");    
      return undef;
    } 

    $sock->autoflush(1);
    while($buf=$sock->getline()){
       print $buf;
     }
}

Вот так работает, но ошибка Bad file descriptor все равно появляется при вызове $sock->close smile