Subversion Repositories DevTools

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

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

    }

}