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;