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

Код


#!/usr/bin/perl -w
use warnings;
use strict;

use Data::Dumper;
use HTTP::Request;
use POE qw(Component::Client::HTTP);

our $debug = 'yes';
my $domains = load('domains.txt');

POE::Component::Client::HTTP->spawn(
  Alias   => 'ua',
  MaxSize => 204800,
  Timeout => 60,
  Agent   => 'Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1; .NET CLR 1.1.4322)'
);

for my $domain (keys %$domains) {
  init_session($domain);
}

$poe_kernel->run();

sub init_session {
  my $domain = shift;
  
  POE::Session->create(
    inline_states => {
      _start      => \&_sess_start,
      _stop       => \&_sess_stop,
      fetch_page  => \&_page_fetch,
      recv_page   => \&_page_recv
    },
    heap => {
      domain      => $domain,
    }
  );
}

sub _sess_start {
  my ($kernel, $heap) = @_[KERNEL, HEAP];
  my $domain = $heap->{domain};
  debug("_sess_start: started ($domain)\n");
  $kernel->yield('fetch_page');
}

sub _sess_stop {
  my ($kernel, $heap) = @_[KERNEL, HEAP];
  my $domain = $heap->{domain};
  debug("_sess_stop: stopped ($domain)\n");
}

sub _page_fetch {
  my ($kernel, $heap) = @_[KERNEL, HEAP];
  my $domain = $heap->{domain};
  debug("_page_fetch: create request ($domain)\n");
  my $request = HTTP::Request->new(GET => "http://".$domain."/");
  $kernel->post('ua', 'request', 'recv_page', $request);
}

sub _page_recv {
  my ($kernel, $heap) = @_[KERNEL, HEAP];
  my ($request_packet, $response_packet) = @_[ARG0, ARG1];
  my $domain = $heap->{domain};
  my $request = $request_packet->[0];
  my $response = $response_packet->[0];
  my $code = $response->code;
  debug("_page_recv: $domain = $code\n");
  open(FILE, ">pages/[$code]-$domain.html");
  print FILE $response->content;
  close(FILE);
}

sub debug {
  print @_ if $debug eq 'yes';
}

sub load {
  my $file = shift;
  my %domains = ();
  
  open(FILE, $file) || return undef;
  while (<FILE>) {
    chomp();
    $domains{$_} = 0;
  }
  close(FILE);
  
  return \%domains;
}

Цитата

Error: Internal Server Error
Cannot connect to domain:80 (connect error 10060: Unknown error) This is a client error, not a server error.

Код


#!/usr/bin/perl
use warnings;
use strict;

use HTTP::Request;
use POE qw(Component::Client::HTTP Component::Client::Keepalive);

my %config = (jobs_max  => 100,
              delay     => 10);

my %data = (domains => load('domains.txt'));

our $debug = 'yes';

my $pool = POE::Component::Client::Keepalive->new(
  'keep_alive'    => 300,
  'max_open'      => 1000,
  'max_per_host'  => 10,
  'timeout'       => 20,
);

POE::Component::Client::HTTP->spawn(
  'Alias'             => 'HTTP_CLIENT',
  'MaxSize'           => 300000,
  'Timeout'           => 300,
  'Agent'             => 'Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1; .NET CLR 1.1.4322)',
  'Streaming'         => 0,
  'FollowRedirects'   => 0,
  'ConnectionManager' => $pool
);

POE::Session->create(
  'inline_states' => {
    '_start'    => \&_sess_start,
    '_stop'     => \&_sess_stop,
    'get_jobs'  => \&_get_jobs,
    'job_done'  => \&_job_done,
  },
  'heap' => {
    config  => \%config,
    data    => \%data,
  }
);

POE::Kernel->run;

sub _sess_start {
  my ($kernel, $heap) = @_[KERNEL, HEAP];
  
  debug("_sess_start: STARTED\n");
  $kernel->yield('get_jobs');
}

sub _sess_stop {
  my ($kernel, $heap) = @_[KERNEL, HEAP];
  
  debug("_sess_stop: STOPPED\n");
}

sub _get_jobs {
  my ($kernel, $heap) = @_[KERNEL, HEAP];
  my $config = $heap->{config};
  my $data = $heap->{data};
  
  if (($difference == $config->{jobs_max}) && (scalar(@{$data->{domains}}) == 0)) {
    $kernel->delay('get_jobs', $config->{delay});
  }
  
  my $difference = $config->{jobs_max} - $kernel->call('HTTP_CLIENT' => 'pending_requests_count');
  debug("_get_jobs: DIFFERENCE $difference\n");
  if ($difference <= 0) {
    debug("_get_jobs: RETURN\n");
    return;
  }

  my @jobs = splice(@{$data->{domains}}, 0, $difference);
  
  foreach my $job (@jobs) {
    my $request = HTTP::Request->new(GET => "http://".$job."/");
    $kernel->post('HTTP_CLIENT' => 'request', 'job_done', $request);
  }
  debug("_get_jobs: ADDED ".scalar(@jobs)."\n");
  debug("_get_jobs: REMAINS ".scalar(@{$data->{domains}})."\n");
}

sub _job_done {
  my ($request_packet, $response_packet) = @_[ARG0, ARG1];
  my $request = $request_packet->[0];
  my $response = $response_packet->[0];
  debug("_job_done: ".$response->code."(".$1.")\n") if $response->base =~/^http:\/\/([a-z0-9-\.]+)\//;
  open(FILE, ">pages/[".$response->code."]-$1.html");
  print FILE $response->content;
  close(FILE);
}

sub debug {
  print @_ if $debug eq 'yes';
}

sub load {
  my $file = shift;
  my @domains = ();
  
  open(FILE, $file) || return undef;
  while (<FILE>) {
    chomp();
    push(@domains, $_);
  }
  close(FILE);
  
  return \@domains;
}