source: PATCHED/FCM_V1.1/lib/Fcm/Build.pm @ 1

Last change on this file since 1 was 1, checked in by fcm, 15 years ago

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