test.curl.pl

#!/usr/bin/env perl

package CurlEasy;
use strict;
use utf8;

use Moo;
use Net::Curl::Easy qw(/^CURLOPT_/);
extends 'AnyEvent::Net::Curl::Queued::Easy';

after init => sub {
    my ($self) = @_;

    $self->setopt( CURLOPT_ENCODING,       '' );
    $self->setopt( CURLOPT_FOLLOWLOCATION, 1 );
    $self->setopt( CURLOPT_USERAGENT,      'Mozilla/4.0 (compatible; MSIE 8.0; Windows NT 5.1; Trident/4.0)' );

    $self->setopt( CURLOPT_BUFFERSIZE, 1024 );
    $self->setopt( CURLOPT_NOPROGRESS, 0 );
    $self->setopt( CURLOPT_PROGRESSFUNCTION,
        sub {
            my ( $self, $total, $now, $uptotal, $upnow ) = @_;
            return 0 unless $now;
            return 1 if $now > 1024;
            return 0;
        }
    );
};

has '_ref' => ( is => 'rw', weak_ref => 1 );

1;

package main;

        my @urls = (
'http://google.com/foo',
'http://google.com/ao',
'http://google.com/foobar',

'http://google.com/xfoo',
'http://google.com/sdsaao',
'http://google.com/foosadasbar',
'http://google.com/fossso',
'http://google.com/asso',
'http://google.com/foobar',

);

use AnyEvent::Net::Curl::Queued;
        my $q = AnyEvent::Net::Curl::Queued->new(
            max     => 5,
            timeout => 10,
        );


        my $url_ok;
        my @easys;
        my %refs;
	my $forbidden_count;
        for my $url (@urls) {
            my $add = CurlEasy->new(
                {
                    initial_url => $url,
                    retry       => 0,
                    on_finish   => sub {
                        my ($self) = @_;

                        my $data = $self->data;

                        if ( !$url_ok && $$data =~ /\xFF\xD8/ ) {

                            $url_ok = [ $self->final_url, $self->_ref ];

                            if ( $q->count ) {
                                while ( my $foo = $q->dequeue() ) {
                                    $foo = $foo->();
                                    delete $refs{$foo};
                                }
                            }

                            # acho que eh aqui que pode dar segment fault as vezes..
                            foreach (@easys) {

                                #eval { $q->multi->remove_handle($_) } if exists $refs{$_};
                            }
                        }
                        else {
                            $forbidden_count++ if $$data =~ /forbidden|denied/i;

                        }

                    }
                }
            );

            $refs{$add}++;
            push @easys, $add;
        }

        foreach my $docoon (@easys) {
            $q->append( sub { $docoon } );
        }
        $q->wait;


        undef %refs;
        undef @easys;