File Coverage

blib/lib/WWW/Mechanize/Plugin/Sleepy.pm

Criterion	Covered	Total	%
statement	41	43	95.3
branch	11	14	78.5
condition	1	2	50.0
subroutine	12	13	92.3
pod	1	2	50.0
total	66	74	89.1

package WWW::Mechanize::Plugin::Sleepy;

our $VERSION = '0.003'; # VERSION

# ABSTRACT: A WWW::Mechanize plugin to provide the behaviour of WWW::Mechanize::Sleepy while using WWW::Mechanize::Pluggable

use strict;
use warnings;
use Carp qw/ croak /;


sub import {
    my ( $class, %args ) = @_;
    $WWW::Mechanize::Pluggable::Sleepy = $args{sleep}
        if defined $args{sleep};
}

sub init {
    my ( $class, $pluggable, %args ) = @_;

    no strict 'refs';
    *{ caller() . '::sleep' }  = \&sleep;
    *{ caller() . '::_sleep' } = \&_sleep;

    foreach my $method (
        qw/ get put reload back request follow_link submit submit_form/)
    {

        # return 0; - ensures carries on to rest of parent method
        $pluggable->pre_hook( $method, sub { $_[0]->_sleep(); 0; } );
    }

    my $sleep
        = defined $args{sleep}
        ? $args{sleep}
        : $WWW::Mechanize::Pluggable::Sleepy || 0;

    _set_sleep( $pluggable, $sleep );
}


sub sleep {
    my ( $self, $arg ) = @_;
    _set_sleep( $self, $arg ) if defined $arg;
    return $self->{Sleepy_Time};
}

# sets sleep time and method
sub _set_sleep {
    my ( $self, $arg ) = @_;

    my $method;
    if ( !defined $arg ) {
        $method = sub { };

    } elsif ( my ( $from, $to ) = $arg =~ m/^(\d+)\.\.(\d+)$/ ) {
        croak "sleep range (i1..i2) must have i1 < i2"
            if $1 >= $2;
        $method
            = sub { CORE::sleep( int( rand( ( $to + 1 ) - $from ) ) + $from ) };

    } elsif ( $arg !~ m/\D/ ) {
        $method = sub { CORE::sleep($arg); };

    } else {
        croak "sleep parameter must be an integer or a range i1..i2";
    }

    $self->{Sleepy_Time}   = $arg;
    $self->{Sleepy_Method} = $method;
}

# performs sleep
sub _sleep {
    my ($self) = @_;
    $self->{Sleepy_Method}->();
}


1;

__END__