view release on metacpan or  search on metacpan

lib/Leyland/Negotiator.pm  view on Meta::CPAN

		$prefix .= $suffix;
		$route = $' || '/';
		$i++;
	}

	return $pref_routes;
}

sub _matching_routes {
	my ($class, $app_routes, $pref_routes, $internal) = @_;

	my $routes = [];
	foreach (@$pref_routes) {
		my $pref_name = $_->{prefix} || '_root_';

		next unless $app_routes->EXISTS($pref_name);

		my $pref_routes = $app_routes->FETCH($pref_name);
		
		next unless $pref_routes;
		
		# find matching routes in this prefix
		ROUTE: foreach my $r ($pref_routes->Keys) {
			# does the requested route match the current route?
			next unless my @captures = ($_->{route} =~ m/$r/);
			
			shift @captures if scalar @captures == 1 && $captures[0] eq '1';

			my $route_meths = $pref_routes->FETCH($r);

			# find all routes that support the request method (i.e. GET, POST, etc.)
			METH: foreach my $m (sort { $a eq 'any' || $b eq 'any' } keys %$route_meths) {
				# do not match internal routes
				RULE: foreach my $rule (@{$route_meths->{$m}->{rules}->{is} || []}) {
					next METH if $rule eq 'internal' && !$internal;
				}

				# okay, add this route
				push(@$routes, { method => $m, class => $route_meths->{$m}->{class}, prefix => $_->{prefix}, route => $r, code => $route_meths->{$m}->{code}, rules => $route_meths->{$m}->{rules}, captures => \@captures });
			}
		}
	}

	return $routes;
}

sub _negotiate_method {
	my ($class, $method, $routes) = @_;

	return [grep { $class->method_name($_->{method}) eq $method || $_->{method} eq 'any' } @$routes];
}

sub _negotiate_receive_media {
	my ($class, $c, $all_routes) = @_;

	return $all_routes unless my $ct = $c->content_type;

	# will hold all routes with acceptable receive types
	my $routes = [];

	# remove charset from content-type
	if ($ct =~ m/^([^;]+)/) {
		$ct = $1;
	}

	$c->log->debug("I have received $ct");

	ROUTE: foreach (@$all_routes) {
		# does this route accept all media types?
		unless (exists $_->{rules}->{accepts}) {
			push(@$routes, $_);
			next ROUTE;
		}

		# okay, it has, what are we accepting?
		foreach my $accept (@{$_->{rules}->{accepts}}) {
			if ($accept eq $ct) {
				push(@$routes, $_);
				next ROUTE;
			}
		}
	}

	return $routes;
}

sub _negotiate_return_media {
	my ($class, $c, $all_routes) = @_;

	my @mimes;
	foreach (@{$c->wanted_mimes}) {
		push(@mimes, $_->{mime});
	}
	$c->log->debug('Remote address wants '.join(', ', @mimes));

	# will hold all routes with acceptable return types
	my $routes = [];
	
	ROUTE: foreach (@$all_routes) {
		# does this route return any media type?
		if ($_->{rules}->{returns_all}) {
			$_->{media} = '*/*';
			push(@$routes, $_);
			next ROUTE;
		}

		# what media types does this route return?
		my @have = exists $_->{rules}->{returns} ? 
			@{$_->{rules}->{returns}} :
			('text/html');

		# what routes do the client want?
		if (@{$c->wanted_mimes}) {
			foreach my $want (@{$c->wanted_mimes}) {
				# does the client accept _everything_?
				# if so, just return the first type we support.
				# this will happen only in the end of the
				# wanted_mimes list, so if the client explicitely
				# accepts a type we support, it will have
				# preference over this
				if ($want->{mime} eq '*/*' && $want->{q} > 0) {