Subversion Repositories DevTools

Rev

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

Rev 2354 Rev 2426
Line 77... Line 77...
77 
# Inputs          : $self                   - Instance data
 77 
# Inputs          : $self                   - Instance data
78 
#                   $RepoPath               - Within the repository
 78 
#                   $RepoPath               - Within the repository
79 
#                   $Path                   - Local path
 79 
#                   $Path                   - Local path
80 
#                   Hash of Options
 80 
#                   Hash of Options
81 
#                           export          - Bool: Export Only
 81 
#                           export          - Bool: Export Only
- 
 
 82 
#                           escrow          - Bool: Less sanity testing
82 
#                           force           - Bool: Force export to overwrite
 83 
#                           force           - Bool: Force export to overwrite
83 
#                           print           - Bool: Don't print files exported
 84 
#                           print           - Bool: Don't print files exported
84 
#                           pretext=aa      - Text: Display before operation
 85 
#                           pretext=aa      - Text: Display before operation
85 
#
 86 
#
86 
# Returns         : Nothing
 87 
# Returns         : Nothing
Line 89... Line 90...
89 
{
 90 
{
90 
    my $self = shift;
 91 
    my $self = shift;
91 
    my $RepoPath = shift;
 92 
    my $RepoPath = shift;
92 
    my $path = shift;
 93 
    my $path = shift;
93 
    my %opt = @_;
 94 
    my %opt = @_;
94
95 
 
95 
    Debug ("SvnCo", $RepoPath, $path);
 96 
    Debug ("SvnCo", $RepoPath, $path);
96 
    Error ("SvnCi: Odd number of args") unless ((@_ % 2) == 0);
 97 
    Error ("SvnCi: Odd number of args") unless ((@_ % 2) == 0);
97 
 
 98 
 
98 
    #
 99 
    #
99 
    #   Set some defaults
 100 
    #   Set some defaults
100 
    #
 101 
    #
101 
    my $cmd = $opt{export} ? 'export' : 'checkout';
 102 
    my $cmd = $opt{export} ? 'export' : 'checkout';
102 
    my $print = exists $opt{print} ? $opt{print} : 1;
 103 
    my $print = exists $opt{print} ? $opt{print} : 1;
103 
    $self->{CoText} =  $opt{pretext} || 'Extracting';
 104 
    $self->{CoText} =  $opt{pretext} || 'Extracting';
104 
 
 105 
 
- 
 
 106 
    #   Define RE to be used to test extraction
- 
 
 107 
    #       Bad news: Some Cots packages have /tags/
- 
 
 108 
    #       Kludge  : Allow /tags/ in escrow mode
- 
 
 109 
    #
- 
 
 110 
    $self->{CoRe} = '((/)(tags|branches|trunk)(/|$))';
- 
 
 111 
    $self->{CoRe} =~ s~tags\|~~ if ( $opt{escrow} );
- 
 
 112
105 
    #
 113 
    #
106 
    #   Ensure that the output path does not exist
 114 
    #   Ensure that the output path does not exist
107 
    #   Do not allow the user to create a local work space
 115 
    #   Do not allow the user to create a local work space
108 
    #   where one already exists
 116 
    #   where one already exists
109 
    #
 117 
    #
Line 139... Line 147...
139 
        Verbose2 ("Remove WorkSpace: $path");
 147 
        Verbose2 ("Remove WorkSpace: $path");
140 
        rmtree( $path, IsVerbose(3) );
 148 
        rmtree( $path, IsVerbose(3) );
141 
        rmtree( $path, IsVerbose(3) );
 149 
        rmtree( $path, IsVerbose(3) );
142 
        Error ("Checking out Workspace", @{$self->{ERROR_LIST}}, @co_list );
 150 
        Error ("Checking out Workspace", @{$self->{ERROR_LIST}}, @co_list );
143 
    }
 151 
    }
- 
 
 152 
 
- 
 
 153 
    #
- 
 
 154 
    #   Cleanup
- 
 
 155 
    #
- 
 
 156 
    delete $self->{CoText};
- 
 
 157 
    delete $self->{CoRe};
144 
    return;
 158 
    return;
145 
 
 159 
 
146 
    #
 160 
    #
147 
    #   Internal routine to scan each the checkout
 161 
    #   Internal routine to scan each the checkout
148 
    #
 162 
    #
Line 171... Line 185...
171 
            {
 185 
            {
172 
                Information1 ( $self->{CoText} . ': ' . $data);
 186 
                Information1 ( $self->{CoText} . ': ' . $data);
173 
            }
 187 
            }
174 
        }
 188 
        }
175 
 
 189 
 
- 
 
 190 
        #
- 
 
 191 
        #   Detect user attempting to checkout too much of a repo
- 
 
 192 
        #   If the extract contains a 'key' directory then create error
- 
 
 193 
        #
- 
 
 194 
        #   Re is provide by caller such that $1 is the dirpath
- 
 
 195 
        #
176 
        if (  $data =~ m~((/)(tags|branches|trunk)(/|$))~ )
 196 
        if ( $data =~ m~$self->{CoRe}~ )
177 
        {
 197 
        {
178 
            my $bad_dir = $1;
 198 
            my $bad_dir = $1;
179 
            push @{$self->{ERROR_LIST}}, "Checkout does not describe the root of a package. Contains: $bad_dir";
 199 
            push @{$self->{ERROR_LIST}}, "Checkout does not describe the root of a package. Contains: $bad_dir";
180 
            return 1;
 200 
            return 1;
181 
        }
 201 
        }