Subversion Repositories DevTools

Rev

Go to most recent revision | Details | Last modification | View Log | RSS feed

Rev Author Line No. Line
229 dpurdie 1
#! perl
2
########################################################################
3
# Copyright ( C ) 2004 ERG Limited, All rights reserved
4
#
5
# Module name   : jats.sh
6
# Module type   : Makefile system
7
# Compiler(s)   : n/a
8
# Environment(s): jats
9
#
10
# Description   : Metrics gathering utility
11
#                 This is a JATS command line utility that is designed to be
12
#                 used by the automated build environment to gather metrics
13
#
14
#                 The utilty should be called:
15
#                   1) After a sandbox has been populated, but before
16
#                      a 'build' has been performed. This allows basic
17
#                      information to be collected.
18
#
19
#                   2) After the build has been completed, but before the
20
#                      final package has been transferred to dpkg_archive
21
#                      This allows build information to be collected and
22
#                      possibly inserted into the descpkg file. Information
23
#                      is also prepared for transfer to the Release Manager.
24
#
25
#               All calls should be performed in the same directory
26
#               The utility will maintain state information in a file in the
27
#               'current' directory. This will be created by the first
28
#               invocation and used by later invocations.
29
#
30
#
31
# Implementation Notes:
32
#
33
#
34
#
35
# Usage:    jats_metrics
36
#
37
#......................................................................#
38
 
255 dpurdie 39
require 5.006_001;
229 dpurdie 40
use strict;
41
use warnings;
42
 
43
use JatsError;
44
use FileUtils;
45
use JatsSystem;
46
use JatsEnv;
47
use JatsProperties;
48
 
49
use Getopt::Long;
50
use Pod::Usage;                             # required for help support
51
use File::Find;
52
 
53
 
54
################################################################################
55
#   Option variables
56
#
57
 
58
my $VERSION = "1.0.0";                      # Update this
59
my $opt_verbose = 0;
60
my $opt_debug = 0;
61
my $opt_help = 0;
62
my $opt_manual;
63
my $opt_mode;
64
my $opt_datafile = 'jats_metrics.dat';
65
my $opt_root;
66
my $opt_outfile;
67
 
68
#   Globals
69
#
70
our $GBE_TOOLS;
71
our $GBE_PERL;
72
 
73
our $find_dirs;
74
our $find_files;
75
our $find_makefiles;
76
our $find_depth;
77
 
78
my  $joiner_char = ';';
79
 
80
#
81
#   Option parsing
82
#
83
my $result = GetOptions (
84
                "help+"         => \$opt_help,          # flag, multiple use allowed
85
                "manual"        => \$opt_manual,        # flag
86
                "verbose+"      => \$opt_verbose,       # flag
87
                "debug+"        => \$opt_debug,         # flag
88
                "mode=s"        => \$opt_mode,          # string
89
                "datafile=s"    => \$opt_datafile,      # string
90
                "outfile=s"     => \$opt_outfile,       # string
91
                "rootdir=s"     => \$opt_root,          # string
92
                );
93
 
94
#
95
#   Process help and manual options
96
#
97
pod2usage(-verbose => 0, -message => "Version: $VERSION")  if ($opt_help == 1  || ! $result);
98
pod2usage(-verbose => 1)  if ($opt_help == 2 );
99
pod2usage(-verbose => 2)  if ($opt_manual || ($opt_help > 2));
100
 
101
#
102
#   Configure the error reporting process now that we have the user options
103
#
104
ErrorConfig( 'name'    =>'METRICS',
105
             'verbose' => $opt_verbose,
106
             'debug'   => $opt_debug
107
              );
108
 
