Subversion Repositories DevTools

Rev

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

Rev 1341 Rev 1343
Line 78... Line 78...
78 
#                   $RepoPath           - Within the repository
 78 
#                   $RepoPath           - Within the repository
79 
#                   $Path               - Local path
 79 
#                   $Path               - Local path
80 
#                   Options             - Options
 80 
#                   Options             - Options
81 
#                           --Export    - Export Only
 81 
#                           --Export    - Export Only
82 
#                           --NoPrint   - Don't print files exported
 82 
#                           --NoPrint   - Don't print files exported
- 
 
 83 
#                           --Force     - Force export to overwrite
83 
#
 84 
#
84 
# Returns         : Nothing
 85 
# Returns         : Nothing
85 
#
 86 
#
86 
sub SvnCo
 87 
sub SvnCo
87 
{
 88 
{
88 
    my ($self, $RepoPath, $path, @opts) = @_;
 89 
    my ($self, $RepoPath, $path, @opts) = @_;
89 
    my $export = grep (/^--Export/, @opts );
 90 
    my $export = grep (/^--Export/, @opts );
- 
 
 91 
    my $force  = grep (/^--Force/, @opts );
90 
    $self->{PRINTDATA} = ! grep (/^--NoPrint/, @opts );
 92 
    $self->{PRINTDATA} = ! grep (/^--NoPrint/, @opts );
91 
    Debug ("SvnCo", $RepoPath, $path);
 93 
    Debug ("SvnCo", $RepoPath, $path);
92 
 
 94 
 
93 
    #
 95 
    #
94 
    #   Ensure that the output path does not exist
 96 
    #   Ensure that the output path does not exist
95 
    #   Do not allow the user to create a local work space
 97 
    #   Do not allow the user to create a local work space
96 
    #   where one already exists
 98 
    #   where one already exists
97 
    #
 99 
    #
98 
    Error ("SvnCo: No PATH specified" ) unless ( $path );
 100 
    Error ("SvnCo: No PATH specified" ) unless ( $path );
99 
    Error ("SvnCo: Target path already exists", "Path: " . $path ) if ( -e $path );
 101 
    Error ("SvnCo: Target path already exists", "Path: " . $path ) if ( ! $force && -e $path  );
100 
 
 102 
 
101 
    #
 103 
    #
102 
    #   Build up the command line
 104 
    #   Build up the command line
103 
    #
 105 
    #
104 
    my @args = $export ? 'export' : 'checkout';
 106 
    my @args = $export ? 'export' : 'checkout';
105 
    push @args, qw( --ignore-externals );
 107 
    push @args, qw( --ignore-externals );
- 
 
 108 
    push @args, qw( --force ) if ( $force );
106 
    push @args, $RepoPath, $path;
 109 
    push @args, $RepoPath, $path;
107 
 
 110 
 
108 
 
 - 
 
109 
    my @co_list;
 111 
    my @co_list;
110 
    if ( $self->SvnCmd ( @args,
 112 
    if ( $self->SvnCmd ( @args,
111 
                            {
 113 
                            {
112 
                                'process' => \&ProcessCo,
 114 
                                'process' => \&ProcessCo,
113 
                                'data' => \@co_list,
 115 
                                'data' => \@co_list,
Line 177... Line 179...
177 
        #}
 179 
        #}
178 
    }
 180 
    }
179 
}
 181 
}
180 
 
 182 
 
181 
#-------------------------------------------------------------------------------
 183 
#-------------------------------------------------------------------------------
- 
 
 184 
# Function        : SvnSwitch
- 
 
 185 
#
- 
 
 186 
# Description     : Switches files and directories
- 
 
 187 
#
- 
 
 188 
# Inputs          : $self               - Instance data
- 
 
 189 
#                   $RepoPath           - Within the repository
- 
 
 190 
#                   $Path               - Local path
- 
 
 191 
#                   Options             - Options
- 
 
 192 
#                           --NoPrint   - Don't print files exported
- 
 
 193 
#
- 
 
 194 
# Returns         : Nothing
- 
 
 195 
#
- 
 
 196 
sub SvnSwitch
- 
 
 197 
{
- 
 
 198 
    my ($self, $RepoPath, $path, @opts) = @_;
- 
 
 199 
    $self->{PRINTDATA} = ! grep (/^--NoPrint/, @opts );
- 
 
 200 
    Debug ("SvnSwitch", $RepoPath, $path);
- 
 
 201 
 
- 
 
 202 
    #
- 
 
 203 
    #   Build up the command line
- 
 
 204 
    #
- 
 
 205 
    my @sw_list;
- 
 
 206 
    if ( $self->SvnCmd ( 'switch', $RepoPath, $path,
- 
 
 207 
                            {
- 
 
 208 
                                'process' => \&ProcessSwitch,
- 
 
 209 
                                'data' => \@sw_list,
- 
 
 210 
                                'credentials' => 1,
- 
 
 211 
                                'nosavedata' => 1,
- 
 
 212 
                            }
- 
 
 213 
                       ) || @sw_list )
- 
 
 214 
    {
- 
 
 215 
        #
- 
 
 216 
        #   We have a switch problem
- 
 
 217 
        #   Delete the workspace and then report the error
- 
 
 218 
        #
- 
 
 219 
        #   Note: For some reason a simple rmtree doesn't work
- 
 
 220 
        #         Nor does glob show all the directories
- 
 
 221 
        #
- 
 
 222 
        Verbose2 ("Remove WorkSpace: $path");
- 
 
 223 
        rmtree( $path, IsVerbose(3) );
- 
 
 224 
        rmtree( $path, IsVerbose(3) );
- 
 
 225 
        Error ("Switch elements", @{$self->{ERROR_LIST}}, @sw_list );
- 
 
 226 
    }
- 
 
 227 
    $self->{PRINTDATA} = 0;
- 
 
 228 
    return;
- 
 
 229 
 
- 
 
 230 
    #
- 
 
 231 
    #   Internal routine to scan each line of the Switch output
- 
 
 232 
    #   Use to provide a nice display
- 
 
 233 
    #
- 
 
 234 
    sub ProcessSwitch
- 
 
 235 
    {
- 
 
 236 
        my $self = shift;
- 
 
 237 
        my $data = shift;
- 
 
 238 
 
- 
 
 239 
        if ( $self->{PRINTDATA} )
- 
 
 240 
        {
- 
 
 241 
            #
- 
 
 242 
            #   Pretty display for user
- 
 
 243 
            #
- 
 
 244 
            Information1 ("Switching : $data");
- 
 
 245 
        }
- 
 
 246 
    }
- 
 
 247 
}
- 
 
 248 
 
- 
 
 249 
#-------------------------------------------------------------------------------
182 
# Function        : SvnCi
 250 
# Function        : SvnCi
183 
#
 251 
#
184 
# Description     : Check in the specified WorkSpace
 252 
# Description     : Check in the specified WorkSpace
185 
#
 253 
#
186 
# Inputs          : $self           - Instance data
 254 
# Inputs          : $self           - Instance data
Line 575... Line 643...
575 
#                       modified - Array of files that are allowed to
 643 
#                       modified - Array of files that are allowed to
576 
#                                  be modified in the workspace.
 644 
#                                  be modified in the workspace.
577 
#                       noswitch        - True: Don't switch to the new URL
 645 
#                       noswitch        - True: Don't switch to the new URL
578 
#                       replace         - True: Delete existing tag if present
 646 
#                       replace         - True: Delete existing tag if present
579 
#                       allowLocalMods  - True: Allow complex tagging
 647 
#                       allowLocalMods  - True: Allow complex tagging
- 
 
 648 
#                       noupdatecheck   - True: Do not check that the WS is up to date
580 
#
 649 
#
581 
# Returns         : Revision of the copy
 650 
# Returns         : Revision of the copy
582 
#
 651 
#
583 
sub SvnCopyWs
 652 
sub SvnCopyWs
584 
{
 653 
{
Line 608... Line 677...
608 
 
 677 
 
609 
    #
 678 
    #
610 
    #   Ensure the Workspace is up to date
 679 
    #   Ensure the Workspace is up to date
611 
    #       Determine the state of the Repo and the Workspace
 680 
    #       Determine the state of the Repo and the Workspace
612 
    #
 681 
    #
- 
 
 682 
    unless ( $opt{noupdatecheck} )
- 
 
 683 
    {
613 
    $self->SvnInfo( $self->{WS} , 'InfoWs' );
 684 
        $self->SvnInfo( $self->{WS} , 'InfoWs' );
614 
    $self->SvnInfo( $self->FullWs, 'InfoRepo' );
 685 
        $self->SvnInfo( $self->FullWs, 'InfoRepo' );
615 
 
 686 
 
616 
    my $wsLastChangedRev = $self->{'InfoWs'}{'Last Changed Rev'} || Error ("SvnCopyWs: Bad info for Workspace");
 687 
        my $wsLastChangedRev = $self->{'InfoWs'}{'Last Changed Rev'} || Error ("SvnCopyWs: Bad info for Workspace");
617 
    my $repoLastChangedRev = $self->{'InfoRepo'}{'Last Changed Rev'} || Error ("SvnCopyWs: Bad info for Repository");
 688 
        my $repoLastChangedRev = $self->{'InfoRepo'}{'Last Changed Rev'} || Error ("SvnCopyWs: Bad info for Repository");
618 
 
 689 
 
619 
    Verbose("WS Rev  : $wsLastChangedRev");
 690 
        Verbose("WS Rev  : $wsLastChangedRev");
620 
    Verbose("Repo Rev: $repoLastChangedRev");
 691 
        Verbose("Repo Rev: $repoLastChangedRev");
621 
 
 692 
 
622 
    Error ('SvnCopyWs: The repository has been modified since the workspace was last updated.',
 693 
        Error ('SvnCopyWs: The repository has been modified since the workspace was last updated.',
623 
           'Possibly caused by a commit without an update.',
 694 
               'Possibly caused by a commit without an update.',
624 
           'Update the workspace and try again.',
 695 
               'Update the workspace and try again.',
625 
           "Last Changed Rev. Repo: $repoLastChangedRev. Ws:$wsLastChangedRev") if ( $repoLastChangedRev > $wsLastChangedRev );
 696 
               "Last Changed Rev. Repo: $repoLastChangedRev. Ws:$wsLastChangedRev") if ( $repoLastChangedRev > $wsLastChangedRev );
- 
 
 697 
    }
626 
 
 698 
 
627 
    #
 699 
    #
628 
    #   Examine the workspace and ensure that there are no modified
 700 
    #   Examine the workspace and ensure that there are no modified
629 
    #   files - unless they are expected
 701 
    #   files - unless they are expected
630 
    #
 702 
    #
Line 1600... Line 1672...
1600 
# Returns         : Data Item
 1672 
# Returns         : Data Item
1601 
#
 1673 
#
1602 
sub Full        { return $_[0]->{URL} . $_[0]->{PKGROOT} ; }
 1674 
sub Full        { return $_[0]->{URL} . $_[0]->{PKGROOT} ; }
1603 
sub FullWs      { return $_[0]->{URL} . $_[0]->{WSURL} ; }
 1675 
sub FullWs      { return $_[0]->{URL} . $_[0]->{WSURL} ; }
1604 
sub FullWsRev   { return $_[0]->{URL} . $_[0]->{WSURL} . '@' . $_[0]->{WSREVNO} ; }
 1676 
sub FullWsRev   { return $_[0]->{URL} . $_[0]->{WSURL} . '@' . $_[0]->{WSREVNO} ; }
- 
 
 1677 
sub FullPath    { return $_[0]->{URL} . $_[0]->{PATH} ; }
1605 
sub Peg         { return $_[0]->{PEG} ; }
 1678 
sub Peg         { return $_[0]->{PEG} ; }
1606 
sub Type        { return $_[0]->{TAGTYPE} || '' ; }
 1679 
sub Type        { return $_[0]->{TAGTYPE} || '' ; }
1607 
sub WsType      { return $_[0]->{WSTYPE}  || '' ; }
 1680 
sub WsType      { return $_[0]->{WSTYPE}  || '' ; }
1608 
sub Path        { return $_[0]->{PATH} ; }
 1681 
sub Path        { return $_[0]->{PATH} ; }
1609 
sub Version     { return $_[0]->{VERSION} ; }
 1682 
sub Version     { return $_[0]->{VERSION} ; }
Line 1635... Line 1708...
1635 
    print $indent . "PKGROOT :" . $self->{PKGROOT} . "\n";
 1708 
    print $indent . "PKGROOT :" . $self->{PKGROOT} . "\n";
1636 
    print $indent . "PATH    :" . $self->{PATH} . "\n";
 1709 
    print $indent . "PATH    :" . $self->{PATH} . "\n";
1637 
    print $indent . "TAGTYPE :" . ($self->{TAGTYPE} || '') . "\n";
 1710 
    print $indent . "TAGTYPE :" . ($self->{TAGTYPE} || '') . "\n";
1638 
    print $indent . "VERSION :" . ($self->{VERSION} || '') . "\n";
 1711 
    print $indent . "VERSION :" . ($self->{VERSION} || '') . "\n";
1639 
    print $indent . "PEG     :" . ($self->{PEG} || '') . "\n";
 1712 
    print $indent . "PEG     :" . ($self->{PEG} || '') . "\n";
1640 
    print $indent . "FULL    :" . $self->Full . "\n";
 1713 
#    print $indent . "FULL    :" . $self->Full . "\n";
- 
 
 1714 
 
- 
 
 1715 
    print $indent . "Full         :" . $self->Full . "\n";
- 
 
 1716 
#    print $indent . "FullWs       :" . $self->FullWs    . "\n";
- 
 
 1717 
#    print $indent . "FullWsRev    :" . $self->FullWsRev . "\n";
- 
 
 1718 
    print $indent . "FullPath     :" . $self->FullPath  . "\n";
- 
 
 1719 
    print $indent . "Peg          :" . $self->Peg       . "\n";
- 
 
 1720 
    print $indent . "Type         :" . $self->Type      . "\n";
- 
 
 1721 
    print $indent . "WsType       :" . $self->WsType    . "\n";
- 
 
 1722 
    print $indent . "Path         :" . $self->Path      . "\n";
- 
 
 1723 
    print $indent . "Version      :" . $self->Version   . "\n";
- 
 
 1724 
    print $indent . "RmRef        :" . ($self->RmRef || '') . "\n";
- 
 
 1725 
#    print $indent . "RmPath       :" . ($self->RmPath|| '') . "\n";
1641 
}
 1726 
}
1642 
 
 1727 
 
1643 
#-------------------------------------------------------------------------------
 1728 
#-------------------------------------------------------------------------------
1644 
# Function        : BranchName
 1729 
# Function        : BranchName
1645 
#
 1730 
#
Line 1731... Line 1816...
1731 
#                   that was used to create the label
 1816 
#                   that was used to create the label
1732 
#
 1817 
#
1733 
# Inputs          : $self                   - Instance Data
 1818 
# Inputs          : $self                   - Instance Data
1734 
#                   $src_label              - Label to process
 1819 
#                   $src_label              - Label to process
1735 
#                                             Label within the current instance
 1820 
#                                             Label within the current instance
- 
 
 1821 
#                   $refData                - Optional Ref.
- 
 
 1822 
#                                             If present will pass back data
1736 
#
 1823 
#
1737 
# Returns         : Branch from which the label was taken
 1824 
# Returns         : Branch from which the label was taken
1738 
#                   or the label prefixed with 'tags'.
 1825 
#                   or the label prefixed with 'tags'.
1739 
#
 1826 
#
1740 
sub backTrackSvnLabel
 1827 
sub backTrackSvnLabel
1741 
{
 1828 
{
1742 
    my ($self, $src_label) = @_;
 1829 
    my ($self, $src_label, $refData) = @_;
- 
 
 1830 
 
- 
 
 1831 
    if ( $refData && ref($refData) ne 'SCALAR' )
- 
 
 1832 
    {
- 
 
 1833 
        Error ('Internal: backTrackSvnLabel. 3rd arg must be ref to a scalar');
- 
 
 1834 
    }
1743 
 
 1835 
 
1744 
    #
 1836 
    #
1745 
    #   Init stored data
 1837 
    #   Init stored data
1746 
    #
 1838 
    #
1747 
    $self->{btData} = ();
 1839 
    $self->{btData} = ();
1748 
 
 1840 
 
1749 
    #
 1841 
    #
1750 
    #   extract data
 1842 
    #   extract data
1751 
    #
 1843 
    #
1752 
#    DebugDumpData("SVN", $svn );
 1844 
#DebugDumpData("SVN", $svn );
1753 
#$self->{PRINTDATA} = 1;
 1845 
#$self->{PRINTDATA} = 1;
1754 
    $src_label =~ s~^tags/~~;
 1846 
    $src_label =~ s~^tags/~~;
1755 
    $self->SvnCmd ( 'log', '-v', '--xml', '-q', '--stop-on-copy', $self->Full() . '/tags/' . $src_label
 1847 
    $self->SvnCmd ( 'log', '-v', '--xml', '-q', '--stop-on-copy', $self->FullPath() . '/tags/' . $src_label
1756 
                    , { 'credentials' => 1,
 1848 
                    , { 'credentials' => 1,
1757 
                        'process' => \&ProcessBackTrack,
 1849 
                        'process' => \&ProcessBackTrack,
1758 
                         }
 1850 
                         }
1759 
                        );
 1851 
                        );
1760 
 
 1852 
 
Line 1783... Line 1875...
1783 
                $branch = $2 . '@' . $entry->{fromRev};
 1875 
                $branch = $2 . '@' . $entry->{fromRev};
1784 
                last;
 1876 
                last;
1785 
            }
 1877 
            }
1786 
        }
 1878 
        }
1787 
    }
 1879 
    }
