Subversion Repositories DevTools

Rev

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

Rev 1348 Rev 1349
Line 174... Line 174...
174
 
174
 
175
        if ( $self->{PRINTDATA} )
175
        if ( $self->{PRINTDATA} )
176
        {
176
        {
177
            #
177
            #
178
            #   Pretty display for user
178
            #   Pretty display for user
-
 
179
            #   Hide some noise, but not much
179
            #
180
            #
-
 
181
            unless ( $data =~ m~^Export complete.~ )
-
 
182
            {
180
            Information1 ( $self->{CoText} . ': ' . $data);
183
                Information1 ( $self->{CoText} . ': ' . $data);
-
 
184
            }
181
        }
185
        }
182
 
186
 
183
        if (  $data =~ m~((/)(tags|branches|trunk)(/|$))~ )
187
        if (  $data =~ m~((/)(tags|branches|trunk)(/|$))~ )
184
        {
188
        {
185
            my $bad_dir = $1;
189
            my $bad_dir = $1;
Line 1849... Line 1853...
1849
    }
1853
    }
1850
 
1854
 
1851
    return $retval;
1855
    return $retval;
1852
}
1856
}
1853
 
1857
 
1854
 
-
 
1855
#-------------------------------------------------------------------------------
1858
#-------------------------------------------------------------------------------
1856
# Function        : backTrackSvnLabel
1859
# Function        : backTrackSvnLabel
1857
#
1860
#
1858
# Description     : Examine a Svn Tag and backtrack until we find the branch
1861
# Description     : Examine a Svn Tag and backtrack until we find the branch
1859
#                   that was used to create the label
1862
#                   that was used to create the label
1860
#
1863
#
1861
# Inputs          : $self                   - Instance Data
1864
# Inputs          : $self                   - Instance Data
1862
#                   $src_label              - Label to process
1865
#                   $src_label              - Label to process
1863
#                                             Label within the current instance
1866
#                                             Label within the current instance
-
 
1867
#                   A hash of named arguments
-
 
