CGI-Info

 view release on metacpan or  search on metacpan

README.md  view on Meta::CPAN

    {
      cookie_name => {
        'type' => 'string',
        'min' => 1,
        'matches' => qr/^[!#-'*+\-.\^_`|~0-9A-Za-z]+$/    # RFC6265
      }
    }

#### OUTPUT

Cookie not set: `undef`

Cookie set:

    {
      type => 'string',
      optional => 1,
      matches => qr/      # RFC6265
        ^
        (?:
          "[\x21\x23-\x2B\x2D-\x3A\x3C-\x5B\x5D-\x7E]*"   # quoted
        | [\x21\x23-\x2B\x2D-\x3A\x3C-\x5B\x5D-\x7E]*     # unquoted
        )

bin/info.pl  view on Meta::CPAN

if($info->params()) {
	my %FORM = %{$info->params()};
	foreach (keys(%FORM)) {
		print "$_ => $FORM{$_}\n";
	}
}

if($ENV{'HTTP_COOKIE'}) {
	print 'HTTP_COOKIE: ', $ENV{'HTTP_COOKIE'}, "\n",
		"Cookies:\n";

	foreach my $cookie(split (/; /, $ENV{'HTTP_COOKIE'})) {
		my ($key, $value) = split(/=/, $cookie);

		print "Cookie $key:\n";
		my $c = $info->get_cookie(cookie_name => $key);
		if(!defined($c)) {
			print "ERROR: Expected $value, got undef\n";
		} elsif($c eq $value) {
			print "$c\n";
		} else {
			print "ERROR: Expected $value, got $c\n";
		}
	}
}

lib/CGI/Info.pm  view on Meta::CPAN

  {
    cookie_name => {
      'type' => 'string',
      'min' => 1,
      'matches' => qr/^[!#-'*+\-.\^_`|~0-9A-Za-z]+$/	# RFC6265
    }
  }

=head4 OUTPUT

Cookie not set: C<undef>

Cookie set:

  {
    type => 'string',
    optional => 1,
    matches => qr/	# RFC6265
      ^
      (?:
        "[\x21\x23-\x2B\x2D-\x3A\x3C-\x5B\x5D-\x7E]*"   # quoted
      | [\x21\x23-\x2B\x2D-\x3A\x3C-\x5B\x5D-\x7E]*     # unquoted
      )

lib/CGI/Info.pm  view on Meta::CPAN

	my $field = $params->{'cookie_name'};

	# Validate field argument
	if(!defined($field)) {
		$self->_error('what cookie do you want?');
		Carp::croak('what cookie do you want?');
		return;
	}
	if(ref($field)) {
		$self->_error('Cookie name should be a string');
		Carp::croak('Cookie name should be a string');
		return;
	}

	# Load cookies if not already loaded
	unless($self->{jar}) {
		if(defined $ENV{'HTTP_COOKIE'}) {
			# grep { /=/ } filters out malformed tokens (empty strings, bare
			# semicolons, entries with no name=value separator) that would
			# otherwise cause split(/=/, $_, 2) to return a single-element list
			# and make the flattened list odd-length, corrupting the hash.

t/cookies.t  view on Meta::CPAN

		$i->get_cookie();
	};
	ok($@ =~ /^Usage: /);

	$ENV{'HTTP_COOKIE'} = 'phpbb3_ljj67_k=3dba1f0d50e51f76; style_cookie=printonly; __utma=249501332.293603655.1368565227.1380805951.1380808408.13; __utmz=249501332.1368565227.1.1.utmccn=(direct)|utmcsr=(direct)|utmcmd=(none); phpbb3_ljj67_u=2; phpbb3_l...
	$i = new_ok('CGI::Info');
	ok($i->get_cookie(cookie_name => 'cart') eq 'tubabb:1');
	ok($i->cookie('cart') eq 'tubabb:1');
}

# Cookie not set, should warn about missing field
{
	local $ENV{'HTTP_COOKIE'} = 'user=JohnDoe; session=abc123';  # Example cookie
	my $obj = new_ok('CGI::Info');

	# Check for missing field
	diag('Ignore message about what cookie would you like');
	throws_ok { $obj->cookie() } qr/^Usage/ , 'undef if no cookie field is provided';
	cmp_ok($obj->cookie('user'), 'eq', 'JohnDoe');
}

# Cookie jar is populated correctly with valid cookies
{
	local $ENV{'HTTP_COOKIE'} = 'user=JohnDoe; session=abc123';  # Example cookie
	my $obj = new_ok('CGI::Info');

	# Test retrieving cookies from jar
	is($obj->cookie('user'), 'JohnDoe', 'Correctly retrieves "user" cookie');
	is($obj->cookie('session'), 'abc123', 'Correctly retrieves "session" cookie');
}

# Cookie field not found in the jar
{
	local $ENV{'HTTP_COOKIE'} = 'user=JohnDoe; session=abc123';  # Example cookie
	my $obj = new_ok('CGI::Info');

	# Test non-existent cookie field
	is($obj->cookie('nonexistent'), undef, 'Returns undef for non-existent cookie');
}

# Cookie field provided but no cookies in the header (edge case)
{
	local $ENV{'HTTP_COOKIE'} = '';  # No cookies set
	my $obj = new_ok('CGI::Info');

	# Test with no cookies available
	is($obj->cookie('user'), undef, 'Returns undef when no cookies are available');
}

# Ensure loading of the cookie jar
{

t/edge_cases.t  view on Meta::CPAN

    reset_env();
    $ENV{SCRIPT_FILENAME} = '/var/www/cgi-bin/app.cgi';

    my $info = CGI::Info->new();
    my $d1   = $info->script_dir();
    my $d2   = $info->script_dir();
    is($d1, $d2, 'script_dir() idempotent across multiple calls');
};

# ============================================================
# 9. Cookie edge cases
# ============================================================

subtest 'cookie: name with all valid RFC6265 token chars' => sub {
    reset_env();
    # RFC6265 token chars: visible ASCII except separators
    $ENV{HTTP_COOKIE} = 'valid-name.ok=value123';

    my $info = CGI::Info->new();
    my $val  = eval { $info->cookie('valid-name.ok') };
    ok(!$@, 'does not die on RFC6265-valid cookie name with dots and hyphens');

t/integration.t  view on Meta::CPAN

    my $info = CGI::Info->new();

    my $params = $info->params();
    is($params->{page}, '2',    'page param parsed');
    is($params->{sort}, 'date', 'sort param parsed');

    is($info->cookie('session'), 'abc123', 'session cookie read');
    is($info->cookie('theme'),   'dark',   'theme cookie read');

    # Cookie lookup doesn't disturb params
    is($info->param('page'), '2',    'param still intact after cookie lookup');
    is($info->param('sort'), 'date', 'sort param still intact');
};

subtest 'cookie: repeated lookups return same value (stateful jar)' => sub {
    reset_env();
    $ENV{HTTP_COOKIE} = 'user=nigel; prefs=verbose';

    my $info = CGI::Info->new();
    my $first  = $info->cookie('user');

t/integration.t  view on Meta::CPAN

    # Form params
    my $p = $info->params();
    ok(defined $p, 'params returned');
    is($p->{action},   'save', 'action param correct');
    is($p->{category}, 'tech', 'category param correct');

    # Individual param access
    is($info->param('action'), 'save', 'param(action) correct');

    # Cookie access
    is($info->cookie('sessionid'), 's3cr3t', 'session cookie read');
    is($info->cookie('csrf'),      'tok3n',  'csrf cookie read');

    # as_string for cache key
    my $key = $info->as_string();
    like($key, qr/action=save/, 'as_string usable as cache key');

    # Clean status throughout
    is($info->status(), 200, 'status 200 for authenticated form submission');
};