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
#