Subversion Repositories DevTools

# Inputs          : $self       - Instance data

#                   Last argument may be a hash of options.

#                           Progress    - True: Show progress

#                           Show        - >1 : display matched Tags and stats

#                                         >2 : display Packages

#                           Tag         - Enable Tag Matching

#                                         Value is the tag to match

#                   Ref to an array of all packahes with matched tag

    #

    #   Extract arguments and options

    #   If last argument is a hesh, then its a hash of options

    #

    my $opt;

        if (@_ > 0 and UNIVERSAL::isa($_[-1],'HASH'));

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

    my @mlist;

        if ( $opt->{Progress} )

        {

            Message ("Reading: " . ( $path || 'RepoRoot') );

        }

        }

    }

    if ( $opt->{Tag} )

    {

        my $tag = $opt->{Tag};

        foreach my $path ( sort @list )

        {

            Message ("Testing: $path") if ( $opt->{Progress} );

            if ( $self->SvnTestPath ( 'Listing Packages', join('/', $repo, $path, 'tags', $tag) ) )

            {

                push @mlist, $path;

            }

    if ( $opt->{Show} )

    {

        Message ("Found Packages:", @list ) if  $opt->{Show} > 2;

        Message ("Tags Found: " . scalar @mlist );

        Message ("Packages Found: " . scalar @list );

    }

#                   $allowError     - Support for bad repositories

# Returns         : 0 - Change made

    my $retval = 0;

        if ( $allowError )

        {

            Warning ("setRepoProperty: $name - FAILED");

            $retval = 1;

        }

        else

        {

        }

    }

    return $retval;

}

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

# Function        : backTrackSvnLabel

#

# Description     : Examine a Svn Tag and backtrack until we find the branch

#                   that was used to create the label

#

# Inputs          : $self                   - Instance Data

#                   $src_label              - Label to process

#                                             Label within the current instance

#

# Returns         : Branch from which the label was taken

#                   or the label prefixed with 'tags'.

#

sub backTrackSvnLabel

{

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

    #

    #   Init stored data

    #

    $self->{btData} = ();

    #

    #   extract data

    #

#    DebugDumpData("SVN", $svn );

#$self->{PRINTDATA} = 1;

    $src_label =~ s~^tags/~~;

    $self->SvnCmd ( 'log', '-v', '--xml', '-q', '--stop-on-copy', $self->Full() . '/tags/' . $src_label

                    , { 'credentials' => 1,

                        'process' => \&ProcessBackTrack,

                         }

                        );

    #

    #   Process data

    #       $self->{btData}{entry}      - temp stuff

    #       @{$self->{btData}{data}}    - Array of entries

    #

    #

#    DebugDumpData("btData", $self->{btData} );

    my $peglessLabel = $src_label;

       $peglessLabel =~ s~@\d+$~~;

    my $branch;

    foreach my $entry ( @{$self->{btData}{data}} )

    {

        my $name;

        my $isaBranch;

        my $target = $entry->{target};

        if ( $target =~ m~/tags/$peglessLabel$~ )

        {

            my $parent = $entry->{fromPath};

            if ( $parent =~ m~(.+)/((tags|branches|trunk)(/|$).*)~ )

            {

                $branch = $2 . '@' . $entry->{fromRev};

                last;

            }

        }

    }

    delete $self->{btData};

    #

    #   Return nice value or original value

    #

    unless ( $branch )

    {

        $branch = 'tags/' . $src_label;

    }

    Verbose( "backTrackSvnLabel: $src_label -> $branch");

    return $branch;

}

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

# Function        : ProcessBackTrack

#

# 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>

#

#

#                   Uses:   $self->{btData}     - Scratch Data

#

# Inputs          : $self           - Class Data

#                   $line           - Input data to parse

#

# Returns         : 0 - Do not terminate input command

#

sub  ProcessBackTrack

{

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

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

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

        $self->{btData}{entry} = ();

    } elsif ( $line =~ m~^\s+revision="(\d+)"~ ) {

        $self->{btData}{entry}{Rev} = $1;

    } elsif ( $line =~ m~^\s+copyfrom-path="(.*)"~ ) {

        $self->{btData}{entry}{fromPath} = $1;

    } elsif ( $line =~ m~^\s+copyfrom-rev="(\d+)"~ ) {

        $self->{btData}{entry}{fromRev} = $1;

    } elsif ( $line =~ m~\s+action=.*?>(.*)</path~ ) {

        $self->{btData}{entry}{target} = $1;

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

        if ( exists $self->{btData}{entry}{fromPath} )

        {

#            DebugDumpData("Data", $self->{btData}{entry};

            push @{$self->{btData}{data}}, $self->{btData}{entry};

        }

    #

    #   Return 0 to keep on going

    return 0;