[10] | 1 | #!/usr/bin/perl |
---|
| 2 | # ------------------------------------------------------------------------------ |
---|
| 3 | # NAME |
---|
| 4 | # fcm |
---|
| 5 | # |
---|
| 6 | # SYNOPSIS |
---|
| 7 | # fcm SUBCOMMAND [OPTIONS...] ARGS... |
---|
| 8 | # |
---|
| 9 | # DESCRIPTION |
---|
| 10 | # The fcm command is the frontend of the FCM system. The first argument to the |
---|
| 11 | # command must be a recognised subcommand. See "fcm help" for a full list of |
---|
| 12 | # functionalities. |
---|
| 13 | # |
---|
| 14 | # COPYRIGHT |
---|
| 15 | # (C) Crown copyright Met Office. All rights reserved. |
---|
| 16 | # For further details please refer to the file COPYRIGHT.txt |
---|
| 17 | # which you should have received as part of this distribution. |
---|
| 18 | # ------------------------------------------------------------------------------ |
---|
| 19 | |
---|
| 20 | # Standard pragmas: |
---|
| 21 | use warnings; |
---|
| 22 | use strict; |
---|
| 23 | |
---|
| 24 | # Standard modules: |
---|
| 25 | use File::Basename; |
---|
| 26 | use File::Spec; |
---|
| 27 | use Getopt::Long; |
---|
| 28 | use Cwd; |
---|
| 29 | |
---|
| 30 | # FCM component modules: |
---|
| 31 | use lib File::Spec->catfile (dirname (dirname ($0)), 'lib'); |
---|
| 32 | use Fcm::Config; |
---|
| 33 | use Fcm::Extract; |
---|
| 34 | use Fcm::Build; |
---|
| 35 | use Fcm::Util; |
---|
| 36 | |
---|
| 37 | BEGIN { |
---|
| 38 | eval { |
---|
| 39 | require Fcm::Cm; |
---|
| 40 | import Fcm::Cm; |
---|
| 41 | |
---|
| 42 | require Fcm::CmUrl; |
---|
| 43 | import Fcm::CmUrl; |
---|
| 44 | } |
---|
| 45 | } |
---|
| 46 | |
---|
| 47 | # Function declaration: |
---|
| 48 | sub cmp_ext_cfg; |
---|
| 49 | sub invoke_build_system; |
---|
| 50 | sub invoke_extract_system; |
---|
| 51 | sub invoke_cfg_printer; |
---|
| 52 | sub invoke_cm_system; |
---|
| 53 | sub invoke_www_browser; |
---|
| 54 | sub invoke_help; |
---|
| 55 | |
---|
| 56 | # ------------------------------------------------------------------------------ |
---|
| 57 | |
---|
| 58 | my $prog = basename $0; |
---|
| 59 | my $year = (localtime)[5] + 1900; |
---|
| 60 | my $copyright = <<EOF; |
---|
| 61 | |
---|
| 62 | (C) Crown copyright $year Met Office. All rights reserved. |
---|
| 63 | EOF |
---|
| 64 | |
---|
| 65 | # List of sub-commands recognised by FCM |
---|
| 66 | my %subcommand = ( |
---|
| 67 | HLP => [qw/help ? h/], |
---|
| 68 | BLD => [qw/build bld/], |
---|
| 69 | EXT => [qw/extract ext/], |
---|
| 70 | CFG => [qw/cfg/], |
---|
| 71 | GUI => [qw/gui/], |
---|
| 72 | CM => [qw/ |
---|
| 73 | branch br |
---|
| 74 | conflicts cf |
---|
| 75 | add |
---|
| 76 | blame praise annotate ann |
---|
| 77 | cat |
---|
| 78 | checkout co |
---|
| 79 | cleanup |
---|
| 80 | commit ci |
---|
| 81 | copy cp |
---|
| 82 | delete del remove rm |
---|
| 83 | diff di |
---|
| 84 | export |
---|
| 85 | import |
---|
| 86 | info |
---|
| 87 | list ls |
---|
| 88 | lock |
---|
| 89 | log |
---|
| 90 | merge |
---|
| 91 | mkdir |
---|
| 92 | mkpatch |
---|
| 93 | move mv rename ren |
---|
| 94 | propdel pdel pd |
---|
| 95 | propedit pedit pe |
---|
| 96 | propget pget pg |
---|
| 97 | proplist plist pl |
---|
| 98 | propset pset ps |
---|
| 99 | resolved |
---|
| 100 | revert |
---|
| 101 | status stat st |
---|
| 102 | switch sw |
---|
| 103 | unlock |
---|
| 104 | update up |
---|
| 105 | /], |
---|
| 106 | CMP => [qw/cmp-ext-cfg/], |
---|
| 107 | WWW => [qw/www trac/], |
---|
| 108 | ); |
---|
| 109 | |
---|
| 110 | # Get configuration settings |
---|
| 111 | my $config = Fcm::Config->new (); |
---|
| 112 | $config->get_config (); |
---|
| 113 | |
---|
| 114 | # Determine the functionality of this invocation of the command |
---|
| 115 | my $function = @ARGV ? shift @ARGV : ''; |
---|
| 116 | |
---|
| 117 | # Run command accordingly |
---|
| 118 | if (grep {$_ eq $function} @{ $subcommand{BLD} }) { |
---|
| 119 | invoke_build_system; |
---|
| 120 | |
---|
| 121 | } elsif (grep {$_ eq $function} @{ $subcommand{EXT} }) { |
---|
| 122 | invoke_extract_system; |
---|
| 123 | |
---|
| 124 | } elsif (grep {$_ eq $function} @{ $subcommand{CFG} }) { |
---|
| 125 | invoke_cfg_printer; |
---|
| 126 | |
---|
| 127 | } elsif (grep {$_ eq $function} @{ $subcommand{GUI} }) { |
---|
| 128 | &run_command (['fcm_gui', @ARGV], METHOD => 'exec'); |
---|
| 129 | |
---|
| 130 | } elsif (grep {$_ eq $function} @{ $subcommand{CM} }) { |
---|
| 131 | invoke_cm_system; |
---|
| 132 | |
---|
| 133 | } elsif (grep {$_ eq $function} @{ $subcommand{CMP} }) { |
---|
| 134 | cmp_ext_cfg; |
---|
| 135 | |
---|
| 136 | } elsif (grep {$_ eq $function} @{ $subcommand{WWW} }) { |
---|
| 137 | invoke_www_browser; |
---|
| 138 | |
---|
| 139 | } elsif ($function =~ /^\s*$/ or grep {$_ eq $function} @{ $subcommand{HLP} }) { |
---|
| 140 | invoke_help; |
---|
| 141 | |
---|
| 142 | } else { |
---|
| 143 | w_report 'Unknown command: ', $function; |
---|
| 144 | e_report 'Type "', $prog, ' help" for usage'; |
---|
| 145 | } |
---|
| 146 | |
---|
| 147 | exit; |
---|
| 148 | |
---|
| 149 | # ------------------------------------------------------------------------------ |
---|
| 150 | # SYNOPSIS |
---|
| 151 | # $cfg = &main::cfg (); |
---|
| 152 | # |
---|
| 153 | # DESCRIPTION |
---|
| 154 | # Return the $config variable. |
---|
| 155 | # ------------------------------------------------------------------------------ |
---|
| 156 | |
---|
| 157 | sub cfg { |
---|
| 158 | return $config; |
---|
| 159 | } |
---|
| 160 | |
---|
| 161 | # ------------------------------------------------------------------------------ |
---|
| 162 | # SYNOPSIS |
---|
| 163 | # &cmp_ext_cfg (); |
---|
| 164 | # |
---|
| 165 | # DESCRIPTION |
---|
| 166 | # Compare two similar extract configuration files. |
---|
| 167 | # ------------------------------------------------------------------------------ |
---|
| 168 | |
---|
| 169 | sub cmp_ext_cfg { |
---|
| 170 | # Check options |
---|
| 171 | # ---------------------------------------------------------------------------- |
---|
| 172 | my ($wiki); |
---|
| 173 | |
---|
| 174 | GetOptions ('wiki|w=s' => \$wiki); |
---|
| 175 | |
---|
| 176 | # Check arguments |
---|
| 177 | # ---------------------------------------------------------------------------- |
---|
| 178 | e_report $prog, ' ', $function, |
---|
| 179 | ': 2 extract config files must be specified, abort.' |
---|
| 180 | if @ARGV < 2; |
---|
| 181 | |
---|
| 182 | # Invoke 2 new instances of the Fcm::Extract class |
---|
| 183 | # ---------------------------------------------------------------------------- |
---|
| 184 | my (@cfg, $rc); |
---|
| 185 | for my $i (0 .. 1) { |
---|
| 186 | $cfg[$i] = Fcm::Extract->new (CFG_SRC => $ARGV[$i]); |
---|
| 187 | |
---|
| 188 | # Read the extract configuration file |
---|
| 189 | $rc = $cfg[$i]->decipher_cfg; |
---|
| 190 | $rc = $cfg[$i]->expand_cfg if $rc; |
---|
| 191 | |
---|
| 192 | last if not $rc; |
---|
| 193 | } |
---|
| 194 | |
---|
| 195 | # Throw error if command has failed |
---|
| 196 | # ---------------------------------------------------------------------------- |
---|
| 197 | e_report $prog, ' ', $function, ': failed.' if not $rc; |
---|
| 198 | |
---|
| 199 | # Get list of URLs |
---|
| 200 | # ---------------------------------------------------------------------------- |
---|
| 201 | my @urls = (); |
---|
| 202 | for my $i (0 .. 1) { |
---|
| 203 | # List of branches in each extract configuration file |
---|
| 204 | my @branches = $cfg[$i]->branches; |
---|
| 205 | |
---|
| 206 | for my $branch (@branches) { |
---|
| 207 | # Ignore declarations of local directories |
---|
| 208 | next if $branch->type eq 'user'; |
---|
| 209 | |
---|
| 210 | # List of SRC declarations in each branch |
---|
| 211 | my %dirs = $branch->dirs; |
---|
| 212 | |
---|
| 213 | for my $dir (values %dirs) { |
---|
| 214 | # Set up a new instance of Fcm::CmUrl object for each SRC declaration |
---|
| 215 | my $cm_url = Fcm::CmUrl->new ( |
---|
| 216 | URL => $dir . ($branch->version ? '@' . $branch->version : ''), |
---|
| 217 | ); |
---|
| 218 | |
---|
| 219 | $urls[$i]{$cm_url->branch_url}{$dir} = $cm_url; |
---|
| 220 | } |
---|
| 221 | } |
---|
| 222 | } |
---|
| 223 | |
---|
| 224 | # Compare |
---|
| 225 | # ---------------------------------------------------------------------------- |
---|
| 226 | my %log; |
---|
| 227 | for my $i (0 .. 1) { |
---|
| 228 | # Compare the first file with the second one and then vice versa |
---|
| 229 | my $j = ($i == 0) ? 1 : 0; |
---|
| 230 | |
---|
| 231 | for my $branch (sort keys %{ $urls[$i] }) { |
---|
| 232 | if (exists $urls[$j]{$branch}) { |
---|
| 233 | # Same REPOS declarations in both files |
---|
| 234 | for my $dir (sort keys %{ $urls[$i]{$branch} }) { |
---|
| 235 | if (exists $urls[$j]{$branch}{$dir}) { |
---|
| 236 | # Same SRC declarations in both files, only need to compare once |
---|
| 237 | next if $i == 1; |
---|
| 238 | |
---|
| 239 | my $this_url = $urls[$i]{$branch}{$dir}; |
---|
| 240 | my $that_url = $urls[$j]{$branch}{$dir}; |
---|
| 241 | |
---|
| 242 | # Check whether their last changed revisions are the same |
---|
| 243 | my $this_rev = $this_url->svninfo (FLAG => 'Last Changed Rev'); |
---|
| 244 | my $that_rev = $that_url->svninfo (FLAG => 'Last Changed Rev'); |
---|
| 245 | |
---|
| 246 | next if $this_rev eq $that_rev; |
---|
| 247 | |
---|
| 248 | # Last changed revisions differ, get list of changed revisions |
---|
| 249 | # between them using the commit log |
---|
| 250 | my $u = ($this_rev > $that_rev) ? $this_url : $that_url; |
---|
| 251 | my %revs = $u->svnlog (REV => [$this_rev, $that_rev]); |
---|
| 252 | |
---|
| 253 | for my $rev (keys %revs) { |
---|
| 254 | $log{$branch}{$rev} = $u unless exists $log{$branch}{$rev}; |
---|
| 255 | } |
---|
| 256 | |
---|
| 257 | } else { |
---|
| 258 | # Report SRC declaration in one file but not in another |
---|
| 259 | print $urls[$i]{$branch}{$dir}->url_peg, ':', "\n"; |
---|
| 260 | print ' in : ', $ARGV[$i], "\n"; |
---|
| 261 | print ' not in: ', $ARGV[$j], "\n\n"; |
---|
| 262 | } |
---|
| 263 | } |
---|
| 264 | |
---|
| 265 | } else { |
---|
| 266 | # Report REPOS declaration in one file but not in another |
---|
| 267 | print $branch, ':', "\n"; |
---|
| 268 | print ' in : ', $ARGV[$i], "\n"; |
---|
| 269 | print ' not in: ', $ARGV[$j], "\n\n"; |
---|
| 270 | } |
---|
| 271 | } |
---|
| 272 | } |
---|
| 273 | |
---|
| 274 | # Report modifications |
---|
| 275 | # ---------------------------------------------------------------------------- |
---|
| 276 | print 'Revisions at which declared source directories are modified:', "\n" |
---|
| 277 | if keys %log; |
---|
| 278 | |
---|
| 279 | if ($wiki) { |
---|
| 280 | # Output in wiki format |
---|
| 281 | my $wiki_url = Fcm::CmUrl->new (URL => &expand_url_keyword (URL => $wiki)); |
---|
| 282 | my $base_trac = &get_browser_url (URL => $wiki_url->project_url); |
---|
| 283 | $base_trac = $wiki_url if not $base_trac; |
---|
| 284 | |
---|
| 285 | for my $branch (sort keys %log) { |
---|
| 286 | # Name of the branch |
---|
| 287 | my $branch_trac = &get_browser_url (URL => $branch); |
---|
| 288 | $branch_trac =~ s#^$base_trac(?:/*|$)#source:#; |
---|
| 289 | |
---|
| 290 | print '[', $branch_trac, ']:', "\n"; |
---|
| 291 | |
---|
| 292 | # Revision table |
---|
| 293 | for my $rev (sort {$b <=> $a} keys %{ $log{$branch} }) { |
---|
| 294 | print $log{$branch}{$rev}->display_svnlog ($rev, $base_trac), "\n"; |
---|
| 295 | } |
---|
| 296 | } |
---|
| 297 | |
---|
| 298 | } else { |
---|
| 299 | for my $branch (sort keys %log) { |
---|
| 300 | # Output in plain text format |
---|
| 301 | print $branch, ':', "\n"; |
---|
| 302 | print join (' ', sort {$b <=> $a} keys %{ $log{$branch} }), "\n\n"; |
---|
| 303 | } |
---|
| 304 | } |
---|
| 305 | |
---|
| 306 | return $rc; |
---|
| 307 | } |
---|
| 308 | |
---|
| 309 | # ------------------------------------------------------------------------------ |
---|
| 310 | # SYNOPSIS |
---|
| 311 | # &invoke_build_system (); |
---|
| 312 | # |
---|
| 313 | # DESCRIPTION |
---|
| 314 | # Invoke the build system. |
---|
| 315 | # ------------------------------------------------------------------------------ |
---|
| 316 | |
---|
| 317 | sub invoke_build_system { |
---|
| 318 | my ($archive, $full, $ignore_lock, $jobs, $stage, @targets, $verbose); |
---|
| 319 | |
---|
| 320 | GetOptions ( |
---|
| 321 | 'archive|a' => \$archive, # switch on archive mode? |
---|
| 322 | 'full|f' => \$full, # full build? |
---|
| 323 | 'ignore-lock' => \$ignore_lock, # ignore lock file? |
---|
| 324 | 'jobs|j=i' => \$jobs, # number of parallel jobs in make |
---|
| 325 | 'stage|s=s' => \$stage, # build up to and including this stage |
---|
| 326 | 'targets|t=s' => \@targets, # make targets |
---|
| 327 | 'verbose|v=i' => \$verbose, # verbose level |
---|
| 328 | ); |
---|
| 329 | |
---|
| 330 | # Verbose level |
---|
| 331 | $config->verbose ($verbose) if defined $verbose; |
---|
| 332 | |
---|
| 333 | # Invoke a new instance of the Fcm::Build class |
---|
| 334 | my $bld = Fcm::Build->new (CFG_SRC => @ARGV ? join (' ', @ARGV) : cwd ()); |
---|
| 335 | |
---|
| 336 | # Perform build |
---|
| 337 | $bld->build ( |
---|
| 338 | ARCHIVE => $archive, |
---|
| 339 | FULL => $full, |
---|
| 340 | IGNORE_LOCK => $ignore_lock, |
---|
| 341 | JOBS => $jobs ? $jobs : 1, |
---|
| 342 | STAGE => $stage ? $stage : 5, |
---|
| 343 | TARGETS => (@targets ? [split (/:/, join (':', @targets))] : [qw/all/]), |
---|
| 344 | ); |
---|
| 345 | |
---|
| 346 | return 1; |
---|
| 347 | } |
---|
| 348 | |
---|
| 349 | # ------------------------------------------------------------------------------ |
---|
| 350 | # SYNOPSIS |
---|
| 351 | # &invoke_extract_system (); |
---|
| 352 | # |
---|
| 353 | # DESCRIPTION |
---|
| 354 | # Invoke the extract system. |
---|
| 355 | # ------------------------------------------------------------------------------ |
---|
| 356 | |
---|
| 357 | sub invoke_extract_system { |
---|
| 358 | my ($full, $ignore_lock, $verbose); |
---|
| 359 | |
---|
| 360 | GetOptions ( |
---|
| 361 | 'full|f' => \$full, # full extract? |
---|
| 362 | 'ignore-lock' => \$ignore_lock, # ignore lock file? |
---|
| 363 | 'verbose|v=i' => \$verbose, # verbose level |
---|
| 364 | ); |
---|
| 365 | |
---|
| 366 | $config->verbose ($verbose) if defined $verbose; |
---|
| 367 | |
---|
| 368 | # Invoke a new instance of the Fcm::Extract class |
---|
| 369 | my $ext = Fcm::Extract->new (CFG_SRC => @ARGV ? join (' ', @ARGV) : cwd ()); |
---|
| 370 | |
---|
| 371 | # Perform extract |
---|
| 372 | $ext->extract (FULL => $full, IGNORE_LOCK => $ignore_lock); |
---|
| 373 | |
---|
| 374 | return 1; |
---|
| 375 | } |
---|
| 376 | |
---|
| 377 | # ------------------------------------------------------------------------------ |
---|
| 378 | # SYNOPSIS |
---|
| 379 | # &invoke_cfg_printer (); |
---|
| 380 | # |
---|
| 381 | # DESCRIPTION |
---|
| 382 | # Invoke the CFG file pretty printer. |
---|
| 383 | # ------------------------------------------------------------------------------ |
---|
| 384 | |
---|
| 385 | sub invoke_cfg_printer { |
---|
| 386 | |
---|
| 387 | use Fcm::CfgFile; |
---|
| 388 | |
---|
| 389 | my $out_file; |
---|
| 390 | GetOptions ( |
---|
| 391 | 'output|o=s' => \$out_file, # output file for print |
---|
| 392 | ); |
---|
| 393 | |
---|
| 394 | my $file = join (' ', @ARGV); |
---|
| 395 | e_report $prog, ' ', $function, ': file not specified, abort.' if ! $file; |
---|
| 396 | |
---|
| 397 | # Invoke a new Fcm::CfgFile instance |
---|
| 398 | my $cfg = Fcm::CfgFile->new (SRC => $file); |
---|
| 399 | |
---|
| 400 | # Read the cfg file |
---|
| 401 | my $read = $cfg->read_cfg; |
---|
| 402 | e_report if not $read; |
---|
| 403 | |
---|
| 404 | # Pretty print CFG file |
---|
| 405 | $cfg->print_cfg ($out_file); |
---|
| 406 | |
---|
| 407 | return 1; |
---|
| 408 | } |
---|
| 409 | |
---|
| 410 | # ------------------------------------------------------------------------------ |
---|
| 411 | # SYNOPSIS |
---|
| 412 | # &invoke_cm_system (); |
---|
| 413 | # |
---|
| 414 | # DESCRIPTION |
---|
| 415 | # Invoke a code management system command. |
---|
| 416 | # ------------------------------------------------------------------------------ |
---|
| 417 | |
---|
| 418 | sub invoke_cm_system { |
---|
| 419 | |
---|
| 420 | &cm_command ($function); |
---|
| 421 | |
---|
| 422 | return 1; |
---|
| 423 | } |
---|
| 424 | |
---|
| 425 | # ------------------------------------------------------------------------------ |
---|
| 426 | # SYNOPSIS |
---|
| 427 | # &invoke_www_browser (); |
---|
| 428 | # |
---|
| 429 | # DESCRIPTION |
---|
| 430 | # Invoke a web browser on the specified PATH. |
---|
| 431 | # ------------------------------------------------------------------------------ |
---|
| 432 | |
---|
| 433 | sub invoke_www_browser { |
---|
| 434 | |
---|
| 435 | # Options |
---|
| 436 | my ($browser); |
---|
| 437 | GetOptions ( |
---|
| 438 | 'browser|b=s' => \$browser, # browser command |
---|
| 439 | ); |
---|
| 440 | |
---|
| 441 | $browser = &cfg->setting (qw/MISC WEB_BROWSER/) unless $browser; |
---|
| 442 | |
---|
| 443 | # Arguments |
---|
| 444 | my ($arg) = @ARGV ? $ARGV[0] : (&is_wc () ? '.' : ''); |
---|
| 445 | e_report $prog, ' ', $function, |
---|
| 446 | ': input URL not specified and . not a working copy, abort.' |
---|
| 447 | if not $arg; |
---|
| 448 | |
---|
| 449 | # Local PATH? |
---|
| 450 | $arg = &expand_tilde ($arg); |
---|
| 451 | $arg = &get_url_of_wc ($arg) if -e $arg; |
---|
| 452 | |
---|
| 453 | # Expand URL and revision keywords |
---|
| 454 | my $www_url = &expand_url_keyword (URL => $arg); |
---|
| 455 | my $rev = 'HEAD'; |
---|
| 456 | |
---|
| 457 | if ($www_url =~ m#^(\w+://\S+)@(\S+)$#) { |
---|
| 458 | $www_url = $1; |
---|
| 459 | $rev = $2; |
---|
| 460 | } |
---|
| 461 | |
---|
| 462 | $rev = &expand_rev_keyword (URL => $www_url, REV => $rev, HEAD => 1) |
---|
| 463 | unless uc ($rev) eq 'HEAD'; |
---|
| 464 | |
---|
| 465 | # Get web browser URL |
---|
| 466 | $www_url = &get_browser_url (URL => $www_url); |
---|
| 467 | die 'WWW URL not defined for "', $arg, '", abort' unless $www_url; |
---|
| 468 | |
---|
| 469 | $www_url = $www_url . '?rev=' . $rev; |
---|
| 470 | |
---|
| 471 | # Execute command |
---|
| 472 | my @command = (split (/\s+/, $browser), $www_url); |
---|
| 473 | &run_command (\@command, METHOD => 'exec', PRINT => 1); |
---|
| 474 | } |
---|
| 475 | |
---|
| 476 | # ------------------------------------------------------------------------------ |
---|
| 477 | # SYNOPSIS |
---|
| 478 | # &invoke_help (); |
---|
| 479 | # |
---|
| 480 | # DESCRIPTION |
---|
| 481 | # Invoke help. |
---|
| 482 | # ------------------------------------------------------------------------------ |
---|
| 483 | |
---|
| 484 | sub invoke_help { |
---|
| 485 | |
---|
| 486 | my $cmd = @ARGV ? shift @ARGV : undef; |
---|
| 487 | |
---|
| 488 | if ($cmd) { |
---|
| 489 | if (grep {$_ eq $cmd} @{ $subcommand{BLD} }) { |
---|
| 490 | print <<EOF; |
---|
| 491 | $prog $cmd: invoke the build system. |
---|
| 492 | usage: $prog $cmd [OPTIONS...] [CFGFILE] |
---|
| 493 | |
---|
| 494 | The path to a CFG file may be provided. Otherwise, the build system |
---|
| 495 | searches the default locations for a bld cfg file. |
---|
| 496 | |
---|
| 497 | If no option is specified, the options "-s 5 -t all -j 1 -v 1" are assumed. |
---|
| 498 | |
---|
| 499 | If the option for full build is specified, the sub-directories created by |
---|
| 500 | previous builds will be removed, so that the current build can start cleanly. |
---|
| 501 | |
---|
| 502 | The -s option can be used to limit the actions performed by the build system |
---|
| 503 | up to a named stage. The stages are: |
---|
| 504 | "1", "s" or "setup" - stage 1, setup |
---|
| 505 | "2", "pp" or "pre_process" - stage 2, pre-process |
---|
| 506 | "3", "gd" or "generate_dependency" - stage 3, generate dependency |
---|
| 507 | "4", "gi" or "generate_interface" - stage 4, generate Fortran 9X interface |
---|
| 508 | "5", "m", "make" - stage 5, make |
---|
| 509 | |
---|
| 510 | If a colon separated list of targets is specified using the -t option, the |
---|
| 511 | default targets specified in the configuration file will not be used. |
---|
| 512 | |
---|
| 513 | If archive mode is switched on, build sub-directories that are only used |
---|
| 514 | in the build process will be archived to TAR files. The default is off. |
---|
| 515 | |
---|
| 516 | If specified, the verbose level must be an integer greater than 0. Verbose |
---|
| 517 | level 0 is the quiet mode. Increasing the verbose level will increase the |
---|
| 518 | amount of diagnostic output. |
---|
| 519 | |
---|
| 520 | When a build is invoked, it sets up a lock file in the build root directory. |
---|
| 521 | The lock is normally removed at the end of the build. While the lock file is |
---|
| 522 | in place, othe build commands invoked in the same root directory will fail. |
---|
| 523 | If you need to bypass this check for whatever reason, you can invoke the |
---|
| 524 | build system with the --ignore-lock option. |
---|
| 525 | |
---|
| 526 | Valid options: |
---|
| 527 | -a [--archive] : archive build sub-directories? |
---|
| 528 | -f [--full] : full build |
---|
| 529 | --ignore-lock : ignore lock files in build root directory |
---|
| 530 | -j [--jobs] arg : number of parallel jobs that "make" can handle |
---|
| 531 | -s [--stage] arg : perform build up to a named stage |
---|
| 532 | -t [--targets] arg : build a colon (:) separated list of targets |
---|
| 533 | -v [--verbose] arg : verbose level |
---|
| 534 | $copyright |
---|
| 535 | EOF |
---|
| 536 | |
---|
| 537 | } elsif (grep {$_ eq $cmd} @{ $subcommand{EXT} }) { |
---|
| 538 | print <<EOF; |
---|
| 539 | $prog $cmd: invoke the extract system. |
---|
| 540 | usage: $prog $cmd [OPTIONS...] [CFGFILE] |
---|
| 541 | |
---|
| 542 | The path to a CFG file may be provided. Otherwise, the extract system |
---|
| 543 | searches the default locations for an ext cfg file. |
---|
| 544 | |
---|
| 545 | If no option is specified, the system will attempt an incremental extract |
---|
| 546 | where appropriate. |
---|
| 547 | |
---|
| 548 | If specified, the verbose level must be an integer greater than 0. Verbose |
---|
| 549 | level 0 is the quiet mode. Increasing the verbose level will increase the |
---|
| 550 | amount of diagnostic output. |
---|
| 551 | |
---|
| 552 | When an extract is invoked, it sets up a lock file in the extract destination |
---|
| 553 | root directory. The lock is normally removed at the end of the extract. While |
---|
| 554 | the lock file is in place, othe extract commands invoked in the same |
---|
| 555 | destination root directory will fail. If you need to bypass this check for |
---|
| 556 | whatever reason, you can invoke the extract system with the --ignore-lock |
---|
| 557 | option. |
---|
| 558 | |
---|
| 559 | Valid options: |
---|
| 560 | -f [--full] : perform a full/clean extract |
---|
| 561 | --ignore-lock : ignore lock files in build root directory |
---|
| 562 | -v [--verbose] arg : verbose level |
---|
| 563 | $copyright |
---|
| 564 | EOF |
---|
| 565 | |
---|
| 566 | } elsif (grep {$_ eq $cmd} @{ $subcommand{CFG} }) { |
---|
| 567 | print <<EOF; |
---|
| 568 | $prog $cmd: invoke the CFG file pretty printer. |
---|
| 569 | usage: $prog $cmd [OPTIONS...] FILE |
---|
| 570 | |
---|
| 571 | If no option is specified, the output will be sent to standard output. |
---|
| 572 | |
---|
| 573 | Valid options: |
---|
| 574 | -o [--output] arg : send output to a file as specified by arg. |
---|
| 575 | $copyright |
---|
| 576 | EOF |
---|
| 577 | |
---|
| 578 | } elsif (grep {$_ eq $cmd} @{ $subcommand{GUI} }) { |
---|
| 579 | print <<EOF; |
---|
| 580 | $prog $cmd: invoke the GUI wrapper for CM commands. |
---|
| 581 | usage: $prog $cmd DIR |
---|
| 582 | |
---|
| 583 | The optional argument DIR modifies the initial working directory. |
---|
| 584 | $copyright |
---|
| 585 | EOF |
---|
| 586 | |
---|
| 587 | } elsif (grep {$_ eq $cmd} @{ $subcommand{CM} }) { |
---|
| 588 | @ARGV = qw(--help); |
---|
| 589 | cm_command ($cmd); |
---|
| 590 | |
---|
| 591 | } elsif (grep {$_ eq $cmd} @{ $subcommand{CMP} }) { |
---|
| 592 | print <<EOF; |
---|
| 593 | $prog $cmd: compare two similar extract configuration files. |
---|
| 594 | usage: $prog $cmd [OPTIONS...] CFG1 CFG2 |
---|
| 595 | |
---|
| 596 | Compares the extract configurations of two similar extract configuration |
---|
| 597 | files CFG1 and CFG2. |
---|
| 598 | |
---|
| 599 | Valid options: |
---|
| 600 | -w [--wiki] arg : print revision tables in wiki format. The argument to this |
---|
| 601 | option must be the Subversion URL or FCM URL keyword of a |
---|
| 602 | FCM project associated with the intended Trac system. |
---|
| 603 | $copyright |
---|
| 604 | EOF |
---|
| 605 | |
---|
| 606 | } elsif (grep {$_ eq $cmd} @{ $subcommand{WWW} }) { |
---|
| 607 | print <<EOF; |
---|
| 608 | $prog $cmd: invoke the web repository browser on a Subversion URL. |
---|
| 609 | usage: $prog $cmd [OPTIONS...] [PATH] |
---|
| 610 | |
---|
| 611 | If PATH is specified, it must be a FCM URL keyword, a Subversion URL or the |
---|
| 612 | PATH to a local working copy. If not specified, the current working directory |
---|
| 613 | is assumed to be a working copy. If the --browser option is specified, the |
---|
| 614 | specified web browser command is used to launch the repository browser. |
---|
| 615 | Otherwise, it attempts to use the default browser from the configuration |
---|
| 616 | setting. |
---|
| 617 | |
---|
| 618 | Valid options: |
---|
| 619 | -b [--browser] arg : specify a command arg for the web browser. |
---|
| 620 | $copyright |
---|
| 621 | EOF |
---|
| 622 | |
---|
| 623 | } elsif (grep {$_ eq $cmd} @{ $subcommand{HLP} }) { |
---|
| 624 | print <<EOF; |
---|
| 625 | help (?, h): Describe the usage of $prog or its subcommands. |
---|
| 626 | usage: $prog help [SUBCOMMAND...] |
---|
| 627 | $copyright |
---|
| 628 | EOF |
---|
| 629 | |
---|
| 630 | &run_command ([qw/svn help/, $cmd, @ARGV], PRINT => 1); |
---|
| 631 | |
---|
| 632 | } else { |
---|
| 633 | warn $prog, ' help: "', $cmd, '" not recognised'; |
---|
| 634 | $cmd = undef; |
---|
| 635 | } |
---|
| 636 | } |
---|
| 637 | |
---|
| 638 | if (not $cmd) { |
---|
| 639 | # Get output from "svn help" |
---|
| 640 | my @lines = &run_command ( |
---|
| 641 | [qw/svn help/], DEVNULL => 1, METHOD => 'qx', ERROR => 'ignore', |
---|
| 642 | ); |
---|
| 643 | |
---|
| 644 | # Get release number, (and revision number from revision number file) |
---|
| 645 | my $release = &cfg->setting ('RELEASE'); |
---|
| 646 | my $rev_file = &cfg->setting ('REV_FILE'); |
---|
| 647 | |
---|
| 648 | if (-r $rev_file) { |
---|
| 649 | open FILE, '<', $rev_file; |
---|
| 650 | my $rev = readline 'FILE'; |
---|
| 651 | close FILE; |
---|
| 652 | |
---|
| 653 | chomp $rev; |
---|
| 654 | $release .= ' (r' . $rev . ')' if $rev; |
---|
| 655 | } |
---|
| 656 | |
---|
| 657 | # Print common help |
---|
| 658 | print <<EOF; |
---|
| 659 | usage: $prog <subcommand> [options] [args] |
---|
| 660 | Flexible configuration management system, release $release. |
---|
| 661 | Type "$prog help <subcommand>" for help on a specific subcommand. |
---|
| 662 | |
---|
| 663 | Available subcommands: |
---|
| 664 | help (h, ?) - help |
---|
| 665 | build (bld) - build system |
---|
| 666 | EOF |
---|
| 667 | |
---|
| 668 | # The following are only available on platforms with "svn" installed |
---|
| 669 | if (@lines) { |
---|
| 670 | print <<EOF; |
---|
| 671 | branch (br) - cm system: branch info & creation |
---|
| 672 | cfg - CFG file pretty printer |
---|
| 673 | cmp-ext-cfg - compare two similar extract configuration files |
---|
| 674 | conflicts (cf) - cm system: resolve conflicts |
---|
| 675 | extract (ext) - extract system |
---|
| 676 | mkpatch - create patches from specified revisions of a URL |
---|
| 677 | trac (www) - cm system: browse a path using the web browser |
---|
| 678 | <SVN COMMANDS> - any Subversion sub-commands |
---|
| 679 | EOF |
---|
| 680 | } |
---|
| 681 | |
---|
| 682 | # Print FCM copyright notice |
---|
| 683 | print $copyright; |
---|
| 684 | |
---|
| 685 | # Print output from "svn help" |
---|
| 686 | if (@lines) { |
---|
| 687 | print "\n"; |
---|
| 688 | &print_command ([qw/svn help/]); |
---|
| 689 | print @lines; |
---|
| 690 | } |
---|
| 691 | } |
---|
| 692 | |
---|
| 693 | return 1; |
---|
| 694 | } |
---|
| 695 | |
---|
| 696 | # ------------------------------------------------------------------------------ |
---|
| 697 | # SYNOPSIS |
---|
| 698 | # $ans = &main::get_input (MESSAGE => $mesg, TYPE => $type, DEFAULT => $def); |
---|
| 699 | # |
---|
| 700 | # DESCRIPTION |
---|
| 701 | # Get an input string from the user and return it as $ans. MESSAGE is the |
---|
| 702 | # main message printed on screen to prompt the user for an input. If TYPE is |
---|
| 703 | # 'YN', print message to prompt user to enter either 'y' or 'n'. If TYPE is |
---|
| 704 | # 'YNA', then 'a' is given as a third option. If DEFAULT is set, print message |
---|
| 705 | # to inform user that the return value will be set to the $def (if nothing is |
---|
| 706 | # entered). |
---|
| 707 | # ------------------------------------------------------------------------------ |
---|
| 708 | |
---|
| 709 | sub get_input { |
---|
| 710 | my %args = @_; |
---|
| 711 | my $type = exists $args{TYPE} ? $args{TYPE} : ''; |
---|
| 712 | my $mesg = exists $args{MESSAGE} ? $args{MESSAGE} : ''; |
---|
| 713 | my $def = exists $args{DEFAULT} ? $args{DEFAULT} : ''; |
---|
| 714 | |
---|
| 715 | my $ans; |
---|
| 716 | |
---|
| 717 | while (1) { |
---|
| 718 | # Print the prompt |
---|
| 719 | print $mesg; |
---|
| 720 | print "\n", 'Enter "y" or "n"' if uc ($type) eq 'YN'; |
---|
| 721 | print "\n", 'Enter "y", "n" or "a"' if uc ($type) eq 'YNA'; |
---|
| 722 | print ' (or just press <return> for "', $def, '")' if $def; |
---|
| 723 | print ': '; |
---|
| 724 | |
---|
| 725 | # Get answer from STDIN |
---|
| 726 | $ans = <STDIN>; |
---|
| 727 | chomp $ans; |
---|
| 728 | |
---|
| 729 | # Set answer to default, if necessary |
---|
| 730 | $ans = $def if ($def and not $ans); |
---|
| 731 | |
---|
| 732 | if ($type =~ /^yna?$/i) { |
---|
| 733 | # For YN and YNA type dialog boxes, |
---|
| 734 | # check that the answer is in the correct form |
---|
| 735 | my $pat = (uc ($type) eq 'YN' ? 'y|n' : 'y|n|a'); |
---|
| 736 | last if $ans =~ /^(?:$pat)/i; |
---|
| 737 | |
---|
| 738 | } else { |
---|
| 739 | last; |
---|
| 740 | } |
---|
| 741 | } |
---|
| 742 | |
---|
| 743 | return $ans; |
---|
| 744 | } |
---|
| 745 | |
---|
| 746 | # ------------------------------------------------------------------------------ |
---|
| 747 | |
---|
| 748 | __END__ |
---|