view release on metacpan or  search on metacpan

lib/HTTP/DAV/Lock.pm  view on Meta::CPAN

#      <D:timeout>Infinite</D:timeout>
#      <D:owner>pcollins</D:owner>
#      <D:locktoken>
#          <D:href>opaquelocktoken:d3ae67b0-1dd1-a5f7-f067587e98e1</D:href>
#          <D:href>...</D:href>
#      </D:locktoken>
#   </D:activelock>
#</D:lockdiscovery>
# 
# returns an array of locks (will be more than one in shared locks scenarios)

sub XML_lockdiscovery_parse {
   my ($self,$node_lockdiscovery) = @_;
   my @found_locks = ();

   # <!ELEMENT lockdiscovery (activelock)* >
   my @nodes_activelock= HTTP::DAV::Utils::get_elements_by_tag_name($node_lockdiscovery,"D:activelock");

   # <!ELEMENT activelock (lockscope, locktype, depth, owner?, timeout?, locktoken?) >
   foreach my $node_activelock ( @nodes_activelock ) {

      my $lock = HTTP::DAV::Lock->new();
      push(@found_locks,$lock);
   
      my $nodes_lock_params = $node_activelock->getChildNodes();
      next unless $nodes_lock_params;
      my $prop_count = $nodes_lock_params->getLength;

      for (my $prop_num = 0; $prop_num < $prop_count; $prop_num++) {
         my $node_lock_param = $nodes_lock_params->item($prop_num);   

         # $node_lock_param is one of the following
         # 1. <!ELEMENT lockscope (exclusive | shared) >
         # 2. <!ELEMENT locktype (write) >
         # 3. <!ELEMENT depth (#PCDATA) >
         # 4. <!ELEMENT owner ANY >
         # 5. <!ELEMENT timeout (#PCDATA) >
         # 6. <!ELEMENT locktoken (href+) >

         my $lock_prop_name = $node_lock_param->getNodeName();
         $lock_prop_name =~ s/.*:(.*)/$1/g;
   
         # 1. RFC2518 currently only allows locktype of exclusive or shared
         if ( $lock_prop_name eq "lockscope" ) {
            my $node_lock_scope = HTTP::DAV::Utils::get_only_element($node_lock_param);
            my $lock_scope = $node_lock_scope->getNodeName;
            $lock_scope =~ s/.*:(.*)/$1/g;
            $lock->set_scope($lock_scope);
         } 
   
         # 2. RFC2518 currently only allows locktype of "write"
         elsif ( $lock_prop_name eq "locktype" ) {
            my $node_lock_type = HTTP::DAV::Utils::get_only_element($node_lock_param);
            my $lock_type = $node_lock_type->getNodeName;
            $lock_type =~ s/.*:(.*)/$1/g;
            $lock->set_type($lock_type);
         } 
   
         # 3. RFC2518 allows only depth of 0,1,infinity
         elsif ( $lock_prop_name eq "depth" ) {
            my $lock_depth = HTTP::DAV::Utils::get_only_cdata($node_lock_param);
            $lock->set_depth($lock_depth);
         }
   
         # 4. RFC2518 allows anything here.
         # Patrick: I'm just going to convert the XML to a string
         elsif ( $lock_prop_name eq "owner" ) {
            $lock->set_owner( $node_lock_param->getFirstChild->toString );
         }
   
         # 5. RFC2518 (Section 9.8) e.g. Timeout: Second-234234 or Timeout: infinity
         elsif ( $lock_prop_name eq "timeout" ) {
            my $lock_timeout = HTTP::DAV::Utils::get_only_cdata($node_lock_param);
            my $timeout = HTTP::DAV::Lock->interpret_timeout($lock_timeout);
            $lock->set_timeout( $timeout );
            #if ( $HTTP::DAV::DEBUG ) {
            #   $lock->{ "_timeout_val" } = HTTP::Date::time2str($timeout) 
            #}
         }
   
         # 6. RFC2518 allows one or more <href>'s
         # Push them all into the lock object.
         elsif ( $lock_prop_name eq "locktoken" ) {
            my @nodelist_hrefs = HTTP::DAV::Utils::get_elements_by_tag_name($node_lock_param,"D:href");
            foreach my $node ( @nodelist_hrefs) {
               my $href_cdata = HTTP::DAV::Utils::get_only_cdata( $node );
               $lock->set_locktoken( $href_cdata );
            }
         }

      } # Foreach property
   } # Foreach ActiveLock

   return @found_locks;
}

###########################################################################
# Synopsis: $hashref = get_supportedlock_details($node);
#<D:supportedlock>
#   <D:lockentry>
#      <D:lockscope> <D:exclusive/> </D:lockscope>
#      <D:locktype>  <D:write/>     </D:locktype>
#   </D:lockentry>
#   <D:lockentry>
#      <D:lockscope> <D:shared/>    </D:lockscope>
#      <D:locktype>  <D:write/>     </D:locktype>
#   </D:lockentry>
#</D:supportedlock>
#
# Returns something similar to:
#  @supportedlocks'  = (
#    { 'type' => 'write', 'scope' => 'exclusive' },
#    { 'type' => 'write', 'scope' => 'shared'    }
#  );    

sub get_supportedlock_details {
   my ($node_supportedlock) = @_;

   return unless $node_supportedlock;

   # Return values
   my @supportedlocks=();

   my @nodelist_lockentries = HTTP::DAV::Utils::get_elements_by_tag_name($node_supportedlock,"D:lockentry");
   foreach my $i ( 0 .. $#nodelist_lockentries ) {
      my $node_lockentry = $nodelist_lockentries[$i];

      my $lock_prop_name = $node_lockentry->getNodeName();
      next unless $lock_prop_name;

      # RFC2518 currently only allows lockscope of exclusive or shared
      # <D:lockscope> <D:shared|exclusive/>    </D:lockscope>
      my $node_lockscope=HTTP::DAV::Utils::get_only_element($node_lockentry,"D:lockscope");
      if ( $node_lockscope ) {
         my $node_lockscope_param =HTTP::DAV::Utils::get_only_element($node_lockscope);
         my $lockscope = $node_lockscope_param->getNodeName;
         $lockscope =~ s/.*:(.*)/$1/g;
         $supportedlocks[$i]{ "scope" } = $lockscope;
      }

      # RFC2518 currently only allows locktype of "write"
      # <D:locktype>  <D:write/>     </D:locktype>
      my $node_locktype = HTTP::DAV::Utils::get_only_element($node_lockentry,"D:locktype");
      if ( $node_locktype ) {
         my $node_locktype_param =HTTP::DAV::Utils::get_only_element($node_locktype);
         my $locktype = $node_locktype_param->getNodeName;
         $locktype =~ s/.*:(.*)/$1/g;