source: LMDZ5/branches/testing/tools/fcm/lib/Fcm/Build.pm @ 5456

Last change on this file since 5456 was 1665, checked in by Laurent Fairhead, 12 years ago

Version testing basée sur la r1628

http://lmdz.lmd.jussieu.fr/utilisateurs/distribution-du-modele/versions-intermediaires

Testing release based on r1628
File size: 72.3 KB
Line 
1#!/usr/bin/perl
2# ------------------------------------------------------------------------------
3# NAME
4#   Fcm::Build
5#
6# DESCRIPTION
7#   The main purpose of this class is to process the build configuration,
8#   generate the required files for the build and invoke make to create the
9#   build.
10#
11# COPYRIGHT
12#   (C) Crown copyright Met Office. All rights reserved.
13#   For further details please refer to the file COPYRIGHT.txt
14#   which you should have received as part of this distribution.
15# ------------------------------------------------------------------------------
16
17package Fcm::Build;
18
19# Standard pragma
20use strict;
21use warnings;
22
23# Standard modules
24use Carp;
25use Cwd;
26use File::Basename;
27use File::Path;
28use File::Spec::Functions;
29
30# FCM component modules
31use Fcm::CfgFile;
32use Fcm::SrcPackage;
33use Fcm::BuildTask;
34use Fcm::Util;
35use Fcm::Timer;
36
37# ------------------------------------------------------------------------------
38# SYNOPSIS
39#   $bld = Fcm::Build->new (
40#     CONFIG  => $config,
41#     CFG_SRC => $cfg_src,
42#   );
43#
44# DESCRIPTION
45#   This method constructs a new instance of the Fcm::Build class.
46#
47# ARGUMENTS
48#   CONFIG     - reference to a Fcm::Config instance
49#   CFG_SRC    - source path to the build configuration file
50# ------------------------------------------------------------------------------
51
52sub new {
53  my $this  = shift;
54  my %args  = @_;
55  my $class = ref $this || $this;
56
57  my $cfg    = exists $args{CFG_SRC} ? $args{CFG_SRC} : undef;
58  my $config = exists $args{CONFIG}  ? $args{CONFIG}  : &main::cfg;
59
60  my $self  = {
61    CONFIG   => $config,            # configuration settings
62    CFG      => Fcm::CfgFile->new ( # bld cfg
63      TYPE   => 'bld',              # config file type
64      SRC    => $cfg,               # source path of the bld cfg
65      CONFIG => $config,            # configuration settings
66    ),
67    NAME     => '',                 # name of this build
68    DIR      => {                   # directory tree of this build
69      ROOT    => '',                # root directory of this build
70    },
71    PATH     => {},                 # search paths of this build
72    SEARCH   => 1,                  # search for source directories in src/?
73    SRCDIR   => {},                 # source directories of this build
74    PP       => {},                 # pre-process flags
75    PACKAGE  => {},                 # source directory packages of this build
76    TARGET   => [],                 # targets of this build
77    USE      => [],                 # list of inherited builds
78    INHERIT  => {                   # inheritance flags
79      SRCDIR => 1,                  # inherit source directories?
80      PP     => 1,                  # inherit pre-process flags?
81      TARGET => 0,                  # inherit targets?
82    },
83    LIB      => {'' => ''},         # name of libraries
84    LOCK     => undef,              # lock file
85  };
86  bless $self, $class;
87  return $self;
88}
89
90# ------------------------------------------------------------------------------
91# SYNOPSIS
92#   $self->DESTROY;
93#
94# DESCRIPTION
95#   This method is called automatically when a Fcm::Build object is
96#   destroyed.
97# ------------------------------------------------------------------------------
98
99sub DESTROY {
100  my $self = shift;
101
102  # Remove the lock if it is set
103  unlink $self->{LOCK} if $self->{LOCK} and -e $self->{LOCK};
104
105  return;
106}
107
108# ------------------------------------------------------------------------------
109# SYNOPSIS
110#   $config = $bld->config;
111#
112# DESCRIPTION
113#   This method returns a reference to the Fcm::Config instance.
114# ------------------------------------------------------------------------------
115
116sub config {
117  my $self = shift;
118
119  return $self->{CONFIG};
120}
121
122# ------------------------------------------------------------------------------
123# SYNOPSIS
124#   $cfgfile = $bld->cfg;
125#
126# DESCRIPTION
127#   This method returns a reference to a Fcm::CfgFile instance for the build
128#   configuration file.
129# ------------------------------------------------------------------------------
130
131sub cfg {
132  my $self = shift;
133
134  return $self->{CFG};
135}
136
137# ------------------------------------------------------------------------------
138# SYNOPSIS
139#   %allpcks = $bld->allpcks ();
140#
141# DESCRIPTION
142#   This method returns a hash table with keys representing all the packages
143#   declared in the current build. The value of each element in the hash is a
144#   reference to a list of children of the current package.
145# ------------------------------------------------------------------------------
146
147sub allpcks {
148  my $self        = shift;
149  my %allpcks = ();
150
151  for my $pckname (keys %{ $self->{PACKAGE} }) {
152    $allpcks{$pckname} = [];
153  }
154
155  for my $pckname (keys %{ $self->{PACKAGE} }) {
156    my @names = split /__/, $pckname;
157
158    my $cur = $pckname;
159    while ($cur) {
160      pop @names;
161      my $depend = @names ? join '__', @names : '';
162      $allpcks{$depend} = [] unless exists $allpcks{$depend};
163
164      push @{ $allpcks{$depend} }, $cur
165        unless grep {$_ eq $cur} @{ $allpcks{$depend} };
166
167      $cur = $depend;
168    }
169  }
170
171  return %allpcks;
172}
173
174# ------------------------------------------------------------------------------
175# SYNOPSIS
176#   $rc = $bld->build (
177#     [ARCHIVE     => $archive,]
178#     [FULL        => $full,]
179#     [IGNORE_LOCK => $ignore_lock,]
180#     [JOBS        => $jobs,]
181#     [STAGE       => $stage,]
182#     [TARGETS     => \@targets,]
183#   );
184#
185# DESCRIPTION
186#   This method performs a build based on the current configuration. The
187#   method returns 1 on success.
188#
189# ARGUMENTS
190#   ARCHIVE      - If set to "true", invoke the "archive" mode. Most build files
191#                  and directories created by this build will be archived using
192#                  the "tar" command. If not set, the default is not to invoke
193#                  the "archive" mode.
194#   FULL         - If set to "true", invoke the build in "full" mode. Build files
195#                  and directories created by previous builds in the same
196#                  location will be removed before the current build is
197#                  performed. If not set, the default is to perform the build
198#                  in "incremental" mode.
199#   IGNORE_LOCK  - If set to "true", it ignores any lock files that may exist in
200#                  the build root directory.
201#   JOBS         - Specify number of jobs that can be handled by "make". If set,
202#                  the value must be a natural integer. If not set, the default
203#                  value is 1 (i.e. run "make" in serial mode).
204#   STAGE        - If set, it should be an integer number or a recognised
205#                  keyword or abbreviation. If set, the build is performed up
206#                  to the named stage. If not set, the default is to perform
207#                  all stages of the build. Allowed values are:
208#                  1, setup or s
209#                  2, pre_process or pp
210#                  3, generate_dependency or gd
211#                  4, generate_interface or gi
212#                  5, all, a, make or m
213#   TARGETS      - Specify targets to be built. If set, these targets will be
214#                  built instead of the ones specified in the build
215#                  configuration file.
216# ------------------------------------------------------------------------------
217
218sub build {
219  my $self = shift;
220  my %args = @_;
221
222  # Process arguments
223  my $archive     = exists $args{ARCHIVE}     ? $args{ARCHIVE}     : 0;
224  my $full        = exists $args{FULL}        ? $args{FULL}        : 0;
225  my $ignore_lock = exists $args{IGNORE_LOCK} ? $args{IGNORE_LOCK} : 0;
226  my $jobs        = exists $args{JOBS}        ? $args{JOBS}        : 1;
227  my $stage       = exists $args{STAGE}       ? $args{STAGE}       : 5;
228  my $targets     = exists $args{TARGETS}     ? $args{TARGETS}     : [qw/all/];
229
230  # Resolve named stages
231  $stage = 5 unless $stage;
232  if ($stage !~ /^\d$/) {
233    my %stagenames = (
234      'S(?:ETUP)?'                      => 1,
235      'P(?:RE)?_?P(?:ROCESS)?'          => 2,
236      'G(?:ENERATE)?_?D(?:ENPENDENCY)?' => 3,
237      'G(?:ENERATE)?_?I(?:NTERFACE)?'   => 4,
238      '(?:A(?:LL)|M(?:AKE)?)'           => 5,
239    );
240
241    for my $name (keys %stagenames) {
242      if ($stage =~ /$name/i) {
243        $stage = $stagenames{$name};
244        last;
245      }
246    }
247
248    if ($stage !~ /^\d$/) {
249      w_report 'Warning: invalid build stage: ', $stage, ', default to "5"';
250      $stage = 5;
251    }
252  }
253
254  # Get verbose mode
255  my $verbose = $self->config->verbose;
256
257  # Stage 1: setup
258  my $date = localtime;
259  print 'Build command started on ', $date, '.', "\n" if $verbose;
260  my $otime = time;
261
262  print '->Setup              : start', "\n" if $verbose;
263  my $stime = time;
264
265  # Read configurations
266  my $rc = $self->decipher_cfg;
267
268  # Check directories are set
269  $rc = $self->check_dir if $rc;
270
271  # Check for lock files
272  $rc = $self->check_lock if $rc and not $ignore_lock;
273
274  # Set a lock file
275  $rc = $self->_set_lock if $rc;
276
277  # Create build root directory if necessary
278  $rc = $self->_create_build_dir if $rc;
279
280  # Set up directory inheritance
281  $rc = $self->_setup_dir (FULL => $full) if $rc;
282
283  # Set up source directories, targets, etc
284  $rc = $self->_update_bld_info if $rc;
285
286  # Set up PP flag cache
287  $rc = $self->_update_pp_info if $rc;
288
289  # Set up build tools cache
290  $rc = $self->_update_tool_info if $rc;
291
292  # Set up regenerate make rule cache
293  $rc = $self->_update_regen_rule_info if $rc;
294
295  my $ftime = time;
296  my $s_str = $ftime - $stime > 1 ? 'seconds' : 'second';
297  print '->Setup              : ', $ftime - $stime, ' ', $s_str, "\n";
298
299  # Stage 2: Pre-process
300  if ($rc and $stage >= 2) {
301    print '->Pre-process        : start', "\n" if $verbose;
302    my $stime = time;
303
304    $rc = $self->_pre_process;
305
306    $ftime = time;
307    $s_str = $ftime - $stime > 1 ? 'seconds' : 'second';
308    print '->Pre-process        : ', $ftime - $stime, ' ', $s_str, "\n";
309  }
310
311  # Stage 3: Scan dependency and write make rules
312  if ($rc and $stage >= 3) {
313    print '->Scan dependency    : start', "\n" if $verbose;
314    my $stime = time;
315
316    $rc = $self->_scan_dependency;
317    $rc = $self->_write_make_rules if $rc;
318    $rc = $self->_write_makefile if $rc;
319
320    $ftime = time;
321    $s_str = $ftime - $stime > 1 ? 'seconds' : 'second';
322    print '->Scan dependency    : ', $ftime - $stime, ' ', $s_str, "\n";
323  }
324
325  # Stage 4: Generate Fortran 9x interface block
326  if ($rc and $stage >= 4) {
327    print '->Generate interface : start', "\n" if $verbose;
328    my $stime = time;
329
330    $rc = $self->_generate_f9x_interface;
331
332    $ftime = time;
333    $s_str = $ftime - $stime > 1 ? 'seconds' : 'second';
334    print '->Generate interface : ', $ftime - $stime, ' ', $s_str, "\n";
335  }
336
337  # Stage 5: Make the build
338  if ($rc and $stage >= 5) {
339    print '->Make               : start', "\n" if $verbose;
340    my $stime = time;
341
342    $rc = $self->_invoke_make (
343      TARGETS => $targets,
344      JOBS    => $jobs,
345      ARCHIVE => $archive,
346    );
347
348    # Remove empty build directories
349    $rc = $self->_remove_empty_dirs () if $rc;
350
351    # Create TAR archives if necessary
352    $rc = $self->_tar_build_dirs () if $rc and $archive;
353
354    # Create run time environment script if necessary
355    $rc = $self->_create_runenv_script () if $rc;
356
357    # Create exclude dependency configurations for libraries
358    $rc = $self->_create_lib_excl_dep () if $rc;
359
360    $ftime = time;
361    $s_str = $ftime - $stime > 1 ? 'seconds' : 'second';
362    print '->Make               : ', $ftime - $stime, ' ', $s_str, "\n";
363  }
364
365  if ($verbose) {
366    $s_str = $ftime - $otime > 1 ? 'seconds' : 'second';
367    print '->TOTAL              : ', $ftime - $otime, ' ', $s_str, "\n";
368  }
369
370  $date = localtime;
371  if ($rc) {
372    print 'Build command finished on ', $date, '.', "\n" if $verbose;
373
374  } else {
375    e_report 'Build command failed on ', $date, '.';
376  }
377
378  return $rc;
379}
380
381# ------------------------------------------------------------------------------
382# SYNOPSIS
383#   $bld->decipher_cfg ();
384#
385# DESCRIPTION
386#   This method deciphers the build configuration file and assigns the
387#   configurations to the variables of the current build.
388# ------------------------------------------------------------------------------
389
390sub decipher_cfg {
391  my $self = shift;
392
393  my $read = $self->cfg->read_cfg;
394
395  # Check config file type
396  if ($read) {
397    if ($self->cfg->type ne 'bld') {
398      w_report 'Error: ', $self->cfg->src, ': not a build config file.';
399      return;
400    }
401
402  } else {
403    return;
404  }
405
406  my %cfg_label = %{ $self->config->setting ('CFG_LABEL') };
407  my %tools     = %{ $self->config->setting ('TOOL') };
408
409  # Get lines from cfg file
410  my @cfg_lines  = $self->cfg->lines;
411
412  LINE: for my $line (@cfg_lines) {
413    # Label and value of each line
414    my $label = $line->{LABEL};
415    my $value = $line->{VALUE};
416
417    next LINE unless $label; # ignore blank or comment line
418
419    # Strip out BLD prefix from all labels
420    my $prefix = $cfg_label{BDECLARE} . '::';
421    $label = substr ($label, length ($prefix))
422      if index (uc ($label), $prefix) == 0;
423
424    next LINE unless $label; # ignore blank or comment line
425
426    # Configuration file type/version, ignore
427    next LINE if uc $label eq $cfg_label{CFGFILE}{TYPE};
428    next LINE if uc $label eq $cfg_label{CFGFILE}{VERSION};
429
430    # User variable, ignore
431    next LINE if index (uc ($label), '%') == 0;
432
433    # Build name
434    if (uc $label eq $cfg_label{NAME}) {
435      $self->{NAME} = $value;
436      next LINE;
437    }
438
439    # Build directory tree
440    $prefix = $cfg_label{DIR} . '::';
441    if (index (uc ($label), $prefix) == 0) {
442      my $name = substr uc ($label), length ($prefix);
443      $self->{DIR}{$name} = expand_tilde $value;
444      next LINE;
445    }
446
447    # Source directory
448    $prefix = $cfg_label{SRCDIR} . '::';
449    if (index (uc ($label), $prefix) == 0) {
450      my $name = substr $label, length ($prefix);
451      $name    =~ s/::/__/g;
452      $self->{SRCDIR}{$name} = expand_tilde $value;
453      next LINE;
454    }
455
456    # Automatic source directory search?
457    if (uc $label eq $cfg_label{SEARCH_SRC}) {
458      $self->{SEARCH} = $value;
459      next LINE;
460    }
461
462    # Pre-process flag, directory/file requires pre-processing before all tasks
463    $prefix = $cfg_label{PP};
464    if (index (uc ($label), $prefix) == 0) {
465      my @flds = split /::/, $label;
466      my $name = uc shift @flds;
467      $name    = join '__', ($name, @flds) if @flds;
468      $self->{PP}{$name} = $value;
469      next LINE;
470    }
471
472    # Specify name of top level or package library
473    $prefix = $cfg_label{LIB};
474    if (index (uc ($label), $prefix) == 0) {
475      my @flds = split /::/, $label;
476      shift @flds;
477      my $name = @flds ? join ('__', @flds) : '';
478      $self->{LIB}{$name} = $value;
479
480      next LINE;
481    }
482
483    # Specify extra executable dependencies and BLOCKDATA dependency
484    for my $name (qw/EXE_DEP BLOCKDATA/) {
485      $prefix = $cfg_label{$name};
486
487      if (index (uc ($label), $prefix) == 0) {
488        my @flds = split /::/, $label;
489        shift @flds;
490        my $target = @flds ? $flds[0] : '';
491        my @deps   = split /\s+/, $value;
492
493        # If $value is a null string, set executable to depend on all objects
494        if (not @deps) {
495          if ($name eq 'BLOCKDATA') {
496
497            # Label not recognised
498            w_report 'Warning: ', $line->{SRC}, ': LINE ', $line->{NUMBER},
499                     ': "', $label, '" declaration must have a value';
500            next LINE;
501
502          } else {
503            push @deps, '';
504          }
505        }
506
507        for my $dep (@deps) {
508          $dep =~ s/::/__/g;
509
510          $self->config->assign_setting (
511            LABELS => [$name, $target, $dep],
512            VALUE  => 1,
513          );
514        }
515
516        next LINE;
517      }
518    }
519
520    # Build target
521    if (uc $label eq $cfg_label{TARGET}) {
522      push @{ $self->{TARGET} }, split (/\s+/, $value);
523      next LINE;
524    }
525
526    # Rename a main program target
527    $prefix = $cfg_label{EXE_NAME};
528    if (index (uc ($label), $prefix) == 0) {
529      my @flds = split /::/, $label;
530      shift @flds;
531      my $name = shift @flds;
532
533      if ($name and $value) {
534        $self->config->assign_setting (
535          LABELS => ['EXE_NAME', $name],
536          VALUE  => $value,
537        );
538
539        next LINE;
540      }
541    }
542
543    # Build tool
544    $prefix = $cfg_label{TOOL} . '::';
545    if (index (uc ($label), $prefix) == 0) {
546      my $name = substr $label, length ($prefix);
547      my @flds = split /::/, $name;
548
549      $name = uc (shift @flds);
550
551      if (exists $tools{$name}) {
552        $name = join '__', ($name, @flds) if @flds;
553
554        $self->config->assign_setting (
555          LABELS => ['TOOL', $name],
556          VALUE  => $value,
557        );
558        next LINE;
559      }
560    }
561
562    # File name extension and type
563    for my $name (qw/INFILE_EXT OUTFILE_EXT/) {
564      $prefix = $cfg_label{$name};
565      if (index (uc ($label), $prefix) == 0) {
566        my $key = (split /::/, $label)[1];
567        $key    = uc $key if $name eq 'OUTFILE_EXT';
568
569        my $val = ($name eq 'INFILE_EXT') ? uc $value : $value;
570
571        $self->config->assign_setting (
572          LABELS => [$name, $key],
573          VALUE  => $val,
574        );
575        next LINE;
576      }
577    }
578
579    # Dependency scan exclusion
580    $prefix = $cfg_label{EXCL_DEP};
581    if (index (uc ($label), $prefix) == 0) {
582      my @flds = split /::/, $label;
583      shift @flds;
584
585      my $pk = @flds ? join ('__', @flds) : '';
586      $self->config->assign_setting (
587        LABELS => ['EXCL_DEP', uc ($value), $pk],
588        VALUE  => 1,
589      );
590      next LINE;
591    }
592
593    # Use (inherit from) another build
594    if (uc $label eq $cfg_label{USE}) {
595      my $use = Fcm::Build->new (
596        CONFIG  => $self->config,
597        CFG_SRC => expand_tilde ($value),
598      );
599      $use->decipher_cfg;
600      $use->check_dir;
601      push @{ $self->{USE} }, $use;
602      next LINE;
603    }
604
605    # Inheritance flag
606    $prefix = $cfg_label{INHERIT} . '::';
607    if (index (uc ($label), $prefix) == 0) {
608      my $name = substr $label, length ($prefix);
609      my @flds = split /::/, $name;
610
611      $name = uc (shift @flds);
612
613      for my $flag (qw/SRCDIR PP LIB TARGET/) {
614        if ($name eq $cfg_label{$flag}) {
615          $name = @flds ? join ('__', ($flag, @flds)) : $flag;
616          $self->{INHERIT}{$name} = $value;
617          next LINE;
618        }
619      }
620    }
621
622    # Label not recognised
623    w_report 'ERROR: ', $line->{SRC}, ': LINE ', $line->{NUMBER}, ': label "',
624             $label, '" not recognised';
625    return;
626  }
627
628  return 1;
629}
630
631# ------------------------------------------------------------------------------
632# SYNOPSIS
633#   $bld->check_dir ();
634#
635# DESCRIPTION
636#   This method checks whether the build directories are set correctly.
637# ------------------------------------------------------------------------------
638
639sub check_dir {
640  my $self = shift;
641
642  # Make sure build root directory is set
643  if (not $self->{DIR}{ROOT}) {
644    w_report 'Error: build root directory not set.';
645    return;
646  }
647
648  # Set value of build sub-directories if necessary
649  for my $name (keys %{ $self->config->setting ('DIR') }) {
650    next if $self->{DIR}{$name};
651
652    $self->{DIR}{$name} = catfile (
653      $self->{DIR}{ROOT},
654      $self->config->setting ('DIR', $name),
655    );
656  }
657
658  # Search src/ sub-directory if necessary
659  if ($self->{SEARCH} and -d $self->{DIR}{SRC}) {
660    my %dir = find_srcdir ($self->{DIR}{SRC});
661    for my $name (keys %dir) {
662      $self->{SRCDIR}{$name} = $dir{$name} unless $self->{SRCDIR}{$name};
663    }
664  }
665
666  # Expand source directory paths if necessary
667  for my $name (keys %{ $self->{SRCDIR} }) {
668    if ($self->{SRCDIR}{$name} =~ /^\w/) {
669      my $src_search  = catfile $self->{DIR}{SRC} , $self->{SRCDIR}{$name};
670      my $root_search = catfile $self->{DIR}{ROOT}, $self->{SRCDIR}{$name};
671
672      if ($self->{DIR}{SRC} and -d $src_search) {
673        $self->{SRCDIR}{$name} = $src_search;
674
675      } elsif (-d $root_search) {
676        $self->{SRCDIR}{$name} = $root_search;
677
678      } else {
679        w_report 'Warning: cannot locate declared source directory: ',
680                 $self->{SRCDIR}{$name};
681        next;
682      }
683    }
684  }
685
686  return 1;
687}
688
689# ------------------------------------------------------------------------------
690# SYNOPSIS
691#   $bld->check_lock ();
692#
693# DESCRIPTION
694#   This method checks whether a lock is set in the current build.
695# ------------------------------------------------------------------------------
696
697sub check_lock {
698  my $self = shift;
699
700  my $rootdir  = $self->{DIR}{ROOT};
701  my $lock_ext = catfile ($rootdir, $self->config->setting (qw/MISC LOCK_EXT/));
702  my $lock_bld = catfile ($rootdir, $self->config->setting (qw/MISC LOCK_BLD/));
703
704  # Always throw error if extract lock exists
705  if (-e $lock_ext) {
706    w_report 'ERROR: extract lock file exists: ', $lock_ext, ',';
707    w_report '       an extract may be running at ', $rootdir, ', abort.';
708    return;
709  }
710
711  # Always throw error if build lock exists
712  if (-e $lock_bld) {
713    w_report 'ERROR: build lock file exists: ', $lock_bld, ',';
714    w_report '       a build may be running at ', $rootdir, ', abort.';
715    return;
716  }
717
718  # Check locks in inherited build
719  for my $use (@{ $self->{USE} }) {
720    return unless $use->check_lock;
721  }
722
723  return 1;
724}
725
726# ------------------------------------------------------------------------------
727# SYNOPSIS
728#   $self->_set_lock ();
729#
730# DESCRIPTION
731#   This method sets a lock is set in the current build.
732# ------------------------------------------------------------------------------
733
734sub _set_lock {
735  my $self = shift;
736
737  $self->{LOCK} = catfile (
738    $self->{DIR}{ROOT}, $self->config->setting (qw/MISC LOCK_BLD/),
739  );
740
741  &touch_file ($self->{LOCK});
742
743  return 1;
744}
745
746# ------------------------------------------------------------------------------
747# SYNOPSIS
748#   $self->_setup_dir (FULL => $full);
749#
750# DESCRIPTION
751#   This internal method sets up the build directories.
752# ------------------------------------------------------------------------------
753
754sub _setup_dir {
755  my $self = shift;
756  my %args = @_;
757
758  my $full = exists $args{FULL} ? $args{FULL} : 0;
759
760  my $tar      = $self->config->setting (qw/OUTFILE_EXT TAR/);
761  my @tar_dirs = split /,/, $self->config->setting (qw/TAR_DIRS/);
762  my $verbose  = $self->config->verbose;
763
764  if ($full) {
765    # Remove sub-directories/archives created from previous builds
766    for my $name (qw/BIN BLD DONE ETC FLAGS INC LIB PPSRC OBJ TMP/) {
767      &run_command ([qw/rm -rf/, $self->{DIR}{$name}], PRINT => $verbose)
768        if -d $self->{DIR}{$name};
769
770      &run_command ([qw/rm -f/, $self->{DIR}{$name} . $tar], PRINT => $verbose)
771        if -f $self->{DIR}{$name} . $tar;
772    }
773
774    # Remove cache
775    my @files;
776    if (-d $self->{DIR}{CACHE} and opendir DIR, $self->{DIR}{CACHE}) {
777      @files = grep {$_ ne '.' and $_ ne '..'} readdir 'DIR';
778      closedir DIR;
779    }
780
781    my $extension = '\\' . $self->config->setting (qw/CACHE PCKFILE/) . '|' .
782                    '\\' . $self->config->setting (qw/CACHE PCKPPDEPEND/) . '|' .
783                    '\\' . $self->config->setting (qw/CACHE PCKDEPEND/);
784
785
786    for my $file (@files) {
787      next unless $file eq $self->config->setting (qw/CACHE BLDTOOL/) or
788                  $file eq $self->config->setting (qw/CACHE PPOPTION/) or
789                  $file eq $self->config->setting (qw/CACHE EXE_DEP/) or
790                  $file =~ /$extension$/;
791
792      my $path = File::Spec->catfile ($self->{DIR}{CACHE}, $file);
793      &run_command ([qw/rm -f/, $path], PRINT => $verbose);
794    }
795
796  } else {
797    # Extract archives if necessary
798    for my $name (@tar_dirs) {
799      my $tar_file = $self->{DIR}{$name} . $tar;
800
801      if (-f $tar_file) {
802        &run_command ([qw/tar -x -f/, $tar_file], PRINT => $verbose > 1);
803        &run_command ([qw/rm -f/, $tar_file], PRINT => $verbose > 1);
804      }
805    }
806  }
807
808  # Set up search paths
809  for my $name (keys %{ $self->{DIR} }) {
810    $self->{PATH}{$name} = [$self->_get_inherited_paths ($name)];
811
812    $self->config->assign_setting (
813      LABELS => ['PATH', $name],
814      VALUE  => $self->{PATH}{$name},
815    )
816  }
817
818  return 1;
819}
820
821# ------------------------------------------------------------------------------
822# SYNOPSIS
823#   $self->_update_bld_info ();
824#
825# DESCRIPTION
826#   This internal method sets up the inheritance relationship for source
827#   directories and targets, and other configurations required by the build.
828# ------------------------------------------------------------------------------
829
830sub _update_bld_info {
831  my $self = shift;
832
833  # Set up build targets
834  $self->{TARGET} = [$self->_get_inherited_items ('TARGET')];
835
836  # Set up PP switches
837  $self->{PP} = {$self->_get_inherited_items ('PP')};
838
839  # Set up source directory packages for this build
840  my %srcdir = $self->_get_inherited_items ('SRCDIR');
841  for my $name (keys %srcdir) {
842    my $package = Fcm::SrcPackage->new (
843      CONFIG     => $self->config,
844      NAME       => $name,
845      CURRENT    => exists $self->{SRCDIR}{$name},
846      REQUIREPP  => $self->_require_pp ($name),
847      SEARCHPATH => [$self->_get_inherited_srcdirs ($name)],
848    );
849
850    $package->update_file_info ();
851
852    $self->{PACKAGE}{$name} = $package;
853  }
854
855  # Set up runtime dependency scan patterns
856  my %dep_pattern = %{ $self->config->setting ('DEP_PATTERN') };
857  for my $key (keys %dep_pattern) {
858    my $pattern = $dep_pattern{$key};
859
860    while ($pattern =~ /##([\w:]+)##/g) {
861      my $match = $1;
862      my $val   = $self->config->setting (split (/::/, $match));
863
864      last unless defined $val;
865      $val =~ s/\./\\./;
866
867      $pattern =~ s/##$match##/$val/;
868    }
869
870    $self->config->assign_setting (
871      LABELS => ['DEP_PATTERN', $key],
872      VALUE  => $pattern,
873    ) unless $pattern eq $dep_pattern{$key};
874  }
875
876  # Set up top level library name
877  {
878    $self->{LIB} = {$self->_get_inherited_items ('LIB')};
879
880    my $lib = $self->{LIB}{''};
881    $lib    = ($self->{NAME} ? $self->{NAME} : 'fcm_default') unless $lib;
882    $self->{LIB}{''} = $lib;
883  }
884
885  return 1;
886}
887
888# ------------------------------------------------------------------------------
889# SYNOPSIS
890#   $self->_update_regen_rule_info ();
891#
892# DESCRIPTION
893#   This internal method compares the current EXE_DEP, BLOCKDATA and EXE_NAME
894#   declarations and the previous. If changed, the REGEN_MAKERULE flag will be
895#   set to true and the cache will be updated.
896# ------------------------------------------------------------------------------
897
898sub _update_regen_rule_info {
899  my $self = shift;
900
901  # Look for an extra executable dependency cache file
902  my $cachebase = $self->config->setting (qw/CACHE EXE_DEP/);
903  my $incache   = find_file_in_path $cachebase, $self->{PATH}{CACHE};
904
905  my $uptodate = 0;
906  my @inlines  = ();
907
908  # Read cache if it exists
909  if ($incache and -r $incache) {
910    my $incfg = Fcm::CfgFile->new (CONFIG => $self->config, SRC => $incache);
911    $incfg->read_cfg;
912
913    @inlines  = $incfg->lines;
914    $uptodate = 1;
915  }
916
917  # Prepare output lines
918  my $outcfg = Fcm::CfgFile->new (CONFIG => $self->config);
919  $outcfg->add_line (COMMENT => 'EXE_DEP cache');
920
921  # List of extra executable dependencies
922  my %exe_dep   = %{ $self->config->setting ('EXE_DEP') };
923  for my $target (sort keys %exe_dep) {
924    $outcfg->add_line (
925      LABEL => ($target ? 'OBJECTS__' . $target : 'OBJECTS'),
926      VALUE => join (' ', sort keys %{ $exe_dep{$target} }),
927    );
928  }
929
930  # List of BLOCKDATA dependencies
931  my %blockdata = %{ $self->config->setting ('BLOCKDATA') };
932  for my $target (sort keys %blockdata) {
933    $outcfg->add_line (
934      LABEL => ($target ? 'BLOCKDATA__' . $target : 'BLOCKDATA'),
935      VALUE => join (' ', sort keys %{ $blockdata{$target} }),
936    );
937  }
938
939  # List of EXE_NAME
940  my %exe_name = %{ $self->config->setting ('EXE_NAME') };
941  for my $target (sort keys %exe_name) {
942    $outcfg->add_line (
943      LABEL => 'EXE_NAME__' . $target,
944      VALUE => $exe_name{$target},
945    );
946  }
947
948  # Compare cache with current output
949  my @outlines = $outcfg->lines ();
950
951  $uptodate = 0 if @inlines != @outlines;
952
953  if ($uptodate) {
954    for my $i (0 .. $#outlines) {
955      next unless $inlines[$i]->{LABEL} and $outlines[$i]->{LABEL};
956
957      if ($inlines[$i]->{LABEL} ne $outlines[$i]->{LABEL} or
958          $inlines[$i]->{VALUE} ne $outlines[$i]->{VALUE}) {
959        $uptodate = 0;
960        last;
961      }
962    }
963  }
964
965  # Update cache if it is out of date
966  $outcfg->print_cfg (catfile ($self->{DIR}{CACHE}, $cachebase))
967    unless $uptodate;
968
969  # If out to date, set regenerate make rule flag to true
970  $self->config->assign_setting (
971    LABELS => [qw/REGEN_MAKERULE/],
972    VALUE  => ! $uptodate,
973  );
974
975  return 1;
976}
977
978# ------------------------------------------------------------------------------
979# SYNOPSIS
980#   $self->_update_pp_info ();
981#
982# DESCRIPTION
983#   This internal method compares the current set of pre-processor options
984#   with that of the previous build using a "cache" file. If some
985#   pre-processor options have changed, the method updates the cache file and
986#   remove the "make" rules for the appropriate source packages.
987# ------------------------------------------------------------------------------
988
989sub _update_pp_info {
990  my $self = shift;
991
992  # Look for a PP option cache file
993  my $cachebase = $self->config->setting (qw/CACHE PPOPTION/);
994  my $incache   = find_file_in_path $cachebase, $self->{PATH}{CACHE};
995
996  my @chgpp = ();
997  my %newpp = %{ $self->{PP} };
998
999  # Read config if exists, otherwise marked all current PP flags as "changed"
1000  if ($incache and -r $incache) {
1001    my $cfg = Fcm::CfgFile->new (CONFIG => $self->config, SRC => $incache);
1002    $cfg->read_cfg;
1003
1004    my @lines   = $cfg->lines;
1005    my %oldpp = ();
1006
1007    for my $line (@lines) {
1008      next unless $line->{LABEL};
1009
1010      $oldpp{$line->{LABEL}} = $line->{VALUE};
1011    }
1012
1013    # Compare new and old, mark as "changed" if changed or does not exist in old
1014    @chgpp = (grep {
1015      exists $oldpp{$_} ? $oldpp{$_} ne $newpp{$_} : 1;
1016    } keys %newpp);
1017
1018    # Compare old and new, mark as "changed" if not exist in new
1019    push @chgpp, (grep {not exists $newpp{$_}} keys %oldpp);
1020
1021  } else {
1022    @chgpp = keys %newpp;
1023  }
1024
1025  if (@chgpp) {
1026    for my $name (@chgpp) {
1027      for my $package (values %{ $self->{PACKAGE} }) {
1028        next if $package->newpp;
1029
1030        if (('PP__' . $package->name) =~ /^$name(?:__|$)/) {
1031          $package->current (1);
1032          $package->newpp   (1);
1033        }
1034      }
1035    }
1036
1037    # Update the PP cache file if necessary
1038    my $cfg = Fcm::CfgFile->new (CONFIG => $self->config);
1039
1040    for my $name (keys %newpp) {
1041      $cfg->add_line (LABEL => $name, VALUE => $newpp{$name});
1042    }
1043    $cfg->add_line unless $cfg->lines;
1044
1045    $cfg->print_cfg (catfile ($self->{DIR}{CACHE}, $cachebase));
1046  }
1047
1048  return 1;
1049}
1050
1051# ------------------------------------------------------------------------------
1052# SYNOPSIS
1053#   $self->_update_tool_info ();
1054#
1055# DESCRIPTION
1056#   This internal method compares the current set of build tools with that of
1057#   the previous build using a "cache" file. If some build tools have changed,
1058#   the method updates the cache file and (the time stamps of) dummy "flags"
1059#   files to denote changes in build tools from the previous build.
1060# ------------------------------------------------------------------------------
1061
1062sub _update_tool_info {
1063  my $self = shift;
1064
1065  # Look for a build tool cache file
1066  my $cachebase = $self->config->setting (qw/CACHE BLDTOOL/);
1067  my $incache   = find_file_in_path $cachebase, $self->{PATH}{CACHE};
1068
1069  my @chgtool = ();
1070  my %newtool = %{ $self->config->setting ('TOOL') };
1071
1072  # Read config if exists, otherwise marked all current tools as "changed"
1073  if ($incache and -r $incache) {
1074    my $cfg = Fcm::CfgFile->new (CONFIG => $self->config, SRC => $incache);
1075    $cfg->read_cfg;
1076
1077    my @lines   = $cfg->lines;
1078    my %oldtool = ();
1079
1080    for my $line (@lines) {
1081      next unless $line->{LABEL};
1082
1083      $oldtool{$line->{LABEL}} = $line->{VALUE};
1084    }
1085
1086    # Compare new and old, mark as "changed" if changed or does not exist in old
1087    @chgtool = (grep {
1088      exists $oldtool{$_} ? $oldtool{$_} ne $newtool{$_} : 1;
1089    } keys %newtool);
1090
1091    # Compare old and new, mark as "changed" if not exist in new
1092    push @chgtool, (grep {not exists $newtool{$_}} keys %oldtool);
1093
1094  } else {
1095    @chgtool = keys %newtool;
1096  }
1097
1098  if (@chgtool) {
1099    # Update the time stamps of dummy files for changed tools
1100    $self->_create_build_dir ('FLAGS');
1101
1102    my $ext = $self->config->setting (qw/OUTFILE_EXT FLAGS/);
1103    for my $name (@chgtool) {
1104      my $file = catfile $self->{DIR}{FLAGS}, $name . $ext;
1105
1106      # Create/touch the file
1107      touch_file $file or croak 'Unable to update: ', $file, ', abort';
1108
1109      print 'Updated: ', $file, "\n" if $self->config->verbose > 2;
1110    }
1111
1112    # Update the build tool cache file if necessary
1113    my $cfg = Fcm::CfgFile->new (CONFIG => $self->config);
1114
1115    for my $name (keys %newtool) {
1116      $cfg->add_line (LABEL => $name, VALUE => $newtool{$name});
1117    }
1118
1119    $cfg->print_cfg (catfile ($self->{PATH}{CACHE}->[0], $cachebase));
1120  }
1121
1122  return 1;
1123}
1124
1125# ------------------------------------------------------------------------------
1126# SYNOPSIS
1127#   $self->_pre_process ();
1128#
1129# DESCRIPTION
1130#   This internal method obtains a list of source files that require
1131#   pre-processing in the source packages of this build, and attempts to
1132#   pre-process them. The method returns 1 on success.
1133# ------------------------------------------------------------------------------
1134
1135sub _pre_process {
1136  my $self = shift;
1137
1138  # Go through source packages/files to see if PP is required
1139  my @srcfiles = ();
1140  for my $package (values %{ $self->{PACKAGE} }) {
1141    next unless $package->requirepp;
1142
1143    $package->scan_dependency (HEADER_ONLY => 1);
1144
1145    push @srcfiles, grep ({$_->is_type_or (qw/FPP C/)} $package->srcfile);
1146  }
1147
1148  return 1 unless @srcfiles;
1149
1150  my %task     = ();
1151  my $flagsext = $self->config->setting (qw/OUTFILE_EXT FLAGS/);
1152  my $pdoneext = $self->config->setting (qw/OUTFILE_EXT PDONE/);
1153
1154  # Set up tasks for each source file
1155  for my $srcfile (@srcfiles) {
1156    my $command  = $srcfile->is_type ('FPP') ? 'FPP' : 'CPP';
1157    my @pck_list = $srcfile->get_package_list;
1158    my @pknames  = split '__', pop (@pck_list);
1159
1160    # Set up a PP build task for each source file
1161    my $target    = $srcfile->base . $pdoneext;
1162    my $ppkeyname = join ('__', ($command . 'KEYS' , @pknames)) . $flagsext;
1163    my $flagsname = join ('__', ($command . 'FLAGS', @pknames)) . $flagsext;
1164
1165    # Issue warning for duplicated tasks
1166    if (exists $task{$target}) {
1167      w_report 'Warning: ', $target, ': unable to create task for: ',
1168               $srcfile->src, ': task already exists for: ',
1169               $task{$target}->srcfile->src;
1170      next;
1171    }
1172
1173    $task{$target} = Fcm::BuildTask->new (
1174      CONFIG     => $self->config,
1175      TARGET     => $target,
1176      TARGETPATH => $self->{PATH}{DONE},
1177      SRCFILE    => $srcfile,
1178      DEPENDENCY => [$ppkeyname, $flagsname, ($srcfile->dep ('H'))],
1179      ACTIONTYPE => 'PP',
1180    );
1181
1182    # Set up update ppkeys/flags build tasks for each source file/package
1183    for my $i (0 .. $#pknames) {
1184      my $name  = join '__', @pknames [0 .. $i];     # package name
1185      my $dname = join '__', @pknames [0 .. $i - 1]; # dependent package name
1186
1187      for my $flag (qw/KEYS FLAGS/) {
1188        my $fullflag = $command . $flag;
1189        my $target   = join '__', ($fullflag, $name);
1190        my $depend   = $dname ? join '__', ($fullflag, $dname) : $fullflag;
1191
1192        $target .= $flagsext;
1193        $depend .= $flagsext;
1194
1195        next if exists $task{$target};
1196
1197        $task{$target} = Fcm::BuildTask->new (
1198          CONFIG     => $self->config,
1199          TARGET     => $target,
1200          TARGETPATH => $self->{PATH}{FLAGS},
1201          DEPENDENCY => [$depend],
1202          ACTIONTYPE => 'UPDATE',
1203        );
1204      }
1205    }
1206  }
1207
1208  # Set up update global ppkeys/flags build tasks
1209  for my $command (qw/CPP FPP/) {
1210    for my $flag ('', qw/KEYS FLAGS/) {
1211      my $target = $command . $flag . $flagsext;
1212
1213      $task{$target} = Fcm::BuildTask->new (
1214        CONFIG     => $self->config,
1215        TARGET     => $target,
1216        TARGETPATH => $self->{PATH}{FLAGS},
1217        ACTIONTYPE => 'UPDATE',
1218      );
1219    }
1220  }
1221
1222  # Set up build tasks to copy all header files
1223  for my $package (values %{ $self->{PACKAGE} }) {
1224    my @files = grep {$_->is_type (qw/CPP INCLUDE/)} $package->srcfile;
1225
1226    # Author's note: may also want to issue warning for duplicated tasks
1227
1228    for my $file (@files) {
1229      $task{$file->base} = Fcm::BuildTask->new (
1230        CONFIG     => $self->config,
1231        TARGET     => $file->base,
1232        TARGETPATH => $self->{PATH}{INC},
1233        SRCFILE    => $file,
1234        DEPENDENCY => [$file->dep ('H')],
1235        ACTIONTYPE => 'COPY',
1236      );
1237    }
1238  }
1239
1240  # Build all PP tasks
1241  my $count = 0;
1242
1243  for my $task (values %task) {
1244    next unless $task->actiontype eq 'PP';
1245
1246    my $rc = $task->action (TASKLIST => \%task);
1247    $count++ if $rc;
1248  }
1249
1250  print 'Number of pre-processed files: ', $count, "\n"
1251    if $self->config->verbose and $count;
1252
1253  # Change path and file type of pre-processed source files
1254  for my $task (values %task) {
1255    next unless $task->actiontype eq 'PP';
1256
1257    # Remove header dependencies from source file
1258    my %dep = $task->srcfile->dep ();
1259    for my $key (keys %dep) {
1260      delete $dep{$key} if $dep{$key} eq 'H';
1261    }
1262    $task->srcfile->dep (\%dep);
1263  }
1264
1265  return 1;
1266}
1267
1268# ------------------------------------------------------------------------------
1269# SYNOPSIS
1270#   $self->_generate_f9x_interface ();
1271#
1272# DESCRIPTION
1273#   This internal method obtains a list of Fortran 9X source files in the
1274#   source packages of this build, and attempts to generate an interface block
1275#   file for each of the Fortran 9X source files. The method returns 1 on
1276#   success.
1277# ------------------------------------------------------------------------------
1278
1279sub _generate_f9x_interface {
1280  my $self = shift;
1281
1282  # Go through source packages/files for Fortran 9x source files with
1283  # standalone subroutines or functions
1284  my @srcfiles = ();
1285  for my $package (values %{ $self->{PACKAGE} }) {
1286    next unless $package->current;
1287
1288    push @srcfiles, grep {
1289      $_->is_type_or (qw/FORTRAN9X FPP9X/) and
1290      uc ($_->select_tool ('GENINTERFACE')) ne 'NONE' and
1291      not $_->is_type_or (qw/PROGRAM MODULE INCLUDE/)
1292    } $package->srcfile;
1293  }
1294
1295  my $flagsext = $self->config->setting (qw/OUTFILE_EXT FLAGS/);
1296  my $pdoneext = $self->config->setting (qw/OUTFILE_EXT PDONE/);
1297
1298  # Set up build task to generate interface files for all selected Fortran 9x
1299  # sources
1300  my %task         = ();
1301  for my $srcfile (@srcfiles) {
1302    my $target  = $srcfile->interfacebase . $pdoneext;
1303    my @pknames = split '__', ($srcfile->get_package_list)[-1];
1304    my $flag    = join ('__', ('GENINTERFACE', @pknames)) . $flagsext;
1305
1306    $task{$target} = Fcm::BuildTask->new (
1307      CONFIG     => $self->config,
1308      TARGET     => $target,
1309      TARGETPATH => $self->{PATH}{DONE},
1310      SRCFILE    => $srcfile,
1311      DEPENDENCY => [$flag],
1312      ACTIONTYPE => 'GENINTERFACE',
1313    );
1314
1315    # Set up build tasks for each source file/package flags file for interface
1316    # generator tool
1317    for my $i (0 .. $#pknames) {
1318      my $name   = join '__', @pknames [0 .. $i];     # package name
1319      my $dname  = join '__', @pknames [0 .. $i - 1]; # dependent package name
1320
1321      my $target = join '__', ('GENINTERFACE', $name);
1322      my $depend = $dname ? join '__', ('GENINTERFACE', $dname) : 'GENINTERFACE';
1323
1324      $target .= $flagsext;
1325      $depend .= $flagsext;
1326
1327      next if exists $task{$target};
1328
1329      $task{$target} = Fcm::BuildTask->new (
1330        CONFIG     => $self->config,
1331        TARGET     => $target,
1332        TARGETPATH => $self->{PATH}{FLAGS},
1333        DEPENDENCY => [$depend],
1334        ACTIONTYPE => 'UPDATE',
1335      );
1336    }
1337  }
1338
1339  # Set up build task to update the flags file for interface generator tool
1340  {
1341    my $target     = 'GENINTERFACE' . $flagsext;
1342    $task{$target} = Fcm::BuildTask->new (
1343      CONFIG     => $self->config,
1344      TARGET     => $target,
1345      TARGETPATH => $self->{PATH}{FLAGS},
1346      ACTIONTYPE => 'UPDATE',
1347    );
1348  }
1349
1350  my $count = 0;
1351
1352  # Performs task
1353  for my $task (values %task) {
1354    next unless $task->actiontype eq 'GENINTERFACE';
1355
1356    my $rc = $task->action (TASKLIST => \%task);
1357    $count++ if $rc;
1358  }
1359
1360  print 'Number of generated interfaces: ', $count, "\n"
1361    if $self->config->verbose and $count;
1362
1363  return 1;
1364}
1365
1366# ------------------------------------------------------------------------------
1367# SYNOPSIS
1368#   $self->_scan_dependency ();
1369#
1370# DESCRIPTION
1371#   This internal method goes through each source package to obtain dependency
1372#   information from their source files. It returns 1 on success.
1373# ------------------------------------------------------------------------------
1374
1375sub _scan_dependency {
1376  my $self = shift;
1377
1378  # Go through source packages/files
1379  my $count = 0;
1380
1381  for my $package (values %{ $self->{PACKAGE} }) {
1382    my $rc = $package->scan_dependency;
1383    $count++ if $rc;
1384  }
1385
1386  print 'Scanned files in ', $count, ' package(s) for dependency', "\n"
1387    if $self->config->verbose and $count;
1388
1389  return 1;
1390}
1391
1392# ------------------------------------------------------------------------------
1393# SYNOPSIS
1394#   $self->_set_targets ();
1395#
1396# DESCRIPTION
1397#   This internal method determines the default targets to be built.
1398# ------------------------------------------------------------------------------
1399
1400sub _set_targets {
1401  my $self = shift;
1402
1403  # Targets of the build
1404  if (not @{ $self->{TARGET} }) {
1405    # Build targets not specified by user, default to building all main programs
1406    my @programs = ();
1407
1408    # Get all main programs from all packages
1409    for my $package (values %{ $self->{PACKAGE} }) {
1410      my @srcfiles = grep {$_->exebase} $package->srcfile;
1411
1412      for (@srcfiles) {
1413        push @programs, $_->exebase;
1414      }
1415    }
1416
1417    @programs = sort (@programs);
1418
1419    if (@programs) {
1420      # Build main programs, if there are any
1421      @{ $self->{TARGET} } = @programs;
1422
1423    } else {
1424      # No main program in source tree, build the default library
1425      @{ $self->{TARGET} } = (
1426        'lib' . $self->{LIB}{''} . $self->config->setting (qw/OUTFILE_EXT LIB/),
1427      );
1428    }
1429  }
1430
1431  return @{ $self->{TARGET} };
1432}
1433
1434# ------------------------------------------------------------------------------
1435# SYNOPSIS
1436#   $self->_write_make_rules ();
1437#
1438# DESCRIPTION
1439#   This internal method writes the included make rules if necessary.
1440# ------------------------------------------------------------------------------
1441
1442sub _write_make_rules {
1443  my $self   = shift;
1444  my $return = 1;
1445
1446  # Get list of all packages
1447  my %allpcks = $self->allpcks;
1448
1449  # Get list of types that cannot have duplicated targets
1450  my @no_duplicated_target_types = split (
1451    /,/, $self->config->setting ('NO_DUPLICATED_TARGET_TYPE'),
1452  );
1453
1454  my $unusual = 0;
1455  my $count   = 0;
1456  my %targets;
1457  for my $name (sort keys %allpcks) {
1458    # Check whether package is an actual package of the build
1459    my $package  = exists $self->{PACKAGE}{$name} ? $self->{PACKAGE}{$name} : '';
1460
1461    # Regenerate make rules if this flag is set to true
1462    my $regen_mk;
1463
1464    # Register non-word package name
1465    if (not $name =~ /^\w*$/) {
1466      $self->config->assign_setting (
1467        LABELS => ['FCM_PCK_OBJECTS', $name],
1468        VALUE  => 'FCM_PCK_OBJECTS' . $unusual++,
1469      );
1470
1471      # Set regenerate make rule flag to true
1472      $regen_mk = 1;
1473    }
1474
1475    # Cycle loop if not an actual package of the build
1476    next unless $package;
1477
1478    # Check whether make rule for each source package needs updating. Yes if:
1479    # 1. package name contains non-word characters
1480    # 2. the config setting REGEN_MAKERULE is set to true
1481    # 3. package is current and the make rule for the package is out of date
1482    $regen_mk = (
1483      $regen_mk or
1484      $self->config->setting ('REGEN_MAKERULE') or
1485      ($package->current and not $package->makerule_uptodate)
1486    );
1487
1488    # Update make rule for source package, if necessary
1489    $count += $package->write_makerule () if $regen_mk;
1490
1491    # Check for duplicated rules
1492    for my $srcfile (sort $package->srcfile) {
1493      next unless $srcfile->type;
1494
1495      my %rules = $srcfile->required_rules;
1496
1497      for my $key (sort keys %rules) {
1498        if (exists $targets{$key}) {
1499          # Duplicated target: warning for most file types
1500          my $status = 'WARNING';
1501
1502          # Duplicated target: error for the following file types
1503          if (@no_duplicated_target_types and
1504              $srcfile->is_type_or (@no_duplicated_target_types) and
1505              $targets{$key}->is_type_or (@no_duplicated_target_types)) {
1506            $status = 'ERROR';
1507            $return = 0;
1508          }
1509
1510          # Report the warning/error
1511          w_report $status, ': ', $key, ': duplicated targets for building:';
1512          w_report '       ', $targets{$key}->src;
1513          w_report '       ', $srcfile->src;
1514
1515        } else {
1516          $targets{$key} = $srcfile;
1517        }
1518      }
1519    }
1520  }
1521
1522  # Diagnostic
1523  print 'Updated make rules for ', $count, ' package(s).', "\n"
1524    if $count and $self->config->verbose;
1525
1526  return $return;
1527}
1528
1529# ------------------------------------------------------------------------------
1530# SYNOPSIS
1531#   $self->_write_makefile ();
1532#
1533# DESCRIPTION
1534#   This internal method writes the "Makefile" for this build.
1535# ------------------------------------------------------------------------------
1536
1537sub _write_makefile {
1538  my $self = shift;
1539
1540  # Makefile header
1541  # ----------------------------------------------------------------------------
1542  my $makefile = '# Automatic Makefile' . "\n\n";
1543
1544  # Name of the build
1545  $makefile .= 'FCM_BUILD_NAME = ' . $self->{NAME} . "\n" if $self->{NAME};
1546 
1547  # Location of FCM config file
1548  $makefile .= 'FCM_BLD_CFG = ' . $self->cfg->src . "\n";
1549
1550  # Targets of the build
1551  $makefile .= 'FCM_BLD_TARGETS = ' . join (' ', ($self->_set_targets)) . "\n\n";
1552
1553  # Perl library
1554  # ----------------------------------------------------------------------------
1555  {
1556    my $libdir  = dirname (dirname ($INC{'Fcm/Build.pm'}));
1557    my @libpath = split /:/, ($ENV{PERL5LIB} ? $ENV{PERL5LIB} : '');
1558
1559    if (not grep (m/$libdir/, @libpath)) {
1560      $makefile .= 'export PERL5LIB := ' . $libdir;
1561      $makefile .= ':$(PERL5LIB)' if exists $ENV{PERL5LIB};
1562      $makefile .= "\n\n";
1563    }
1564  }
1565
1566  # Build directories
1567  # ----------------------------------------------------------------------------
1568  my @keys    = ('ROOT', sort grep {$_ ne 'ROOT'} keys (%{ $self->{DIR} }));
1569  my $rootdir = $self->{DIR}{ROOT};
1570
1571  # Build sub-directories
1572  for my $name (@keys) {
1573    my $dir = $self->{DIR}{$name};
1574    $dir    =~ s/^$rootdir/\$(FCM_ROOTDIR)/ unless $name eq 'ROOT';
1575
1576    $makefile .= 'export FCM_' . $name . 'DIR = ' . $dir . "\n";
1577  }
1578
1579  $makefile .= "\n";
1580
1581  # Build sub-directory paths
1582  for my $name (@keys) {
1583    my @path = @{ $self->{PATH}{$name} };
1584    shift @path;
1585
1586    $makefile .= 'export FCM_' . $name . 'PATH = ' .
1587                 join (':', ('$(FCM_' . $name . 'DIR)', @path)) . "\n";
1588  }
1589
1590  $makefile .= "\n";
1591
1592  # Build tools
1593  # ----------------------------------------------------------------------------
1594  # List of build tools
1595  my $tool          = $self->config->setting ('TOOL');
1596
1597  # List of tools local to FCM, (will not be exported)
1598  my %localtool     = map {($_, 1)} split (    # map into a hash table
1599    /,/, $self->config->setting ('LOCALTOOL'), # split comma separated list
1600  );
1601
1602  # Export required tools
1603  my $unusual_count = 0;
1604  for my $name (sort keys %$tool) {
1605    # Ignore local tools
1606    my $topname = (split (/__/, $name))[0];
1607    next if exists $localtool{$topname};
1608
1609    if ($name =~ /^\w+$/) {
1610      # Tools with normal name, just export it as an environment variable
1611      $makefile .= 'export ' . $name . ' = ' . $tool->{$name} . "\n";
1612
1613    } else {
1614      # Tools with unusual characters, export using a label/value pair
1615      $makefile .= 'export FCM_UNUSUAL_TOOL_LABEL' . $unusual_count . ' = ' .
1616                   $name . "\n";
1617      $makefile .= 'export FCM_UNUSUAL_TOOL_VALUE' . $unusual_count . ' = ' .
1618                   $tool->{$name} . "\n";
1619      $unusual_count++;
1620    }
1621  }
1622
1623  $makefile .= "\n";
1624
1625  # Verbose mode
1626  # ----------------------------------------------------------------------------
1627  $makefile .= 'export FCM_VERBOSE ?= ' . $self->config->verbose . "\n\n";
1628
1629  # VPATH
1630  # ----------------------------------------------------------------------------
1631  # $name is internal name of build sub-directories
1632  # $type is the type of files
1633  for my $name (sort keys %{ $self->config->setting ('VPATH') }) {
1634    my @types = split /,/, $self->config->setting ('VPATH', $name);
1635
1636    for my $type (sort @types) {
1637      # If $type is EMPTY, it is a file with no file name extension
1638      if (uc ($type) eq 'EMPTY') {
1639        $makefile .= 'vpath % $(FCM_' . $name . 'PATH)' . "\n";
1640
1641      } elsif ($type =~ s/^(in|out)://i) {
1642        if (uc ($1) eq 'IN') {
1643          # If $type begins with IN:<type>, it is a list of file extensions that
1644          # can be found under the INFILE_EXT hash in the configuration setting,
1645          # with <type> matching a keyword in the values of the hash.
1646          my %infile_ext = %{ $self->config->setting ('INFILE_EXT') };
1647
1648          for my $ext (sort keys %infile_ext) {
1649            $makefile .= 'vpath %.' . $ext . ' $(FCM_' . $name . 'PATH)' . "\n"
1650              if grep {$_ eq $type} split /::/, $infile_ext{$ext};
1651          }
1652
1653        } else {
1654          # If $type begins with OUT:<type>, it is the value of a hash element
1655          # in the OUTFILE_EXT hash in the configuration setting, with <type>
1656          # matching the key.
1657          my $ext    = $self->config->setting ('OUTFILE_EXT', $type);
1658          $makefile .= 'vpath %' . $ext . ' $(FCM_' . $name . 'PATH)' . "\n";
1659        }
1660
1661      } else {
1662        # Otherwise, $type is a VPATH pattern recognised by "make".
1663        $makefile .= 'vpath ' . $type . ' $(FCM_' . $name . 'PATH)' . "\n";
1664      }
1665    }
1666  }
1667
1668  # VPATH for dummy files
1669  $makefile .= 'vpath %.dummy $(FCM_DONEDIR)' . "\n";
1670  $makefile .= "\n";
1671
1672  # Default targets
1673  # ----------------------------------------------------------------------------
1674  $makefile .= '.PHONY : all clean' . "\n\n";
1675  $makefile .= 'all : $(FCM_BLD_TARGETS)' . "\n\n";
1676  $makefile .= 'clean : ' . "\n";
1677  $makefile .= "\t" . 'rm -rf';
1678  for my $dir (qw/BIN LIB OBJ DONE/) {
1679    $makefile .= ' $(FCM_' . $dir . 'DIR)' if exists $self->{DIR}{$dir};
1680  }
1681  $makefile .= "\n";
1682  $makefile .= "\t" . 'rm -f lib__*' .
1683               $self->config->setting (qw/OUTFILE_EXT LIB/) .
1684               ' *' . $self->config->setting (qw/OUTFILE_EXT OBJ/) . "\n";
1685  $makefile .= "\n";
1686
1687  # Targets for copy dummy
1688  $makefile .= $self->config->setting (qw/MISC CPDUMMY/) . ' :' . "\n";
1689  $makefile .= "\t" . 'touch $@' . "\n\n";
1690
1691  # Targets for all (non-main-program) objects and libraries
1692  # ----------------------------------------------------------------------------
1693  my %allpcks = $self->allpcks;
1694  for my $key (reverse sort keys %allpcks) {
1695    # Objects variable
1696    my $var;
1697    if ($self->config->setting ('FCM_PCK_OBJECTS', $key)) {
1698      # Package name contains unusual characters, use predefined variable
1699      $var = $self->config->setting ('FCM_PCK_OBJECTS', $key);
1700
1701    } else {
1702      # Normal package name, prefix the package name with "OBJECTS__"
1703      # Top level package, simply set to "OBJECTS"
1704      $var = $key ? join ('__', ('OBJECTS', $key)) : 'OBJECTS';
1705    }
1706
1707    # Export top level OBJECTS variable
1708    # but keep sub-package OBJECTS variables local to the Makefile
1709    $makefile .= ($var eq 'OBJECTS' ? 'export ' : '') . $var . ' =';
1710
1711    # Add objects from children
1712    if (@{ $allpcks{$key} }) {
1713      # List of sub-packages of current package
1714      my @deps   = map {
1715        if ($self->config->setting ('FCM_PCK_OBJECTS', $_)) {
1716          # Package name contains unusual characters, use predefined variable
1717          '$(' . $self->config->setting ('FCM_PCK_OBJECTS', $_) . ')';
1718
1719        } else {
1720          # Normal package name, prefix the package name with "OBJECTS__"
1721          '$(OBJECTS__' . $_ . ')';
1722        }
1723      } @{ $allpcks{$key} };
1724
1725      $makefile .= ' ' . join (' ', sort @deps);
1726    }
1727
1728    # Add its own objects
1729    if (exists $self->{PACKAGE}{$key}) {
1730      # List of source files in the current package
1731      my @files = sort {$a->base cmp $b->base} $self->{PACKAGE}{$key}->srcfile;
1732
1733      for my $file (@files) {
1734        # Consider compilable source files only
1735        next unless $file->objbase;
1736
1737        # Ignore main programs and Fortran BLOCKDATA program units
1738        next if $file->is_type_or (qw/PROGRAM BLOCKDATA/);
1739
1740        # Add to object list
1741        $makefile .= ' ' . $file->objbase;
1742      }
1743    }
1744
1745    $makefile .= "\n\n";
1746
1747    # Library target
1748    my $lib = exists ($self->{LIB}{$key}) ? $self->{LIB}{$key} : $key;
1749    $lib    = 'lib' . $lib . $self->config->setting (qw/OUTFILE_EXT LIB/);
1750
1751    $makefile .= $lib . ' : $(' . $var . ')' . "\n";
1752    $makefile .= "\t" . 'fcm_internal archive $@ $(^F)' . "\n\n";
1753  }
1754
1755  # Targets for top level and package flags files and dummy dependencies
1756  my %src_tool   = %{ $self->config->setting ('SRC_TOOL') };
1757  my %flags_tool = (LD => '', LDFLAGS => '');
1758
1759  for my $key (keys %src_tool) {
1760    $flags_tool{$src_tool{$key}{FLAGS}} = $src_tool{$key}{COMPILER}
1761      if exists $src_tool{$key}{FLAGS};
1762
1763    $flags_tool{$src_tool{$key}{PPKEYS}} = ''
1764      if exists $src_tool{$key}{PPKEYS};
1765  }
1766
1767  my $ext = $self->config->setting (qw/OUTFILE_EXT FLAGS/);
1768  for my $name (sort keys %flags_tool) {
1769    # Flags files for tool command
1770    if ($flags_tool{$name}) {
1771      $makefile .= $flags_tool{$name} . $ext . ' :' . "\n";
1772      $makefile .= "\t" . 'touch ' . catfile ('$(FCM_FLAGSDIR)', '$@') . "\n\n";
1773    }
1774
1775    # Top level flags files
1776    $makefile .= $name . $ext . ' :';
1777    $makefile .= ' ' . $flags_tool{$name} . $ext if $flags_tool{$name};
1778    $makefile .= "\n\t" . 'touch ' . catfile ('$(FCM_FLAGSDIR)', '$@') . "\n\n";
1779
1780    # Package level flags files
1781    for my $key (sort keys %allpcks) {
1782      next unless @{ $allpcks{$key} }; # ignore packages without children
1783
1784      my $depend  = $key ? join '__', ($name, $key) : $name;
1785      my @targets = sort map {$name . '__' . $_ . $ext} @{ $allpcks{$key} };
1786
1787      $makefile .= join (' ', @targets) . ' : ' . $depend . $ext . "\n";
1788      $makefile .= "\t" . 'touch ' . catfile ('$(FCM_FLAGSDIR)', '$@') .
1789                   "\n\n";
1790    }
1791  }
1792
1793  # Include source package make rules
1794  # ----------------------------------------------------------------------------
1795  for my $package (sort {$a->name cmp $b->name} values %{ $self->{PACKAGE} }) {
1796    my $mkbase = $package->name . $self->config->setting (qw/OUTFILE_EXT MK/);
1797    my $mkfile = find_file_in_path ($mkbase, $self->{PATH}{BLD});
1798
1799    if ($mkfile) {
1800      if (index ($mkfile, $self->{DIR}{BLD}) == 0) {
1801        $mkfile = catfile '$(FCM_BLDDIR)',
1802                  substr ($mkfile, length ($self->{DIR}{BLD}) + 1);
1803
1804      } elsif (index ($mkfile, $self->{DIR}{ROOT}) == 0) {
1805        $mkfile = catfile '$(FCM_ROOTDIR)',
1806                  substr ($mkfile, length ($self->{DIR}{ROOT}) + 1);
1807      }
1808
1809      $makefile .= 'include ' . $mkfile . "\n";
1810
1811    } else {
1812      my $pck = join ('::', split (/__/, $package->name));
1813      w_report 'Warning: no make rule file for source package: ', $pck;
1814    }
1815  }
1816
1817  $makefile .= "\n" . '# EOF' . "\n";
1818
1819  # Print Makefile
1820  # ----------------------------------------------------------------------------
1821  $self->_create_build_dir ('BLD');
1822  my $out = catfile (
1823    $self->{DIR}{BLD}, $self->config->setting (qw/MISC MAKEFILE/),
1824  );
1825
1826  # Check whether an old file exists, if so compare current contents with it
1827  my $old = '';
1828
1829  if (-r $out) {
1830    open OLD, '<', $out or croak 'Cannot open "', $out, '" (', $!, '), abort';
1831    my @lines = readline 'OLD';
1832    close OLD;
1833
1834    $old = join ('', @lines);
1835  }
1836
1837  # Update Makefile if changed
1838  if ($old ne $makefile) {
1839    open OUT, '>', $out or croak 'Cannot open "', $out, '" (', $!, '), abort';
1840    print OUT $makefile;
1841    close OUT or croak 'Cannot close "', $out, '" (', $!, '), abort';
1842
1843    print 'Updated Makefile: ', $out, "\n" if $self->config->verbose;
1844  }
1845
1846  return 1;
1847}
1848
1849# ------------------------------------------------------------------------------
1850# SYNOPSIS
1851#   $self->_invoke_make (
1852#     TARGETS => \@targets,
1853#     JOBS    => $jobs,
1854#     ARCHIVE => $archive,
1855#   );
1856#
1857# DESCRIPTION
1858#   This internal method invokes the "make" command to make the build.
1859#
1860# ARGUMENTS
1861#   TARGETS - Specify targets to be built. If set, these targets will be built
1862#             instead of the ones specified in the build configuration file.
1863#   JOBS    - Specify number of jobs that can be handled by "make". If set,
1864#             the value must be a natural integer. If not set, the default
1865#             value is 1 (i.e. run "make" in serial mode).
1866#   ARCHIVE - If set to "true", invoke the "archive" mode. Most build files and
1867#             directories created by this build will be archived using the
1868#             "tar" command. If not set, the default is not to invoke the
1869#             "archive" mode.
1870# ------------------------------------------------------------------------------
1871
1872sub _invoke_make {
1873  my $self = shift;
1874  my %args = @_;
1875
1876  # Build the make command from the specified targets
1877  my @targets  = exists $args{TARGETS} ? @{ $args{TARGETS} } : qw/all/;
1878  my $jobs     = exists $args{JOBS}    ? $args{JOBS}         : 1;
1879  my $archive  = exists $args{ARCHIVE} ? $args{ARCHIVE}      : 0;
1880  my $verbose  = $self->config->verbose;
1881
1882  # Create the required build directories
1883  for my $dir (qw/BIN DONE ETC INC FLAGS LIB OBJ TMP/) {
1884    $self->_create_build_dir ($dir);
1885  } 
1886
1887  my @commands = ();
1888  my @make_cmd = ($self->config->setting (qw/TOOL MAKE/));
1889  push @make_cmd, split (/\s+/, $self->config->setting (qw/TOOL MAKEFLAGS/));
1890  push @make_cmd, $self->config->setting (qw/TOOL MAKE_SILENT/)
1891    unless $verbose > 2;
1892
1893  if ($jobs > 1) { # multi-process "make"
1894    my $make_job = $self->config->setting (qw/TOOL MAKE_JOB/);
1895
1896    # Setup the "make" commands for each target
1897    while (my $target = shift @targets) {
1898      if ($target eq 'clean') { # Do not run "clean" in parallel
1899        push @commands, [@make_cmd, $target];
1900
1901      } else {
1902        push @commands, [@make_cmd, $make_job, $jobs, $target];
1903      }
1904    }
1905
1906  } else { # single process "make"
1907
1908    # Setup the "make" command
1909    push @commands, [@make_cmd, @targets];
1910
1911  }
1912 
1913  # Run the make command
1914  my $rc  = 0;
1915  my $cwd = cwd;
1916  print 'cd ', $self->{DIR}{BLD}, "\n" if $verbose > 2;
1917  chdir $self->{DIR}{BLD};
1918  while (my $cmd = shift @commands) {
1919    $| = 1; # flush STDOUT before running "make"
1920    print timestamp_command (&get_command_string ($cmd)) if $verbose > 2;
1921    $| = 0;
1922    &run_command ($cmd, ERROR => 'warn', RC => \$rc);
1923    print timestamp_command (&get_command_string ($cmd), 'End') if $verbose > 2;
1924    last if $rc;
1925  }
1926  print 'cd ', $cwd, "\n" if $verbose > 2;
1927  chdir $cwd;
1928
1929  return $rc ? undef : 1;
1930}
1931
1932# ------------------------------------------------------------------------------
1933# SYNOPSIS
1934#   $rc = $self->_remove_empty_dirs ();
1935#
1936# DESCRIPTION
1937#   This internal method removes empty build directories.
1938# ------------------------------------------------------------------------------
1939
1940sub _remove_empty_dirs {
1941  my $self = shift;
1942
1943  for my $name (qw/BIN CACHE DONE ETC FLAGS INC LIB PPSRC OBJ TMP/) {
1944    opendir DIR, $self->{DIR}{$name};
1945    my @files = readdir DIR;
1946    @files    = grep !/^\.\.?$/, @files;
1947    closedir DIR;
1948
1949    if (not @files) {
1950      print 'Remove directory: ', $self->{DIR}{$name}, "\n"
1951        if $self->config->verbose > 1;
1952      rmdir $self->{DIR}{$name};
1953    }
1954  }
1955
1956  return 1;
1957}
1958
1959# ------------------------------------------------------------------------------
1960# SYNOPSIS
1961#   $rc = $self->_tar_build_dirs ();
1962#
1963# DESCRIPTION
1964#   This internal method creates TAR archives for selected build directories.
1965# ------------------------------------------------------------------------------
1966
1967sub _tar_build_dirs {
1968  my $self = shift;
1969
1970  # Create TAR archives if necessary
1971  my $cwd = cwd;
1972
1973  my $tar      = $self->config->setting (qw/OUTFILE_EXT TAR/);
1974  my @tar_dirs = split /,/, $self->config->setting (qw/TAR_DIRS/);
1975  my $verbose  = $self->config->verbose;
1976
1977  for my $name (@tar_dirs) {
1978    my $dir = $self->{DIR}{$name};
1979
1980    if (-d $dir) {
1981      my $base = basename ($dir);
1982      print 'cd ', dirname ($dir), "\n" if $verbose > 2;
1983      chdir dirname ($dir);
1984
1985      my $rc = &run_command (
1986        [qw/tar -c -f/, $base . $tar, $base],
1987        PRINT => $verbose > 1, ERROR => 'warn',
1988      );
1989
1990      &run_command ([qw/rm -rf/, $base], PRINT => $verbose > 1) if not $rc;
1991    }
1992  }
1993
1994  print 'cd ', $cwd, "\n" if $verbose > 2;
1995  chdir $cwd;
1996
1997  return 1;
1998}
1999
2000# ------------------------------------------------------------------------------
2001# SYNOPSIS
2002#   $rc = $self->_create_runenv_script ();
2003#
2004# DESCRIPTION
2005#   This internal method creates the runtime environment script if necessary.
2006# ------------------------------------------------------------------------------
2007
2008sub _create_runenv_script {
2009  my $self = shift;
2010
2011  # More diagnostic on how to use the build
2012  my @bin_dirs = grep {-d} @{ $self->{PATH}{BIN} };
2013  my $etc_dir  = -d $self->{DIR}{ETC} ? $self->{DIR}{ETC} : undef;
2014
2015  if (@bin_dirs or $etc_dir) {
2016    # Create a runtime environment script if necessary
2017    my $run_env_sh_base = $self->config->setting (qw/MISC RUN_ENV_SH/);
2018    my $run_env_sh      = catfile $self->{DIR}{ROOT}, $run_env_sh_base;
2019
2020    open FILE, '>', $run_env_sh
2021      or croak $run_env_sh, ': cannot open (', $!, '), abort';
2022    print FILE '#!/usr/bin/ksh', "\n";
2023    print FILE 'export PATH=', join (':', @bin_dirs), ':$PATH', "\n"
2024      if @bin_dirs;
2025    print FILE 'export FCM_ETCDIR=', $self->{DIR}{ETC}, "\n" if $etc_dir;
2026    close FILE or croak $run_env_sh, ': cannot close (', $!, '), abort';
2027
2028    # Create symbolic link in bin/ sub-directory for backward compatibility
2029    if (-d $self->{DIR}{BIN}) {
2030      my $file = catfile ($self->{DIR}{BIN}, $run_env_sh_base);
2031     
2032      # Remove old link if necessary
2033      unlink $file if -l $file and readlink ($file) ne $run_env_sh;
2034
2035      # Create the new link
2036      symlink $run_env_sh, $file if not -l $file;
2037    }
2038
2039    # Information on the location/usage of the runtime environment script
2040    if ($self->config->verbose > 1 and $run_env_sh) {
2041      print '# ', '-' x 78, "\n";
2042      print '# To use this build, source the following shell script:', "\n";
2043      print '. ', $run_env_sh, "\n";
2044      print '# ', '-' x 78, "\n";
2045    }
2046  }
2047
2048  return 1;
2049}
2050
2051# ------------------------------------------------------------------------------
2052# SYNOPSIS
2053#   $self->_create_lib_excl_dep ();
2054#
2055# DESCRIPTION
2056#   This internal method creates a set of exclude dependency configurations for
2057#   libraries of this build.
2058# ------------------------------------------------------------------------------
2059
2060sub _create_lib_excl_dep {
2061  my $self = shift;
2062
2063  if (-d $self->{DIR}{LIB}) {
2064    $self->_create_build_dir ('ETC');
2065   
2066    my %allpcks  = $self->allpcks;
2067    my $cfgext   = $self->config->setting (qw/OUTFILE_EXT CFG/);
2068    my %cfglabel = %{ $self->config->setting ('CFG_LABEL') };
2069
2070    for my $key (reverse sort keys %allpcks) {
2071      my $outcfg = Fcm::CfgFile->new (CONFIG => $self->config);
2072
2073      # Include configurations from sub-packages
2074      for my $subpck (@{ $allpcks{$key} }) {
2075        my $base = 'lib' . $subpck . $cfgext;
2076        ($base = $self->{LIB}{$subpck}) =~ s/\.\w+$/$cfgext/
2077          if exists ($self->{LIB}{$subpck});
2078        my $file = catfile ('$HERE', $base);
2079
2080        $outcfg->add_line (LABEL => $cfglabel{INC}, VALUE => $file)
2081          if -r catfile ($self->{DIR}{ETC}, $base);;
2082      }
2083
2084      # Exclude dependency for source files in current package
2085      if (exists $self->{PACKAGE}{$key}) {
2086        my @srcfiles = $self->{PACKAGE}{$key}->srcfile;
2087
2088        for my $srcfile (@srcfiles) {
2089          if ($srcfile->is_type ('INCLUDE')) {
2090            if ($srcfile->is_type ('CPP')) {
2091              $outcfg->add_line (
2092                LABEL => $cfglabel{EXCL_DEP},
2093                VALUE => 'H::' . $srcfile->base,
2094              );
2095
2096            } elsif ($srcfile->is_type ('INTERFACE')) {
2097              $outcfg->add_line (
2098                LABEL => $cfglabel{EXCL_DEP},
2099                VALUE => 'INTERFACE::' . $srcfile->base,
2100              );
2101
2102            } else {
2103              $outcfg->add_line (
2104                LABEL => $cfglabel{EXCL_DEP},
2105                VALUE => 'INC::' . $srcfile->base,
2106              );
2107            }
2108
2109          } elsif ($srcfile->is_type ('SOURCE')) {
2110            next if $srcfile->is_type_or (qw/PROGRAM BLOCKDATA/);
2111
2112            if ($srcfile->is_type ('FORTRAN')) {
2113              if ($srcfile->is_type (qw/FORTRAN MODULE/)) {
2114                $outcfg->add_line (
2115                  LABEL => $cfglabel{EXCL_DEP},
2116                  VALUE => 'USE::' . $srcfile->root,
2117                );
2118
2119              } else {
2120                $outcfg->add_line (
2121                  LABEL => $cfglabel{EXCL_DEP},
2122                  VALUE => 'INTERFACE::' . $srcfile->interfacebase,
2123                ) if $srcfile->interfacebase;
2124
2125                $outcfg->add_line (
2126                  LABEL => $cfglabel{EXCL_DEP},
2127                  VALUE => 'OBJ::' . $srcfile->root,
2128                );
2129              }
2130
2131            } else {
2132              $outcfg->add_line (
2133                LABEL => $cfglabel{EXCL_DEP},
2134                VALUE => 'OBJ::' . $srcfile->root,
2135              );
2136            }
2137          }
2138        }
2139      }
2140
2141      # Name of configuration file, follows the name of library
2142      my $outbase ='lib' . $key . $cfgext;
2143      ($outbase = $self->{LIB}{$key}) =~ s/\.\w+$/$cfgext/
2144        if exists ($self->{LIB}{$key});
2145      my $outfile = catfile ($self->{DIR}{ETC}, $outbase);
2146
2147      # Write to configuration file
2148      $outcfg->print_cfg ($outfile);
2149    }
2150
2151    # Information on the location/usage of the exclude dependency configurations
2152    if ($self->config->verbose > 1) {
2153      my $etcdir = $self->{DIR}{ETC};
2154      print '# ', '-' x 78, "\n";
2155      print <<EOF;
2156# To use a library archive of this build in another FCM build, you need to
2157# include in the new build configuration the corresponding configuration file
2158# that has the relevant exclude dependency information. These configurations
2159# files can be found in $etcdir.
2160EOF
2161      print '# ', '-' x 78, "\n";
2162    }
2163  }
2164
2165  return 1;
2166}
2167
2168# ------------------------------------------------------------------------------
2169# SYNOPSIS
2170#   $self->_create_build_dir ();
2171#   $self->_create_build_dir ($label);
2172#
2173# DESCRIPTION
2174#   This internal method creates a build directory. If $label is specified,
2175#   the method will attempt to create a named sub-directory according to
2176#   $label. Otherwise, the method attempts to create the build root
2177#   directory. Returns the name of the directory if it is created successfully
2178#   or if it already exists.
2179# ------------------------------------------------------------------------------
2180
2181sub _create_build_dir {
2182  my $self  = shift;
2183  my $label = $_[0] ? uc $_[0] : 'ROOT';
2184
2185  my $dir = undef;
2186
2187  # Make sure the variable is set
2188  if ($self->{DIR}{$label}) {
2189    $dir = $self->{DIR}{$label};
2190
2191    # Expand relative path if necessary
2192    $dir = catfile $self->{DIR}{ROOT}, $dir if $dir =~ /^\w/;
2193
2194  } else {
2195    if ($label eq 'ROOT') {
2196      w_report 'Error: build root directory not set.';
2197      return;
2198
2199    } elsif ($self->config->setting ('DIR', $label)) {
2200      $dir = catfile $self->{DIR}{ROOT}, $self->config->setting ('DIR', $label);
2201
2202    } else {
2203      carp 'Directory label "', $label, '" not recognised';
2204      return undef;
2205    }
2206  }
2207
2208  # Set up the bld directory, if required
2209  if (not -d $dir) {
2210    print 'Make directory: ', $dir, "\n" if $self->config->verbose > 1;
2211    mkpath $dir or croak 'Cannot create directory "', $dir, '"';
2212  }
2213
2214  $self->{DIR}{$label} = $dir unless $self->{DIR}{$label};
2215
2216  return $dir;
2217}
2218
2219# ------------------------------------------------------------------------------
2220# SYNOPSIS
2221#   $self->_get_inherited_paths ($name);
2222#
2223# DESCRIPTION
2224#   This recursive internal method returns a list containing the search path
2225#   for a build directory named by the internal label $name. (Please note that
2226#   a build directory will only be placed into the search path if the
2227#   directory exists.)
2228# ------------------------------------------------------------------------------
2229
2230sub _get_inherited_paths {
2231  my $self = shift;
2232  my $name = shift;
2233
2234  return () unless $name and exists $self->{DIR}{$name};
2235
2236  my @path = ();
2237
2238  # Recursively inherit the search path for a this type of build directory
2239  for my $use (@{ $self->{USE} }) {
2240    my @cur_path = $use->_get_inherited_paths ($name);
2241    unshift @path, @cur_path;
2242  }
2243
2244  # Place the path of the current build in the front
2245  unshift @path, $self->{DIR}{$name};
2246
2247  return @path;
2248}
2249
2250# ------------------------------------------------------------------------------
2251# SYNOPSIS
2252#   $self->_get_inherited_srcdirs ($name);
2253#
2254# DESCRIPTION
2255#   This recursive internal method returns a list containing the search path
2256#   for a source directory named by the internal package label $name. (Please
2257#   note that a source directory will only be placed into the search path if
2258#   the directory exists.)
2259# ------------------------------------------------------------------------------
2260
2261sub _get_inherited_srcdirs {
2262  my $self = shift;
2263  my $name = shift;
2264
2265  return () unless $name;
2266
2267  my @path = ();
2268
2269  # Recursively inherit the search path for this source directory
2270  my $key = 'SRCDIR__' . $name;
2271  if ($self->_inherit_ok ($key)) {
2272    for my $use (@{ $self->{USE} }) {
2273      my @cur_path = $use->_get_inherited_srcdirs ($name);
2274      unshift @path, @cur_path;
2275    }
2276  }
2277
2278  # Place the path of the current source in the front
2279  unshift @path, $self->{SRCDIR}{$name}
2280    if exists $self->{SRCDIR}{$name} and -d $self->{SRCDIR}{$name};
2281
2282  return @path;
2283}
2284
2285# ------------------------------------------------------------------------------
2286# SYNOPSIS
2287#   $self->_get_inherited_items ($type);
2288#
2289# DESCRIPTION
2290#   This recursive internal method returns a list containing an inherited
2291#   build item of the type $type. (Depending of $type, the returned list can
2292#   be an array or a hash.)
2293# ------------------------------------------------------------------------------
2294
2295sub _get_inherited_items {
2296  my $self = shift;
2297  my $type = shift;
2298
2299  return () if not exists $self->{$type};
2300
2301  if (ref $self->{$type} eq 'ARRAY') {
2302
2303    my @items = ();
2304
2305    # Recursively inherit from used builds
2306    if ($self->{INHERIT}{$type}) {
2307      for my $use (@{ $self->{USE} }) {
2308        my @cur_items = $use->_get_inherited_items ($type);
2309
2310        for my $item (@cur_items) {
2311          my $type_item = $type . '__' . $item;
2312
2313          # Check inheritance option of current item
2314          next unless $self->_inherit_ok ($type_item);
2315
2316          # The statement ensures that there is no duplication
2317          push @items, $item unless grep {$_ eq $item} @items;
2318        }
2319      }
2320    }
2321
2322    # Items in current build
2323    if (@{ $self->{$type} }) {
2324      for my $item (@{ $self->{$type} }) {
2325        # The statement ensures that there is no duplication
2326        push @items, $item unless grep {$_ eq $item} @items;
2327      }
2328    }
2329
2330    return @items;
2331
2332  } elsif (ref $self->{$type} eq 'HASH') {
2333
2334    my %items = ();
2335
2336    # Recursively inherit from used builds
2337    if ($self->{INHERIT}{$type}) {
2338      for my $use (@{ $self->{USE} }) {
2339        my %cur_items = $use->_get_inherited_items ($type);
2340
2341        for my $name (keys %cur_items) {
2342          my $type_name = $type . '__' . $name;
2343
2344          # Check inheritance option of current item
2345          next unless $self->_inherit_ok ($type_name);
2346
2347          # "Closer" ancestors overrides more "distant" ones
2348          $items{$name} = $cur_items{$name};
2349        }
2350      }
2351    }
2352
2353    # Items in current build
2354    if (%{ $self->{$type} }) {
2355      for my $name (keys %{ $self->{$type} }) {
2356        # Settings in current build override inherited settings
2357        $items{$name} = $self->{$type}{$name};
2358      }
2359    }
2360
2361    return %items;
2362
2363  }
2364}
2365
2366# ------------------------------------------------------------------------------
2367# SYNOPSIS
2368#   $self->_require_pp ($name);
2369#
2370# DESCRIPTION
2371#   This internal method returns true if source package $name requires
2372#   pre-processing.
2373# ------------------------------------------------------------------------------
2374
2375sub _require_pp {
2376  my $self = shift;
2377  my $name = $_[0];
2378
2379  my $rc    = 0;
2380  my @names = 'PP';
2381  push @names, (split /__/, $name);
2382
2383  # Check whether pre-process flag exists, going up the source package hierarchy
2384  do {
2385    my $cur_name = join '__', @names;
2386    if (exists $self->{PP}{$cur_name}) {
2387      $rc = $self->{PP}{$cur_name};
2388      return $rc;
2389    }
2390  } while pop @names;
2391
2392  return $rc;
2393}
2394
2395# ------------------------------------------------------------------------------
2396# SYNOPSIS
2397#   $self->_inherit_ok ($name);
2398#
2399# DESCRIPTION
2400#   This internal method returns true if it is OK to inherit an item specified
2401#   by $name, (where $name is a double underscore "__" delimited positional
2402#   list of source package names).
2403# ------------------------------------------------------------------------------
2404
2405sub _inherit_ok {
2406  my $self  = shift;
2407  my $name  = $_[0];
2408
2409  my $rc    = 1;
2410  my @names = split /__/, $name;
2411
2412  # Check whether INHERIT flag exists, going up the source package hierarchy
2413  do {
2414    my $cur_name = join '__', @names;
2415    if (exists $self->{INHERIT}{$cur_name}) {
2416      $rc = $self->{INHERIT}{$cur_name};
2417      return $rc;
2418    }
2419  } while pop @names;
2420
2421  return $rc;
2422}
2423
2424# ------------------------------------------------------------------------------
2425
24261;
2427
2428__END__
Note: See TracBrowser for help on using the repository browser.