Subversion Repositories DevTools

########################################################################
# Copyright (C) 1998-2012 Vix Technology, 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;
}