view release on metacpan or  search on metacpan

lib/Store/Digest/HTTP.pm  view on Meta::CPAN

);


=item param_map

Any of the URI query parameters used in this module can be remapped to
different literals using a HASH reference like so:

    # in case 'mtime' collides with some other parameter elsewhere
    { modified => 'mtime' }

=back

=cut

has param_map => (
    is       => 'ro',
    isa      => 'HashRef',
    required => 0,
    lazy     => 1,
    default  => sub { { } },
);

=head2 respond

    my $response = $sdh->respond($request);

=cut

# ok this thing should be able to handle a HTTP::Request,
# Plack::Request, Catalyst::Request, and Apache2::RequestRec

# we only care about the method, request-uri, headers for just
# about everything except POST and PUT (and PROPFIND/PROPPATCH).

# We should normalize all body input to an IO handle or duck type
# in the case of apache

sub respond {
    my ($self, $req) = @_;
    $req = Plack::Request->new($req) unless Scalar::Util::blessed($req);
    # we'll start by doing this for Plack, and then we'll fill in the
    # other HTTP drivers.

    # now that that's sorted out, here's the resolver:

    my $header = $req->headers;
    my $body   = $req->body;
    my $uri    = $req->uri;
    my $path   = $uri->path;
    my $query  = $uri->query_form_hash;
    my $base   = $self->base;

    # first we should clip off the prefix(es)

    $path =~ s!^$base!!;
    $path =~ s!^/*!!;

    #warn $path;

    my @segments = split m!/+!, $path, -1;

    #warn join('/', @segments);

    # here's the all-important resource type
    my $type;

    if (@segments == 0) {
        # root
        $type = 'stats';
    }
    else {
        my @algorithms = @{$self->store->_algorithms || []};
        if (grep { $_ eq $segments[0] } @algorithms) {
            # we know this is now an algorithm
            my $algo = $query->{algorithm} = $segments[0];

            if (defined $segments[1]) {
                if ($segments[1] ne '') {
                    unless ($segments[1] =~ /^[0-9A-Za-z_-]+$/) {
                        # no matcho
                        return [404, [], []];
                    }
                    my $b64len = POSIX::ceil($DIGESTS{$algo} * 4/3);
                    my $hexlen = $DIGESTS{$algo} * 2;
                    my $seglen = length $segments[1];
                    #warn "$seglen $b64len";
                    # could be partial, could be full
                    if ($seglen == $b64len) {
                        $type = 'object';
                    }
                    elsif ($seglen =~ /^[0-9A-Fa-f]{$hexlen}$/) {
                        $type = 'object';
                        $query->{radix} = 16;
                    }
                    else {
                        $type = 'partial';
                    }

                    $query->{digest} = $segments[1];
                }
                else {
                    # definitely a collection
                    $type = 'collection';
                }
            }
            else {
                # this is a collection; redirect 307 with trailing /

                # the base was a regex so we want to retrieve what was
                # actually matched by subtracting the altered path
                # from the original path.
                my $fullpath = $uri->path;

                # pretty sure these are already done but whatev
                utf8::downgrade($fullpath);
                utf8::downgrade($path);

                # aaand the surgery:
                my $pdiff = substr($fullpath, 0, - length $path);
                warn $pdiff;