view release on metacpan or  search on metacpan

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

        return NOT_FOUND;
    }

    $r->status(207);
    $r->content_type('text/xml; charset="utf-8"');

    my @files;

    if($depth == 0)
    {
        @files = ($uri);
    }
    elsif($depth == 1)
    {
        $uri =~ s/\/$//; # strip trailing slash, we don't store it in the db

        @files = $handler->list($uri);

        # remove . and .. from the list
        @files = grep( $_ !~ /^\.\.?$/, @files );

        # Add a trailing slash to the directory if there isn't one already
        if($uri !~ /\/$/)
        {
            $uri .= '/';
        }

        # Add the current folder to the front of the filename
        @files = map { "$uri$_" } @files;

        # Goliath only doesn't want to see the current/base directory in the
        # response.
        if($r->header_in('User-Agent') !~ /Goliath/)
        {
            push @files, $uri;
        }
    }

    my %wanted_properties = $self->get_wanted_properties($r);

    # The list of properties in order which a stat() call must return.
    my @properties = qw(dev ino mode nlink uid gid rdev getcontentlength
                        atime getlastmodified creationdate);

    # Loop through all the files and call stat() on each one.  Keep track of
    # which properties the client requested.
    my @results;

    foreach my $path (@files)
    {
        my %stat;
        my $info;

        my $handler = $self->get_handler_for_path($path);

        $info->{'getcontenttype'} = 'application/octet-stream';
        $info->{'resourcetype'}   = '';

        if($handler->test('d', $path))
        {
            $info->{'getcontenttype'} = 'httpd/unix-directory';
            $info->{'resourcetype'}   = 'collection';
        }

        @stat{@properties} = $handler->stat($path);

        foreach my $prop (keys %wanted_properties)
        {
            # These are set above automatically, don't want to overwrite them
            next if $prop eq 'resourcetype';
            next if $prop eq 'getcontenttype';

            $info->{$prop} = $stat{$prop};
        }

        push @results, {
            path => $path,
            stat => $info
        }
    }

    return $self->list_response($r, \@results);
}

#
# Write a file.
#
sub put
{
    my ($self, $r, $handler) = @_;

    my $path = $r->uri();

    my $fh = $handler->open_write($path) or return 403;

    my $content = $self->get_request_content($r);

    print $fh $content;

    $handler->close_write($fh);

    return 201; # Created.
}

#
#
# Helper methods below here.
#
#

#
# This method builds up an xml response to a delete request ONLY IF the delete
# request had errors.  A delete request with no errors sends only a header, not
# an associated XML document.  So again, this method is only used when an error
# occurs.
#
# @arg $r apache object
# @arg $files arrayref of files that had errors
#
# @ret 200 OK
#