- 
 
 1880 
 
- 
 
 1881 
    $$refData = $self->{btData}{data}
- 
 
 1882 
        if ( $refData );
1788 
    delete $self->{btData};
 1883 
    delete $self->{btData};
1789 
 
 1884 
 
1790 
    #
 1885 
    #
1791 
    #   Return nice value or original value
 1886 
    #   Return nice value or original value
1792 
    #
 1887 
    #
Line 1831... Line 1926...
1831 
sub  ProcessBackTrack
 1926 
sub  ProcessBackTrack
1832 
{
 1927 
{
1833 
    my ($self, $line ) = @_;
 1928 
    my ($self, $line ) = @_;
1834 
    Message ( $line ) if $self->{PRINTDATA};
 1929 
    Message ( $line ) if $self->{PRINTDATA};
1835 
 
 1930 
 
1836 
    if ( $line =~ m~^<logentry~ ) {
 1931 
    if ( $line =~ m~^<path$~ ) {
- 
 
 1932 
        delete $self->{btData}{entry};
- 
 
 1933 
    } elsif ( $line =~ m~^\s*kind="(.+)"~ ) {
1837 
        $self->{btData}{entry} = ();
 1934 
        $self->{btData}{entry}{kind} = $1;
1838 
 
 - 
 
1839 
    } elsif ( $line =~ m~^\s+revision="(\d+)"~ ) {
 1935 
    } elsif ( $line =~ m~^\s+revision="(\d+)"~ ) {
1840 
        $self->{btData}{entry}{Rev} = $1;
 1936 
        $self->{btData}{entry}{Rev} = $1;
1841 
 
 - 
 
1842 
    } elsif ( $line =~ m~^\s+copyfrom-path="(.*)"~ ) {
 1937 
    } elsif ( $line =~ m~^\s+copyfrom-path="(.*)"~ ) {
1843 
        $self->{btData}{entry}{fromPath} = $1;
 1938 
        $self->{btData}{entry}{fromPath} = $1;
1844 
 
 - 
 
1845 
    } elsif ( $line =~ m~^\s+copyfrom-rev="(\d+)"~ ) {
 1939 
    } elsif ( $line =~ m~^\s+copyfrom-rev="(\d+)"~ ) {
1846 
        $self->{btData}{entry}{fromRev} = $1;
 1940 
        $self->{btData}{entry}{fromRev} = $1;
1847
- 
 
1848 
    } elsif ( $line =~ m~\s+action=.*?>(.*)</path~ ) {
 1941 
    } elsif ( $line =~ m~^\s*action="(.+)">(.*)</path>~ ) {
1849 
        $self->{btData}{entry}{target} = $1;
 1942 
        $self->{btData}{entry}{action} = $1;
1850 
 
 - 
 
1851 
    } elsif ( $line =~ m~</logentry~ ) {
 - 
 
1852 
        if ( exists $self->{btData}{entry}{fromPath} )
 1943 
        $self->{btData}{entry}{target} = $2;
1853 
        {
 - 
 
1854 
#            DebugDumpData("Data", $self->{btData}{entry};
 1944 
        push @{$self->{btData}{data}}, $self->{btData}{entry};
1855 
            push @{$self->{btData}{data}}, $self->{btData}{entry};
 1945 
        delete $self->{btData}{entry};
1856 
        }
 - 
 
1857 
    }
 1946 
    }
1858 
 
 1947 
 
1859 
    #
 1948 
    #
1860 
    #   Return 0 to keep on going
 1949 
    #   Return 0 to keep on going
1861 
    return 0;
 1950 
    return 0;