Subversion Repositories DevTools

########################################################################

# COPYRIGHT - VIX IP PTY LTD ("VIX"). ALL RIGHTS RESERVED.

#

# Module name   : cc2svn_locateTips.pl

# Module type   : Makefile system

# Compiler(s)   : Perl

# Environment(s): jats

#

# Description   : Locate the tips in a package

#

# Usage:

#

# Version   Who      Date        Description

#

#......................................................................#

require 5.008_002;

use strict;

use warnings;

use Pod::Usage;

use Getopt::Long;

use JatsError;

use JatsSystem;

use JatsSvn qw(:All);

#

#   Options

#

my $opt_help = 0;

my $opt_manual = 0;

my $opt_verbose = 0;

my $opt_url;

#

#   Globals

#

my @dataItems;

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

# Function        : main

#

# Description     : Main entry point

#

# Inputs          : 

#

# Returns         : 

#

my $result = GetOptions (

                "help+"         => \$opt_help,          # Help

                "manual"        => \$opt_manual,        # Help

                "verbose:+"     => \$opt_verbose,       # Versose

                );

#

#   Process help and manual options

#

pod2usage(-verbose => 0 )  if ($opt_help == 1  || ! $result);

pod2usage(-verbose => 1)  if ($opt_help == 2 );

pod2usage(-verbose => 2)  if ($opt_manual || ($opt_help > 2));

#

#   Configure the error reporting process now that we have the user options

#

SystemConfig ('ExitOnError' => 1);

ErrorConfig( 'name'    =>'CC2SVN_LOCATETIPS',

             'verbose' => $opt_verbose,

              );

$opt_url = shift (@ARGV) if ( $#ARGV == 0 );

Error ("No URL specified") unless ( $opt_url );

#

#   Create an SVN session

#

my $svn = NewSessionByUrl ( $opt_url );

#

#   extract data

#

DebugDumpData("SVN", $svn );

    $svn->SvnCmd ( 'log', '-v', '--xml', '--stop-on-copy', $svn->Full()

                    , { 'credentials' => 1,

                        'process' => \&ProcessLog,

                         }

                        );

#DebugDumpData("dataItems", @dataItems );

my %mdata;

my %target;

my %revToName;

my %tags;

my %branches;

my @nonTags;

foreach my $entry ( @dataItems )

{

    push @{$mdata{$entry->{fromPath}}}, $entry;

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

    $revToName{$entry->{Rev}} = $entry->{target};

    my $name;

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

    if ( $target =~ m~/tags/(.*)~ ) {

        $name = $1;

        $tags{$1} = 1;

    } elsif ( $target =~ m~/branches/(.*)~ )  {

        $name = $1;

#        $branches{$1} = 1;

    } else {

        push @nonTags, $target;

    }

    $entry->{fromPath} =~ m~/branches/(.*)~;

    my $fromBranch = $1;

    if ( defined($1) && ! exists $branches{$fromBranch} )

    {

        $branches{$fromBranch} = $name;

    }

}

Message ("Tags", sort keys %tags);

#Message ("Branches", sort keys %branches);

foreach my $branch ( sort keys %branches )

{

    Message ("$branch : $branches{$branch}");

}

Message ('NonTags', sort @nonTags );

#DebugDumpData("From", \%from);

#

#   Create a DOT file

#

    my $filebase = 'aaa';

    open (FH, ">$filebase.dot" ) or die "Cannot open output";

    print FH "digraph \"${filebase}\" {\n";

    #print FH "rankdir=LR;\n";

    print FH "node[fontsize=16];\n";

    print FH "node[target=_graphviz];\n";

    my %doneLabel;

    foreach my $root ( keys %mdata )

    {

        my $last = undef;

        my $first = 1;

        foreach my $entry ( @{$mdata{$root}} )

        {

#            DebugDumpData("dataItems", $entry );

print FH "//root      :$root\n";

print FH "//Rev       :$entry->{Rev}\n";

print FH "//target    :$entry->{target}\n";

print FH "//fromRev   :$entry->{fromRev}\n";

print FH "//fromPath  :$entry->{fromPath}\n";

            if ( $last )

            {

                print FH dotTag($revToName{$entry->{Rev}})  ,' -> ', dotTag($revToName{$last->{Rev}}) , ";\n";

            }

            else

            {

                #

                #   Display branch tip

                #

                my $tip_tag = 'BH_' . dotTag($root);

                print FH $tip_tag  ,'[shape=box label="', "BRANCH_HEAD\\nName: $root",'"];', "\n";

                print FH dotTag($revToName{$entry->{Rev}})  ,' -> ', $tip_tag , ";\n";

            }

##=pod

##            print FH dotTag($entry->{fromRev})  ,' -> ', dotTag($entry->{Rev}) , ";\n";

##            my $text = $first ? "HEAD\\n" : '';

##            print FH $entry->{Rev}  ,'[label="', "$text$entry->{target}\\n$entry->{Rev}" , '"];', "\n";

###            print FH $entry->{fromRev}  ,'[label="', "ROOT\\n $entry->{fromPath}\\n$entry->{fromRev}",'"];', "\n"

###                unless $doneLabel{$root};

##            $doneLabel{$root} = 1;

##

##            if ( $last )

##            {

##                print FH dotTag($last->{Rev})  ,' -> ', dotTag($entry->{fromRev}) , ";\n";

##            }

##            else

##            {

##                #print FH dotTag($target{$entry->{fromPath}})  ,' -> ', dotTag($entry->{fromRev}) , ";\n" if $target{$entry->{fromPath}};

##            }

##=cut

            $last = $entry;

            $first = 0;

        }

        #

        #   Display branch point name

        #

        my $tag = dotTag($revToName{$last->{Rev}});

        print FH dotTag($root)  ,' -> ', $tag , ";\n" if $last;

        print FH dotTag($root)  ,'[label="', "BRANCH_NAME\\n" . $root , '"];', "\n";

        print FH $tag  ,'[label="', "BRANCH_POINT\\n" . $revToName{$last->{Rev}} , '"];', "\n";

    }

    print FH "\n};\n";

    close FH;

    #

    #   Convert DOT to a SVG

    #

    print "Generated: $filebase.dot\n";

sub dotTag

{

    my ($label) = @_;

    $label =~ s~[-() /.]~_~g;

    return $label;

}

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

# Function        : ProcessLog

#

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

#

my $entryData;

sub  ProcessLog

{

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

#print "----- $line\n";

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

        $entryData = ();

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

        $entryData->{Rev} = $1;

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

        $entryData->{fromPath} = $1;

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

        $entryData->{fromRev} = $1;

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

        $entryData->{target} = $1;

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

        if ( exists $entryData->{fromPath} )

        {

#            DebugDumpData("Data", $entryData);

            push @dataItems, $entryData;

        }

    }

    #

    #   Return 0 to keep on going

    return 0;

}