view release on metacpan or  search on metacpan

lib/App/Foca/Client.pm  view on Meta::CPAN

    my @results = ();
    my $pm = new Parallel::ForkManager($self->{'maxflight'});
    $pm->run_on_finish(
            sub {
                my ($pid, $exit_code, $id, $exit, $core, $data) = @_;
                
                my $item;
                if ($data->{'got_response'}) {
                    my $response = $data->{'response'};
                    if ($response->is_success) {
                        my $data = $response->decoded_content;
                        chomp($data);
                        $item = {
                            'hostname'  => $id,
                            'ok'        => 1,
                            'output'    => $data};
                        $options->{'on_good'}->($item) if
                            ref $options->{'on_good'} eq 'CODE';
                    } else {
                        my $msg = $response->decoded_content || $response->status_line;
                        chomp($msg);
                        if ($msg eq "500 Can't connect to $id:12346 (connect: timeout)") {
                            $msg = "Connect timeout";
                        }
                        $item = {
                            'hostname'  => $id,
                            'ok'        => 0,
                            'output'    => $msg};
                        $options->{'on_bad'}->($item) if
                            ref $options->{'on_bad'} eq 'CODE';
                    }
                } else {
                    $item = {
                        'hostname'      => $id,
                        'ok'            => 0,
                        'output'        => $data->{'reason'}};
                }
                push(@results, $item);
                $options->{'on_host'}->($item) if
                    ref $options->{'on_host'} eq 'CODE';
            });

    foreach my $host (@{$hosts}) {
        $pm->start($host) and next;

        my $url = 'http://' . $host . ':' . $self->{'port'} . '/foca/' . $foca_cmd;

        my ($response_body, $response_headers) = ('', '');

        open(my $response_body_fh, ">", \$response_body);
        open(my $response_headers_fh, ">", \$response_headers);

        my @headers = ();
        push(@headers, 'Foca-Cmd-Params:' . $foca_args) if $foca_args;
        
        my $curl = new WWW::Curl::Easy;
        $curl->setopt(CURLOPT_VERBOSE, $self->{'debug'});
        $curl->setopt(CURLOPT_HEADER, 0);
        $curl->setopt(CURLOPT_URL, $url);
        $curl->setopt(CURLOPT_WRITEDATA, $response_body_fh);
        $curl->setopt(CURLOPT_WRITEHEADER, $response_headers_fh);
        $curl->setopt(CURLOPT_TIMEOUT, $self->{'timeout'});
        $curl->setopt(CURLOPT_CONNECTTIMEOUT, $self->{'connect_timeout'});
        $curl->setopt(CURLOPT_HTTPHEADER, \@headers);

        log_debug("$host - Requesting $url");

        my $retcode = $curl->perform;
        my $data    = {};
        if ($retcode == 0) {
             my $full_response = $response_headers;
             $full_response .= $response_body if $response_body;
             my $response = HTTP::Response->parse($full_response);
             $pm->finish(1, {
                     'got_response' => 1,
                     'response'     => $response});
        } else {
            $pm->finish(1, {
                    'got_response'  => 0,
                    'reason'        => $curl->strerror($retcode)});
        }
    }
    $pm->wait_all_children;
    return @results;
}

###################### PRIVATE/PROTECTED METHODS ##########################
sub BUILD {
    my ($self) = @_;

    init_logger();
    use_debug(1) if $self->{'debug'};
    
    $self->port(6666) unless defined $self->{'port'};
}

=head1 COPYRIGHT

Copyright (c) 2010-2012 Yahoo! Inc. All rights reserved.

=head1 LICENSE

This program is free software. You may copy or redistribute it under
the same terms as Perl itself. Please see the LICENSE file included
with this project for the terms of the Artistic License under which 
this project is licensed.

=head1 AUTHORS

Pablo Fischer (pablo@pablo.com.mx)

=cut
1;