view release on metacpan or  search on metacpan

lib/CPAN/Mirrors.pm  view on Meta::CPAN

                push @$output, CPAN::Mirrored::By->new($current);
            }
        }
    }
    if ( $mirror ) {
        push @$output, CPAN::Mirrored::By->new($mirror);
    }

    return;
}

#--------------------------------------------------------------------------#

package CPAN::Mirrored::By;
use strict;
use Net::Ping   ();

sub new {
    my($self,$arg) = @_;
    $arg ||= {};
    bless $arg, $self;
}
sub hostname  { shift->{hostname}    }
sub continent { shift->{continent}   }
sub country   { shift->{country}     }
sub http      { shift->{http}  || '' }
sub ftp       { shift->{ftp}   || '' }
sub rsync     { shift->{rsync} || '' }
sub rtt       { shift->{rtt}         }
sub ping_time { shift->{ping_time}   }

sub url {
    my $self = shift;
    return $self->{http} || $self->{ftp};
}

sub ping {
    my($self, %args) = @_;

    my $external_ping = $args{external_ping};
    if ($external_ping) {
        eval { require Net::Ping::External }
            or die "Net::Ping::External required to use external ping command";
    }
    my $ping = Net::Ping->new(
        $external_ping ? 'external' : $^O eq 'VMS' ? 'icmp' : 'tcp',
        1
    );
    my ($proto) = $self->url =~ m{^([^:]+)};
    my $port = $proto eq 'http' ? 80 : 21;
    return unless $port;

    if ( $ping->can('port_number') ) {
        $ping->port_number($port);
    }
    else {
        $ping->{'port_num'} = $port;
    }

    $ping->hires(1) if $ping->can('hires');
    my ($alive,$rtt) = eval { $ping->ping($self->hostname); };
    my $verbose = $args{verbose};
    if ($verbose && !$alive) {
        printf "(host %s not alive)", $self->hostname;
    }

    $self->{rtt} = $alive ? $rtt : undef;
    $self->{ping_time} = time;

    $self->rtt;
}


1;

=back

=head1 AUTHOR

Andreas Koenig C<< <andk@cpan.org> >>, David Golden C<< <dagolden@cpan.org> >>,
brian d foy C<< <bdfoy@cpan.org> >>

=head1 LICENSE

This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.

See L<http://www.perl.com/perl/misc/Artistic.html>

=cut