# $Id: ResourceList.pm,v 0.10 2001/09/01 19:48:14 pcollins Exp $ package HTTP::DAV::ResourceList; $VERSION = sprintf("%d.%02d", q$Revision: 0.10 $ =~ /(\d+)\.(\d+)/); use strict; use vars qw($VERSION); #### # Construct a new object and initialize it sub new { my $class = shift; my $self = bless {}, ref($class) || $class; $self->_init(@_); return $self; } sub _init { my ($self,@p) = @_; #### # This is the order of the arguments unless used as # named parameters my @arg_names = qw ( RESOURCE_TYPE ); my @pa = HTTP::DAV::Utils::rearrange( \@arg_names, @p); $self->{_resources} = (); } #### # List Operators sub get_resources { my ($self) =shift; my $arr = $self->{_resources}; return (defined $arr ) ? @{$self->{_resources}} : (); } sub get_urls { my ($self) =shift; my @arr; foreach my $r ( $self->get_resources() ) { push( @arr, $r->get_uri() ); } return @arr; } sub count_resources { return $#{$_[0]->{_resources}}+1; } sub get_member { my ($self,$uri) = @_; $uri = HTTP::DAV::Utils::make_uri($uri); foreach my $r ( $self->get_resources ) { if ( HTTP::DAV::Utils::compare_uris($uri,$r->get_uri) ) { return $r; } } return 0; } sub add_resource { my ($self,$resource) = @_; # print "Adding $resource\n"; # print "Before: ". $self->as_string . "\n"; $self->remove_resource($resource); $resource->set_parent_resourcelist($self); push (@{$self->{_resources}}, $resource); # print "After: ". $self->as_string . "\n"; } # Synopsis: $list->remove_resource( resource_obj : HTTP::DAV::Resource ); sub remove_resource { my ($self,$resource ) = @_; my $uri; my $ret; $uri = HTTP::DAV::Utils::make_uri($resource->get_uri); if (defined $uri && $uri->scheme ) { my $found_index = -1; foreach my $i ( 0 .. $#{$self->{_resources}} ) { my $this_resource = $self->{_resources}[$i]; my $equiv = HTTP::DAV::Utils::compare_uris($uri,$this_resource->get_uri); if ( $equiv || $resource eq $this_resource ) { $found_index = $i; last; } } if ( $found_index != -1 ) { $resource = splice(@{$self->{_resources}},$found_index,1); $resource->set_parent_resourcelist(); $ret = $resource; } else { $ret = 0; } } else { $ret = 0; } #print "Removing $ret\n" if $HTTP::DAV::DEBUG>2; return $ret; } ########################################################################### # %tokens = get_locktokens( "http://localhost/test/dir" ) # Look for all of the lock tokens given a URI: # Returns: # %$tokens = ( # 'http://1' => ( token1, token2, token3 ), # 'http://2' => ( token4, token5, token6 ), # ); # sub get_locktokens { my ($self,@p) = @_; my($uri,$owned) = HTTP::DAV::Utils::rearrange(['URI','OWNED'],@p); $owned = 0 unless defined $owned; my %tokens; my @uris; if (ref($uri) =~ /ARRAY/ ) { @uris = map { HTTP::DAV::Utils::make_uri($_) } @{$uri}; } else { push( @uris, HTTP::DAV::Utils::make_uri($uri) ); } # OK, let's say we hold three locks on 3 resources: # 1./a/b/c/ 2./a/b/d/ and 3./f/g # If you ask me for /a/b you'll get the locktokens on 1 and 2. # If you ask me for /a and /f you'll get 1,2 and 3. # If you ask me for /a/b/c/x.txt you'll get 1 # If you ask me for /a/b/e you'll get nothing # So, for each locked resource, if it is a member # of the uri you specify, I'll tell you what the # locked resource tokens were foreach my $resource ( $self->get_resources ) { my $resource_uri = $resource->get_uri; foreach my $url ( @uris ) { # if $resource_uri is in $uri # e.g. u=/a r=/a/b/e # e.g. u=/a r=/a/b/c.txt my $r = $resource_uri->canonical(); my $u = $url->canonical(); $r =~ s/\/*$/\//g; # Add a trailing slash $u =~ s/\/*$/\//g; # Add a tailing slash if ($u =~ /\Q$r/ ) { my @locks = $resource->get_locks(-owned=>$owned); #my $uri = $resource_uri->path(); foreach my $lock (@locks) { my @lock_tokens = @{$lock->get_locktokens()}; push(@{$tokens{$resource_uri}}, @lock_tokens); } } } # foreach uri } # foreach resource return \%tokens; } # Utility to convert lock tokens to an if header # %$tokens = ( # 'http://1' => ( token1, token2, token3 ), # 'http://2' => ( token4, token5, token6 ), # ) # to # if tagged: # () # or if not tagged: # () # sub tokens_to_if_header { my ($self, $tokens, $tagged) = @_; my $if_header; foreach my $uri (keys %$tokens ) { $if_header .= "<$uri> " if $tagged; foreach my $token (@{$$tokens{$uri}}) { $if_header .= "(<$token>) "; } $if_header=~ s/\s+$//g; } return $if_header; } ########################################################################### # Dump the objects contents as a string sub as_string { my ($self,$space,$depth,$verbose) = @_; $verbose=1 if (!defined $verbose || $verbose!=0); $space||=" "; my ($return) = ""; $return .= "${space}ResourceList Object ($self)\n"; $space .= " "; foreach my $resource ( $self->get_resources() ) { if ($verbose) { $return .= $resource->as_string($space,$depth); } else { $return .= $space . $resource . " " . $resource->get_uri. "\n"; } } $return; } sub showlocks { my ($self,$space,$depth) = @_; $space||=" "; my ($return) = ""; foreach my $resource ( $self->get_resources() ) { $return .= $resource->as_string("$space",2); } $return; } 1; 1;