View file File name : Path.pm Content :package CGI::XMLForm::Path; use strict; use vars qw($VERSION @ISA @EXPORT @EXPORT_OK); require Exporter; require AutoLoader; @ISA = qw(Exporter AutoLoader); # Items to export into callers namespace by default. Note: do not export # names by default without a very good reason. Use EXPORT_OK instead. # Do not simply export all your public functions/methods/constants. @EXPORT = qw( ); $VERSION = '0.01'; 1; __END__ # This class allows comparison of current paths sub new { my $proto = shift; my $class = ref($proto) || $proto; my $self; $self->{_path} = $_[0]; $self->{_fullpath} = []; bless ($self, $class); # reconsecrate if ($self->{_path}) { $self->buildSelf($_[1] || new $class); } return $self; } sub buildSelf { my $self = shift; my $prev = shift; if ($self->{_path} =~ s/\*$//) { $self->{_repeat} = 1; } # warn "Building from ", $self->{_path}, "\n"; my @parts = split('/', $self->{_path}); my @fullpath; $self->{Relative} = 0; if ($self->{_path} !~ /^\//) { # It's a relative path $self->{_relative} = 1; @fullpath = @{$prev->{_fullpath}}; if ($prev->isRelative) { # prev was a relative path so remove top item pop @fullpath; } foreach ( @parts ) { if ($_ eq "..") { pop @fullpath; } else { push @fullpath, $_; } } } else { # remove crap from beginning (empty because of preceding "/") shift @parts; @fullpath = @parts; } if ($fullpath[$#fullpath] =~ /^\@(\w+)$/) { pop @fullpath; pop @parts; $self->{_attrib} = $1; } $self->{Parts} = \@parts; $self->{_fullpath} = \@fullpath; # warn "Built: ", $self->FullPath, "\n"; } sub rebuildSelf { my $self = shift; $self->buildSelf(new CGI::XMLExt::Path); } sub isRelative { $_[0]->{_relative}; } sub isRepeat { $_[0]->{_repeat}; } sub isChildPath { my $self = shift; my $compare = shift; # Now compare each level of the tree, and throw away attributes. my @a = @{$self->{_fullpath}}; my @b = @{$compare->{_fullpath}}; if (@a >= @b) { return 0; } foreach ($#a..0) { $a[$_] =~ s/\[.*\]//; $b[$_] =~ s/\[.*\]//; return 0 if ($a[$_] ne $b[$_]); } return 1; } sub Attrib { $_[0]->{_attrib}; } sub isEqual { my $self = shift; my $compare = shift; my @a = @{$self->{_fullpath}}; my @b = @{$compare->{_fullpath}}; # warn "Comparing: ", $self->FullPath, "\nTo : ", $compare->FullPath, # "\n"; if (scalar @a != scalar @b) { return 0; } foreach (0..$#a) { $a[$_] =~ s/\[.*\]//; $b[$_] =~ s/\[.*\]//; if ($a[$_] ne $b[$_]) { return 0; } } # warn "*** FOUND ***\n"; return 1; } sub Append { my $self = shift; my $element = shift; my %attribs = @_; if (%attribs) { $element .= "["; $element .= join " and ", (map "\@$_=\"$attribs{$_}\"", (keys %attribs)); $element .= "]"; } push @{$self->{_fullpath}}, $element; push @{$self->{Parts}}, $element; $self->{_path} .= "/". $element; } sub Pop { my $self = shift; pop @{$self->{_fullpath}}; $self->{_path} =~ s/^(.*)\/.*?$/$1/; pop @{$self->{Parts}}; } sub Path { $_[0]->{_path}; } sub FullPath { my $self = shift; my $path = "/" . (join "/", @{$self->{_fullpath}}); $path .= ($self->Attrib ? "/\@" . $self->Attrib : ''); $path; } 1;