Subversion Repositories DevTools

#! perl
########################################################################
# Copyright ( C ) 2004 ERG Limited, All rights reserved
#
# Module name   : jats.sh
# Module type   : Makefile system
# Compiler(s)   : n/a
# Environment(s): jats
#
# Description   : Metrics gathering utility
#                 This is a JATS command line utility that is designed to be
#                 used by the automated build environment to gather metrics
#
#                 The utilty should be called:
#                   1) After a sandbox has been populated, but before
#                      a 'build' has been performed. This allows basic
#                      information to be collected.
#
#                   2) After the build has been completed, but before the
#                      final package has been transferred to dpkg_archive
#                      This allows build information to be collected and
#                      possibly inserted into the descpkg file. Information
#                      is also prepared for transfer to the Release Manager.
#
#               All calls should be performed in the same directory
#               The utility will maintain state information in a file in the
#               'current' directory. This will be created by the first
#               invocation and used by later invocations.
#
#
# Implementation Notes:
#
#
#
# Usage:    jats_metrics
#
#......................................................................#

require 5.006_001;
use strict;
use warnings;

use JatsError;
use FileUtils;
use JatsSystem;
use JatsEnv;
use JatsProperties;

use Getopt::Long;
use Pod::Usage;                             # required for help support
use File::Find;


################################################################################
#   Option variables
#

my $VERSION = "1.0.0";                      # Update this
my $opt_verbose = 0;
my $opt_debug = 0;
my $opt_help = 0;
my $opt_manual;
my $opt_mode;
my $opt_datafile = 'jats_metrics.dat';
my $opt_root;
my $opt_outfile;

#   Globals
#
our $GBE_TOOLS;
our $GBE_PERL;

our $find_dirs;
our $find_files;
our $find_makefiles;
our $find_depth;

my  $joiner_char = ';';

#
#   Option parsing
#
my $result = GetOptions (
                "help+"         => \$opt_help,          # flag, multiple use allowed
                "manual"        => \$opt_manual,        # flag
                "verbose+"      => \$opt_verbose,       # flag
                "debug+"        => \$opt_debug,         # flag
                "mode=s"        => \$opt_mode,          # string
                "datafile=s"    => \$opt_datafile,      # string
                "outfile=s"     => \$opt_outfile,       # string
                "rootdir=s"     => \$opt_root,          # string
                );

#
#   Process help and manual options
#
pod2usage(-verbose => 0, -message => "Version: $VERSION")  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
#
ErrorConfig( 'name'    =>'METRICS',
             'verbose' => $opt_verbose,
             'debug'   => $opt_debug
              );

