view release on metacpan or  search on metacpan

lib/REST/Application.pm  view on Meta::CPAN

    return 0;
}

# Basic idea stolen from CGI.pm.  Its semantics made it hard to pull out the
# information I wanted without a lot of trickery, so I improved upon the
# original.  Same with libwww's HTTP::Negotiate algorithim, it's also hard to
# make go with what we want.
sub getContentPrefs {
    my $self = shift;
    my $default_weight = 1;
    my @prefs;

    # Parse the Accept header, and save type name, score, and position.
    my @accept_types = split /,/, $self->getAcceptHeader();
    my $order = 0;
    for my $accept_type (@accept_types) {
        my ($weight) = ($accept_type =~ /q=(\d\.\d+|\d+)/);
        my ($name) = ($accept_type =~ m#(\S+/[^;]+)#);
        next unless $name;
        push @prefs, { name => $name, order => $order++};
        if (defined $weight) {
            $prefs[-1]->{score} = $weight;
        } else {
            $prefs[-1]->{score} = $default_weight;
            $default_weight -= 0.001;
        }
    }

    # Sort the types by score, subscore by order, and pull out just the name
    @prefs = map {$_->{name}} sort {$b->{score} <=> $a->{score} || 
                                    $a->{order} <=> $b->{order}} @prefs;
    return @prefs, '*/*';  # Allows allow for */*
}

sub getAcceptHeader {
    my $self = shift;
    return $self->query->http('accept') || "";
}

# List _getLastRegexMatches(void)
#
# Returns a list of all the paren matches in the last regular expression who's