ssphys/test/lib/VssPath.pm

   1 # Copyright 2004 Ed Price.
   2 #
   3 # This file is part of vss2svn2 (see http://vss2svn2.tigris.org/).
   4 #
   5 # vss2svn2 is free software; you can redistribute it and/or modify it
   6 # under the terms of the GNU General Public License as published by
   7 # the Free Software Foundation; either version 2 of the License, or
   8 # (at your option) any later version.
   9 #
  10 # vss2svn2 is distributed in the hope that it will be useful, but
  11 # WITHOUT ANY WARRANTY; without even the implied warranty of
  12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  13 # General Public License for more details.
  14 #
  15 # You should have received a copy of the GNU General Public License
  16 # along with vss2svn2; if not, write to the Free Software Foundation,
  17 # Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
  18
  19 package VssPath;
  20
  21 our $VERSION = '0.5.6';
  22
  23 =head1 NAME
  24
  25 VssPath - unambiguous specification of a version of a VSS item.
  26
  27 =head1 DESCRIPTION
  28
  29 A VssPath is like a regular "path" except that each component of the
  30 path has a version number.  So it's a "versioned path", consisting of
  31 a list of (Version, Name) pairs.
  32
  33 A VssPath unambiguously identifies a unique version of a "node" in a
  34 VSS repository.
  35
  36 =head2 Constraints
  37
  38  * Version is a positive integer.
  39  * Name is a string (without any "/" characters).
  40
  41 Addtionally, although it's not currently enforced here, the following
  42 appear generally true of VSS:
  43
  44  * root node has empty Name (zero-length "").
  45  * non-root node must have non-empty Name.
  46  * only the last path component can have version 1.
  47
  48 =head2 Textual representation
  49
  50  * each path "component" represented as "<version>:<name>".
  51  * multiple components separated by slash ("/").
  52
  53 Examples:
  54
  55  * root          => 1:
  56  * toplevel dir  => 2:/1:foo
  57  * toplevel file => 2:/1:foo
  58
  59 =head2 Note on uniqueness
  60
  61 Although a VssPath is unambiguous, it is I<not> unique.  There can be
  62 (and generally are) multiple VssPaths which identify the same version
  63 of the same VSS item.
  64
  65 For example, consider the following history:
  66
  67                   1:
  68   mkdir foo       2:/1:foo
  69   mkdir bar       3:/1:bar
  70
  71 Note that there is only one version of "/foo", but it can be accessed
  72 through both v2 and v3 of the root.
  73
  74 So the following are equivalent:
  75
  76   2:/1:foo
  77   3:/1:foo
  78
  79 =cut
  80
  81 use warnings;
  82 use strict;
  83 use Carp;
  84
  85 #
  86
  87 sub new
  88 {
  89     my ($class, $string) = @_;
  90     my $self = defined $string ? _parse_string ($string) : [];
  91     bless $self, $class;
  92 }
  93
  94 sub copy
  95 {
  96     my ($self) = @_;
  97     return VssPath->new($self->toString);
  98 }
  99
 100 sub push
 101 {
 102     my ($self, $name, $version) = @_;
 103     _validate ($name, $version);
 104     push @$self, [$name, $version];
 105     return $self;
 106 }
 107
 108 # returns [name, version] of the "end" of the path, and removes it from the path.
 109 # returns undef (???) if path is root. (huh? doesnt root have name and version??)
 110
 111 sub pop
 112 {
 113     my ($self) = @_;
 114     pop @$self;
 115 }
 116
 117 # returns textual representation
 118
 119 sub toString
 120 {
 121     my ($self) = @_;
 122     my $ans;
 123     foreach (@$self)
 124     {
 125         my ($name, $version) = @$_;
 126         $ans .= "/" if defined $ans;
 127         $ans .= "$version:$name";
 128     }
 129     return $ans;
 130 }
 131
 132 # returns "normal" unversioned path (as string).
 133
 134 sub toSimplePath
 135 {
 136     my ($self) = @_;
 137     my $ans;
 138     foreach (@$self)
 139     {
 140         my ($name, $version) = @$_;
 141         $ans .= "/" if defined $ans;
 142         $ans .= $name;
 143     }
 144     return $ans;
 145 }
 146
 147 # parses textual representation
 148
 149 sub fromString
 150 {
 151     my ($class, $string) = @_;
 152     bless _parse_string ($string), $class;
 153 }
 154
 155 # returns array of [name, version] pairs
 156
 157 sub toArray
 158 {
 159     my ($self) = @_;
 160     return @{$self->copy};
 161 }
 162
 163 # return 'depth' of path.  root is considered depth zero, "/foo" is 1, etc.
 164 #
 165 # XXX TODO tests!
 166
 167 sub depth
 168 {
 169     my ($self) = @_;
 170     return scalar @$self;
 171 }
 172
 173 # this returns true if self matches a PREFIX of another given VssPath.
 174 # "matching" means that names are equal, and version numbers in self
 175 # are GREATER THAN OR EQUAL to those in the other VssPath.
 176 #
 177 # examples:
 178 #
 179 # self      other     matchesPrefix?
 180 # --------  --------  ------------------------------------------
 181 # 1:        1:        yes
 182 # 2:        1:        yes
 183 # 1:        2:        no   (version is less than other)
 184 # 1:/1:foo  1:        no   (cant match prefix of shorter path)
 185 # 1:        1:/1:foo  yes  (1: matches 1:)
 186 # 2:        1:/1:foo  yes  (2: matches 1:)
 187 # 1:        2:/1:foo  no   (1: does not match 2:)
 188 # 1:/1:foo  1:/1:foo  yes  (complete match)
 189 # 2:/2:foo  1:/1:foo  yes  (complete match)
 190 # 1:/1:foo  1:/2:foo  no   (1:foo version less than 2:foo)
 191
 192 sub matchesPrefix
 193 {
 194     my ($self, $other) = @_;
 195
 196     my @self_stack = @$self;
 197     my @other_stack = @$other;
 198
 199     # longer path cant match prefix of shorter path.
 200     return 0 if $#self_stack > $#other_stack;
 201
 202     for (my $i = 0; $i <= $#self_stack; $i++)
 203     {
 204         my ($self_name,  $self_version)  = @{$self_stack[$i]};
 205         my ($other_name, $other_version) = @{$other_stack[$i]};
 206
 207         return 0 if $self_name ne $other_name; # XXX case sensitivity?
 208         return 0 if $self_version < $other_version;
 209     }
 210
 211     return 1;
 212 }
 213
 214 #
 215 # INTERNAL METHODS
 216 #
 217
 218 sub _parse_string
 219 {
 220     my $string = shift;
 221     croak "bad input (trailing slash): $string" if $string =~ m|/$|;
 222     my @pieces = split /\//, $string;
 223     croak "bad input (no pieces?!): $string" unless @pieces;
 224     my $ans = [];
 225     for (@pieces)
 226     {
 227         croak "bad input (piece): $_ of $string" unless m|(\d+):(.*)|;
 228         my ($version, $name) = ($1, $2);
 229         _validate ($name, $version);
 230         CORE::push @$ans, [$name, $version];
 231     }
 232     return $ans;
 233 }
 234
 235 sub _validate
 236 {
 237     my ($name, $version) = @_;
 238     _validate_name ($name);
 239     _validate_version ($version);
 240 }
 241
 242 sub _validate_name
 243 {
 244     my $name = shift;
 245     croak "slash ('/') in name: $name" if $name =~ m|/|;
 246 }
 247
 248 sub _validate_version
 249 {
 250     my $version = shift;
 251     croak "non-decimal version: $version" unless $version =~ m|^\d+$|;
 252     croak "non-integer version: $version" unless $version eq int $version;
 253     croak "non-positive version: $version" unless $version > 0;
 254 }
 255
 256 1;