#
#   Sanity test the user arguemnts
#
Error ("Too many command line arguments: @ARGV" )
    if ( $#ARGV >= 0 );

Error ("No mode specified. Use -mode='mode'")
    unless ( $opt_mode );

#
#   This program requires a 'mode' selector
#   Ensure that a suitable MODE has been used, then
#   Invoke a 'mode' subroutineto do the hard work
#
{
    my $mode_sub = "mode_$opt_mode";
    Error ("Unknown mode: $opt_mode") unless ( exists &$mode_sub );

    no strict 'refs';
    &$mode_sub();
}
exit 0;

#-------------------------------------------------------------------------------
# Function        : mode_init
#
# Description     : Perform the initial metrics collection process
#                   This must be called within a clean build area as
#                   it will gather metrics on files and folders.
#                   If there are build artifacts in the area, then these will
#                   be included in the metrics.
#
#                   The init phase will gather metrics on:
#                       SLOC
#                       Files and Folders
#                       ClearCase branches
#
#
# Inputs          : None. Parameters extracted from global option variables
#
# Returns         : Will not retuirn on error
#
sub mode_init
{
    my $data = JatsProperties::New();

    Message ("Initial Metrics Collection");

    #
    #   Validate required parameters
    #
    Error ("Root directory not specified") unless ( defined $opt_root );
    Error ("Root directory does not exist") unless ( -e $opt_root );
    Error ("Root directory is not a directory") unless ( -d $opt_root );

    Verbose ("Determine LOC");
    EnvImport( "GBE_TOOLS" );
    my $cloc = "$GBE_TOOLS/cloc-1.00.pl";
    Error ("Cannot find cloc utility","Need: $cloc") unless ( -f $cloc );

    #
    #   Invoke a standard version of cloc
    #   Parse the text output.
    #       NOTE: It may be better to modify cloc to get the required data
    #
    EnvImport( "GBE_PERL" );

    open(CMD, "$GBE_PERL $cloc --no3 $opt_root 2>&1 |") || Error "Can't run command: cloc...", "Reason: $!";
    while (<CMD>)
    {
        #
        #   The command output contains both \r and \n terminators
        #   Just to be neat we will split the line again
        #
        foreach  ( split ('[\r\n]', $_ ) )
        {
            Verbose2 ( "cloc resp:" . $_);
            $data->setProperty('code.ignored', $1) if ( m~(\d+)\s+files ignored~ );
            if ( m~^SUM:\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)~ )
            {
                $data->setProperty('code.files',   $1);
                $data->setProperty('lines.blank',   $2);
                $data->setProperty('lines.comment', $3);
                $data->setProperty('lines.code',    $4);
            }
        }
    }
    close(CMD);
    Verbose2 "Exit Status: $?";
    Error ("cloc program reported error: $?") if ($?);

    #
    #   Scan the complete directory tree looking for
    #       files
    #       directories
    #       makefiles.pl
    #
    Verbose ("Determine Files and Dirs");
    $find_dirs = 0;
    $find_files = 0;
    $find_makefiles = 0;
    $find_depth = 0;

    #
    #   Helper routine to count files and directories
    #   Used by File::Find:find
    #
    sub find_filecounter
    {
        if ( -d $_ ) {
            $find_dirs++;
            my @count = split ('[\\/]', $File::Find::dir );
            my $count = $#count + 1;
            $find_depth = $count if ( $count > $find_depth );

        } else {
            $find_files++;
        }

        if ( $_ =~ 'makefile.pl' ) {
            $find_makefiles++;
        } elsif ( $_ =~ m~\w+depends\.xml$~ ) {
            $find_makefiles++;
        }
    }

    #
    #       Under Unix we need to follow symbolic links, but Perl's
    #       Find:find does not work with -follow under windows if the source
    #       path contains a drive letter.
    #
    #       Solution. Only use follow under non-windows systems.
    #                 Works as Windows does not have symlinks (yet).
    #
    my $follow_opt =  ($ENV{GBE_UNIX}  > 0);
    File::Find::find( {wanted => \&find_filecounter, follow_fast => $follow_opt }, $opt_root );


    $data->setProperty('count.file', $find_files);
    $data->setProperty('count.dir',  $find_dirs);
    $data->setProperty('count.dirdepth',  $find_depth);
    $data->setProperty('count.makefile',  $find_makefiles);

    #
    #   Determine the number of clearcase branches used by files
    #   and folders in this view
    #
    Verbose ("Determine ClearCase branches");
    
    #
    #   Ensure that the 'cleartool' program can be located
    #
    Verbose2 ("Locate clearcase utility in users path");
    Error ("Cannot locate the 'cleartool' utility in the users PATH")
        unless ( LocateProgInPath('cleartool', '--All') );

    my %branches;
    my $cmd = QuoteCommand (qw (cleartool ls -vob_only -visible -rec -short), $opt_root );
    Verbose2($cmd);

    open(CMD, "$cmd 2>&1 |") || Error( "can't run command: $!");
    while (<CMD>)
    {
        chomp;
        tr~\\/~/~s;                 # Clean up and convert multiple / and \ -> /

        #
        #   If we are not within a VOB, then we will get errors
        #
        if ( m~cleartool: Error:~i )
        {
            Verbose ( $_ );
            next;
        }

        #
        #   Split the line into filename and branch
        #   Only want the last branch. DOn't need the version on the branch
        #
        m~([^/]+)\@\@.*/(.+)/\d+~;
        my $file = $1;
        my $branch = $2;
        Verbose2( "ct ls: " . $_ . ": $file,[$branch]");

        #
        #   Ignore build files
        #   Try to catch naughty users that put non-buildfiles onthe auto builder branch
        #
        next if ( $file eq 'build.pl' );
        next if ( $file =~ m~depends\.xml$~ );

        $branches{$branch} = 0
            unless ( exists $branches{$branch} );
        $branches{$branch}++;
    }
    close(CMD);
        
    my @blist = sort keys %branches;
    $data->setProperty('ccbranch.count',  1 + $#blist );
    $data->setProperty('ccbranch.list',  join (',', @blist) );
    

    #
    #   All done
    #   Save the current set of metrics
    #
    $data->setProperty('done.init', 1);
    $data->Dump('Init') if ($opt_verbose);
    $data->store( $opt_datafile );
}

#-------------------------------------------------------------------------------
# Function        : mode_finish
#
# Description     : Perform the final metrics collection process
#                   This will populate a specified file with metrics data
#
# Inputs          : None. Parameters extracted from global option variables
#
#
# Returns         : Will not retuirn on error
#
sub mode_finish
{
    Message ("Finish Metrics Collection");

    #
    #   Read in the accumulated properties information
    #   The file must be present, in the default location, or the location
    #   specified by the user.
    #
    my $data = JatsProperties::New($opt_datafile);

    #
    #   Validate required parameters
    #
    Error ("Output file not specified") unless ( defined $opt_outfile );
    Error ("Output file exists and is a directory") if ( -d $opt_outfile );

    unlink $opt_outfile;
    Error ("Output file cannot ") if ( -e $opt_outfile );

    #
    #   Create a data blob that can be passed through to release manager
    #   Design notes:
    #       Will not be processed by anything other than Release Manager
    #       Data may conatin spaces and commas
    #       Data needs to be easy to parse at far end
    #
    $data->Dump('finish') if ($opt_verbose);
    $data->Dump() if ($opt_verbose);

    my $mdata = '';
    my $joiner = '';

    foreach my $name ( sort $data->enum() )
    {
        my $value = $data->getProperty($name);

        #
        #   Since the data fields will be seperated with a $joiner_char, we must
        #   make sure that we don't have the character within the data stream
        #
        Error ("Metric data  contains a '$joiner_char'",
               "Name: $name, Value: $value" ) if ( $value =~ m~$joiner_char~ );

        $mdata .= "$joiner$name=$value";
        $joiner = $joiner_char;
    }
    
    FileCreate ( $opt_outfile, $mdata );
}


#-------------------------------------------------------------------------------
#   Documentation
#

=pod

=for htmltoc    SYSUTIL::

=head1 NAME

jats_metrics - Gather and Process build metrics

=head1 SYNOPSIS

  jats etool jats_metrics [options]

 Options:
    -help               - brief help message
    -help -help         - Detailed help message
    -man                - Full documentation
    -verbose            - Verbose operation
    -mode=MODE          - Specifies mode of operation (Mandatoty)
    -datafile=path      - Path to the metrics data file
    -outfile=file       - Output file
    -rootdir=path       - Base of the package to process


=head1 OPTIONS

=over 8

=item B<-help>

Print a brief help message and exits.

=item B<-help -help>

Print a detailed help message with an explanation for each option.

=item B<-man>

Prints the manual page and exits.

=item B<-verbose>

Increases program output. This option may be specified mutiple times


=item B<-mode=MODE>

This mandatory parameter specifies the mode in which the metrix gathering
program will operate. MODE must be one of:

=over 8

=item *

init

=item *

finish

=back

=item B<-datafile=path>

This option allows the user to provide an alternate data file to be used by the
utilit. The default datafile is located in the current directory. Theis may be
reloacetd if required.


=item B<-outfile=xxx>

The name of the output file.

This option is mandatory for the 'finish' operation.

=item B<-rootdir=path>

This option specified the path to the base of the view to process. The path must
address a valid ClearCase view. Only files and directories below the root will
be considered.

This option is mandatory for the 'init' operation.

=back

=head1 DESCRIPTION

This JATS utility is used within the build system to perform a number of file
mertics gathering and processing operations. The utility performs one of the
sub-comamnds as specified by the B<-mode> option.

=cut