File Coverage

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

Criterion	Covered	Total	%
statement	33	35	94.2
branch	15	18	83.3
condition	18	24	75.0
subroutine	7	8	87.5
pod	1	2	50.0
total	74	87	85.0

#

package WWW::Mechanize::Plugin::FollowMetaRedirect;

use strict;
use warnings;
use vars qw($VERSION);
use HTML::TokeParser;

$VERSION = '0.03';

sub init {
    no strict 'refs';    ## no critic
    *{caller() . '::follow_meta_redirect'} = \&follow_meta_redirect;
}

sub follow_meta_redirect {
    my ($mech, %args) = @_;
    my $waiting = ( defined $args{ignore_wait} and $args{ignore_wait} ) ? 0 : 1;

    my $p = HTML::TokeParser->new( \ $mech->content )
	or return;

    while( my $token = $p->get_token ){
	# the line should emerge before
	last if $token->[0] eq 'E' && $token->[1] eq 'head';

	my ($url, $sec) = &_extract( $token );
	next if ! defined $url || $url eq '';

	if( $waiting and defined $sec ){
	    sleep int $sec;
	}

	return $mech->get( $url );
    }

    return;
}

*WWW::Mechanize::follow_meta_redirect = \&follow_meta_redirect;

sub _extract {
    my $token = shift;

    if( $token->[0] eq 'S' and $token->[1] eq 'meta' ){
	if( defined $token->[2] and ref $token->[2] eq 'HASH' ){
	    if( defined $token->[2]->{'http-equiv'} and $token->[2]->{'http-equiv'} =~ /^refresh$/io ){
		if( defined $token->[2]->{'content'} and $token->[2]->{'content'} =~ m|^(([0-9]+)\s*;\s*)*url\='?([^']+)'?$|io ){
		    return ($3, $2);
		}
	    }
	}
    }

    return;
}

1;

__END__