1868
#                       data                - Scalar ref. Hash of good stuff returned
1864
#                   $refData                - Optional Ref.
1869
#                       printdata           - Print RAW svn data
1865
#                                             If present will pass back data
1870
#                       onlysimple          - Do not do exhaustive scan
1866
#
1871
#
1867
# Returns         : Branch from which the label was taken
1872
# Returns         : Branch from which the label was taken
1868
#                   or the label prefixed with 'tags'.
1873
#                   or the label prefixed with 'tags'.
1869
#
1874
#
1870
sub backTrackSvnLabel
1875
sub backTrackSvnLabel
1871
{
1876
{
1872
    my ($self, $src_label, $refData) = @_;
1877
    my $self = shift;
1873
 
-
 
1874
    Error ('Internal: backTrackSvnLabel. 3rd arg must be ref to a scalar')
1878
    my $src_label = shift;
1875
        if ( $refData && ref($refData) ne 'SCALAR' );
1879
    my %opt = @_;
-
 
1880
    my $branch;
1876
 
1881
 
-
 
1882
    Debug ("backTrackSvnLabel");
-
 
1883
    Error ("backTrackSvnLabel: Odd number of args") unless ((@_ % 2) == 0);
-
 
1884
    
1877
    #
1885
    #
1878
    #   Init stored data
1886
    #   May need to read and process data twice
1879
    #
1887
    #   First   - stop on copy. May it fast
1880
    $self->{btData} = ();
1888
    #   Second  - all the log.
1881
 
1889
 
1882
    #
1890
    #
1883
    #   extract data
1891
    #   extract data
1884
    #
1892
    #
1885
    $self->SvnCmd ( 'log', '-v', '--xml', '-q', '--stop-on-copy', $self->FullPath() . '/' . $src_label
1893
    foreach my $mode ( '--stop-on-copy', '' )
-
 
1894
    {
1886
                    , { 'credentials' => 1,
1895
        #   Init stored data
1887
                        'process' => \&ProcessBackTrack,
1896
        #   Used to communicate with callback function(s)
-
 
1897
        #
1888
                        'printdata' => 0,
1898
        Information ("backTrackSvnLabel: Performing exhaustive search") unless $mode;
1889
                         }
1899
        $self->{btData} = ();
-
 
1900
        $self->{btData}{results}{base} = $self->FullPath();
-
 
1901
        $self->{btData}{results}{label} = $src_label;
1890
                        );
1902
        $self->{btData}{results}{changeSets} = 0;
1891
 
1903
 
1892
    #
1904
        #
1893
    #   Process data
-
 
1894
    #       $self->{btData}{entry}      - temp stuff
1905
        #   Linux does not handle empty arguments in the same
1895
    #       @{$self->{btData}{data}}    - Array of entries
1906
        #   manner as windows. Solution: pass an array
1896
    #
1907
        #
1897
    #
1908
        my @mode;
1898
#    DebugDumpData("btData", $self->{btData} );
1909
        push @mode, $mode if ( $mode);
1899
 
1910
 
1900
    my $peglessLabel = $src_label;
1911
        $self->SvnCmd ( 'log', '-v', '--xml', '-q'
1901
       $peglessLabel =~ s~@\d+$~~;
1912
                        , @mode
-
 
1913
                        , $self->FullPath() . '/' . $src_label
1902
    my $branch;
1914
                        , { 'credentials' => 1,
-
 
1915
                            'process' => \&ProcessBackTrack,
1903
    foreach my $entry ( @{$self->{btData}{data}} )
1916
                            'printdata' => $opt{printdata},
1904
    {
-
 
1905
        my $name;
1917
                            'nosavedata' => 1,
1906
        my $isaBranch;
1918
                             }
1907
        my $target = $entry->{target};
1919
                            );
1908
 
1920
 
1909
        if ( $target =~ m~/$peglessLabel$~ )
-
 
1910
        {
-
 
1911
            my $parent = $entry->{fromPath};
1921
        last if ( $self->{btData}{good} );
1912
            if ( defined $parent && $parent =~ m~(.+)/((tags|branches|trunk)(/|$).*)~ )
-
 
1913
            {
-
 
1914
                $branch = $2 . '@' . $entry->{fromRev};
-
 
1915
                last;
1922
        last if ( $opt{onlysimple} );
1916
            }
-
 
1917
        }
-
 
1918
    }
1923
    }
1919
 
1924
 
1920
    #
1925
    #
-
 
1926
    #   Did not backtrack to a branch (or trunk)
1921
    #   Return nice value or original value
1927
    #   Return the users label
1922
    #
1928
    #
1923
    unless ( $branch )
1929
    unless ( $self->{btData}{good} )
1924
    {
1930
    {
1925
        $branch = $src_label;
1931
        $branch = $src_label;
-
 
1932
    }
-
 
1933
    else
-
 
1934
    {
1926
        $self->{btData}{entryCount} = 0;
1935
        $branch = $self->{btData}{results}{devBranch};
1927
    }
1936
    }
1928
 
1937
 
1929
    #
1938
    #
1930
    #   Pass data back to the user
1939
    #   Return data to the user
1931
    #   Clean up data in the class
-
 
1932
    #
1940
    #
1933
    $$refData = $self->{btData}
1941
    if ( my $refData = $opt{data} )
-
 
1942
    {
-
 
1943
        Error ('Internal: backTrackSvnLabel. Arg to "data" must be ref to a scalar')
1934
        if ( $refData );
1944
            unless ( ref($refData) eq 'SCALAR' );
1935
    delete $self->{btData};
1945
        $$refData = $self->{btData}{results};
-
 
1946
    }
1936
 
1947
 
-
 
1948
    #
-
 
1949
    #   Clean up the data
-
 
1950
    #
1937
    Verbose( "backTrackSvnLabel: $src_label -> $branch");
1951
    delete $self->{btData};
1938
    return $branch;
1952
    return $branch;
1939
}
1953
}
1940
 
1954
 
