Subversion Repositories DevTools

########################################################################
# COPYRIGHT - VIX IP PTY LTD ("VIX"). ALL RIGHTS RESERVED.
#
# Module name   : cc2svn_cctest_paths.pl
# Module type   : Makefile system
# Compiler(s)   : Perl
# Environment(s): jats
#
# Description   : Test CC paths
#                 Process a cc2svn.raw.txt file and examine the CC
#                 tags for validity.
#
#                 Not fast as it creates a dynamic view for each one
#                 About one evry two seconds :(
#
#                 Creates a log file
#
#                 Can be stopped by creating a stop file
#
#                 Can read in a log file and not retry known good labels
#
#......................................................................#

require 5.006_001;
use strict;
use warnings;
use JatsError;
use JatsSystem;
use Getopt::Long;
use Pod::Usage;                                 # required for help support
use JatsRmApi;


my $opt_verbose = 1;
my $opt_help = 0;
my $opt_manual;
my $opt_retest;

#
#   Package information
#
our %ScmReleases;
our %ScmPackages;
our %ScmSuffixes;

my %Good;
my %Bad;
my $goodFile = 'cc2svn_labeltest.txt';
my $badFile ='cc2svn_labeltest.bad.txt';


#-------------------------------------------------------------------------------
# Function        : Main Entry
#
# Description     :
#
# Inputs          :
#
# Returns         :
#
my $result = GetOptions (
                "help+"         => \$opt_help,          # flag, multiple use allowed
                "manual"        => \$opt_manual,        # flag
                "verbose+"      => \$opt_verbose,       # flag
                "retest"        => \$opt_retest,        # flag
                );

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


ErrorConfig( 'name'    =>'CCTEST_PATHS' );
Message ("Reading input data");
inputData();
inputPastData();

#
#   If retesting, then delete the Bad data
#
if ( $opt_retest )
{
    Message ("Deleting Bad Tag database");
    unlink $badFile;
    %Bad = ();
}

    #
    #   Process the data and attempt to validate the label for each package
    #
    SystemConfig ('ExitOnError' => 0);
    foreach ( sort {lc($ScmPackages{$a}{name}) cmp lc($ScmPackages{$b}{name}) } keys %ScmPackages )
    {
        next if ( exists $Good{$_} );
        next if ( exists $Bad{$_} );

        if ( -f 'stop' )
        {
            unlink 'stop';
            Error ("Stop file encountered");
        }
        my $tag = $ScmPackages{$_}{vcstag};
        my $name = $ScmPackages{$_}{name};
        my $rv = 0;
        next if ( $tag =~ m~^SVN::~ );                     # Skip packages in Subversion
        next if ( $name eq 'AtmelHAL' );                   # Skip - vob not available

        $tag =~ tr~\\/~/~;
        if ( $tag !~ m~^CC::~ || examineVcsTag ($tag)){
            $rv = 55;
        }

        unless ( $rv )
        {
            $rv = JatsToolPrint ( 'cc2svn_cctest_path.pl', $tag );
        }

        doLog ($rv, "$_, $name: $tag, $rv");
    }

sub JatsToolPrint
{
#    Information ("Command: @_");
    JatsTool @_;
}
    

#-------------------------------------------------------------------------------
# Function        : inputData
#
# Description     : Write out data in a form to allow post processing
#
# Inputs          : 
#
# Returns         : 
#
sub inputData
{

    my $fname = 'cc2svn.raw.txt';
    Error "Cannot locate $fname" unless ( -f $fname );
    require $fname;

    Error "Data in $fname is not valid\n"
        unless ( keys(%ScmReleases) >= 0 );

#    DebugDumpData("ScmReleases", \%ScmReleases );
#    DebugDumpData("ScmPackages", \%ScmPackages );
#    DebugDumpData("ScmSuffixes", \%ScmSuffixes );
}

#-------------------------------------------------------------------------------
# Function        : examineVcsTag
#
# Description     : Examine a VCS Tag and determine if it looks like rubbish
#
# Inputs          : Tag to examine
#
# Returns         : Badness
#
sub examineVcsTag
{
    my ($vcstag) = @_;
    my $bad = 0;
    if ( $vcstag =~ m~^CC::(.*?)(::(.+))?$~ )
    {
        my $path = $1  || '';
        my $label = $2 || '';
#print "$vcstag, $bad, $path, $label\n";
        $bad = 1 unless ( $label );
        $bad = 1 if ( $label =~ m~^N/A$~i || $label  =~ m~^na$~i );

        $bad = 1 unless ( $path );
        $bad = 1 if ( $path =~ m~^N/A$~i || $path  =~ m~^na$~i );
        $bad = 1 if ( $path =~ m~^/dpkg_archive~ );
        $bad = 1 if ( $path =~ m~^dpkg_archive~ );
        $bad = 1 if ( $path =~ m~^http:~i );
        $bad = 1 if ( $path =~ m~^[A-Za-z]\:~ );
        $bad = 1 if ( $path =~ m~^//~ );
#        $bad = 1 unless ( $path =~ m~^/~ );
    }
    else
    {
        $bad = 1;
    }
    return $bad;
}

#-------------------------------------------------------------------------------
# Function        : doLog
#
# Description     : Log data to output file
#
# Inputs          : $rv                 - Result code
#                                         Determine log file
#                   Data to log
#
# Returns         : 
#
sub doLog
{
    my $rv = shift;
    my $file = $rv ? $badFile : $goodFile;
    open (my $fh, '>>', $file);
    print $fh @_, "\n";
    close $fh;
}

#-------------------------------------------------------------------------------
# Function        : inputPastData
#
# Description     : Read in a previous log file and determine versions that
#                   have already been examined
#
# Inputs          : 
#
# Returns         : 
#
sub inputPastData
{
    Message ("Reading historical data");
    open (my $fh, '<', $goodFile );
    while ( <$fh> )
    {
        #
        #   Format of data is:
        #       pvid, $name:, $tag, $rv
        #
        chomp;
        next if ( m~^#~ );
        my @data = split (/\s*,\s*/, $_);
        next if ( $data[2] );
        next unless ( $data[0] );

        $Good{$data[0]} = 1;
    }
    close $fh;


    #
    #   Also read in the 'known' bad data
    #

    if ( -f $badFile )
    {
        open (my $fh, '<', $badFile );
        while ( <$fh> )
        {
            #
            #   Format of data is:
            #       pvid, $name:, $tag, $rv
            #
            chomp;
            next if ( m~^#~ );
            my @data = split (/\s*,\s*/, $_);
            next unless ( $data[2] );
            next unless ( $data[0] );

            $Bad{$data[0]} = 1;
        }
        close $fh;
    }
}