view release on metacpan or  search on metacpan

lib/CatalystX/ActionRole/Negotiate.pm  view on Meta::CPAN

variant-generating operation and the variant-selecting operation. It
is placed as an C<ARRAY> reference for your convenience in
C<< $c->stash->{variants} >>. This structure is exactly the same as
that which is passed into L<HTTP::Negotiate>, save for these
exceptions:

=over 4

=item 1.

Variants do not need to be a string identifier, but in fact can be
anything that can be consumed by a view or middleware component, e.g.,
a file handle or any other kind of supported object.

=item 2.

L<Path::Class::File> objects get special treatment, as they are what
the initial static variant list is made out of.

=item 3.

Append an additional integer to the end of a variant's record to
supply an artificial C<Last-Modified> value as a UNIX time stamp.

=back

Otherwise, consult L<HTTP::Negotiate> for how to construct the
records. This modification enables you to mix static variants in with
dynamic ones, or overwrite the list with purely dynamic variants.

=head CAVEATS

Note that this module may conflict with L<Catalyst::Plugin::Static::Simple>.
In future releases I will attempt to bring this module up to par so
that it can be a viable replacement, or at the very least be a better
cohabitant.

=cut

before execute => sub {

    my $self = shift;
    my ($ctl, $c, @args) = @_;

    my $req  = $c->req;
    my $resp = $c->res;

    $resp->status(404);

    my $root = Path::Class::Dir->new($c->config->{root});

    my @ps;

    # XXX flip this later maybe
    if ($c->stash->{negotiate_use_args}) {
        @ps = @args;
    }
    else {
        # get a clean URI path. (unfortunately Path::Class doesn't get it
        # this clean)
        @ps = map { (/^([^;]*)(?:;.*)?$/) } split m!/+!, $req->path;
        my $i = 0;
        while ($i < @ps) {
            if ($ps[$i] eq '' or $ps[$i] eq '.') {
                splice @ps, $i, 1;
            }
            elsif ($ps[$i] eq '..') {
                $i > 0 ? splice @ps, $i-1, 2 : splice @ps, $i, 1;
            }
            else {
                $i++;
            }
        }
    }

    $c->log->debug('Negotiate: trying ' . $root->file(@ps));

    # if the path terminates with a slash, what does it mean?

    # * the path is a legitimate directory /foo/ which should be
    # forwarded internally to /foo/index

    # * the client (probably robot) is appending a trailing slash to
    # /foo which ordinarily wouldn't have one.

    # ok, so how do we want it to behave?

    # if @ps is length 0, then we are looking at the root URI, so
    # append 'index' and start looking for variants.

    # if @ps is any longer than 0, then we are looking at something
    # beneath the root.

    # if there is a trailing slash in the request, we want to do an
    # exact match on the dir(/index) first, then exact match for
    # files, then fuzzy match on the files. if no trailing slash, then
    # exact match on files first, then fuzzy match on files, then
    # dir(/index). this is different from mod_negotiate.

    # if there is a trailing slash on the request and what was found
    # was a file, 301 to a url with no trailing slash. similarly, if
    # the request had no trailing slash and what was found was a dir,
    # 301 to a url with a trailing slash.

    my $slash = $c->stash->{negotiate_use_args} ? undef :
        $req->path =~ m!/(?:;[^/]*)?$!;
    my $dpath = $root->file(@ps, 'index');
    my $fpath = $root->file(@ps);

    my @indices = grep { $_ and my $x = $_->stat; $x and -f $x }
        map { Path::Class::File->new($_) } glob(quotemeta($dpath) . "{,.*}");

    my @files = grep { $_ and my $x = $_->stat; $x and -f $x }
        ($fpath, map { Path::Class::File->new($_) }
             glob(quotemeta($fpath) . "{,.*}")) if @ps > 0;

    # XXX we needed to switch the order of operations around a bit,
    # otherwise this stashed stuff will never get assigned

    # gin up some maps so we can figure out where the chosen variant
    # came from