Subversion Repositories DevTools

Rev

Rev 1380 | Rev 1422 | Go to most recent revision | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 1380 Rev 1399
Line 1056... Line 1056...
1056 
sub SvnLocateWsRoot
 1056 
sub SvnLocateWsRoot
1057 
{
 1057 
{
1058 
    my ($self, $test) = @_;
 1058 
    my ($self, $test) = @_;
1059 
    my @path;
 1059 
    my @path;
1060 
    my $path = $self->{WS};
 1060 
    my $path = $self->{WS};
- 
 
 1061 
    my $found;
1061 
 
 1062 
 
1062 
    Debug ("SvnLocateWsRoot");
 1063 
    Debug ("SvnLocateWsRoot");
1063 
    Error ("SvnLocateWsRoot: No Workspace") unless ( $path  );
 1064 
    Error ("SvnLocateWsRoot: No Workspace") unless ( $path  );
1064 
    Verbose2 ("SvnLocateWsRoot: Start in $path");
 1065 
    Verbose2 ("SvnLocateWsRoot: Start in $path");
1065 
 
 1066 
 
Line 1070... Line 1071...
1070 
    {
 1071 
    {
1071 
        return undef;
 1072 
        return undef;
1072 
    }
 1073 
    }
1073 
 
 1074 
 
1074 
    #
 1075 
    #
1075 
    #   Need to sanitize the users path to ensure that the following
 1076 
    #   Under Subversion 1.7 the process is a lot easier
1076 
    #   algorithm works. Need:
 - 
 
1077 
    #       1) Absolute Path
 - 
 
1078 
    #       2) Not ending in '/'
 - 
 
1079 
    #
 1077 
    #
1080 
 
 - 
 
1081 
    #
 - 
 
1082 
    #   If we have a relative path then prepend the current directory
 - 
 
1083 
    #   An absolute path is:
 - 
 
1084 
    #           /aaa/aa/aa
 - 
 
1085 
    #       or  c:/aaa/aa/aa
 - 
 
1086 
    #
 - 
 
1087 
    $path = getcwd() . '/' . $path
 - 
 
1088 
        unless ( $path =~ m~^/|\w:/~  );
 - 
 
1089 
 
 - 
 
1090 
    #
 - 
 
1091 
    #   Walk the bits and remove ".." directories
 - 
 
1092 
    #       Done by pushing non-.. elements and poping last entry for .. elements.
 - 
 
1093 
    #   Have a leading "/" which is good.
 - 
 
1094 
    #
 - 
 
1095 
    #   Create a array of directories in the path
 1078 
    if ( exists $self->{'InfoWs'}{'Working Copy Root Path'} )
1096 
    #   Split on one or more \ or / separators
 - 
 
1097 
    #
 - 
 
1098 
    foreach ( split /[\\\/]+/ , $path )
 - 
 
1099 
    {
 - 
 
1100 
        next if ( $_ eq '.' );
 - 
 
1101 
        unless ( $_ eq '..' )
 - 
 
1102 
        {
 - 
 
1103 
            push @path, $_;
 - 
 
1104 
        }
 - 
 
1105 
        else
 - 
 
1106 
        {
 - 
 
1107 
            Error ("SvnLocateWsRoot: Bad Pathname: $path")
 - 
 
1108 
                if ( $#path <= 0 );
 - 
 
1109 
            pop @path;
 - 
 
1110 
        }
 - 
 
1111 
    }
 - 
 
1112 
 
 - 
 
1113 
    #
 - 
 
1114 
    #   Need to adjust the WSURL too
 - 
 
1115 
    #   Break into parts and pop them off as we go
 - 
 
1116 
    #   Add a dummy one to allow for the first iteration
 - 
 
1117 
    #
 - 
 
1118 
    my @wsurl = (split (/[\\\/]+/ , $self->{WSURL}), 'Dummy');
 - 
 
1119 
 
 - 
 
1120 
    Verbose2 ("Clean absolute path elements: @path");
 - 
 
1121 
    PATH_LOOP:
 - 
 
1122 
    while ( @path )
 - 
 
1123 
    {
 1079 
    {
1124 
        #
 1080 
        #
1125 
        #   This directory element. Append / to assist in compare
 - 
 
1126 
        #   Determine parent path
 1081 
        #   WS is now known
1127 
        #
 1082 
        #
1128 
        my $name = pop (@path) . '/';
 - 
 
1129 
        my $parent = join ('/', @path );
 1083 
        $self->{WS} = $self->{'InfoWs'}{'Working Copy Root Path'};
1130 
        pop @wsurl;
 - 
 
1131 
 
 1084 
 
1132 
        #
 1085 
        #
1133 
        #   Examine the parent directory
 1086 
        #   Calculate WSURL
1134 
        #   Get a list of all elements in the parent
 - 
 
1135 
        #   Need to ensure that this directory is one of them
 - 
 
1136 
        #
 1087 
        #
- 
 
 1088 
        $self->{WSURL} = join('/', $self->{PKGROOT}, $self->{DEVBRANCH});
- 
 
 1089 
        $found = 1;
- 
 
 1090 
    }
- 
 
 1091 
    else
- 
 
 1092 
    {
- 
 
 1093 
        # Preversion 1.7
1137 
        #   Ignore any errors - assume that they are because the
 1094 
        Warning ("Using svn < 1.7. This is not recommended");
- 
 
 1095 
 
- 
 
 1096 
        #
1138 
        #   parent is not a part of the work space. This will terminate the
 1097 
        #   Need to sanitize the users path to ensure that the following
- 
 
 1098 
        #   algorithm works. Need:
1139 
        #   search.
 1099 
        #       1) Absolute Path
- 
 
 1100 
        #       2) Not ending in '/'
1140 
        #
 1101 
        #
1141 
        $self->SvnCmd ('list', $parent, '--depth', 'immediates' );
 - 
 
1142 
        foreach my $entry ( @{$self->{RESULT_LIST}} )
 - 
 
1143 
        {
 - 
 
1144 
            next PATH_LOOP
 - 
 
1145 
                if ( $entry eq $name );
 - 
 
1146 
        }
 - 
 
1147 
 
 1102 
 
1148 
        #
 1103 
        #
1149 
        #   Didn't find 'dir' in directory svn listing of parent
 1104 
        #   If we have a relative path then prepend the current directory
1150 
        #   This parent is not a part of the same WorkSpace as 'dir'
 1105 
        #   An absolute path is:
1151 
        #   We have a winner.
 1106 
        #           /aaa/aa/aa
- 
 
 1107 
        #       or  c:/aaa/aa/aa
1152 
        #
 1108 
        #
1153 
        chop $name;                         #   Chop the '/' previously added
 1109 
        $path = getcwd() . '/' . $path
1154 
        $self->{WS} = $parent . '/' . $name;
 1110 
            unless ( $path =~ m~^/|\w:/~  );
1155 
 
 1111 
 
1156 
        #
 1112 
        #
- 
 
 1113 
        #   Walk the bits and remove ".." directories
1157 
        #   Reform the WSURL. Elements have been removed as we tested up the
 1114 
        #       Done by pushing non-.. elements and poping last entry for .. elements.
1158 
        #   path
 1115 
        #   Have a leading "/" which is good.
1159 
        #
 1116 
        #
- 
 
 1117 
        #   Create a array of directories in the path
- 
 
 1118 
        #   Split on one or more \ or / separators
- 
 
 1119 
        #
1160 
        $self->{WSURL} = join '/', @wsurl;
 1120 
        foreach ( split /[\\\/]+/ , $path )
- 
 
 1121 
        {
- 
 
 1122 
            next if ( $_ eq '.' );
- 
 
 1123 
            unless ( $_ eq '..' )
- 
 
 1124 
            {
- 
 
 1125 
                push @path, $_;
- 
 
 1126 
            }
- 
 
 1127 
            else
- 
 
 1128 
            {
- 
 
 1129 
                Error ("SvnLocateWsRoot: Bad Pathname: $path")
- 
 
 1130 
                    if ( $#path <= 0 );
- 
 
 1131 
                pop @path;
- 
 
 1132 
            }
- 
 
 1133 
        }
1161 
 
 1134 
 
- 
 
 1135 
        #
- 
 
 1136 
        #   Need to adjust the WSURL too
- 
 
 1137 
        #   Break into parts and pop them off as we go
- 
 
 1138 
        #   Add a dummy one to allow for the first iteration
- 
 
 1139 
        #
- 
 
 1140 
        my @wsurl = (split (/[\\\/]+/ , $self->{WSURL}), 'Dummy');
- 
 
 1141 
 
- 
 
 1142 
        Verbose2 ("Clean absolute path elements: @path");
- 
 
 1143 
        PATH_LOOP:
- 
 
 1144 
        while ( @path )
- 
 
 1145 
        {
- 
 
 1146 
            #
- 
 
 1147 
            #   This directory element. Append / to assist in compare
- 
 
 1148 
            #   Determine parent path
- 
 
 1149 
            #
- 
 
 1150 
            my $name = pop (@path) . '/';
- 
 
 1151 
            my $parent = join ('/', @path );
- 
 
 1152 
            pop @wsurl;
- 
 
 1153 
 
- 
 
 1154 
            #
- 
 
 1155 
            #   Examine the parent directory
- 
 
 1156 
            #   Get a list of all elements in the parent
- 
 
 1157 
            #   Need to ensure that this directory is one of them
- 
 
 1158 
            #
- 
 
 1159 
            #   Ignore any errors - assume that they are because the
- 
 
 1160 
            #   parent is not a part of the work space. This will terminate the
- 
 
 1161 
            #   search.
- 
 
 1162 
            #
- 
 
 1163 
            $self->SvnCmd ('list', $parent, '--depth', 'immediates' );
- 
 
 1164 
            foreach my $entry ( @{$self->{RESULT_LIST}} )
- 
 
 1165 
            {
- 
 
 1166 
                next PATH_LOOP
- 
 
 1167 
                    if ( $entry eq $name );
- 
 
 1168 
            }
- 
 
 1169 
 
- 
 
 1170 
            #
- 
 
 1171 
            #   Didn't find 'dir' in directory svn listing of parent
- 
 
 1172 
            #   This parent is not a part of the same WorkSpace as 'dir'
- 
 
 1173 
            #   We have a winner.
- 
 
 1174 
            #
- 
 
 1175 
            chop $name;                         #   Chop the '/' previously added
- 
 
 1176 
            $self->{WS} = $parent . '/' . $name;
- 
 
 1177 
 
- 
 
 1178 
            #
- 
 
 1179 
            #   Reform the WSURL. Elements have been removed as we tested up the
- 
 
 1180 
            #   path
- 
 
 1181 
            #
- 
 
 1182 
            $self->{WSURL} = join '/', @wsurl;
1162 
        return $self->{WS};
 1183 
            $found = 1;
- 
 
 1184 
            last;
- 
 
 1185 
        }
1163 
    }
 1186 
    }
1164 
 
 1187 
 
1165 
    #
 1188 
    #
1166 
    #   Shouldn't get this far
 1189 
    #   Shouldn't get this far
1167 
    #
 1190 
    #
1168 
    Error ("SvnLocateWsRoot: Root not found");
 1191 
    Error ("SvnLocateWsRoot: Root not found")
- 
 
 1192 
        unless ( $found );
- 
 
 1193 
 
- 
 
 1194 
    #
- 
 
 1195 
    #   Refresh Info
- 
 
 1196 
    #   Must kill cached copy
- 
 
 1197 
    #
- 
 
 1198 
    delete $self->{'InfoWs'};
- 
 
 1199 
    $self->SvnInfo($self->{WS}, 'InfoWs');
- 
 
 1200 
    return $self->{WS};
- 
 
 1201
1169 
}
 1202 
}
1170 
 
 1203 
 
1171 
#-------------------------------------------------------------------------------
 1204 
#-------------------------------------------------------------------------------
1172 
# Function        : SvnValidateWs
 1205 
# Function        : SvnValidateWs
1173 
#
 1206 
#