Pimp your CMS
using WebDAV and Perl

Michael Kröll <pepl@cpan.org>

What is WebDAV?

Why WebDAV?

WebDAV Clients

WebDAV and Content Management

An example WebDAV implementation (XIMS Web CMS)

mod_perl handler godav.pm

handler

01sub handler {
02  my $r = shift;
03  my $method = lc $r->method;
04  my $path   = Apache::URI::uri_unescape($r->uri);
05
06  # Fetch the user set by the Auth Handler
07  my $user =  $r->pnotes( 'ximsBasicAuthUser' );
08  return (403) unless defined $user;
09
10  # Tell MS Webfolders that we are not a Frontpage Server Extensions-,
11  # but a WebDAV server
12  $r->header_out( 'MS-Author-Via', 'DAV' );
13

handler (continued)

14  # Dispatch to method handler
15  no strict 'refs';
16  my ($status_code, $content) = &{$method}( $r, $user );
17  use strict 'refs';
18
19  $r->status( $status_code );
20  if ( defined $content ) {
21    my $bytes;
22    do { use bytes; $bytes = length($content) };
23    $r->header_out( 'Content-Length', $bytes );
24    $r->send_http_header();
25    $r->print( $content );
26  }
27  else {
28    $r->send_http_header();
29  }
30}

mkcol (Creating folders)

1sub mkcol {
2  my $r = shift;
3  my $user = shift;
4
5  my $path = uri_unescape( $r->path_info() );
6  $path =~ s#/$##;
7  my $object = XIMS::Object->new( User => $user, path => $path,
8                                  marked_deleted => undef );
9
10  # Content-Length headers are not supposed to be here
11  if ( $r->header_in( 'Content-Length') ) {
12    return (415); Unsupported Media Type
13  }

mkcol (continued)

14  elsif ( not defined $object ) {
15    my ($parentpath) = ( $path =~ m|^(.*)/[^/]+$| );
16    my $parent = XIMS::Object->new( User => $user, path => $parentpath,
17                                    marked_deleted => undef );
18    # Conflict
19    return (409) unless (defined $parent and defined $parent->id());
20
21    my $privmask = $user->object_privmask( $parent );
22    return (403) unless $privmask & XIMS::Privileges::CREATE();

mkcol (continued)

23    my $importer = XIMS::Importer::Object->new( User => $user,
24                                                Parent => $parent );
25    my ($location) = ( $path =~ m|([^/]+)$| );
26    my $folder = XIMS::Folder->new( User => $user,
27                                    location => $location );
28    if ( not $importer->import( $folder ) ) {
29        # Method not allowed
30        return (405);
31    }
32  }
33  else {
34    return (405);
35  }
36  # Created
37  return (201);
38}

Other Methods

options, propfind, put, get, delete, lock, unlock, copy und move

Additional Information

Thank you!
Ďakujem!
Danke!





Questions?