Subversion Repositories DevTools

Rev

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

Rev 1349 Rev 1356
Line 75... Line 75...
75 
#                   subversion control files.
 75 
#                   subversion control files.
76 
#
 76 
#
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 
#                   Options                 - Options
 80 
#                   Hash of Options
81 
#                           --Export        - Export Only
 81 
#                           export          - Bool: Export Only
82 
#                           --NoPrint       - Don't print files exported
 82 
#                           force           - Bool: Force export to overwrite
83 
#                           --Force         - Force export to overwrite
 83 
#                           print           - Bool: Don't print files exported
84 
#                           --PreText=aa    - Display before operation
 84 
#                           pretext=aa      - Text: Display before operation
85 
#
 85 
#
86 
# Returns         : Nothing
 86 
# Returns         : Nothing
87 
#
 87 
#
88 
sub SvnCo
 88 
sub SvnCo
89 
{
 89 
{
- 
 
 90 
    my $self = shift;
90 
    my ($self, $RepoPath, $path, @opts) = @_;
 91 
    my $RepoPath = shift;
- 
 
 92 
    my $path = shift;
- 
 
 93 
    my %opt = @_;
- 
 
 94
91 
    Debug ("SvnCo", $RepoPath, $path);
 95 
    Debug ("SvnCo", $RepoPath, $path);
- 
 
 96 
    Error ("SvnCi: Odd number of args") unless ((@_ % 2) == 0);
92 
 
 97 
 
93 
    my $cmd = 'checkout';
 - 
 
94 
    my $force;
 - 
 
95 
    my $text = 'Extracting';
 - 
 
96 
    my $print = 1;
 - 
 
97
98 
    #
98 
    foreach  ( @opts )
 99 
    #   Set some defaults
99 
    {
 100 
    #
100 
        if ( m~^--Export~ ) {
 - 
 
101 
            $cmd = 'export';
 101 
    my $cmd = $opt{export} ? 'export' : 'checkout';
102 
        } elsif ( m~^--Force~ ) {
 - 
 
103 
            $force = 1;
 - 
 
104 
        } elsif ( m~^--PreText=(.+)~ ) {
 - 
 
105 
            $text = $1;
 - 
 
106 
        } elsif ( m~^--NoPrint~ ) {
 - 
 
107 
            $print = 0;
 - 
 
108 
        } elsif ( m~^--Print~ ) {
 - 
 
109 
            $print = 1;
 - 
 
110 
        } else {
 - 
 
111 
            Error ("SvnCo: Unknown option: $_");
 102 
    my $print = exists $opt{print} ? $opt{print} : 1;
112 
        }
 - 
 
113 
    }
 - 
 
114 
    $self->{CoText} = $text;
 103 
    $self->{CoText} =  $opt{pretext} || 'Extracting';
115 
 
 104 
 
116 
    #
 105 
    #
117 
    #   Ensure that the output path does not exist
 106 
    #   Ensure that the output path does not exist
118 
    #   Do not allow the user to create a local work space
 107 
    #   Do not allow the user to create a local work space
119 
    #   where one already exists
 108 
    #   where one already exists
120 
    #
 109 
    #
121 
    Error ("SvnCo: No PATH specified" ) unless ( $path );
 110 
    Error ("SvnCo: No PATH specified" ) unless ( $path );
122 
    Error ("SvnCo: Target path already exists", "Path: " . $path ) if ( ! $force && -e $path  );
 111 
    Error ("SvnCo: Target path already exists", "Path: " . $path ) if ( ! $opt{force} && -e $path  );
123 
 
 112 
 
124 
    #
 113 
    #
125 
    #   Build up the command line
 114 
    #   Build up the command line
126 
    #
 115 
    #
127 
    my @args = $cmd;
 116 
    my @args = $cmd;
128 
    push @args, qw( --ignore-externals );
 117 
    push @args, qw( --ignore-externals );
129 
    push @args, qw( --force ) if ( $force );
 118 
    push @args, qw( --force ) if ( $opt{force} );
130 
    push @args, $RepoPath, $path;
 119 
    push @args, $RepoPath, $path;
131 
 
 120 
 
132 
    my @co_list;
 121 
    my @co_list;
133 
    if ( $self->SvnCmd ( @args,
 122 
    if ( $self->SvnCmd ( @args,
134 
                            {
 123 
                            {
Line 418... Line 407...
418 
    Error ("Package name contains a Peg ($1)", "Path: $package")
 407 
    Error ("Package name contains a Peg ($1)", "Path: $package")
419 
        if ( $package =~ m~.*(@\d+)$~ );
 408 
        if ( $package =~ m~.*(@\d+)$~ );
420 
 
 409 
 
421 
    #
 410 
    #
422 
    #   Determine TTB target
 411 
    #   Determine TTB target
423 
    #   The TTB type for branckes and tags also conatins the branch or tag
 412 
    #   The TTB type for branches and tags also conatins the branch or tag
424 
    #
 413 
    #
425 
    $opt{'type'} = 'trunk' unless ( $opt{'type'} );
 414 
    $opt{'type'} = 'trunk' unless ( $opt{'type'} );
426 
    if ( $opt{'type'} =~ m~^(tags|branches|trunk)(/|$)(.*)~ ) {
 415 
    if ( $opt{'type'} =~ m~^(tags|branches|trunk)(/|$)(.*)~ ) {
427 
        Error ("SvnCreatePackage: TTB type ($1) must be followed by a path element")
 416 
        Error ("SvnCreatePackage: TTB type ($1) must be followed by a path element")
428 
            if ( (($1 eq 'tags') or ($1 eq 'branches' )) && ! $3  );
 417 
            if ( (($1 eq 'tags') or ($1 eq 'branches' )) && ! $3  );
Line 437... Line 426...
437 
    #   Determine the import target(s)
 426 
    #   Determine the import target(s)
438 
    #
 427 
    #
439 
    my $import_target;
 428 
    my $import_target;
440 
    my $copy_target;
 429 
    my $copy_target;
441 
 
 430 
 
- 
 
 431 
    $self->{DEVBRANCH} = 'trunk';
442 
    if ( $opt{'import'} )
 432 
    if ( $opt{'import'} )
443 
    {
 433 
    {
444 
        #
 434 
        #
445 
        #   Primary target
 435 
        #   Primary target
446 
        #   trunk, branck or tag
 436 
        #   trunk, branck or tag
Line 575... Line 565...
575 
                          , 'process' => \&ProcessRevNo
 565 
                          , 'process' => \&ProcessRevNo
576 
                          , 'error' => "Import Incomplete" } );
 566 
                          , 'error' => "Import Incomplete" } );
577 
    }
 567 
    }
578 
 
 568 
 
579 
    #
 569 
    #
- 
 
 570 
    #   If we have done very little then we won't know the version
- 
 
 571 
    #   of the repo. Need to force it
- 
 
 572 
    #
- 
 
 573 
    unless ( $self->{REVNO} || $self->{WSREVNO} )
- 
 
 574 
    {
- 
 
 575 
        $self->SvnInfo( $package, 'InfoRepo' );
- 
 
 576 
        $self->{REVNO}  = $self->{'InfoRepo'}{'Last Changed Rev'} || Error ("SvnCreatePackage: Bad info for Repository");
- 
 
 577 
    }
- 
 
 578 
 
- 
 
 579 
 
- 
 
 580 
    #
580 
    #   Pass the updated revision number back to the user
 581 
    #   Pass the updated revision number back to the user
581 
    #
 582 
    #
582 
    $self->CalcRmReference($target);
 583 
    $self->CalcRmReference($target);
583 
    Message ("Create Package Tag is: " . $self->RmRef);
 584 
    Message ("Create Package Rm Ref : " . $self->RmRef);
584 
    Message ("Create Package Vcs is: " . $self->SvnTag);
 585 
    Message ("Create Package Vcs Tag: " . $self->SvnTag);
585 
    return $self->{RMREF} ;
 586 
    return $self->{RMREF} ;
586 
}
 587 
}
587 
 
 588 
 
588 
#-------------------------------------------------------------------------------
 589 
#-------------------------------------------------------------------------------
589 
# Function        : SvnRmView
 590 
# Function        : SvnRmView
Line 722... Line 723...
722 
        my $wsLastChangedRev = $self->{'InfoWs'}{'Last Changed Rev'} || Error ("SvnCopyWs: Bad info for Workspace");
 723 
        my $wsLastChangedRev = $self->{'InfoWs'}{'Last Changed Rev'} || Error ("SvnCopyWs: Bad info for Workspace");
723 
        my $repoLastChangedRev = $self->{'InfoRepo'}{'Last Changed Rev'} || Error ("SvnCopyWs: Bad info for Repository");
 724 
        my $repoLastChangedRev = $self->{'InfoRepo'}{'Last Changed Rev'} || Error ("SvnCopyWs: Bad info for Repository");
724 
 
 725 
 
725 
        Verbose("WS Rev  : $wsLastChangedRev");
 726 
        Verbose("WS Rev  : $wsLastChangedRev");
726 
        Verbose("Repo Rev: $repoLastChangedRev");
 727 
        Verbose("Repo Rev: $repoLastChangedRev");
727 
 
 - 
 
728 
        Error ('SvnCopyWs: The repository has been modified since the workspace was last updated.',
 728 
        Error ('SvnCopyWs: The repository has been modified since the workspace was last updated.',
729 
               'Possibly caused by a commit without an update.',
 729 
               'Possibly caused by a commit without an update.',
730 
               'Update the workspace and try again.',
 730 
               'Update the workspace and try again.',
731 
               "Last Changed Rev. Repo: $repoLastChangedRev. Ws:$wsLastChangedRev") if ( $repoLastChangedRev > $wsLastChangedRev );
 731 
               "Last Changed Rev. Repo: $repoLastChangedRev. Ws:$wsLastChangedRev") if ( $repoLastChangedRev > $wsLastChangedRev );
732 
    }
 732 
    }
Line 1866... Line 1866...
1866 
#                                             Label within the current instance
 1866 
#                                             Label within the current instance
1867 
#                   A hash of named arguments
 1867 
#                   A hash of named arguments
1868 
#                       data                - Scalar ref. Hash of good stuff returned
 1868 
#                       data                - Scalar ref. Hash of good stuff returned
1869 
#                       printdata           - Print RAW svn data
 1869 
#                       printdata           - Print RAW svn data
1870 
#                       onlysimple          - Do not do exhaustive scan
 1870 
#                       onlysimple          - Do not do exhaustive scan
- 
 
 1871 
#                       savedevbranch       - Save Dev Branch in session
1871 
#
 1872 
#
1872 
# Returns         : Branch from which the label was taken
 1873 
# Returns         : Branch from which the label was taken
1873 
#                   or the label prefixed with 'tags'.
 1874 
#                   or the label prefixed with 'tags'.
1874 
#
 1875 
#
1875 
sub backTrackSvnLabel
 1876 
sub backTrackSvnLabel
Line 1898... Line 1899...
1898 
        Information ("backTrackSvnLabel: Performing exhaustive search") unless $mode;
 1899 
        Information ("backTrackSvnLabel: Performing exhaustive search") unless $mode;
1899 
        $self->{btData} = ();
 1900 
        $self->{btData} = ();
1900 
        $self->{btData}{results}{base} = $self->FullPath();
 1901 
        $self->{btData}{results}{base} = $self->FullPath();
1901 
        $self->{btData}{results}{label} = $src_label;
 1902 
        $self->{btData}{results}{label} = $src_label;
1902 
        $self->{btData}{results}{changeSets} = 0;
 1903 
        $self->{btData}{results}{changeSets} = 0;
- 
 
 1904 
        $self->{btData}{results}{distance} = 0;
1903 
 
 1905 
 
1904 
        #
 1906 
        #
1905 
        #   Linux does not handle empty arguments in the same
 1907 
        #   Linux does not handle empty arguments in the same
1906 
        #   manner as windows. Solution: pass an array
 1908 
        #   manner as windows. Solution: pass an array
1907 
        #
 1909 
        #
Line 1931... Line 1933...
1931 
        $branch = $src_label;
 1933 
        $branch = $src_label;
1932 
    }
 1934 
    }
