view release on metacpan or  search on metacpan

lib/Apache/WebDAV.pm  view on Meta::CPAN

        }

        # Add quota information.  This doesn't appear to be in the WebDAV
        # spec, but if it's not here, WebDrive won't allow any uploads.
        #
        # Update: I found it in a proposal here:
        #
        # http://www.greenbytes.de/tech/webdav/draft-ietf-webdav-quota-07.html
        # 
        # But it doesn't say anything about quota, quotaused, or
        # quota-assigned-bytes - I found out that webdrive was looking for those
        # from its log file.
        my $quota                 = $doc->createElement('D:quota');
        my $quota_used            = $doc->createElement('D:quotaused');
        my $quota_available_bytes = $doc->createElement('D:quota-available-bytes');
        my $quota_used_bytes      = $doc->createElement('D:quota-used-bytes');
        my $quota_assigned_bytes  = $doc->createElement('D:quota-assigned-bytes');

        $quota->appendText('2000000000');
        $quota_used->appendText('0');
        $quota_available_bytes->appendText('2000000000');
        $quota_used_bytes->appendText('0');
        $quota_assigned_bytes->appendText('2000000000');

        $okprops->addChild($quota);
        $okprops->addChild($quota_used);
        $okprops->addChild($quota_available_bytes);
        $okprops->addChild($quota_used_bytes);
        $okprops->addChild($quota_assigned_bytes);

        if($okprops->hasChildNodes())
        {
            my $propstat = $doc->createElement('D:propstat');
            $propstat->addChild($okprops);

            my $stat = $doc->createElement('D:status');
            $stat->appendText('HTTP/1.1 200 OK');

            $propstat->addChild($stat);
            $resp->addChild($propstat);
        }
    }

    $r->send_http_header();
    $r->print($doc->toString(1));

    return OK;
}

#
# Parse an incoming PROPFIND request to see what information the client wants.
#
sub get_wanted_properties
{
    my ($self, $r) = @_;

    # Grab the content of the request so we can parse it and look for which
    # properties they are requesting.
    my $content = $self->get_request_content($r);

    # NSExpand expands namespaces so, xmlns:D eq '{DAV:}' in front of every
    # element in that namespace.
    my $xml;

    eval
    {
        $xml = XMLin($content, NSExpand => 1, ForceArray => 0, KeyAttr => []);
    };


    # If parsing the XML file failed, override the 207 status with a 400
    # and return undef.
    if(!$xml)
    {
        $r->status(400);
        $r->send_http_header();
        return;
    }

    my %wanted_properties;

    my $prop_key = '{DAV:}prop';

    foreach my $prop (keys %{$xml->{$prop_key}})
    {
        # Only pay attention if the property is in the DAV namespace.
        if($prop =~ s/^{DAV:}//)
        {
            $wanted_properties{$prop} = 1;
        }
    }

    return %wanted_properties;
}

#
# Note from Apache docs:
#
# The $r->content method will return the entity body read from the client, but
# only if the request content type is application/x-www-form-urlencoded.
#
# Can't use $r->content() because the content type is text/xml, not
# application/x-www-form-urlencoded (I don't know why the Apache module puts
# that restriction on there in the first place).
#
sub get_request_content
{
    my ($self, $r) = @_;

    my $content;
    my $length = $r->header_in('Content-Length');

    $r->read($content, $r->header_in('Content-Length'));

    return $content;
}

#
# Based on the requested path, figure out which module will handle the request.
#
sub get_handler_for_path