File Coverage

blib/lib/Plack/Middleware/DetectRobots.pm

Criterion	Covered	Total	%
statement	63	64	98.4
branch	25	28	89.2
condition	14	15	93.3
subroutine	10	10	100.0
pod	2	2	100.0
total	114	119	95.8

package Plack::Middleware::DetectRobots;
{
  $Plack::Middleware::DetectRobots::VERSION = '0.02';
}

# ABSTRACT: Automatically set a flag in the environment if a robot client is detected

use strict;
use warnings;

use parent qw(Plack::Middleware);
use Plack::Util::Accessor qw( env_key basic_check extended_check generic_check local_regexp );
use Regexp::Assemble qw();
use feature 'state';

sub prepare_app {
	my $self = shift;
	$self->basic_check(1) unless defined $self->basic_check;
	return;
}

sub call {
	my ( $self, $env ) = @_;

	state $reList   = _read_list();
	state $basic    = _assemble( $reList, 'basic' );
	state $extended = _assemble( $reList, 'extended' );
	state $generic  = _assemble( $reList, 'generic' );
	$reList = undef;

	my $key = defined( $self->env_key ) ? $self->env_key : 'robot_client';

	my $ua = $env->{'HTTP_USER_AGENT'};

	$env->{$key} = 0;

	my $local = $self->local_regexp;
	if ( defined($local) and ( ref $local eq ref qr// ) and ( $ua =~ $local ) ) {
		$env->{$key} = 'LOCAL';
	}

	if ( !$env->{$key} and $self->basic_check ) {
		if ( $ua =~ $basic ) {
			$env->{$key} = 'BASIC';
		}
	}

	if ( !$env->{$key} and $self->extended_check ) {
		if ( $ua =~ $extended ) {
			$env->{$key} = 'EXTENDED';
		}
	}

	if ( !$env->{$key} and $self->generic_check ) {
		if ( $ua =~ $generic ) {
			$env->{$key} = 'GENERIC';
		}
	}

	return $self->app->($env);
} ## end sub call

sub _assemble {
	my ( $bots, $type ) = @_;

	my $ra = Regexp::Assemble->new( flags => 'i' );
	foreach my $r ( @{ $bots->{$type} } ) {
		$ra->add($r);
	}

	return $ra->re;
}

sub _read_list {
	my $bots = { basic => [], extended => [], generic => [], };
	my $currentType = 'basic';

	state $pos = tell(Plack::Middleware::DetectRobots::DATA);
	if ( $ENV{'HARNESS_ACTIVE'} ) {
		seek( Plack::Middleware::DetectRobots::DATA, $pos, 0 );
	}

	while () {
		chomp;
		next unless $_;
		$currentType = 'extended' if /\A##\s+EXTENDED/;
		$currentType = 'generic'  if /\A##\s+GENERIC/;

		push @{ $bots->{$currentType} }, $_;
	}

	if ( !$ENV{'HARNESS_ACTIVE'} ) {
		close Plack::Middleware::DetectRobots::DATA;
	}

	return $bots;
}

1;

=pod

=encoding utf-8

=head1 NAME

Plack::Middleware::DetectRobots - Automatically set a flag in the environment if a robot client is detected

=head1 VERSION

version 0.02

=head1 SYNOPSIS

  use Plack::Builder;

  my $app = sub { ... } # as usual

  builder {
      enable 'DetectRobots';
	  # or: enable 'DetectRobots', env_key => 'psgix.robot_client';
	  # or: enable 'DetectRobots', extended_check => 1, generic_check => 1;
      $app;
  };

  # ... and later ...

  if ( $env->{'robot_client'} ) {
      # ... do something ...
  }

=head1 DESCRIPTION

This Plack middleware uses the list of robots that is part of the
L software package to
analyse the C HTTP header and to set an environment
flag to either a true or false value depending on the detection
of a robot client.

Once activated it checks the User-Agent HTTP header against a
basic list of patterns for common bots.

If you activate the appropriate options, it can also use an extended
list for the detection of less common bots (cf. C)
and / or a list of quite generic patterns to detect unknown bots
(cf. C).

You may also pass in your own regular expression as a string for
further checks (cf. ).

The checks are executed in this order:

B<1.> Local regular expression

B<2.> Basic check

B<3.> Extended check

B<4.> Generic check

If a check yields a positive result (i.e.: detects a bot) the
remaining checks are skipped.

Depending on the check which detected a bot, the environment flag
is set to one of these values: C, C, C, or
C.

If no bot is detected, the flag is set to C<0>.

The default name of the flag in the environment is C,
but this can be customized by setting the C option when
enabling this middleware.

It might make sense to use C by default instead,
but the PSGI spec states that the "'psgix.' prefix is reserved for
officially blessed extensions" - which does not apply to this module.
You may, however, set the key to C yourself
by using the C option mentioned before.

=head1 WARNING

This software is currently considered BETA and still needs to
be seriously tested!

=head1 ROBOTS LIST

Based on B of
L.

B that list might be somewhat dated, as I did not find bingbot
in the list of common bots (only in the extended list) while it's
predecessor msnbot was considered common.

=head1 CONFIGURATION

You may specify the following option when enabling the middleware:

=over 4

=item C

Set the name of the entry in the environment hash.

=item C

You may deactivate the standard checks by setting this option to
a false value. E.g. if your are only interested in obscure bots
or in your local pattern checks.

By setting this option to a false value while simultaneously
passing a regular expression to C one can imitate
the behaviour of L.

=item C

Determines if an extended list of less often seen robots is also
checked for.
By default, only common robots are checked for, because the extended
check requires a rather large and complex regular expression.
Set this param to a true value to change the default behaviour.

=item C

Determines if the User-Agent string is also analysed to determine
if it contains certain strings that generically identify the
client as a bot, e.g. "spider" or "crawler"
By default, this check is not performed, even though it uses only
a relatively short and simple regex..
Set this param to a true value to change the default behaviour.

=item C

You may optionally pass in your own regular expression (as a Regexp
object using C) to check for additional patterns in the
User-Agent string.

=back

=head1 SEE ALSO

L, L, L,
L

The functionality provided by C is
basically the same as that of this module, but it requires you to
pass in your own regular expression and does not include a default
list of known bots.

=head1 AUTHOR

Heiko Jansen

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2014 by Heiko Jansen.

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

=cut

__DATA__