109
#
110
#   Sanity test the user arguemnts
111
#
112
Error ("Too many command line arguments: @ARGV" )
113
    if ( $#ARGV >= 0 );
114
 
115
Error ("No mode specified. Use -mode='mode'")
116
    unless ( $opt_mode );
117
 
118
#
119
#   This program requires a 'mode' selector
120
#   Ensure that a suitable MODE has been used, then
121
#   Invoke a 'mode' subroutineto do the hard work
122
#
123
{
124
    my $mode_sub = "mode_$opt_mode";
125
    Error ("Unknown mode: $opt_mode") unless ( exists &$mode_sub );
126
 
127
    no strict 'refs';
128
    &$mode_sub();
129
}
130
exit 0;
131
 
132
#-------------------------------------------------------------------------------
133
# Function        : mode_init
134
#
135
# Description     : Perform the initial metrics collection process
136
#                   This must be called within a clean build area as
137
#                   it will gather metrics on files and folders.
138
#                   If there are build artifacts in the area, then these will
139
#                   be included in the metrics.
140
#
141
#                   The init phase will gather metrics on:
142
#                       SLOC
143
#                       Files and Folders
144
#                       ClearCase branches
145
#
146
#
147
# Inputs          : None. Parameters extracted from global option variables
148
#
149
# Returns         : Will not retuirn on error
150
#
151
sub mode_init
152
{
153
    my $data = JatsProperties::New();
154
 
155
    Message ("Initial Metrics Collection");
156
 
157
    #
158
    #   Validate required parameters
159
    #
160
    Error ("Root directory not specified") unless ( defined $opt_root );
161
    Error ("Root directory does not exist") unless ( -e $opt_root );
162
    Error ("Root directory is not a directory") unless ( -d $opt_root );
163
 
164
    Verbose ("Determine LOC");
165
    EnvImport( "GBE_TOOLS" );
166
    my $cloc = "$GBE_TOOLS/cloc-1.00.pl";
167
    Error ("Cannot find cloc utility","Need: $cloc") unless ( -f $cloc );
168
 
169
    #
170
    #   Invoke a standard version of cloc
171
    #   Parse the text output.
172
    #       NOTE: It may be better to modify cloc to get the required data
173
    #
174
    EnvImport( "GBE_PERL" );
175
 
176
    open(CMD, "$GBE_PERL $cloc --no3 $opt_root 2>&1 |") || Error "Can't run command: cloc...", "Reason: $!";
177
    while (<CMD>)
178
    {
179
        #
180
        #   The command output contains both \r and \n terminators
181
        #   Just to be neat we will split the line again
182
        #
183
        foreach  ( split ('[\r\n]', $_ ) )
184
        {
185
            Verbose2 ( "cloc resp:" . $_);
186
            $data->setProperty('code.ignored', $1) if ( m~(\d+)\s+files ignored~ );
187
            if ( m~^SUM:\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)~ )
188
            {
189
                $data->setProperty('code.files',   $1);
190
                $data->setProperty('lines.blank',   $2);
191
                $data->setProperty('lines.comment', $3);
192
                $data->setProperty('lines.code',    $4);
193
            }
194
        }
195
    }
196
    close(CMD);
197
    Verbose2 "Exit Status: $?";
198
    Error ("cloc program reported error: $?") if ($?);
199
 
200
    #
201
    #   Scan the complete directory tree looking for
202
    #       files
203
    #       directories
204
    #       makefiles.pl
205
    #
206
    Verbose ("Determine Files and Dirs");
207
    $find_dirs = 0;
208
    $find_files = 0;
209
    $find_makefiles = 0;
210
    $find_depth = 0;
211
 
212
    #
213
    #   Helper routine to count files and directories
214
    #   Used by File::Find:find
215
    #
216
    sub find_filecounter
217
    {
218
        if ( -d $_ ) {
219
            $find_dirs++;
220
            my @count = split ('[\\/]', $File::Find::dir );
221
            my $count = $#count + 1;
222
            $find_depth = $count if ( $count > $find_depth );
223
 
224
        } else {
225
            $find_files++;
226
        }
227
 
228
        if ( $_ =~ 'makefile.pl' ) {
229
            $find_makefiles++;
230
        } elsif ( $_ =~ m~\w+depends\.xml$~ ) {
231
            $find_makefiles++;
232
        }
233
    }
234
 
235
    #
236
    #       Under Unix we need to follow symbolic links, but Perl's
237
    #       Find:find does not work with -follow under windows if the source
238
    #       path contains a drive letter.
239
    #
240
    #       Solution. Only use follow under non-windows systems.
241
    #                 Works as Windows does not have symlinks (yet).
242
    #
243
    my $follow_opt =  ($ENV{GBE_UNIX}  > 0);
244
    File::Find::find( {wanted => \&find_filecounter, follow_fast => $follow_opt }, $opt_root );
245
 
246
 
247
    $data->setProperty('count.file', $find_files);
248
    $data->setProperty('count.dir',  $find_dirs);
249
    $data->setProperty('count.dirdepth',  $find_depth);
250
    $data->setProperty('count.makefile',  $find_makefiles);
251
 
252
    #
253
    #   Determine the number of clearcase branches used by files
254
    #   and folders in this view
255
    #
256
    Verbose ("Determine ClearCase branches");
257
 
258
    #
259
    #   Ensure that the 'cleartool' program can be located
260
    #
261
    Verbose2 ("Locate clearcase utility in users path");
262
    Error ("Cannot locate the 'cleartool' utility in the users PATH")
263
        unless ( LocateProgInPath('cleartool', '--All') );
264
 
265
    my %branches;
266
    my $cmd = QuoteCommand (qw (cleartool ls -vob_only -visible -rec -short), $opt_root );
267
    Verbose2($cmd);
268
 
269
    open(CMD, "$cmd 2>&1 |") || Error( "can't run command: $!");
270
    while (<CMD>)
271
    {
272
        chomp;
273
        tr~\\/~/~s;                 # Clean up and convert multiple / and \ -> /
274
 
275
        #
276
        #   If we are not within a VOB, then we will get errors
277
        #
278
        if ( m~cleartool: Error:~i )
279
        {
280
            Verbose ( $_ );
281
            next;
282
        }
283
 
284
        #
285
        #   Split the line into filename and branch
286
        #   Only want the last branch. DOn't need the version on the branch
287
        #
288
        m~([^/]+)\@\@.*/(.+)/\d+~;
289
        my $file = $1;
290
        my $branch = $2;
291
        Verbose2( "ct ls: " . $_ . ": $file,[$branch]");
292
 
293
        #
294
        #   Ignore build files
295
        #   Try to catch naughty users that put non-buildfiles onthe auto builder branch
296
        #
297
        next if ( $file eq 'build.pl' );
298
        next if ( $file =~ m~depends\.xml$~ );
299
 
300
        $branches{$branch} = 0
301
            unless ( exists $branches{$branch} );
302
        $branches{$branch}++;
303
    }
304
    close(CMD);
305
 
306
    my @blist = sort keys %branches;
307
    $data->setProperty('ccbranch.count',  1 + $#blist );
308
    $data->setProperty('ccbranch.list',  join (',', @blist) );
309
 
310
 
311
    #
312
    #   All done
313
    #   Save the current set of metrics
314
    #
315
    $data->setProperty('done.init', 1);
316
    $data->Dump('Init') if ($opt_verbose);
317
    $data->store( $opt_datafile );
318
}
319
 
320
#-------------------------------------------------------------------------------
321
# Function        : mode_finish
322
#
323
# Description     : Perform the final metrics collection process
324
#                   This will populate a specified file with metrics data
325
#
326
# Inputs          : None. Parameters extracted from global option variables
327
#
328
#
329
# Returns         : Will not retuirn on error
330
#
331
sub mode_finish
332
{
333
    Message ("Finish Metrics Collection");
334
 
335
    #
336
    #   Read in the accumulated properties information
337
    #   The file must be present, in the default location, or the location
338
    #   specified by the user.
339
    #
340
    my $data = JatsProperties::New($opt_datafile);
341
 
342
    #
343
    #   Validate required parameters
344
    #
345
    Error ("Output file not specified") unless ( defined $opt_outfile );
346
    Error ("Output file exists and is a directory") if ( -d $opt_outfile );
347
 
348
    unlink $opt_outfile;
349
    Error ("Output file cannot ") if ( -e $opt_outfile );
350
 
351
    #
352
    #   Create a data blob that can be passed through to release manager
353
    #   Design notes:
354
    #       Will not be processed by anything other than Release Manager
355
    #       Data may conatin spaces and commas
356
    #       Data needs to be easy to parse at far end
357
    #
358
    $data->Dump('finish') if ($opt_verbose);
359
    $data->Dump() if ($opt_verbose);
360
 
261 dpurdie 361
    my $mdata = '';
229 dpurdie 362
    my $joiner = '';
261 dpurdie 363
 
229 dpurdie 364
    foreach my $name ( sort $data->enum() )
365
    {
366
        my $value = $data->getProperty($name);
367
 
368
        #
369
        #   Since the data fields will be seperated with a $joiner_char, we must
370
        #   make sure that we don't have the character within the data stream
371
        #
372
        Error ("Metric data  contains a '$joiner_char'",
373
               "Name: $name, Value: $value" ) if ( $value =~ m~$joiner_char~ );
374
 
261 dpurdie 375
        $mdata .= "$joiner$name=$value";
229 dpurdie 376
        $joiner = $joiner_char;
377
    }
261 dpurdie 378
 
379
    FileCreate ( $opt_outfile, $mdata );
229 dpurdie 380
}
381
 
382
 
383
#-------------------------------------------------------------------------------
384
#   Documentation
385
#
386
 
387
=pod
388
 
361 dpurdie 389
=for htmltoc    SYSUTIL::
390
 
229 dpurdie 391
=head1 NAME
392
 
393
jats_metrics - Gather and Process build metrics
394
 
395
=head1 SYNOPSIS
396
 
397
  jats etool jats_metrics [options]
398
 
399
 Options:
400
    -help               - brief help message
401
    -help -help         - Detailed help message
402
    -man                - Full documentation
403
    -verbose            - Verbose operation
404
    -mode=MODE          - Specifies mode of operation (Mandatoty)
405
    -datafile=path      - Path to the metrics data file
406
    -outfile=file       - Output file
407
    -rootdir=path       - Base of the package to process
408
 
409
 
410
=head1 OPTIONS
411
 
412
=over 8
413
 
414
=item B<-help>
415
 
416
Print a brief help message and exits.
417
 
418
=item B<-help -help>
419
 
420
Print a detailed help message with an explanation for each option.
421
 
422
=item B<-man>
423
 
424
Prints the manual page and exits.
425
 
426
=item B<-verbose>
427
 
428
Increases program output. This option may be specified mutiple times
429
 
430
 
431
=item B<-mode=MODE>
432
 
433
This mandatory parameter specifies the mode in which the metrix gathering
434
program will operate. MODE must be one of:
435
 
436
=over 8
437
 
361 dpurdie 438
=item *
229 dpurdie 439
 
361 dpurdie 440
init
229 dpurdie 441
 
361 dpurdie 442
=item *
443
 
444
finish
445
 
229 dpurdie 446
=back
447
 
448
=item B<-datafile=path>
449
 
450
This option allows the user to provide an alternate data file to be used by the
451
utilit. The default datafile is located in the current directory. Theis may be
452
reloacetd if required.
453
 
454
 
455
=item B<-outfile=xxx>
456
 
457
The name of the output file.
458
 
459
This option is mandatory for the 'finish' operation.
460
 
461
=item B<-rootdir=path>
462
 
463
This option specified the path to the base of the view to process. The path must
464
address a valid ClearCase view. Only files and directories below the root will
465
be considered.
466
 
467
This option is mandatory for the 'init' operation.
468
 
469
=back
470
 
471
=head1 DESCRIPTION
472
 
473
This JATS utility is used within the build system to perform a number of file
474
mertics gathering and processing operations. The utility performs one of the
475
sub-comamnds as specified by the B<-mode> option.
476
 
477
=cut
478