############################################################################ # # HTTP::Webdav - Perl interface to Neon HTTP and WebDAV client library # # Copyright (c) 2001 Gerald Richter / ecos gmbh (www.ecos.de) # # You may distribute under the terms of either the GNU General Public # License or the Artistic License, as specified in the Perl README file. # # THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED # WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF # MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. # # $Id: lock.pl,v 1.1 2001/09/24 15:32:31 richter Exp $ # ############################################################################ # # This this an example how to lock a resource # use HTTP::Webdav ; sub auth { my ($userdata, $realm) = @_ ; print "auth called userdata = $userdata realm = $realm\n" ; # return username, password return ("richter", "x") ; } sub discover { my ($sess, $lock, $uri, $status) = @_ ; my $k ; my $v ; print "discover lock at uri = $uri :\n " ; while (($k, $v) = each %$lock) { print "$k=$v " ; } print "\n status: " ; while (($k, $v) = each %$status) { print "$k=$v " ; } print "\n" ; } $sess = HTTP::Webdav -> new ; $sess -> server ("www.gr.ecos.de", 8765) ; $sess -> set_server_auth (\&auth) ; my $lock = { uri => "/dav", depth => NE_DEPTH_INFINITE, # 0 for exclusive scope & 1 for shared scope scope => 0, # 0 for write type type => 0, owner => "richter", timeout => 60 } ; print "*** lock the resource\n" ; $sess->lock($lock); print "Status: ", $sess -> get_error , " locktoken: $lock->{token} \n"; print "*** check if it is locked\n" ; $sess -> lock_discover ($lock -> {uri}, \&discover) ; print "Status: ", $sess -> get_error , "\n"; # here you can do something.... print "*** unlock the resource\n" ; $sess->unlock($lock); print "Status: ", $sess -> get_error , " locktoken: $lock->{token} \n"; print "*** check if it is unlocked\n" ; $sess -> lock_discover ('/dav', \&discover) ; print "Status: ", $sess -> get_error , "\n";