File Coverage

blib/lib/Web/Detect.pm

Criterion	Covered	Total	%
statement	44	61	72.1
branch	29	56	51.7
condition	10	21	47.6
subroutine	6	6	100.0
pod	2	2	100.0
total	91	146	62.3

package Web::Detect;

use strict;
use warnings;

our $VERSION = '0.04'; # VERSION

sub import {
    if ( @_ > 1 ) {
        no strict 'refs';
        if ( grep /^detect_web$/, @_ ) {
            *{ caller() . '::detect_web' } = \&detect_web;
        }

        if ( grep /^detect_web_fast$/, @_ ) {
            *{ caller() . '::detect_web_fast' } = \&detect_web_fast;
        }
    }
}

sub detect_web {
    my ($first) = @_;
    my %res;

    if ( $ENV{MOD_PERL} ) {    # verified on mod_perl 1.3 and mod_perl 2.0
        $res{mod_perl} = 1;
        return \%res if $first;
    }

    if ( $ENV{PLACK_ENV} ) {
        $res{plack} = 1;
        $res{psgi}  = 1;
        return \%res if $first;
    }

    if ( $ENV{'PANGEA'} ) {
        $res{'pangea'} = 1;
        $res{'psgi'}   = 1;
        return \%res if $first;
    }

    if ( $ENV{'CPANEL'} || $ENV{'WHM50'} ) {
        $res{'cpanel'} = 1;
        return \%res if $first;
    }

    if ( $ENV{'CATALYST_SCRIPT_GEN'} ) {
        $res{'catalyst'} = 1;
        return \%res if $first;
    }

    if ( $ENV{'DANCER_APPDIR'} ) {
        $res{'dancer'} = 1;
        return \%res if $first;
    }

    if ( $ENV{'MOJO_EXE'} ) {
        $res{'mojo'} = 1;
        return \%res if $first;
    }

    if ( $ENV{'FCGI_ROLE'} ) {
        $res{'FCGI.pm'} = 1;
        return \%res if $first;
    }

    if ( $ENV{'INSTANCE_ID'} ) {
        $res{'IIS'} = 1;
        return \%res if $first;
    }

    # now, do more generic checks after specific server checks:
    if ( defined $ENV{GATEWAY_INTERFACE} && $ENV{GATEWAY_INTERFACE} =~ m/^CGI/ ) {
        $res{cgi} = 1;
        return \%res if $first;
    }

    # General server vars:
    if ( $ENV{'SCRIPT_NAME'} || $ENV{'SCRIPT_FILENAME'} || $ENV{'REMOTE_ADDR'} || $ENV{'HTTPS'} || $ENV{'QUERY_STRING'} || $ENV{'DOCUMENT_ROOT'} ) {
        $res{'general'} = 1;
        return \%res if $first;
    }

    # still nothing? yikes ...
    for my $k ( keys %ENV ) {
        if ( $k =~ m/^(?:HTTP|SERVER|REQUEST)_/ ) {
            $res{'general'} += 2;
            return \%res if $first;
        }
    }

    # the way scripts are run in some web servers they are still technically
    # "interactive", so interactivity is only reliable for this if it is false
    # (IO::Interactive::Tiny)
    #
    # ditto +/- for term detection (Term::Detect)

    return unless %res;
    return \%res;
}

sub detect_web_fast {
    @_ = (1);
    goto &detect_web;
}

1;

#ABSTRACT: Detect if program is running under some web environment

__END__