Subversion Repositories DevTools

#                   

#                   Only allow a 'copy' if the local workspace NOT a

#                   mixed workspace. A mixed workspace will have 

#                   unexpected results - files will be added/deleted/moved

#                   on 'tags' but not appear on the source branch. 

#                   This is a trap.

    #

    #   Ensure the workspace is not Mixed

    #   Perform an svn info -R and ensure that all files are at the same 'Revision'

    #       Note: can't use the --show-item option as not all versions of svn support this

    #   

    unless ( $opt{allowLocalMods} )

    {

        Verbose "Ensure workspace does not contain Mixed Revisions";

        $rv = $self->SvnCmd ( 'info', '-R' , $path

                            , { 'process' => \&ProcessMixedRev,

                                'nosavedata' => 1,

                                'printdata' => 0,

                                 }

                            );

        if ($rv)

        {

            my @err1 = @{$self->{ERROR_LIST}};

            Error ("SvnCopyWs: Check Mixed Versions", @err1);

        }

        if ($self->{'MixedRev'} )

        {

            Error ('SvnCopyWs: The Workspace contains mixed revision.',

                   'This will result in file changes being made on the \'tags\' path and not',

                   'correctly represented on the branch/trunk.',

                   'Update the workspace and try again.');

        }

    }

# Function        : ProcessMixedRev 

#

# Description     : Process svn output looking for mixed revisions in the workspace

#                   Just interested in the 'Revision:' of each file

#                   Really just want to know if there is more than one revision

#                   workspace.

#

# Inputs          : $self           - Class Data

#                   $line           - Input data to parse

#

# Returns         : 0 - Do not terminate input command

#

sub ProcessMixedRev

{

    my ($self, $line ) = @_;

    Message ( $line ) if $self->{PRINTDATA};

    $line =~ s~\s+$~~;

    return 0 unless ( $line );

    return 0 unless ($line =~ m~^Revision:\s*(\d+)~);

    my $revNo = $1;

     my $revNoStash =  \%{$self->{revNoStash}};

     $revNoStash->{$revNo}++;

     if (scalar keys %{$revNoStash} > 1 ) {

         $self->{'MixedRev'} = 1;

         return 1;

     }

    return 0;

}

#-------------------------------------------------------------------------------

    my $rv;

    if ( $test && $rv )

        Verbose2("SvnLocateWsRoot: Invalid path: $rv");

    return 0;

}

#-------------------------------------------------------------------------------

# Function        :  

#

# Description     : Examine the current workspace and exact information about its

#                   parent.

#                   

#                   Does not extract the entire log history - just the last copyfrom

#

# Inputs          : $self

#

# Returns         : Nothing

#                   Will add {InfoWsExtra} to the session handle

#

sub getWsExtraInfo

{

    my $self = shift;

#DebugDumpData("getWsExtraInfo", $self);

    my $path;

    if (exists $self->{InfoWs}{Path}) {

        $path = $self->{InfoWs}{Path}; 

    } else {

        $path = $self->Full();

    }

    #

    #   Determine the source of the merge

    #   Create a hash entry to store working data

    # 

    $self->{btData} = {};

    $self->SvnCmd ( 'log', '-v', '--xml', '--stop-on-copy', '--limit', '1', '-r0:HEAD', $path

                    , { 'process' => \&ProcessWsExtraInfo,

                        'credentials' => 1

                         }

                        );

    # Grab the first entry of the log array - should only be one

    #

    $self->{InfoWsExtra} = $self->{btData}{Data}[0];

    delete $self->{btData};

}

#-------------------------------------------------------------------------------

# Function        : ProcessWsExtraInfo

#

# Description     :

#                   Parse

#                       <logentry

#                          revision="24272">

#                       <author>bivey</author>

#                       <date>2005-07-25T15:45:35.000000Z</date>

#                       <paths>

#                       <path

#                          prop-mods="false"

#                          text-mods="false"

#                          kind="dir"

#                          copyfrom-path="/enqdef/branches/Stockholm"

#                          copyfrom-rev="24271"

#                          action="A">/enqdef/tags/enqdef_24.0.1.sls</path>

#                       </paths>

#                       <msg>COTS/enqdef: Tagged by Jats Svn Import</msg>

#                       </logentry>

#

# Inputs          : 

#

# Returns         : 

#

sub  ProcessWsExtraInfo

{

    my ($self, $line ) = @_;

    my $data = $self->{btData};

    $data->{Mode} = '' unless ( defined $data->{Mode} );

    return unless ( $line );

#print "----- ($data->{Mode}) $line\n";

    if ( $line =~ m~^<logentry~ ) {

        $data->{Item} = ();

        $data->{Mode} = 'A';

    } elsif ( ($line =~ s~\s*(.+?)="(.*)">(.*)</path>$~~) && ($data->{Mode} eq 'A') ) {

        #

        #   Last entry has two items

        #       Attribute

        #       Data Item

        #

        $data->{Item}->{$1} = $2;

        $data->{Item}->{target} = $3;

    } elsif ( ($line =~ m~\s*(.*?)="(.*)"~) && ($data->{Mode} eq 'A') ) {

        #

        #   Attribute

        #

        $data->{Item}->{$1} = $2;

    } elsif ( $line =~ m~</logentry~ ) {

        $data->{Mode} = '';

        if ( exists $data->{Item}->{'copyfrom-path'} )

        {

            #DebugDumpData("Data", $data->{Item});

            push @{$data->{Data}}, $data->{Item};

        }

    }

    #

    #   Return 0 to keep on going