source: OFFICIAL/FCM_V1.3/lib/Fcm/Build.pm

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

creation de larborescence
File size: 50.4 KB
Line 
1#!/usr/bin/perl
2# ------------------------------------------------------------------------------
3# NAME
4#   Fcm::Build
5#
6# DESCRIPTION
7#   This is the top level class for the FCM build system.
8#
9# COPYRIGHT
10#   (C) Crown copyright Met Office. All rights reserved.
11#   For further details please refer to the file COPYRIGHT.txt
12#   which you should have received as part of this distribution.
13# ------------------------------------------------------------------------------
14
15package Fcm::Build;
16@ISA = qw(Fcm::ConfigSystem);
17
18# Standard pragma
19use strict;
20use warnings;
21
22# Standard modules
23use Carp;
24use Cwd;
25use File::Basename;
26use File::Spec;
27
28# FCM component modules
29use Fcm::BuildSrc;
30use Fcm::BuildTask;
31use Fcm::Config;
32use Fcm::ConfigSystem;
33use Fcm::Dest;
34use Fcm::CfgLine;
35use Fcm::Timer;
36use Fcm::Util;
37
38# List of scalar property methods for this class
39my @scalar_properties = (
40  'name',    # name of this build
41  'target',  # targets of this build
42);
43
44# List of hash property methods for this class
45my @hash_properties = (
46  'srcpkg',      # source packages of this build
47  'dummysrcpkg', # dummy for handling package inheritance with file extension
48);
49
50# List of compare_setting_X methods
51my @compare_setting_methods = (
52  'compare_setting_bld_blockdata', # program executable blockdata dependency
53  'compare_setting_bld_dep',       # custom dependency setting
54  'compare_setting_bld_dep_excl',  # exclude dependency setting
55  'compare_setting_bld_dep_pp',    # custom PP dependency setting
56  'compare_setting_bld_dep_exe',   # program executable extra dependency
57  'compare_setting_bld_exe_name',  # program executable rename
58  'compare_setting_bld_pp',        # PP flags
59  'compare_setting_infile_ext',    # input file extension
60  'compare_setting_outfile_ext',   # output file extension
61  'compare_setting_tool',          # build tool settings
62);
63
64# ------------------------------------------------------------------------------
65# SYNOPSIS
66#   $obj = Fcm::Build->new;
67#
68# DESCRIPTION
69#   This method constructs a new instance of the Fcm::Build class.
70# ------------------------------------------------------------------------------
71
72sub new {
73  my $this  = shift;
74  my %args  = @_;
75  my $class = ref $this || $this;
76
77  my $self = Fcm::ConfigSystem->new (%args);
78
79  $self->{$_} = undef for (@scalar_properties);
80
81  $self->{$_} = {} for (@hash_properties);
82
83  bless $self, $class;
84
85  # List of sub-methods for parse_cfg
86  push @{ $self->cfg_methods }, (qw/target source tool dep misc/);
87
88  # Optional prefix in configuration declaration
89  $self->cfg_prefix ($self->setting (qw/CFG_LABEL BDECLARE/));
90
91  # System type
92  $self->type ('bld');
93
94  return $self;
95}
96
97# ------------------------------------------------------------------------------
98# SYNOPSIS
99#   $value = $obj->X;
100#   $obj->X ($value);
101#
102# DESCRIPTION
103#   Details of these properties are explained in @scalar_properties.
104# ------------------------------------------------------------------------------
105
106for my $name (@scalar_properties) {
107  no strict 'refs';
108
109  *$name = sub {
110    my $self = shift;
111
112    # Argument specified, set property to specified argument
113    if (@_) {
114      $self->{$name} = $_[0];
115    }
116
117    # Default value for property
118    if (not defined $self->{$name}) {
119      if ($name eq 'target') {
120        # Reference to an array
121        $self->{$name} = [];
122
123      } elsif ($name eq 'name') {
124        # Empty string
125        $self->{$name} = '';
126      }
127    }
128
129    return $self->{$name};
130  }
131}
132
133# ------------------------------------------------------------------------------
134# SYNOPSIS
135#   %hash = %{ $obj->X () };
136#   $obj->X (\%hash);
137#
138#   $value = $obj->X ($index);
139#   $obj->X ($index, $value);
140#
141# DESCRIPTION
142#   Details of these properties are explained in @hash_properties.
143#
144#   If no argument is set, this method returns a hash containing a list of
145#   objects. If an argument is set and it is a reference to a hash, the objects
146#   are replaced by the the specified hash.
147#
148#   If a scalar argument is specified, this method returns a reference to an
149#   object, if the indexed object exists or undef if the indexed object does
150#   not exist. If a second argument is set, the $index element of the hash will
151#   be set to the value of the argument.
152# ------------------------------------------------------------------------------
153
154for my $name (@hash_properties) {
155  no strict 'refs';
156
157  *$name = sub {
158    my ($self, $arg1, $arg2) = @_;
159
160    # Ensure property is defined as a reference to a hash
161    $self->{$name} = {} if not defined ($self->{$name});
162
163    # Argument 1 can be a reference to a hash or a scalar index
164    my ($index, %hash);
165
166    if (defined $arg1) {
167      if (ref ($arg1) eq 'HASH') {
168        %hash = %$arg1;
169
170      } else {
171        $index = $arg1;
172      }
173    }
174
175    if (defined $index) {
176      # A scalar index is defined, set and/or return the value of an element
177      $self->{$name}{$index} = $arg2 if defined $arg2;
178
179      return (
180        exists $self->{$name}{$index} ? $self->{$name}{$index} : undef
181      );
182
183    } else {
184      # A scalar index is not defined, set and/or return the hash
185      $self->{$name} = \%hash if defined $arg1;
186      return $self->{$name};
187    }
188  }
189}
190
191# ------------------------------------------------------------------------------
192# SYNOPSIS
193#   ($rc, $new_lines) = $self->X ($old_lines);
194#
195# DESCRIPTION
196#   This method compares current settings with those in the cache, where X is
197#   one of @compare_setting_methods.
198#
199#   If setting has changed:
200#   * For bld_blockdata, bld_dep_ext and bld_exe_name, it sets the re-generate
201#     make-rule flag to true.
202#   * For bld_dep_excl, in a standalone build, the method will remove the
203#     dependency cache files for affected sub-packages. It returns an error if
204#     the current build inherits from previous builds.
205#   * For bld_pp, it updates the PP setting for affected sub-packages.
206#   * For infile_ext, in a standalone build, the method will remove all the
207#     sub-package cache files and trigger a re-build by removing most
208#     sub-directories created by the previous build. It returns an error if the
209#     current build inherits from previous builds.
210#   * For outfile_ext, in a standalone build, the method will remove all the
211#     sub-package dependency cache files. It returns an error if the current
212#     build inherits from previous builds.
213#   * For tool, it updates the "flags" files for any changed tools.
214# ------------------------------------------------------------------------------
215
216for my $name (@compare_setting_methods) {
217  no strict 'refs';
218
219  *$name = sub {
220    my ($self, $old_lines) = @_;
221
222    (my $prefix = uc ($name)) =~ s/^COMPARE_SETTING_//;
223
224    my ($changed, $new_lines) =
225      $self->compare_setting_in_config ($prefix, $old_lines);
226
227    my $rc = scalar (keys %$changed);
228
229    if ($rc and $old_lines) {
230      $self->srcpkg ('')->is_updated (1);
231
232      if ($name =~ /^compare_setting_bld_dep(?:_excl|_pp)?$/) {
233        # Mark affected packages as being updated
234        for my $key (keys %$changed) {
235          for my $pkg (values %{ $self->srcpkg }) {
236            next unless $pkg->is_in_package ($key);
237            $pkg->is_updated (1);
238          }
239        }
240
241      } elsif ($name eq 'compare_setting_bld_pp') {
242        # Mark affected packages as being updated
243        for my $key (keys %$changed) {
244          for my $pkg (values %{ $self->srcpkg }) {
245            next unless $pkg->is_in_package ($key);
246            next unless $self->srcpkg ($key)->is_type_any (
247              keys %{ $self->setting ('BLD_TYPE_DEP_PP') }
248            ); # Is a type requiring pre-processing
249
250            $pkg->is_updated (1);
251          }
252        }
253
254      } elsif ($name eq 'compare_setting_infile_ext') {
255        # Re-set input file type if necessary
256        for my $key (keys %$changed) {
257          for my $pkg (values %{ $self->srcpkg }) {
258            next unless $pkg->src and $pkg->ext and $key eq $pkg->ext;
259
260            $pkg->type (undef);
261          }
262        }
263
264        # Mark affected packages as being updated
265        for my $pkg (values %{ $self->srcpkg }) {
266          $pkg->is_updated (1);
267        }
268
269      } elsif ($name eq 'compare_setting_outfile_ext') {
270        # Mark affected packages as being updated
271        for my $pkg (values %{ $self->srcpkg }) {
272          $pkg->is_updated (1);
273        }
274
275      } elsif ($name eq 'compare_setting_tool') {
276        # Update the "flags" files for changed tools
277        for my $name (sort keys %$changed) {
278          my ($tool, @names) = split /__/, $name;
279          my $pkg  = join ('__', @names);
280          my @srcpkgs = $self->srcpkg ($pkg)
281                        ? ($self->srcpkg ($pkg))
282                        : @{ $self->dummysrcpkg ($pkg)->children };
283
284          for my $srcpkg (@srcpkgs) {
285            my $file = File::Spec->catfile (
286              $self->dest->flagsdir, $srcpkg->flagsbase ($tool)
287            );
288            &touch_file ($file) or croak $file, ': cannot update, abort';
289
290            print $file, ': updated', "\n" if $self->verbose > 2;
291          }
292        }
293      }
294    }
295
296    return ($rc, $new_lines);
297  }
298}
299
300# ------------------------------------------------------------------------------
301# SYNOPSIS
302#   ($rc, $new_lines) = $self->compare_setting_dependency ($old_lines, $flag);
303#
304# DESCRIPTION
305#   This method uses the previous settings to determine the dependencies of
306#   current source files.
307# ------------------------------------------------------------------------------
308
309sub compare_setting_dependency {
310  my ($self, $old_lines, $flag) = @_;
311
312  my $prefix = $flag ? 'DEP_PP' : 'DEP';
313  my $method = $flag ? 'ppdep'  : 'dep';
314
315  my $rc = 0;
316  my $new_lines = [];
317
318  # Separate old lines
319  my %old;
320  if ($old_lines) {
321    for my $line (@$old_lines) {
322      next unless $line->label_starts_with ($prefix);
323      $old{$line->label_from_field (1)} = $line;
324    }
325  }
326
327  # Go through each source to see if the cache is up to date
328  my $count = 0;
329  my %mtime;
330  for my $srcpkg (values %{ $self->srcpkg }) {
331    next unless $srcpkg->cursrc and $srcpkg->type;
332
333    my $key = $srcpkg->pkgname;
334    my $out_of_date = $srcpkg->is_updated;
335
336    # Check modification time of cache and source file if not out of date
337    if (exists $old{$key}) {
338      if (not $out_of_date) {
339        $mtime{$old{$key}->src} = (stat ($old{$key}->src))[9]
340          if not exists ($mtime{$old{$key}->src});
341
342        $out_of_date = 1 if $mtime{$old{$key}->src} < $srcpkg->curmtime;
343      }
344
345    } else {
346      $out_of_date = 1;
347    }
348
349    if ($out_of_date) {
350      # Re-scan dependency
351      $srcpkg->is_updated (1);
352      my $dep = $srcpkg->get_dep ($flag);
353
354      if ($dep) {
355        $count++;
356        $srcpkg->$method ($dep);
357      }
358
359      $rc = 1;
360
361    } else {
362      # Use cached dependency
363      my ($progname, %hash) = split (
364        /$Fcm::Config::DELIMITER_PATTERN/, $old{$key}->value
365      );
366      $srcpkg->progname ($progname) if $progname and not $flag;
367      $srcpkg->$method (\%hash);
368    }
369
370    # New lines values: progname[::dependency-name::type][...]
371    my @value = ((defined $srcpkg->progname ? $srcpkg->progname : ''));
372    for my $name (sort keys %{ $srcpkg->$method }) {
373      push @value, $name, $srcpkg->$method ($name);
374    }
375
376    push @$new_lines, Fcm::CfgLine->new (
377      LABEL => $prefix . $Fcm::Config::DELIMITER . $key,
378      VALUE => join ($Fcm::Config::DELIMITER, @value),
379    );
380  }
381
382  print 'No. of file', ($count > 1 ? 's' : ''), ' scanned for',
383        ($flag ? ' PP': ''), ' dependency: ', $count, "\n"
384    if $self->verbose and $count;
385
386  return ($rc, $new_lines);
387}
388
389# ------------------------------------------------------------------------------
390# SYNOPSIS
391#   ($rc, $new_lines) = $self->compare_setting_srcpkg ($old_lines);
392#
393# DESCRIPTION
394#   This method uses the previous settings to determine the type of current
395#   source files.
396# ------------------------------------------------------------------------------
397
398sub compare_setting_srcpkg {
399  my ($self, $old_lines) = @_;
400
401  my $prefix = 'SRCPKG';
402
403  # Get relevant items from old lines, stripping out $prefix
404  my %old;
405  if ($old_lines) {
406    for my $line (@$old_lines) {
407      next unless $line->label_starts_with ($prefix);
408      $old{$line->label_from_field (1)} = $line;
409    }
410  }
411
412  # Check for change, use previous setting if exist
413  my $out_of_date = 0;
414  my %mtime;
415  for my $key (keys %{ $self->srcpkg }) {
416    if (exists $old{$key}) {
417      next unless $self->srcpkg ($key)->cursrc;
418
419      my $type = defined $self->setting ('BLD_TYPE', $key)
420                 ? $self->setting ('BLD_TYPE', $key) : $old{$key}->value;
421
422      $self->srcpkg ($key)->type ($type);
423
424      if ($type ne $old{$key}->value) {
425        $self->srcpkg ($key)->is_updated (1);
426        $out_of_date = 1;
427      }
428
429      if (not $self->srcpkg ($key)->is_updated) {
430        $mtime{$old{$key}->src} = (stat ($old{$key}->src))[9]
431          if not exists ($mtime{$old{$key}->src});
432
433        $self->srcpkg ($key)->is_updated (1)
434          if $mtime{$old{$key}->src} < $self->srcpkg ($key)->curmtime;
435      }
436
437    } else {
438      $self->srcpkg ($key)->is_updated (1);
439      $out_of_date = 1;
440    }
441  }
442
443  # Check for deleted keys
444  for my $key (keys %old) {
445    next if $self->srcpkg ($key);
446
447    $out_of_date = 1;
448  }
449
450  # Return reference to an array of new lines
451  my $new_lines = [];
452  for my $key (keys %{ $self->srcpkg }) {
453    push @$new_lines, Fcm::CfgLine->new (
454      LABEL => $prefix . $Fcm::Config::DELIMITER . $key,
455      VALUE => $self->srcpkg ($key)->type,
456    );
457  }
458
459  return ($out_of_date, $new_lines);
460}
461
462# ------------------------------------------------------------------------------
463# SYNOPSIS
464#   ($rc, $new_lines) = $self->compare_setting_target ($old_lines);
465#
466# DESCRIPTION
467#   This method compare the previous target settings with current ones.
468# ------------------------------------------------------------------------------
469
470sub compare_setting_target {
471  my ($self, $old_lines) = @_;
472
473  my $prefix = 'TARGET';
474  my $old;
475  if ($old_lines) {
476    for my $line (@$old_lines) {
477      next unless $line->label_starts_with ($prefix);
478      $old = $line->value;
479      last;
480    }
481  }
482
483  my $new = join (' ', sort @{ $self->target });
484
485  return (
486    (defined ($old) ? $old ne $new : 1),
487    [Fcm::CfgLine->new (LABEL => $prefix, VALUE => $new)],
488  );
489}
490
491# ------------------------------------------------------------------------------
492# SYNOPSIS
493#   $rc = $self->invoke_fortran_interface_generator ();
494#
495# DESCRIPTION
496#   This method invokes the Fortran interface generator for all Fortran free
497#   format source files. It returns true on success.
498# ------------------------------------------------------------------------------
499
500sub invoke_fortran_interface_generator {
501  my $self = shift;
502
503  my $pdoneext = $self->setting (qw/OUTFILE_EXT PDONE/);
504
505  # Set up build task to generate interface files for all selected Fortran 9x
506  # sources
507  my %task = ();
508  for my $srcfile (values %{ $self->srcpkg }) {
509    next unless $srcfile->is_type_any (qw/FORTRAN9X FPP9X/) and
510                uc ($srcfile->get_setting (qw/TOOL GENINTERFACE/)) ne 'NONE' and
511                not $srcfile->is_type_any (qw/PROGRAM MODULE INCLUDE/);
512
513    next unless defined $srcfile->interfacebase;
514    my $target  = $srcfile->interfacebase . $pdoneext;
515
516    $task{$target} = Fcm::BuildTask->new (
517      TARGET     => $target,
518      TARGETPATH => $self->dest->donepath,
519      SRCFILE    => $srcfile,
520      DEPENDENCY => [$srcfile->flagsbase ('GENINTERFACE')],
521      ACTIONTYPE => 'GENINTERFACE',
522    );
523
524    # Set up build tasks for each source file/package flags file for interface
525    # generator tool
526    for my $i (1 .. @{ $srcfile->pkgnames }) {
527      my $target = $srcfile->flagsbase ('GENINTERFACE', -$i);
528      my $depend = $i < @{ $srcfile->pkgnames }
529                   ? $srcfile->flagsbase ('GENINTERFACE', -$i - 1)
530                   : undef;
531
532      $task{$target} = Fcm::BuildTask->new (
533        TARGET     => $target,
534        TARGETPATH => $self->dest->flagspath,
535        DEPENDENCY => [defined ($depend) ? $depend : ()],
536        ACTIONTYPE => 'UPDATE',
537      ) if not exists $task{$target};
538    }
539  }
540
541  # Set up build task to update the flags file for interface generator tool
542  $task{$self->srcpkg ('')->flagsbase ('GENINTERFACE')} = Fcm::BuildTask->new (
543    TARGET     => $self->srcpkg ('')->flagsbase ('GENINTERFACE'),
544    TARGETPATH => $self->dest->flagspath,
545    ACTIONTYPE => 'UPDATE',
546  );
547
548  my $count = 0;
549
550  # Performs task
551  for my $task (values %task) {
552    next unless $task->actiontype eq 'GENINTERFACE';
553
554    my $rc = $task->action (TASKLIST => \%task);
555    $count++ if $rc;
556  }
557
558  print 'No. of generated Fortran interface', ($count > 1 ? 's' : ''), ': ',
559        $count, "\n"
560    if $self->verbose and $count;
561
562  return 1;
563}
564
565# ------------------------------------------------------------------------------
566# SYNOPSIS
567#   $rc = $self->invoke_make (%args);
568#
569# DESCRIPTION
570#   This method invokes the make stage of the build system. It returns true on
571#   success.
572#
573# ARGUMENTS
574#   ARCHIVE - If set to "true", invoke the "archive" mode. Most build files and
575#             directories created by this build will be archived using the
576#             "tar" command.  If not set, the default is not to invoke the
577#             "archive" mode.
578#   JOBS    - Specify number of jobs that can be handled by "make". If set, the
579#             value must be a natural integer. If not set, the default value is
580#             1 (i.e.  run "make" in serial mode).
581#   TARGETS - Specify targets to be built. If set, these targets will be built
582#             instead of the ones specified in the build configuration file.
583# ------------------------------------------------------------------------------
584
585sub invoke_make {
586  my ($self, %args) = @_;
587
588  # Build the make command from the specified targets
589  my @targets  = exists $args{TARGETS} ? @{ $args{TARGETS} } : qw/all/;
590  my $jobs     = exists $args{JOBS}    ? $args{JOBS}         : 1;
591  my $verbose  = $self->verbose;
592
593  my @commands = ();
594  my @make_cmd = ($self->setting (qw/TOOL MAKE/));
595  push @make_cmd, split (/\s+/, $self->setting (qw/TOOL MAKEFLAGS/));
596  push @make_cmd, $self->setting (qw/TOOL MAKE_SILENT/)
597    unless $verbose > 2;
598
599  if ($jobs > 1) { # multi-process "make"
600    my $make_job = $self->setting (qw/TOOL MAKE_JOB/);
601
602    # Setup the "make" commands for each target
603    while (my $target = shift @targets) {
604      if ($target eq 'clean') { # Do not run "clean" in parallel
605        push @commands, [@make_cmd, $target];
606
607      } else {
608        push @commands, [@make_cmd, $make_job, $jobs, $target];
609      }
610    }
611
612  } else { # single process "make"
613
614    # Setup the "make" command
615    push @commands, [@make_cmd, @targets];
616
617  }
618 
619  # Run the make command
620  my $code = 0;
621  my $cwd = cwd;
622  print 'cd ', &dirname ($self->dest->bldmakefile), "\n" if $verbose > 2;
623  chdir &dirname ($self->dest->bldmakefile);
624  while (my $cmd = shift @commands) {
625    &run_command ($cmd, ERROR => 'warn', RC => \$code, TIME => $verbose > 2);
626    last if $code;
627  }
628  print 'cd ', $cwd, "\n" if $verbose > 2;
629  chdir $cwd;
630
631  my $rc = $code ? undef : 1;
632
633  # Create TAR archives if necessary
634  $rc = $self->dest->archive if $rc and $args{ARCHIVE};
635
636  # Create run time environment script if necessary
637  $rc = $self->dest->create_bldrunenvsh () if $rc;
638
639  # Create exclude dependency configurations for libraries
640  for my $key (reverse sort keys %{ $self->srcpkg }) {
641    $rc = 0 if $rc and not defined $self->srcpkg ($key)->write_lib_dep_excl;
642  }
643
644  # Information on the location/usage of the exclude dependency configurations
645  if ($rc and $self->verbose > 1) {
646    my $etcdir = $self->dest->etcdir;
647    print '# ', '-' x 78, "\n";
648    print <<EOF;
649# To use a library archive of this build in another FCM build, you need to
650# include in the new build configuration the corresponding configuration file
651# that has the relevant exclude dependency information. These configurations
652# files can be found in $etcdir.
653EOF
654    print '# ', '-' x 78, "\n";
655  }
656
657  return $rc;
658}
659
660# ------------------------------------------------------------------------------
661# SYNOPSIS
662#   $rc = $self->invoke_pre_process ();
663#
664# DESCRIPTION
665#   This method invokes the pre-process stage of the build system. It
666#   returns true on success.
667# ------------------------------------------------------------------------------
668
669sub invoke_pre_process {
670  my $self = shift;
671   
672  # Check whether pre-processing is necessary
673  my $invoke = 0;
674  for (values %{ $self->srcpkg }) {
675    next unless $_->get_setting ('BLD_PP');
676    $invoke = 1;
677    last;
678  }
679  return 1 unless $invoke;
680
681  # Scan header dependency
682  my $rc = $self->compare_setting (
683    METHOD_LIST => ['compare_setting_dependency'],
684    METHOD_ARGS => ['BLD_TYPE_DEP_PP'],
685    CACHEBASE   => $self->setting ('CACHE_DEP_PP'),
686  );
687
688  return $rc if not $rc;
689
690  my %task     = ();
691  my $pdoneext = $self->setting (qw/OUTFILE_EXT PDONE/);
692
693  # Set up tasks for each source file
694  for my $srcfile (values %{ $self->srcpkg }) {
695    if ($srcfile->is_type_all (qw/CPP INCLUDE/)) {
696      # Set up a copy build task for each include file
697      $task{$srcfile->base} = Fcm::BuildTask->new (
698        TARGET     => $srcfile->base,
699        TARGETPATH => $self->dest->incpath,
700        SRCFILE    => $srcfile,
701        DEPENDENCY => [keys %{ $srcfile->ppdep }],
702        ACTIONTYPE => 'COPY',
703      );
704
705    } elsif ($srcfile->lang ('TOOL_SRC_PP')) {
706      next unless $srcfile->get_setting ('BLD_PP');
707
708      # Set up a PP build task for each source file
709      my $target = $srcfile->base . $pdoneext;
710
711      # Issue warning for duplicated tasks
712      if (exists $task{$target}) {
713        w_report 'WARNING: ', $target, ': unable to create task for: ',
714                 $srcfile->src, ': task already exists for: ',
715                 $task{$target}->srcfile->src;
716        next;
717      }
718
719      $task{$target} = Fcm::BuildTask->new (
720        TARGET     => $target,
721        TARGETPATH => $self->dest->donepath,
722        SRCFILE    => $srcfile,
723        DEPENDENCY => [$srcfile->flagsbase ('PPKEYS'), keys %{ $srcfile->ppdep }],
724        ACTIONTYPE => 'PP',
725      );
726
727      # Set up update ppkeys/flags build tasks for each source file/package
728      my $ppkeys = $self->setting (
729        'TOOL_SRC_PP', $srcfile->lang ('TOOL_SRC_PP'), 'PPKEYS'
730      );
731
732      for my $i (1 .. @{ $srcfile->pkgnames }) {
733        my $target = $srcfile->flagsbase ($ppkeys, -$i);
734        my $depend = $i < @{ $srcfile->pkgnames }
735                     ? $srcfile->flagsbase ($ppkeys, -$i - 1)
736                     : undef;
737
738        $task{$target} = Fcm::BuildTask->new (
739          TARGET     => $target,
740          TARGETPATH => $self->dest->flagspath,
741          DEPENDENCY => [defined ($depend) ? $depend : ()],
742          ACTIONTYPE => 'UPDATE',
743        ) if not exists $task{$target};
744      }
745    }
746  }
747
748  # Set up update global ppkeys build tasks
749  for my $lang (keys %{ $self->setting ('TOOL_SRC_PP') }) {
750    my $target = $self->srcpkg ('')->flagsbase (
751      $self->setting ('TOOL_SRC_PP', $lang, 'PPKEYS')
752    );
753
754    $task{$target} = Fcm::BuildTask->new (
755      TARGET     => $target,
756      TARGETPATH => $self->dest->flagspath,
757      ACTIONTYPE => 'UPDATE',
758    );
759  }
760
761  # Build all PP tasks
762  my $count = 0;
763  for my $task (values %task) {
764    next unless $task->actiontype eq 'PP';
765
766    my $rc = $task->action (TASKLIST => \%task);
767    $task->srcfile->is_updated ($rc);
768    $count++ if $rc;
769  }
770
771  print 'No. of pre-processed file', ($count > 1 ? 's' : ''), ': ', $count, "\n"
772    if $self->verbose and $count;
773
774  return 1;
775}
776
777# ------------------------------------------------------------------------------
778# SYNOPSIS
779#   $rc = $self->invoke_scan_dependency ();
780#
781# DESCRIPTION
782#   This method invokes the scan dependency stage of the build system. It
783#   returns true on success.
784# ------------------------------------------------------------------------------
785
786sub invoke_scan_dependency {
787  my $self = shift;
788
789  # Scan/retrieve dependency
790  # ----------------------------------------------------------------------------
791  my $rc = $self->compare_setting (
792    METHOD_LIST => ['compare_setting_dependency'],
793    CACHEBASE   => $self->setting ('CACHE_DEP'),
794  );
795
796  # Check whether make file is out of date
797  # ----------------------------------------------------------------------------
798  my $out_of_date = not -r $self->dest->bldmakefile;
799
800  if ($rc and not $out_of_date) {
801    for (qw/CACHE CACHE_DEP/) {
802      my $cache_mtime = (stat (File::Spec->catfile (
803        $self->dest->cachedir, $self->setting ($_),
804      )))[9];
805      my $mfile_mtime = (stat ($self->dest->bldmakefile))[9];
806
807      next if not defined $cache_mtime;
808      next if $cache_mtime < $mfile_mtime;
809      $out_of_date = 1;
810      last;
811    }
812  }
813
814  if ($rc and not $out_of_date) {
815    for (values %{ $self->srcpkg }) {
816      next unless $_->is_updated;
817      $out_of_date = 1;
818      last;
819    }
820  }
821
822  if ($rc and $out_of_date) {
823    # Write Makefile
824    # --------------------------------------------------------------------------
825    # Register non-word package name
826    my $unusual = 0;
827    for my $key (sort keys %{ $self->srcpkg }) {
828      next if $self->srcpkg ($key)->src;
829      next if $key =~ /^\w*$/;
830
831      $self->setting (
832        ['FCM_PCK_OBJECTS', $key], 'FCM_PCK_OBJECTS' . $unusual++,
833      );
834    }
835
836    # Write different parts in the Makefile
837    my $makefile = '# Automatic Makefile' . "\n\n";
838    $makefile .= 'FCM_BLD_NAME = ' . $self->name . "\n" if $self->name;
839    $makefile .= 'FCM_BLD_CFG = ' . $self->cfg->actual_src . "\n";
840    $makefile .= 'export FCM_VERBOSE ?= ' . $self->verbose . "\n\n";
841    $makefile .= $self->dest->write_rules;
842    $makefile .= $self->_write_makefile_perl5lib;
843    $makefile .= $self->_write_makefile_tool;
844    $makefile .= $self->_write_makefile_vpath;
845    $makefile .= $self->_write_makefile_target;
846
847    # Write rules for each source package
848    # Ensure that container packages come before files - this allows $(OBJECTS)
849    # and its dependent variables to expand correctly
850    my @srcpkg = sort {
851      if ($self->srcpkg ($a)->libbase and $self->srcpkg ($b)->libbase) {
852        $b cmp $a;
853
854      } elsif ($self->srcpkg ($a)->libbase) {
855        -1;
856
857      } elsif ($self->srcpkg ($b)->libbase) {
858        1;
859
860      } else {
861        $a cmp $b;
862      }
863    } keys %{ $self->srcpkg };
864
865    for (@srcpkg) {
866      $makefile .= $self->srcpkg ($_)->write_rules if $self->srcpkg ($_)->rules;
867    }
868    $makefile .= '# EOF' . "\n";
869
870    # Update Makefile
871    open OUT, '>', $self->dest->bldmakefile
872      or croak $self->dest->bldmakefile, ': cannot open (', $!, '), abort';
873    print OUT $makefile;
874    close OUT
875      or croak $self->dest->bldmakefile, ': cannot close (', $!, '), abort';
876
877    print $self->dest->bldmakefile, ': updated', "\n" if $self->verbose;
878
879    # Check for duplicated targets
880    # --------------------------------------------------------------------------
881    # Get list of types that cannot have duplicated targets
882    my @no_duplicated_target_types = split (
883      /$Fcm::Config::DELIMITER_LIST/,
884      $self->setting ('BLD_TYPE_NO_DUPLICATED_TARGET'),
885    );
886
887    my %targets;
888    for my $name (sort keys %{ $self->srcpkg }) {
889      next unless $self->srcpkg ($name)->rules;
890
891      for my $key (sort keys %{ $self->srcpkg ($name)->rules }) {
892        if (exists $targets{$key}) {
893          # Duplicated target: warning for most file types
894          my $status = 'WARNING';
895
896          # Duplicated target: error for the following file types
897          if (@no_duplicated_target_types and
898              $self-srcpkg ($name)->is_type_any (@no_duplicated_target_types) and
899              $targets{$key}->is_type_any (@no_duplicated_target_types)) {
900            $status = 'ERROR';
901            $rc = 0;
902          }
903
904          # Report the warning/error
905          w_report $status, ': ', $key, ': duplicated targets for building:';
906          w_report '       ', $targets{$key}->src;
907          w_report '       ', $self->srcpkg ($name)->src;
908
909        } else {
910          $targets{$key} = $self->srcpkg ($name);
911        }
912      }
913    }
914  }
915
916  return $rc;
917}
918
919# ------------------------------------------------------------------------------
920# SYNOPSIS
921#   $rc = $self->invoke_setup_build ();
922#
923# DESCRIPTION
924#   This method invokes the setup_build stage of the build system. It returns
925#   true on success.
926# ------------------------------------------------------------------------------
927
928sub invoke_setup_build {
929  my $self = shift;
930
931  my $rc = 1;
932
933  # Extract archived sub-directories if necessary
934  $rc = $self->dest->dearchive if $rc;
935
936  # Compare cache
937  $rc = $self->compare_setting (METHOD_LIST => [
938    'compare_setting_target', # targets
939    'compare_setting_srcpkg', # source package type
940    @compare_setting_methods,
941  ]) if $rc;
942
943  # Set up runtime dependency scan patterns
944  my %dep_pattern = %{ $self->setting ('BLD_DEP_PATTERN') };
945  for my $key (keys %dep_pattern) {
946    my $pattern = $dep_pattern{$key};
947
948    while ($pattern =~ /##([\w:]+)##/g) {
949      my $match = $1;
950      my $val   = $self->setting (split (/$Fcm::Config::DELIMITER/, $match));
951
952      last unless defined $val;
953      $val =~ s/\./\\./;
954
955      $pattern =~ s/##$match##/$val/;
956    }
957
958    $self->setting (['BLD_DEP_PATTERN', $key], $pattern)
959      unless $pattern eq $dep_pattern{$key};
960  }
961
962  return $rc;
963}
964
965# ------------------------------------------------------------------------------
966# SYNOPSIS
967#   $rc = $self->invoke_system (%args);
968#
969# DESCRIPTION
970#   This method invokes the build system. It returns true on success. See also
971#   the header for invoke_make for further information on arguments.
972#
973# ARGUMENTS
974#   STAGE - If set, it should be an integer number or a recognised keyword or
975#           abbreviation. If set, the build is performed up to the named stage.
976#           If not set, the default is to perform all stages of the build.
977#           Allowed values are:
978#             1, setup or s
979#             2, pre_process or pp
980#             3, generate_dependency or gd
981#             4, generate_interface or gi
982#             5, all, a, make or m
983# ------------------------------------------------------------------------------
984
985sub invoke_system {
986  my $self = shift;
987  my %args = @_;
988
989  # Parse arguments
990  # ----------------------------------------------------------------------------
991  # Default: run all 5 stages
992  my $stage = (exists $args{STAGE} and $args{STAGE}) ? $args{STAGE} : 5;
993
994  # Resolve named stages
995  if ($stage !~ /^\d$/) {
996    my %stagenames = (
997      'S(?:ETUP)?'                      => 1,
998      'P(?:RE)?_?P(?:ROCESS)?'          => 2,
999      'G(?:ENERATE)?_?D(?:ENPENDENCY)?' => 3,
1000      'G(?:ENERATE)?_?I(?:NTERFACE)?'   => 4,
1001      '(?:A(?:LL)|M(?:AKE)?)'           => 5,
1002    );
1003
1004    # Does it match a recognised stage?
1005    for my $name (keys %stagenames) {
1006      next unless $stage =~ /$name/i;
1007
1008      $stage = $stagenames{$name};
1009      last;
1010    }
1011
1012    # Specified stage name not recognised, default to 5
1013    if ($stage !~ /^\d$/) {
1014      w_report 'WARNING: ', $stage, ': invalid build stage, default to 5.';
1015      $stage = 5;
1016    }
1017  }
1018
1019  # Run the method associated with each stage
1020  # ----------------------------------------------------------------------------
1021  my $rc = 1;
1022
1023  my @stages = (
1024    ['Setup build'               , 'invoke_setup_build'],
1025    ['Pre-process'               , 'invoke_pre_process'],
1026    ['Scan dependency'           , 'invoke_scan_dependency'],
1027    ['Generate Fortran interface', 'invoke_fortran_interface_generator'],
1028    ['Make'                      , 'invoke_make'],
1029  );
1030
1031  for my $i (1 .. 5) {
1032    last if (not $rc) or $i > $stage;
1033
1034    my ($name, $method) = @{ $stages[$i - 1] };
1035    $rc = $self->invoke_stage ($name, $method, %args) if $rc and $stage >= $i;
1036  }
1037
1038  return $rc;
1039}
1040
1041# ------------------------------------------------------------------------------
1042# SYNOPSIS
1043#   $rc = $self->parse_cfg_dep (\@cfg_lines);
1044#
1045# DESCRIPTION
1046#   This method parses the dependency settings in the @cfg_lines.
1047# ------------------------------------------------------------------------------
1048
1049sub parse_cfg_dep {
1050  my ($self, $cfg_lines) = @_;
1051
1052  my $rc = 1;
1053
1054  # EXCL_DEP, EXE_DEP and BLOCKDATA declarations
1055  # ----------------------------------------------------------------------------
1056  for my $name (qw/BLD_BLOCKDATA BLD_DEP BLD_DEP_EXCL BLD_DEP_EXE/) {
1057    for my $line (grep {$_->slabel_starts_with_cfg ($name)} @$cfg_lines) {
1058      # Separate label into a list, delimited by double-colon, remove 1st field
1059      my @flds = $line->slabel_fields;
1060      shift @flds;
1061
1062      if ($name =~ /^(?:BLD_DEP|BLD_DEP_EXCL|BLD_DEP_PP)$/) {
1063        # BLD_DEP_*: label fields may contain sub-package
1064        my $pk = @flds ? join ('__', @flds) : '';
1065
1066        # Check whether sub-package is valid
1067        if ($pk and not ($self->srcpkg ($pk) or $self->dummysrcpkg ($pk))) {
1068          $line->error ($line->label . ': invalid sub-package in declaration.');
1069          $rc = 0;
1070          next;
1071        }
1072
1073        # Setting is stored in an array reference
1074        $self->setting ([$name, $pk], [])
1075          if not defined $self->setting ($name, $pk);
1076
1077        # Add current declaration to the array if necessary
1078        my $list  = $self->setting ($name, $pk);
1079        my $value = $name eq 'BLD_DEP_EXCL' ? uc ($line->value) : $line->value;
1080        push @$list, $value if not grep {$_ eq $value} @$list;
1081
1082      } else {
1083        # EXE_DEP and BLOCKDATA: label field may be an executable target
1084        my $target = @flds ? $flds[0] : '';
1085
1086        # The value contains a list of objects and/or sub-package names
1087        my @deps   = split /\s+/, $line->value;
1088
1089        if (not @deps) {
1090          if ($name eq 'BLD_BLOCKDATA') {
1091            # The objects containing a BLOCKDATA program unit must be declared
1092            $line->error ($line->label . ': value not set.');
1093            $rc = 0;
1094            next;
1095
1096          } else {
1097            # If $value is a null string, target(s) depends on all objects
1098            push @deps, '';
1099          }
1100        }
1101
1102        for my $dep (@deps) {
1103          $dep =~ s/$Fcm::Config::DELIMITER_PATTERN/__/g;
1104        }
1105
1106        $self->setting ([$name, $target], join (' ', sort @deps));
1107      }
1108
1109      $line->parsed (1);
1110    }
1111  }
1112
1113  return $rc;
1114}
1115
1116# ------------------------------------------------------------------------------
1117# SYNOPSIS
1118#   $rc = $self->parse_cfg_dest (\@cfg_lines);
1119#
1120# DESCRIPTION
1121#   This method parses the build destination settings in the @cfg_lines.
1122# ------------------------------------------------------------------------------
1123
1124sub parse_cfg_dest {
1125  my ($self, $cfg_lines) = @_;
1126
1127  my $rc = $self->SUPER::parse_cfg_dest ($cfg_lines);
1128
1129  # Set up search paths
1130  for my $name (@Fcm::Dest::paths) {
1131    (my $label = uc ($name)) =~ s/PATH//;
1132
1133    $self->setting (['PATH', $label], $self->dest->$name);
1134  }
1135
1136  return $rc;
1137}
1138
1139# ------------------------------------------------------------------------------
1140# SYNOPSIS
1141#   $rc = $self->parse_cfg_misc (\@cfg_lines);
1142#
1143# DESCRIPTION
1144#   This method parses misc build settings in the @cfg_lines.
1145# ------------------------------------------------------------------------------
1146
1147sub parse_cfg_misc {
1148  my ($self, $cfg_lines) = @_;
1149
1150  my $rc = 1;
1151
1152  for my $name (qw/BLD_EXE_NAME BLD_LIB BLD_PP BLD_TYPE/) {
1153    for my $line (grep {$_->slabel_starts_with_cfg ($name)} @$cfg_lines) {
1154      # Separate label into a list, remove 1st field
1155      my @flds = $line->slabel_fields;
1156      shift @flds;
1157
1158      if ($name eq 'BLD_EXE_NAME') {
1159        # EXE_NAME declaration, label must contain the original executable name
1160        if (not @flds) {
1161          $line->error ($name . ': executable name not set in label.');
1162          $rc = 0;
1163          next;
1164
1165        } elsif (@flds > 1) {
1166          $line->error ($name . ': invalid executable name.');
1167          $rc = 0;
1168          next;
1169        }
1170
1171        $self->setting ([$name, join ('__', @flds)], $line->value);
1172
1173      } else {
1174        # LIB, PP, TYPE declaration, label may contain sub-package name
1175        my $pk = @flds ? join ('__', @flds) : '';
1176
1177        # Check whether sub-package is valid
1178        if ($pk and not ($self->srcpkg ($pk) or $self->dummysrcpkg ($pk))) {
1179          $line->error ($line->label . ': invalid sub-package in declaration.');
1180          $rc = 0;
1181          next;
1182        }
1183
1184        # Assign the tool in the configuration setting
1185        my @srcpkgs = $self->dummysrcpkg ($pk)
1186                      ? @{ $self->dummysrcpkg ($pk)->children }
1187                      : $self->srcpkg ($pk);
1188
1189        my $method = $name eq 'BLD_PP' ? 'bvalue' : 'value';
1190        for my $srcpkg (@srcpkgs) {
1191          $self->setting ([$name, $srcpkg->pkgname], $line->$method);
1192        }
1193      }
1194
1195      $line->parsed (1);
1196    }
1197  }
1198
1199  for my $name (qw/INFILE_EXT OUTFILE_EXT/) {
1200    for my $line (grep {$_->slabel_starts_with_cfg ($name)} @$cfg_lines) {
1201      my $key = ($line->slabel_fields)[1];
1202      $key    = uc $key if $name eq 'OUTFILE_EXT';
1203
1204      my $val = ($name eq 'INFILE_EXT') ? uc ($line->value) : $line->value;
1205
1206      $self->setting ([$name, $key], $val);
1207
1208      $line->parsed (1);
1209    }
1210  }
1211
1212  return $rc;
1213}
1214
1215# ------------------------------------------------------------------------------
1216# SYNOPSIS
1217#   $rc = $self->parse_cfg_source (\@cfg_lines);
1218#
1219# DESCRIPTION
1220#   This method parses the source package settings in the @cfg_lines.
1221# ------------------------------------------------------------------------------
1222
1223sub parse_cfg_source {
1224  my ($self, $cfg_lines) = @_;
1225
1226  my $rc  = 1;
1227  my %src = ();
1228
1229  # Automatic source directory search?
1230  # ----------------------------------------------------------------------------
1231  my $search = 1;
1232
1233  for my $line (grep {$_->slabel_starts_with_cfg ('SEARCH_SRC')} @$cfg_lines) {
1234    $search = $line->bvalue;
1235    $line->parsed (1);
1236  }
1237
1238  # Search src/ sub-directory if necessary
1239  %src = %{ $self->dest->get_source_files } if $search;
1240
1241  # SRC declarations
1242  # ----------------------------------------------------------------------------
1243  for my $line (grep {$_->slabel_starts_with_cfg ('FILE')} @$cfg_lines) {
1244    # Expand ~ notation and path relative to srcdir of destination
1245    my $value = $line->value;
1246    $value = File::Spec->rel2abs (&expand_tilde ($value), $self->dest->srcdir);
1247
1248    if (not -r $value) {
1249      $line->error ($value . ': source does not exist or is not readable.');
1250      next;
1251    }
1252
1253    # Package name
1254    my @names = $line->slabel_fields;
1255    shift @names;
1256
1257    # If package name not set, determine using the path if possible
1258    if (not @names) {
1259      my $package = $self->dest->get_pkgname_of_path ($value);
1260      @names = @$package if defined $package;
1261    }
1262
1263    if (not @names) {
1264      $line->error ($self->cfglabel ('FILE') .
1265                    ': package not specified/cannot be determined.');
1266      next;
1267    }
1268
1269    $src{join ('__', @names)} = $value;
1270
1271    $line->parsed (1);
1272  }
1273
1274  # For directories, get non-recursive file listing, and add to %src
1275  # ----------------------------------------------------------------------------
1276  for my $key (keys %src) {
1277    next unless -d $src{$key};
1278
1279    opendir DIR, $src{$key} or die $src{$key}, ': cannot read directory';
1280    while (my $base = readdir 'DIR') {
1281      next if $base =~ /^\./;
1282
1283      my $file = File::Spec->catfile ($src{$key}, $base);
1284      next unless -f $file and -r $file;
1285
1286      my $name = join ('__', ($key, $base));
1287      $src{$name} = $file unless exists $src{$name};
1288    }
1289    closedir DIR;
1290
1291    delete $src{$key};
1292  }
1293
1294  # Set up source packages
1295  # ----------------------------------------------------------------------------
1296  my %pkg = ();
1297  for my $name (keys %src) {
1298    $pkg{$name} = Fcm::BuildSrc->new (PKGNAME => $name, SRC => $src{$name});
1299  }
1300
1301  # INHERIT::SRC declarations
1302  # ----------------------------------------------------------------------------
1303  my %inherit_flag = ();
1304
1305  for (grep {$_->slabel_starts_with_cfg (qw/INHERIT FILE/)} @$cfg_lines) {
1306    my @fields = $_->slabel_fields;
1307    $inherit_flag{join ('__', @fields[2 .. $#fields])} = $_->bvalue;
1308
1309    $_->parsed (1);
1310  }
1311
1312  # Inherit packages, if necessary
1313  for my $use (reverse @{ $self->inherit}) {
1314    for my $name (keys %{ $use->srcpkg }) {
1315      next if exists $pkg{$name};            # exist, no need to inherit
1316      next if not $use->srcpkg ($name)->src; # don't inherit, no source file
1317
1318      # Check whether it is OK to inherit this sub-package, default is OK
1319      my $inherit_ok = 1;
1320      for my $cur_name ($use->srcpkg ($name)->pkgnames) {
1321        next unless exists $inherit_flag{$cur_name};
1322        $inherit_ok = $inherit_flag{$cur_name};
1323        last;
1324      }
1325
1326      # Add sub-package if it does not exists
1327      $pkg{$name} = $use->srcpkg ($name) if $inherit_ok;
1328    }
1329  }
1330
1331  # Get list of intermediate "packages"
1332  # ----------------------------------------------------------------------------
1333  for my $name (keys %pkg) {
1334    # Name of current package
1335    my @names = split /__/, $name;
1336
1337    my $cur = $name;
1338
1339    while ($cur) {
1340      # Name of parent package
1341      pop @names;
1342      my $parent = @names ? join ('__', @names) : '';
1343
1344      # If parent package does not exist, create it
1345      $pkg{$parent} = Fcm::BuildSrc->new (PKGNAME => $parent)
1346        unless exists $pkg{$parent};
1347
1348      # Current package is a child of the parent package
1349      push @{ $pkg{$parent}->children }, $pkg{$cur}
1350        unless grep {$_->pkgname eq $cur} @{ $pkg{$parent}->children };
1351
1352      # Go up a package
1353      $cur = $parent;
1354    }
1355  }
1356
1357  $self->srcpkg (\%pkg);
1358
1359  # Dummy "packages" for handling source file package names with .dot extensions
1360  # ----------------------------------------------------------------------------
1361  for my $name (keys %pkg) {
1362    (my $dname = $name) =~ s/\.\w+$//;
1363    next if $dname eq $name;
1364    next if $self->srcpkg ($dname);
1365
1366    $self->dummysrcpkg ($dname, Fcm::BuildSrc->new (PKGNAME => $dname))
1367      unless $self->dummysrcpkg ($dname);
1368    push @{ $self->dummysrcpkg ($dname)->children }, $pkg{$name};
1369  }
1370
1371  # Make sure a package is defined
1372  # ----------------------------------------------------------------------------
1373  if (not %{$self->srcpkg}) {
1374    w_report 'ERROR: ', $self->cfg->actual_src, ': no source file to build.';
1375    $rc = 0;
1376  }
1377
1378  return $rc;
1379}
1380
1381# ------------------------------------------------------------------------------
1382# SYNOPSIS
1383#   $rc = $self->parse_cfg_target (\@cfg_lines);
1384#
1385# DESCRIPTION
1386#   This method parses the target settings in the @cfg_lines.
1387# ------------------------------------------------------------------------------
1388
1389sub parse_cfg_target {
1390  my ($self, $cfg_lines) = @_;
1391
1392  # NAME declaraions
1393  # ----------------------------------------------------------------------------
1394  for my $line (grep {$_->slabel_starts_with_cfg ('NAME')} @$cfg_lines) {
1395    $self->name ($line->value);
1396    $line->parsed (1);
1397  }
1398
1399  # TARGET declarations
1400  # ----------------------------------------------------------------------------
1401  for my $line (grep {$_->slabel_starts_with_cfg ('TARGET')} @$cfg_lines) {
1402    # Value is a space delimited list
1403    push @{ $self->target }, split (/\s+/, $line->value);
1404    $line->parsed (1);
1405  }
1406
1407  # INHERIT::TARGET declarations
1408  # ----------------------------------------------------------------------------
1409  # By default, do not inherit target
1410  my $inherit_flag = 0;
1411
1412  for (grep {$_->slabel_starts_with_cfg (qw/INHERIT TARGET/)} @$cfg_lines) {
1413    $inherit_flag = $_->bvalue;
1414    $_->parsed (1);
1415  }
1416
1417  # Inherit targets from inherited build, if $inherit_flag is set to true
1418  # ----------------------------------------------------------------------------
1419  if ($inherit_flag) {
1420    for my $use (reverse @{ $self->inherit }) {
1421      unshift @{ $self->target }, @{ $use->target };
1422    }
1423  }
1424
1425  return 1;
1426}
1427
1428# ------------------------------------------------------------------------------
1429# SYNOPSIS
1430#   $rc = $self->parse_cfg_tool (\@cfg_lines);
1431#
1432# DESCRIPTION
1433#   This method parses the tool settings in the @cfg_lines.
1434# ------------------------------------------------------------------------------
1435
1436sub parse_cfg_tool {
1437  my ($self, $cfg_lines) = @_;
1438
1439  my $rc = 1;
1440
1441  my %tools         = %{ $self->setting ('TOOL') };
1442  my @package_tools = split (
1443    /$Fcm::Config::DELIMITER_LIST/, $self->setting ('TOOL_PACKAGE')
1444  );
1445
1446  # TOOL declaration
1447  # ----------------------------------------------------------------------------
1448  for my $line (grep {$_->slabel_starts_with_cfg ('TOOL')} @$cfg_lines) {
1449    # Separate label into a list, delimited by double-colon, remove TOOL
1450    my @flds = $line->slabel_fields;
1451    shift @flds;
1452
1453    # Check that there is a field after TOOL
1454    if (not @flds) {
1455      $line->error ('TOOL: not followed by a valid label.');
1456      $rc = 0;
1457      next;
1458    }
1459
1460    # The first field is the tool iteself, identified in uppercase
1461    $flds[0] = uc ($flds[0]);
1462
1463    # Check that the tool is recognised
1464    if (not exists $tools{$flds[0]}) {
1465      $line->error ($flds[0] . ': not a valid TOOL.');
1466      $rc = 0;
1467      next;
1468    }
1469
1470    # Check sub-package declaration
1471    if (@flds > 1 and not grep {$_ eq $flds[0]} @package_tools) {
1472      $line->error ($flds[0] . ': sub-package not accepted with this TOOL.');
1473      $rc = 0;
1474      next;
1475    }
1476
1477    # Name of declared package
1478    my $pk = join ('__', @flds[1 .. $#flds]);
1479
1480    # Check whether package exists
1481    if (not ($self->srcpkg ($pk) or $self->dummysrcpkg ($pk))) {
1482      $line->error ($line->label . ': invalid sub-package in declaration.');
1483      $rc = 0;
1484      next;
1485    }
1486
1487    $self->setting (['TOOL', join ('__', @flds)], $line->value);
1488    $line->parsed (1);
1489  }
1490
1491  return $rc;
1492}
1493
1494# ------------------------------------------------------------------------------
1495# SYNOPSIS
1496#   $string = $self->_write_makefile_perl5lib ();
1497#
1498# DESCRIPTION
1499#   This method returns a makefile $string for defining $PERL5LIB.
1500# ------------------------------------------------------------------------------
1501
1502sub _write_makefile_perl5lib {
1503  my $self = shift;
1504
1505  my $classpath = File::Spec->catfile (split (/::/, ref ($self))) . '.pm';
1506
1507  my $libdir  = dirname (dirname ($INC{$classpath}));
1508  my @libpath = split (/:/, (exists $ENV{PERL5LIB} ? $ENV{PERL5LIB} : ''));
1509
1510  my $string = ((grep {$_ eq $libdir} @libpath)
1511                ? ''
1512                : 'export PERL5LIB := ' . $libdir .
1513                  (exists $ENV{PERL5LIB} ? ':$(PERL5LIB)' : '') . "\n\n");
1514
1515  return $string;
1516}
1517
1518# ------------------------------------------------------------------------------
1519# SYNOPSIS
1520#   $string = $self->_write_makefile_target ();
1521#
1522# DESCRIPTION
1523#   This method returns a makefile $string for defining the default targets.
1524# ------------------------------------------------------------------------------
1525
1526sub _write_makefile_target {
1527  my $self = shift;
1528
1529  # Targets of the build
1530  # ----------------------------------------------------------------------------
1531  my @targets = @{ $self->target };
1532  if (not @targets) {
1533    # Build targets not specified by user, default to building all main programs
1534    my @programs = ();
1535
1536    # Get all main programs from all packages
1537    for my $pkg (values %{ $self->srcpkg }) {
1538      push @programs, $pkg->exebase if $pkg->exebase;
1539    }
1540
1541    @programs = sort (@programs);
1542
1543    if (@programs) {
1544      # Build main programs, if there are any
1545      @targets = @programs;
1546
1547    } else {
1548      # No main program in source tree, build the default library
1549      @targets = ($self->srcpkg ('')->libbase);
1550    }
1551  }
1552
1553  my $return = 'FCM_BLD_TARGETS = ' . join (' ', @targets) . "\n\n";
1554
1555  # Default targets
1556  $return .= '.PHONY : all clean' . "\n\n";
1557  $return .= 'all : $(FCM_BLD_TARGETS)' . "\n\n";
1558  $return .= 'clean : ' . "\n";
1559  $return .= "\t" . 'rm -rf';
1560  for my $dir (qw/bindir libdir objdir donedir/) {
1561    $return .= ' $(FCM_' . uc ($dir) . ')' if $self->dest->$dir;
1562  }
1563  $return .= "\n";
1564
1565  # Targets for copy dummy
1566  $return .= $self->setting (qw/BLD_CPDUMMY/) . ' :' . "\n";
1567  $return .= "\t" . 'touch $@' . "\n\n";
1568
1569  return $return;
1570}
1571
1572# ------------------------------------------------------------------------------
1573# SYNOPSIS
1574#   $string = $self->_write_makefile_tool ();
1575#
1576# DESCRIPTION
1577#   This method returns a makefile $string for defining the build tools.
1578# ------------------------------------------------------------------------------
1579
1580sub _write_makefile_tool {
1581  my $self = shift;
1582
1583  # List of build tools
1584  my $tool = $self->setting ('TOOL');
1585
1586  # List of tools local to FCM, (will not be exported)
1587  my %localtool = map {($_, 1)} split ( # map into a hash table
1588    /$Fcm::Config::DELIMITER_LIST/, $self->setting ('TOOL_LOCAL'),
1589  );
1590
1591  # Export required tools
1592  my $count = 0;
1593  my $return = '';
1594  for my $name (sort keys %$tool) {
1595    # Ignore local tools
1596    next if exists $localtool{(split (/__/, $name))[0]};
1597
1598    if ($name =~ /^\w+$/) {
1599      # Tools with normal name, just export it as an environment variable
1600      $return .= 'export ' . $name . ' = ' . $tool->{$name} . "\n";
1601
1602    } else {
1603      # Tools with unusual characters, export using a label/value pair
1604      $return .= 'export FCM_UNUSUAL_TOOL_LABEL' . $count . ' = ' . $name . "\n";
1605      $return .= 'export FCM_UNUSUAL_TOOL_VALUE' . $count . ' = ' .
1606                 $tool->{$name} . "\n";
1607      $count++;
1608    }
1609  }
1610
1611  $return .= "\n";
1612
1613  return $return;
1614}
1615
1616# ------------------------------------------------------------------------------
1617# SYNOPSIS
1618#   $string = $self->_write_makefile_vpath ();
1619#
1620# DESCRIPTION
1621#   This method returns a makefile $string for defining vpath directives.
1622# ------------------------------------------------------------------------------
1623
1624sub _write_makefile_vpath {
1625  my $self = shift;
1626
1627  my $return = '';
1628  # $name is internal name of build sub-directories
1629  # $type is the type of files
1630  for my $name (sort keys %{ $self->setting ('BLD_VPATH') }) {
1631    my @types = split (
1632      /$Fcm::Config::DELIMITER_LIST/, $self->setting ('BLD_VPATH', $name)
1633    );
1634
1635    for my $type (sort @types) {
1636      # If $type is EMPTY, it is a file with no file name extension
1637      if (uc ($type) eq 'EMPTY') {
1638        $return .= 'vpath % $(FCM_' . $name . 'PATH)' . "\n";
1639
1640      } elsif ($type =~ s/^IN://i) {
1641        # If $type begins with IN:<type>, it is a list of file extensions that
1642        # can be found under the INFILE_EXT hash in the configuration setting,
1643        # with <type> matching a keyword in the values of the hash.
1644        for my $ext (sort keys %{ $self->setting ('INFILE_EXT') }) {
1645          next if not grep {
1646            $_ eq $type
1647          } split /$Fcm::Config::DELIMITER/, $self->setting ('INFILE_EXT', $ext);
1648
1649          $return .= 'vpath %.' . $ext . ' $(FCM_' . $name . 'PATH)' . "\n";
1650        }
1651
1652      } elsif ($type =~ s/^OUT://i) {
1653        # If $type begins with OUT:<type>, it is the value of a hash element
1654        # in the OUTFILE_EXT hash in the configuration setting, with <type>
1655        # matching the key.
1656        $return .= 'vpath %' . $self->setting ('OUTFILE_EXT', $type) .
1657                   ' $(FCM_' . $name . 'PATH)' . "\n";
1658
1659      } else {
1660        # Otherwise, $type is a VPATH pattern recognised by "make".
1661        $return .= 'vpath ' . $type . ' $(FCM_' . $name . 'PATH)' . "\n";
1662      }
1663    }
1664  }
1665
1666  # VPATH for dummy files
1667  $return .= 'vpath %.dummy $(FCM_DONEDIR)' . "\n";
1668  $return .= "\n";
1669
1670  return $return;
1671}
1672
1673# ------------------------------------------------------------------------------
1674
16751;
1676
1677__END__
Note: See TracBrowser for help on using the repository browser.