File Coverage

File:bin/info.pl
Coverage:68.1%

linestmtbrancondsubtimecode
1#!/usr/bin/env perl
2
3
1
1
1
1
1589
1
25
use warnings;
4
1
1
1
1
1
1
7
use strict;
5# use diagnostics;
6
7
1
1
1
1
180
2
32974
use CGI::Info;
8
9
1
29929
my $info = CGI::Info->new();
10
11
1
3
my $tmpdir = $info->tmpdir();
12
1
2
my $script_name = $info->script_name();
13
14
1
2
my $domain = $info->domain_name();
15
1
1
my $host = $info->host_name();
16
1
2
my $is_mobile = $info->is_mobile();
17
1
2
my $is_robot = $info->is_robot();
18
1
3
my $script_dir = $info->script_dir();
19
1
2
my $rootdir = $info->rootdir();
20
1
2
my $is_search_engine = $info->is_search_engine();
21
22
1
2
print 'Status: ', $info->status(), "\n",
23        "Content-type: text/plain\n\n";
24
25
1
4
print "Domain_name: $domain\n",
26        "Host_name: $host\n",
27        "Tmpdir: $tmpdir\n",
28        "Is_mobile: $is_mobile\n",
29        "Is_robot: $is_robot\n",
30        "Is_search_engine: $is_search_engine\n",
31        "Script_dir: $script_dir\n",
32        "Rootdir: $rootdir\n",
33        "Script_name: $script_name\n-----\n";
34
35
1
50
2
if($info->params()) {
36
1
1
77
2
        my %FORM = %{$info->params()};
37
1
1
        foreach (keys(%FORM)) {
38
1
2
                print "$_ => $FORM{$_}\n";
39        }
40}
41
42
1
50
6
if($ENV{'HTTP_COOKIE'}) {
43
0
0
        print 'HTTP_COOKIE: ', $ENV{'HTTP_COOKIE'}, "\n",
44                "Cookies:\n";
45
46
0
0
        foreach my $cookie(split (/; /, $ENV{'HTTP_COOKIE'})) {
47
0
0
                my ($key, $value) = split(/=/, $cookie);
48
49
0
0
                print "Cookie $key:\n";
50
0
0
                my $c = $info->get_cookie(cookie_name => $key);
51
0
0
0
0
                if(!defined($c)) {
52
0
0
                        print "ERROR: Expected $value, got undef\n";
53                } elsif($c eq $value) {
54
0
0
                        print "$c\n";
55                } else {
56
0
0
                        print "ERROR: Expected $value, got $c\n";
57                }
58        }
59}