1933 
    else
 1935 
    else
1934 
    {
 1936 
    {
1935 
        $branch = $self->{btData}{results}{devBranch};
 1937 
        $branch = $self->{btData}{results}{devBranch};
- 
 
 1938 
        if ( $opt{savedevbranch} )
- 
 
 1939 
        {
- 
 
 1940 
            $self->{btData}{results}{devBranch} =~ m~^(.*?)(@|$)~;
- 
 
 1941 
            $self->{DEVBRANCH} = $1;
- 
 
 1942 
        }
- 
 
 1943
1936 
    }
 1944 
    }
1937 
 
 1945 
 
1938 
    #
 1946 
    #
1939 
    #   Return data to the user
 1947 
    #   Return data to the user
1940 
    #
 1948 
    #
Line 2064... Line 2072...
2064 
#            Warning ("Cannot decode XML log: $line");
 2072 
#            Warning ("Cannot decode XML log: $line");
2065 
#        }
 2073 
#        }
2066 
 
 2074 
 
2067 
        if ( $end )
 2075 
        if ( $end )
2068 
        {
 2076 
        {
- 
 
 2077 
            #
- 
 
 2078 
            #   If the Repo is created by a pre 1.6 SVN, then kind will be
- 
 
 2079 
            #   empty. Have a guess.
- 
 
 2080 
            #
- 
 
 2081 
            if ( $workSpace->{path}{'kind'} eq '' )
- 
 
 2082 
            {
2069 
            if ( exists $workSpace->{path}{'copyfrom-path'} )
 2083 
                if ( exists $workSpace->{path}{'copyfrom-path'} ) {
- 
 
 2084 
                    $workSpace->{path}{'kind'} = 'dir';
- 
 
 2085 
                } else {
- 
 
 2086 
                    $workSpace->{path}{'kind'} = 'file';
- 
 
 2087 
                }
- 
 
 2088 
            }
- 
 
 2089 
 
- 
 
 2090 
            if ( $workSpace->{path}{'kind'} eq 'dir' &&  exists $workSpace->{path}{'copyfrom-path'} )
2070 
            {
 2091 
            {
2071 
                my $srev = $workSpace->{path}{'copyfrom-rev'};
 2092 
                my $srev = $workSpace->{path}{'copyfrom-rev'};
- 
 
 2093 
                my $from = $workSpace->{path}{'copyfrom-path'};
- 
 
 2094 
                if ( $from =~ m~/trunk$~ || $from =~ m~/branches/[^/]+$~ )
- 
 
 2095 
                {
2072 
                $workSpace->{devBranch} = $workSpace->{path}{'copyfrom-path'} . '@' . $srev;
 2096 
                    $workSpace->{devBranch} = $from . '@' . $srev;
- 
 
 2097 
                }
2073 
            }
 2098 
            }
2074 
 
 2099 
 
2075 
            elsif ( $workSpace->{path}{'kind'} eq 'file' )
 2100 
            elsif ( $workSpace->{path}{'kind'} eq 'file' )
2076 
            {
 2101 
            {
2077 
                #
 2102 
                #