1941
#-------------------------------------------------------------------------------
1955
#-------------------------------------------------------------------------------
1942
# Function        : ProcessBackTrack
1956
# Function        : ProcessBackTrack
Line 1970... Line 1984...
1970
sub  ProcessBackTrack
1984
sub  ProcessBackTrack
1971
{
1985
{
1972
    my ($self, $line ) = @_;
1986
    my ($self, $line ) = @_;
1973
    Message ( $line ) if $self->{PRINTDATA};
1987
    Message ( $line ) if $self->{PRINTDATA};
1974
 
1988
 
-
 
1989
    $line =~ s~\s+$~~;
-
 
1990
    next unless ( $line );
-
 
1991
#    Debug0('', $line);
-
 
1992
 
-
 
1993
    my $workSpace =  \%{$self->{btData}};
1975
    if ( $line =~ m~^<logentry$~ ) {
1994
    if ( $line =~ m~<logentry$~ ) {
-
 
1995
        $workSpace->{mode} = 'l';
-
 
1996
        $workSpace->{rev} = 0;
1976
        $self->{btData}{entryCount} ++;
1997
        $workSpace->{changesSeen} = 0;
-
 
1998
 
-
 
1999
    } elsif ( $line =~ m~</logentry>$~ ) {
-
 
2000
        $workSpace->{mode} = '';
-
 
2001
 
-
 
2002
        #
-
 
2003
        #   End of a <logenty>
-
 
2004
        #   See if we have a result - a dev branch not copied from a tag
-
 
2005
        #
-
 
2006
        if ( exists $workSpace->{devBranch} )
-
 
2007
        {
-
 
2008
            $workSpace->{results}{distance}++;
-
 
2009
            $workSpace->{devBranch} =~ m~/((tags|branches|trunk)(/|\@).*)~;
-
 
2010
            my $devBranch = $1;
-
 
2011
 
-
 
2012
            push @{$workSpace->{results}{paths}}, $devBranch;
-
 
2013
            unless ( $devBranch =~ m ~^tags~ )
-
 
2014
            {
-
 
2015
                $workSpace->{results}{devBranch} = $devBranch;
-
 
2016
                $workSpace->{results}{isaBranch} = 1;
-
 
2017
                $workSpace->{good} = 1;
-
 
2018
                return 1;
-
 
2019
            }
-
 
2020
        }
-
 
2021
 
-
 
2022
    } elsif ( $line =~ m~<path$~ ) {
-
 
2023
        $workSpace->{mode} = 'p';
-
 
2024
        Error ('Path without Rev') unless ( $workSpace->{rev} );
-
 
2025
 
-
 
2026
    } elsif ( $line =~ m~</paths>$~ ) {
-
 
2027
        $workSpace->{mode} = '';
1977
    }
2028
    }
-
 
2029
    return 0 unless ( $workSpace->{mode} );
-
 
2030
 
-
 
2031
    if ( $workSpace->{mode} eq 'l' )
-
 
2032
    {
-
 
2033
        #
-
 
2034
        #   Processing logentry data
-
 
2035
        #       Only need the rev
-
 
2036
        #
-
 
2037
        $workSpace->{rev} = $1
-
 
2038
            if ( $line =~ m~revision=\"(\d+)\"~ );
1978
 
2039
 
1979
    if ( $line =~ m~^<path$~ ) {
2040
    } elsif ( $workSpace->{mode} eq 'p' ) {
-
 
2041
        #
-
 
2042
        #   Processing Paths
-
 
2043
        #       Entries appear to be in a random order
1980
        delete $self->{btData}{entry};
2044
        #       Not always the same order
-
 
2045
        #
-
 
2046
        my $end = 0;
1981
    } elsif ( $line =~ m~^\s*kind="(.+)"~ ) {
2047
        if ( $line =~ s~\s*(.+?)="(.+)">(.*)</path>$~~ )
-
 
2048
        {
-
 
2049
            #
-
 
2050
            #   Last entry has two items
-
 
2051
            #       Attribute
-
 
2052
            #       Data Item
-
 
2053
            #
-
 
2054
            $end = 1;
-
 
2055
            $workSpace->{path}{$1} = $2;
1982
        $self->{btData}{entry}{kind} = $1;
2056
            $workSpace->{path}{DATA} = $3;
-
 
2057
        }
1983
    } elsif ( $line =~ m~^\s+revision="(\d+)"~ ) {
2058
        elsif ($line =~ m~\s*(.*?)="(.*)"~ )
-
 
2059
        {
1984
        $self->{btData}{entry}{Rev} = $1;
2060
            $workSpace->{path}{$1} = $2;
-
 
2061
        }
-
 
2062
#        else
-
 
2063
#        {
-
 
2064
#            Warning ("Cannot decode XML log: $line");
-
 
2065
#        }
-
 
2066
 
-
 
2067
        if ( $end )
-
 
2068
        {
1985
    } elsif ( $line =~ m~^\s+copyfrom-path="(.*)"~ ) {
2069
            if ( exists $workSpace->{path}{'copyfrom-path'} )
-
 
2070
            {
1986
        $self->{btData}{entry}{fromPath} = $1;
2071
                my $srev = $workSpace->{path}{'copyfrom-rev'};
-
 
2072
                $workSpace->{devBranch} = $workSpace->{path}{'copyfrom-path'} . '@' . $srev;
-
 
2073
            }
-
 
2074
 
1987
    } elsif ( $line =~ m~^\s+copyfrom-rev="(\d+)"~ ) {
2075
            elsif ( $workSpace->{path}{'kind'} eq 'file' )
-
 
2076
            {
-
 
2077
                #
-
 
2078
                #   Track files that have been changed between tag and branch
-
 
2079
                #   The log is presented as newest first
-
 
2080
                #   The files have a tag-name component.
-
 
2081
                #       Remove the tag name - so that we can compare files
-
 
2082
                #       Save the first instance of changed files
-
 
2083
                #           Others will be in older versions
-
 
2084
                #           and thus of no interest
-
 
2085
                #
-
 
2086
                #   Count the chnage sets that have changes
-
 
2087
                #   Having changes in multiple change sets indicates
-
 
2088
                #   development on a /tags/ - which is BAD
-
 
2089
                #
-
 
2090
                $workSpace->{path}{'DATA'} =~ m~(.+)/((tags|branches|trunk)(/|$).*)~;
1988
        $self->{btData}{entry}{fromRev} = $1;
2091
                my $file =  $2;
-
 
2092
                my $full = $file;
1989
    } elsif ( $line =~ m~^\s*action="(.+)">(.*)</path>~ ) {
2093
                $file =~ s~^tags/(.+?)/~~;
-
 
2094
 
-
 
2095
                if ( ! exists $workSpace->{files}{$file}  )
-
 
2096
                {
-
 
2097
                    push @{$workSpace->{results}{files}}, $full . '@' . $workSpace->{rev};
-
 
2098
                }
1990
        $self->{btData}{entry}{action} = $1;
2099
                $workSpace->{files}{$file}++;
-
 
2100
                $workSpace->{firstFile} = $file unless ( defined $workSpace->{firstFile} );
-
 
2101
 
1991
        $self->{btData}{entry}{target} = $2;
2102
                unless ( $workSpace->{changesSeen} )
-
 
2103
                {
-
 
2104
                    unless( $workSpace->{firstFile} eq $file )
-
 
2105
                    {
1992
        push @{$self->{btData}{data}}, $self->{btData}{entry};
2106
                        $workSpace->{results}{changeSets}++;
-
 
2107
                        $workSpace->{changesSeen}++;
-
 
2108
                    }
-
 
2109
                }
-
 
2110
 
-
 
2111
                if ( scalar keys %{$workSpace->{files}} > 1 )
-
 
2112
                {
-
 
2113
                    $workSpace->{results}{multipleChanges} = 1;
-
 
2114
                    Verbose ("backTrackSvnLabel: Changes in multiple versions");
-
 
2115
                }
-
 
2116
            }
-
 
2117
 
1993
        delete $self->{btData}{entry};
2118
            delete $workSpace->{path};
-
 
2119
        }
1994
    }
2120
    }
1995
 
2121
 
1996
    #
2122
    #
1997
    #   Return 0 to keep on going
2123
    #   Return 0 to keep on going
1998
    return 0;
2124
    return 0;