view release on metacpan or  search on metacpan

lib/Browsermob/Server.pm  view on Meta::CPAN

);

has _pid => (
    is => 'rw',
    init_arg => undef,
    default => sub { '' }
);

has ua => (
    is => 'rw',
    lazy => 1,
    default => sub {
        return LWP::UserAgent->new;
    }
);


sub start {
    my $self = shift;
    die '"' . $self->path . '" is an invalid path' unless -f $self->path;

    defined ($self->_pid(fork)) or die "Error starting server: $!";
    if ($self->_pid) {
        # The parent knows about the child pid
        die "Error starting server: $!" unless $self->_is_listening;
    }
    else {
        # If I don't know the pid, then I'm the child and we should
        # exec to replace ourselves with the proxy
        my $cmd = 'sh ' . $self->path . ' -port ' . $self->server_port . ' 2>&1 > /dev/null';
        exec($cmd);
    }
}


sub stop {
    my $self = shift;
    kill('SIGKILL', $self->_pid) and waitpid($self->_pid, 0);
}


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

    my $proxy = Browsermob::Proxy->new(
        server_addr => $self->server_addr,
        server_port => $self->server_port,
        %args
    );

    return $proxy;
}


sub get_proxies {
    my $self = shift;
    my $ua = $self->ua;

    my $res = $ua->get('http://' . $self->server_addr . ':' . $self->server_port . '/proxy');
    if ($res->is_success) {
        my $list = from_json($res->decoded_content)->{proxyList};

        my @proxies = map {
            $_->{port};
        } @$list;

        return \@proxies;
    }

}


sub find_open_port {
    my ($self, @range) = @_;
    my $proxies = $self->get_proxies;

    my $count;
    foreach (@range, @$proxies) {
        $count->{$_}++;
    }

    foreach (sort @range) {
        if ($count->{$_} == 1) {
            return $_;
        }
    }
}


sub _is_listening {
    my ($self, $timeout) = @_;
    $timeout //= 30;

    my $sock = IO::Socket::INET->new(
        PeerAddr => $self->server_addr,
        PeerPort => $self->server_port,
        Timeout => $timeout
    );

    return $sock;
}

1;

__END__

=pod

=encoding UTF-8

=head1 NAME

Browsermob::Server - Perl client to control the Browsermob Proxy server

=head1 VERSION

version 0.17

=head1 SYNOPSIS

    my $server = Browsermob::Server->new(